From c0d0b285cf2a6d6151e66148a022d67d46daca31 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 10 Jan 2017 01:01:24 +1100 Subject: Candidate info parsing added, fixed potential bug in Counter construction --- src/Candidate.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Counter.hs | 72 ++++++++++++++++++++++++++++++++++++++++++++ src/Miscellaneous.hs | 33 ++++++++++++++++++-- src/Preferences.hs | 2 +- src/Senate.hs | 72 -------------------------------------------- src/SenateTypes.hs | 34 --------------------- src/main.hs | 4 +-- 7 files changed, 190 insertions(+), 112 deletions(-) create mode 100644 src/Candidate.hs create mode 100644 src/Counter.hs delete mode 100644 src/Senate.hs delete mode 100644 src/SenateTypes.hs 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/Counter.hs b/src/Counter.hs new file mode 100644 index 0000000..6646133 --- /dev/null +++ b/src/Counter.hs @@ -0,0 +1,72 @@ +module Counter( + SenateCounter, + + createSenateCounter, + doCount + ) where + + + + +import qualified Candidate as Typ +import qualified Preferences as Pref +import qualified CSV as CSV +import qualified Storage as Vec +import qualified System.IO as IO +import qualified File as File +import qualified Control.Monad as Con +import qualified Data.Either.Unwrap as Either +import qualified Data.Maybe as Maybe +import qualified Data.List as List + + + + +data SenateCounter = SenateCounter { prefData :: Vec.Store + , ballotMap :: Typ.BelowLineBallot + , numBallots :: Int } + + + + +createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter +createSenateCounter f a b = do + -- + numLines <- File.countLines f + arrayData <- Vec.createStore numLines (length b) + -- + h <- IO.openFile f IO.ReadMode + let readFunc n p = if (n > numLines) then return p else do + t0 <- IO.hGetLine h + let t1 = CSV.parseRecord CSV.defaultSettings t0 + 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) && (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 + IO.hClose h + -- + return (SenateCounter arrayData b p) + + + + +doCount :: SenateCounter -> Typ.Criteria -> IO Int +doCount sen criteria = do + -- + let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) criteria + -- + let critToPref (a,b) = (Maybe.fromJust (List.elemIndex b (ballotMap sen)) + 1, a) + neededPrefs = map critToPref criteria + checkFunc n r = if (n > (numBallots sen)) then return r else do + t <- Con.liftM and (mapM (Vec.checkPref (prefData sen) n) neededPrefs) + if t then checkFunc (n + 1) (r + 1) else checkFunc (n + 1) r + -- + if isValidCriteria + then checkFunc 1 0 + else return 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/Senate.hs b/src/Senate.hs deleted file mode 100644 index bd048b5..0000000 --- a/src/Senate.hs +++ /dev/null @@ -1,72 +0,0 @@ -module Senate( - SenateCounter, - - createSenateCounter, - doCount - ) where - - - - -import qualified SenateTypes as Typ -import qualified Preferences as Pref -import qualified CSV as CSV -import qualified Storage as Vec -import qualified System.IO as IO -import qualified File as File -import qualified Control.Monad as Con -import qualified Data.Either.Unwrap as Either -import qualified Data.Maybe as Maybe -import qualified Data.List as List - - - - -data SenateCounter = SenateCounter { prefData :: Vec.Store - , ballotMap :: Typ.BelowLineBallot - , numBallots :: Int } - - - - -createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter -createSenateCounter f a b = do - -- - numLines <- File.countLines f - arrayData <- Vec.createStore numLines (length b) - -- - h <- IO.openFile f IO.ReadMode - 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 - t4 = Pref.normalise a b (Either.fromRight t3) - t5 = Maybe.fromJust t4 - if (Either.isRight t1) && (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 - IO.hClose h - -- - return (SenateCounter arrayData b p) - - - - -doCount :: SenateCounter -> Typ.Criteria -> IO Int -doCount sen criteria = do - -- - let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) criteria - -- - let critToPref (a,b) = (Maybe.fromJust (List.elemIndex b (ballotMap sen)) + 1, a) - neededPrefs = map critToPref criteria - checkFunc n r = if (n > (numBallots sen)) then return r else do - t <- Con.liftM and (mapM (Vec.checkPref (prefData sen) n) neededPrefs) - if t then checkFunc (n + 1) (r + 1) else checkFunc (n + 1) r - -- - if isValidCriteria - then checkFunc 1 0 - else return 0 - - 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 -- cgit