diff options
author | Jed Barber <jjbarber@y7mail.com> | 2017-01-10 01:01:24 +1100 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2017-01-10 01:01:24 +1100 |
commit | c0d0b285cf2a6d6151e66148a022d67d46daca31 (patch) | |
tree | 231ea6c982cd98c06d535ca03f48607fc0ec5827 | |
parent | 50adbf5cdf9ef6924c47b6738dfd6139d19a0438 (diff) |
Candidate info parsing added, fixed potential bug in Counter construction
-rw-r--r-- | src/Candidate.hs | 85 | ||||
-rw-r--r-- | src/Counter.hs (renamed from src/Senate.hs) | 10 | ||||
-rw-r--r-- | src/Miscellaneous.hs | 33 | ||||
-rw-r--r-- | src/Preferences.hs | 2 | ||||
-rw-r--r-- | src/SenateTypes.hs | 34 | ||||
-rw-r--r-- | src/main.hs | 4 |
6 files changed, 123 insertions, 45 deletions
diff --git a/src/Candidate.hs b/src/Candidate.hs new file mode 100644 index 0000000..e779051 --- /dev/null +++ b/src/Candidate.hs @@ -0,0 +1,85 @@ +module Candidate( + Ranking, + Position, + CandidateID, + AboveLineBallot, + BelowLineBallot, + Criteria, + + readCandidates + ) where + + + + +import qualified CSV as CSV +import qualified Miscellaneous as Misc +import qualified System.IO as IO +import qualified Data.List as List +import qualified Data.Either.Unwrap as Either +import qualified Data.Maybe as Maybe +import qualified Data.Char as Char + + + + +type Ranking = Int +type Position = Int +type CandidateID = String + +-- positions in the uppermap list correspond to the boxes above the line, +-- and the lists of candidateIDs are the boxes below the line +type AboveLineBallot = [[Position]] + +-- a list of candidates in the order of how they were placed below the line +type BelowLineBallot = [CandidateID] + +-- represents a criteria used for finding ballots that voted a specific +-- way, for example voted for candidate C as #1, candidate F as #2, etc +type Criteria = [(Ranking,CandidateID)] + + + + +readCandidates :: FilePath -> String -> IO (AboveLineBallot, BelowLineBallot) +readCandidates inputFile state = do + h <- IO.openFile inputFile IO.ReadMode + -- + e <- IO.hIsEOF h + let readFunc r c = if c then return r else do + t0 <- IO.hGetLine h + let t1 = CSV.parseRecord CSV.defaultSettings t0 + t2 = Misc.selectFrom [5,6,7,8,9] [(2,"S"),(3,state)] (Either.fromRight t1) + t3 = Maybe.fromJust t2 + tx <- IO.hIsEOF h + if (Either.isRight t1) && (Maybe.isJust t2) + then readFunc (t3:r) tx + else readFunc r tx + raw <- readFunc [] e >>= return . (List.sort) + IO.hClose h + -- + return (makeAboveBallot raw, makeBelowBallot raw) + + + + +-- very hacky, pls revise +makeAboveBallot :: [[String]] -> AboveLineBallot +makeAboveBallot input = + let comp x y = (head x) == (head y) + grouped = List.groupBy comp (filter ((/= "UG") . head) input) + numFunc n r t = + if (t == []) + then r + else numFunc (n + (length (head t))) (r ++ [(map fst (zip [n, n+1 ..] (head t)))]) (tail t) + in numFunc (fromIntegral 1) [] grouped + + + + +makeBelowBallot :: [[String]] -> BelowLineBallot +makeBelowBallot input = + let f (_:_:c:d:e:[]) = d ++ " " ++ c ++ ", " ++ e + in map f input + + diff --git a/src/Senate.hs b/src/Counter.hs index bd048b5..6646133 100644 --- a/src/Senate.hs +++ b/src/Counter.hs @@ -1,4 +1,4 @@ -module Senate( +module Counter( SenateCounter, createSenateCounter, @@ -8,7 +8,7 @@ module Senate( -import qualified SenateTypes as Typ +import qualified Candidate as Typ import qualified Preferences as Pref import qualified CSV as CSV import qualified Storage as Vec @@ -39,11 +39,11 @@ createSenateCounter f a b = do let readFunc n p = if (n > numLines) then return p else do t0 <- IO.hGetLine h let t1 = CSV.parseRecord CSV.defaultSettings t0 - t2 = last (Either.fromRight t1) - t3 = Pref.parsePreferences (length a) (length b) t2 + t2 = Maybe.listToMaybe . reverse . Either.fromRight $ t1 + t3 = Pref.parsePreferences (length a) (length b) (Maybe.fromJust t2) t4 = Pref.normalise a b (Either.fromRight t3) t5 = Maybe.fromJust t4 - if (Either.isRight t1) && (Either.isRight t3) && (Maybe.isJust t4) + if (Either.isRight t1) && (Maybe.isJust t2) && (Either.isRight t3) && (Maybe.isJust t4) then mapM_ (Vec.setPref arrayData n) t5 >> readFunc (n + 1) (p + 1) else readFunc (n + 1) p p <- readFunc 1 0 diff --git a/src/Miscellaneous.hs b/src/Miscellaneous.hs index 94e9672..de20a3d 100644 --- a/src/Miscellaneous.hs +++ b/src/Miscellaneous.hs @@ -1,7 +1,15 @@ module Miscellaneous( - if' - (?) - ) where\ + if', + (?), + selectFrom + ) where + + + + +import Control.Monad as Con +import qualified Data.List as List +import qualified Data.Maybe as Maybe @@ -17,3 +25,22 @@ infixr 1 ? (?) = if' + +-- kinda functions like poor man's sql +-- first argument is the indices of the items you want in the results +-- second argument is index-item pairs to dictate what records are acceptable to select from +-- third argument is the list of items that makes up the record under consideration +-- then if the record was deemed acceptable you get the bits you wanted +-- (note that all indices start from 1) +selectFrom :: (Num t, Eq t, Eq a, Enum t) => [t] -> [(t,a)] -> [a] -> Maybe [a] +selectFrom pick has from = + let tailFunc r i = + let check = List.lookup (fst i) has + in if (Maybe.isNothing check || Maybe.fromJust check == snd i) + then if (List.elem (fst i) pick) + then Just (r ++ [snd i]) + else Just r + else Nothing + in Con.foldM tailFunc [] (zip [1,2..] from) + + diff --git a/src/Preferences.hs b/src/Preferences.hs index 7a67e63..4fee0bc 100644 --- a/src/Preferences.hs +++ b/src/Preferences.hs @@ -9,7 +9,7 @@ module Preferences( -import qualified SenateTypes as Typ +import qualified Candidate as Typ import qualified Text.ParserCombinators.Parsec as Parsec import qualified Data.List as List diff --git a/src/SenateTypes.hs b/src/SenateTypes.hs deleted file mode 100644 index 3691034..0000000 --- a/src/SenateTypes.hs +++ /dev/null @@ -1,34 +0,0 @@ -module SenateTypes( - Ranking, - Position, - CandidateID, - AboveLineBallot, - BelowLineBallot, - Criteria - ) where - - - - --- fairly obvious, rankings, positions and candidateIDs are all numbers -type Ranking = Int -type Position = Int -type CandidateID = String - - - --- positions in the uppermap list correspond to the boxes above the line, --- and the lists of candidateIDs are the boxes below the line -type AboveLineBallot = [[Position]] - - - --- a list of candidates in the order of how they were placed below the line -type BelowLineBallot = [CandidateID] - - - --- represents a criteria used for finding ballots that voted a specific --- way, for example voted for candidate C as #1, candidate F as #2, etc -type Criteria = [(Ranking,CandidateID)] - diff --git a/src/main.hs b/src/main.hs index 603151d..9effc4a 100644 --- a/src/main.hs +++ b/src/main.hs @@ -1,8 +1,8 @@ import qualified System.Environment as Env -import qualified Senate as Sen -import qualified SenateTypes as Typ +import qualified Counter as Sen +import qualified Candidate as Typ import qualified Data.Maybe as Maybe |