summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Senate.hs85
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)