diff options
Diffstat (limited to 'src/Senate.hs')
| -rw-r--r-- | src/Senate.hs | 98 |
1 files changed, 33 insertions, 65 deletions
diff --git a/src/Senate.hs b/src/Senate.hs index b3aad8c..ef2ed9b 100644 --- a/src/Senate.hs +++ b/src/Senate.hs @@ -17,9 +17,12 @@ import qualified Data.List as List -data SenateCounter = SenateCounter { inputData :: FilePath - , upperMap :: Typ.UpperMap - , lowerMap :: Typ.LowerMap } +type Preferences = [(Typ.Position,Typ.Ranking)] +type FullPreferences = (Preferences,Preferences) + +data SenateCounter = SenateCounter { prefData :: [Preferences] + , aboveMap :: Typ.AboveLineBallot + , belowMap :: Typ.BelowLineBallot } @@ -32,49 +35,28 @@ minBelowTheLine = 6 -createSenateCounter :: FilePath -> Typ.UpperMap -> Typ.LowerMap -> IO (Maybe SenateCounter) +createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter createSenateCounter f a b = do raw <- readFile f - let recs = drop headerLines (lines raw) - if (and (map isValidRecord recs)) - then return (Just (SenateCounter f a b)) - else return Nothing - - - + 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) --- preference data may contain odd symbols like '/' or '*' so --- testing for that stuff is relegated to when actual counts are --- performed, while this routine only checks that the CSV format --- is valid and that the required number of fields are present -isValidRecord :: String -> Bool -isValidRecord record = - case (CSV.parseRecord CSV.defaultSettings record) of - Left _ -> False - Right x -> length x == fieldsInRecord +doCount :: SenateCounter -> Typ.Criteria -> Int +doCount sen tr = + let fits = filter (tester (belowMap sen) tr) (prefData sen) + in length fits -doCount :: SenateCounter -> Typ.Trace -> IO Int -doCount sen tr = do - raw <- readFile (inputData sen) - let recs = drop headerLines (lines raw) - parsedRecs = Either.rights (map (CSV.parseRecord CSV.defaultSettings) recs) - prefs = Either.rights - (filter Either.isRight - (map ((parsePreferences - (length (upperMap sen)) - (length (lowerMap sen))) . last) - parsedRecs)) - fits = filter (tester (lowerMap sen) tr) (map (normalise (upperMap sen) (lowerMap sen)) prefs) - return (length fits) - --- tests to see if a given set of preferences matches a specified trace criteria -tester :: Typ.LowerMap -> Typ.Trace -> Typ.BelowPreferences -> Bool +-- 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 @@ -90,36 +72,22 @@ tester m tr p = --- converts a set of above+below-the-line preferences to just below-the-line -normalise :: Typ.UpperMap -> Typ.LowerMap -> Typ.FullPreferences -> Typ.BelowPreferences +-- converts a set of above+below-the-line preferences to just formal below-the-line +normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Maybe Preferences normalise a b f = - let na = normaliseAbove (fst f) - nb = normaliseBelow (snd f) + let na = extractFormal (fst f) + nb = extractFormal (snd f) in if (isValidBelowPreference b nb) - then nb + then Just nb else if (isValidAbovePreference a na) - then (fromAboveToBelow a na) - else [] -- empty preference if both above/below are invalid - - - - --- this needs to be merged with normaliseBelow -normaliseAbove :: Typ.AbovePreferences -> Typ.AbovePreferences -normaliseAbove p = - let funcTail n r p = - let (matches,rest) = List.partition ((== n) . snd) p - in if (p == [] || (length matches) /= 1) - then r - else funcTail (n + 1) ((head matches):r) rest - in funcTail 1 [] p + then Just (fromAboveToBelow a na) + else Nothing --- this needs to be merged with normaliseAbove -normaliseBelow :: Typ.BelowPreferences -> Typ.BelowPreferences -normaliseBelow p = +extractFormal :: Preferences -> Preferences +extractFormal p = let funcTail n r p = let (matches,rest) = List.partition ((== n) . snd) p in if (p == [] || (length matches) /= 1) @@ -130,21 +98,21 @@ normaliseBelow p = -isValidAbovePreference :: Typ.UpperMap -> Typ.AbovePreferences -> Bool +isValidAbovePreference :: Typ.AboveLineBallot -> Preferences -> Bool isValidAbovePreference a p = (((length a) < minAboveTheLine) && ((length a) == (length p))) || ((length p) >= minAboveTheLine) -isValidBelowPreference :: Typ.LowerMap -> Typ.BelowPreferences -> Bool +isValidBelowPreference :: Typ.BelowLineBallot -> Preferences -> Bool isValidBelowPreference b p = (((length b) < minBelowTheLine) && ((length b) == (length p))) || ((length p) >= minBelowTheLine) -fromAboveToBelow :: Typ.UpperMap -> Typ.AbovePreferences -> Typ.BelowPreferences +fromAboveToBelow :: Typ.AboveLineBallot -> Preferences -> Preferences fromAboveToBelow a p = let sortedByRanking = List.sortBy (\x y -> compare (snd x) (snd y)) p tailFunc n bp ap = @@ -160,7 +128,7 @@ fromAboveToBelow a p = -- the two int arguments are the number of boxes above the line and the number -- of boxes below the line respectively -parsePreferences :: Int -> Int -> String -> Either Parsec.ParseError Typ.FullPreferences +parsePreferences :: Int -> Int -> String -> Either Parsec.ParseError FullPreferences parsePreferences aboveBoxes belowBoxes input = Parsec.parse (preference aboveBoxes belowBoxes) "error" input @@ -171,8 +139,8 @@ preference a b = do Parsec.eof let xr = map (read :: String -> Typ.Ranking) x yr = map (read :: String -> Typ.Ranking) y - xp = (filter ((> 0) . snd) (zip [1,2..] xr)) :: Typ.AbovePreferences - yp = (filter ((> 0) . snd) (zip [1,2..] yr)) :: Typ.BelowPreferences + xp = (filter ((> 0) . snd) (zip [1,2..] xr)) + yp = (filter ((> 0) . snd) (zip [1,2..] yr)) return (xp,yp) |