diff options
| -rw-r--r-- | src/Senate.hs | 85 |
1 files changed, 43 insertions, 42 deletions
diff --git a/src/Senate.hs b/src/Senate.hs index ef2ed9b..40f8521 100644 --- a/src/Senate.hs +++ b/src/Senate.hs @@ -9,6 +9,7 @@ module Senate( import qualified SenateTypes as Typ import qualified CSV as CSV +import qualified Storage as Store import qualified Text.ParserCombinators.Parsec as Parsec import qualified Data.Either as Either import qualified Data.Maybe as Maybe @@ -20,15 +21,14 @@ import qualified Data.List as List type Preferences = [(Typ.Position,Typ.Ranking)] type FullPreferences = (Preferences,Preferences) -data SenateCounter = SenateCounter { prefData :: [Preferences] - , aboveMap :: Typ.AboveLineBallot - , belowMap :: Typ.BelowLineBallot } +data SenateCounter = SenateCounter { prefData :: Store.PrefStorage + , ballotMap :: Typ.BelowLineBallot + , numBallots :: Integer } headerLines = 2 -fieldsInRecord = 6 minAboveTheLine = 1 minBelowTheLine = 6 @@ -37,37 +37,34 @@ minBelowTheLine = 6 createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter createSenateCounter f a b = do + -- raw <- readFile f - let rawRecs = drop headerLines (lines raw) - parsedRecs = Either.rights (filter Either.isRight (map (CSV.parseRecord CSV.defaultSettings) rawRecs)) - rawPrefs = Either.rights (filter Either.isRight (map ((parsePreferences (length a) (length b)) . last) parsedRecs)) - normedPrefs = map Maybe.fromJust (filter Maybe.isJust (map (normalise a b) rawPrefs)) - return (SenateCounter normedPrefs a b) + let numLines = length (lines raw) + arrayData <- Store.createStorage 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) + -- + return (SenateCounter arrayData b (length normedPrefs)) doCount :: SenateCounter -> Typ.Criteria -> Int -doCount sen tr = - let fits = filter (tester (belowMap sen) tr) (prefData sen) - in length fits - - - - --- tests to see if a given set of preferences matches a specified criteria -tester :: Typ.BelowLineBallot -> Typ.Criteria -> Preferences -> Bool -tester _ [] _ = True -tester m tr p = - let result = do - index <- List.elemIndex (snd (head tr)) m - hasRank <- List.lookup (index + 1) p - if (hasRank == (fst (head tr))) - then Just True - else Nothing - in if (Maybe.isJust result) - then tester m (tail tr) p - else False +doCount sen crit = + let isValidCriteria = all ((`List.elem` (ballotMap sen)) . snd) crit + 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 @@ -77,9 +74,9 @@ normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Ma normalise a b f = let na = extractFormal (fst f) nb = extractFormal (snd f) - in if (isValidBelowPreference b nb) + in if (isValidFormal minBelowTheLine b nb) then Just nb - else if (isValidAbovePreference a na) + else if (isValidFormal minAboveTheLine a na) then Just (fromAboveToBelow a na) else Nothing @@ -98,16 +95,9 @@ extractFormal p = -isValidAbovePreference :: Typ.AboveLineBallot -> Preferences -> Bool -isValidAbovePreference a p = - (((length a) < minAboveTheLine) && ((length a) == (length p))) || ((length p) >= minAboveTheLine) - - - - -isValidBelowPreference :: Typ.BelowLineBallot -> Preferences -> Bool -isValidBelowPreference b p = - (((length b) < minBelowTheLine) && ((length b) == (length p))) || ((length p) >= minBelowTheLine) +isValidFormal :: Foldable t => Int -> t a -> Preferences -> Bool +isValidFormal minLimit ballot pref = + (length pref >= minLimit) || (length pref == length ballot) @@ -163,5 +153,16 @@ weirdRank = do -- these ranks are standins that will be filtered out -nullRank = return "-1" +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) |