diff options
Diffstat (limited to 'src/Senate.hs')
| -rw-r--r-- | src/Senate.hs | 81 |
1 files changed, 47 insertions, 34 deletions
diff --git a/src/Senate.hs b/src/Senate.hs index 40f8521..f10aa6a 100644 --- a/src/Senate.hs +++ b/src/Senate.hs @@ -9,7 +9,9 @@ module Senate( import qualified SenateTypes as Typ import qualified CSV as CSV -import qualified Storage as Store +import qualified Storage as Vec +import qualified System.IO as IO +import qualified Control.Monad as Con import qualified Text.ParserCombinators.Parsec as Parsec import qualified Data.Either as Either import qualified Data.Maybe as Maybe @@ -21,14 +23,13 @@ import qualified Data.List as List type Preferences = [(Typ.Position,Typ.Ranking)] type FullPreferences = (Preferences,Preferences) -data SenateCounter = SenateCounter { prefData :: Store.PrefStorage +data SenateCounter = SenateCounter { prefData :: Vec.Store , ballotMap :: Typ.BelowLineBallot - , numBallots :: Integer } + , numBallots :: Int } -headerLines = 2 minAboveTheLine = 1 minBelowTheLine = 6 @@ -38,33 +39,55 @@ minBelowTheLine = 6 createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter createSenateCounter f a b = do -- - raw <- readFile f - let numLines = length (lines raw) - arrayData <- Store.createStorage numLines (length b) + numLines <- countLines f + arrayData <- Vec.createStore numLines (length b) -- - raw2 <- readFile f - let rawRecs = drop headerLines (lines raw2) - parsedRecs = fromRights (map (CSV.parseRecord CSV.defaultSettings) rawRecs) - rawPrefs = map last parsedRecs - parsedPrefs = fromRights (map (parsePreferences (length a) (length b)) rawPrefs) - normedPrefs = fromJusts (map (normalise a b) parsedPrefs) - addToArray x (n,p) = mapM_ (uncurry (Store.pokePref x n)) p - mapM_ (addToArray arrayData) (zip [1,2..] normedPrefs) + h <- IO.openFile f IO.ReadMode + let readFunc n p h = if (n > numLines) then return p else do + t0 <- IO.hGetLine h + let t1 = CSV.parseRecord CSV.defaultSettings t0 + t2 = last (head (Either.rights [t1])) + t3 = parsePreferences (length a) (length b) t2 + t4 = normalise a b (head (Either.rights [t3])) + t5 = Maybe.fromJust t4 + if (Either.isRight t1) && (Either.isRight t3) && (Maybe.isJust t4) + then (mapM_ (uncurry (Vec.setPref arrayData n)) t5) >> (readFunc (n + 1) (p + 1) h) + else readFunc (n + 1) p h + p <- readFunc 1 0 h + IO.hClose h -- - return (SenateCounter arrayData b (length normedPrefs)) + return (SenateCounter arrayData b p) -doCount :: SenateCounter -> Typ.Criteria -> Int -doCount sen crit = - let isValidCriteria = all ((`List.elem` (ballotMap sen)) . snd) crit - critToPref (r,c) = (Maybe.fromJust (List.elemIndex c (ballotMap sen)) + 1, r) +countLines :: FilePath -> IO Int +countLines f = do + let tailFunc x h = do + t <- IO.hGetLine h + e <- IO.hIsEOF h + if e then (IO.hClose h >> return (x + 1)) else tailFunc (x + 1) h + h <- IO.openFile f IO.ReadMode + e <- IO.hIsEOF h + if e then (IO.hClose h >> return 0) else tailFunc 0 h + + + + +doCount :: SenateCounter -> Typ.Criteria -> IO Int +doCount sen crit = do + -- + let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) crit + -- + let critToPref (r,c) = (Maybe.fromJust (List.elemIndex c (ballotMap sen)) + 1, r) neededPrefs = map critToPref crit - papers = map (Store.peekPref (prefData sen)) [1 .. (numBallots sen)] - check paper = all (> 0) (map (uncurry paper) neededPrefs) - result = filter id check papers - in if isValidCriteria then (length result) else 0 + checkFunc n r = if (n > (numBallots sen)) then return r else do + t <- Con.liftM and (mapM (uncurry (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 @@ -156,13 +179,3 @@ weirdRank = do nullRank = return "0" - - --- utility functions -fromJusts :: [Maybe a] -> [a] -fromJusts = (map Maybe.fromJust) . (filter Maybe.isJust) - - -fromRights :: [Either a b] -> [b] -fromRights = Either.rights . (filter Either.isRight) - |