summaryrefslogtreecommitdiff
path: root/src/Senate.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Senate.hs')
-rw-r--r--src/Senate.hs143
1 files changed, 17 insertions, 126 deletions
diff --git a/src/Senate.hs b/src/Senate.hs
index f10aa6a..bd048b5 100644
--- a/src/Senate.hs
+++ b/src/Senate.hs
@@ -1,5 +1,6 @@
module Senate(
SenateCounter,
+
createSenateCounter,
doCount
) where
@@ -8,21 +9,19 @@ module Senate(
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 Text.ParserCombinators.Parsec as Parsec
-import qualified Data.Either as Either
+import qualified Data.Either.Unwrap as Either
import qualified Data.Maybe as Maybe
import qualified Data.List as List
-type Preferences = [(Typ.Position,Typ.Ranking)]
-type FullPreferences = (Preferences,Preferences)
-
data SenateCounter = SenateCounter { prefData :: Vec.Store
, ballotMap :: Typ.BelowLineBallot
, numBallots :: Int }
@@ -30,30 +29,24 @@ data SenateCounter = SenateCounter { prefData :: Vec.Store
-minAboveTheLine = 1
-minBelowTheLine = 6
-
-
-
-
createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter
createSenateCounter f a b = do
--
- numLines <- countLines f
+ numLines <- File.countLines f
arrayData <- Vec.createStore numLines (length b)
--
h <- IO.openFile f IO.ReadMode
- let readFunc n p h = if (n > numLines) then return p else do
+ 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 (head (Either.rights [t1]))
- t3 = parsePreferences (length a) (length b) t2
- t4 = normalise a b (head (Either.rights [t3]))
+ 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_ (uncurry (Vec.setPref arrayData n)) t5) >> (readFunc (n + 1) (p + 1) h)
- else readFunc (n + 1) p h
- p <- readFunc 1 0 h
+ 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)
@@ -61,28 +54,15 @@ createSenateCounter f a b = do
-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
+doCount sen criteria = do
--
- let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) crit
+ let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) criteria
--
- let critToPref (r,c) = (Maybe.fromJust (List.elemIndex c (ballotMap sen)) + 1, r)
- neededPrefs = map critToPref crit
+ 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 (uncurry (Vec.checkPref (prefData sen) n)) neededPrefs)
+ 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
@@ -90,92 +70,3 @@ doCount sen crit = do
else return 0
-
-
--- 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 = extractFormal (fst f)
- nb = extractFormal (snd f)
- in if (isValidFormal minBelowTheLine b nb)
- then Just nb
- else if (isValidFormal minAboveTheLine a na)
- then Just (fromAboveToBelow a na)
- else Nothing
-
-
-
-
-extractFormal :: Preferences -> Preferences
-extractFormal 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
-
-
-
-
-isValidFormal :: Foldable t => Int -> t a -> Preferences -> Bool
-isValidFormal minLimit ballot pref =
- (length pref >= minLimit) || (length pref == length ballot)
-
-
-
-
-fromAboveToBelow :: Typ.AboveLineBallot -> Preferences -> Preferences
-fromAboveToBelow a p =
- let sortedByRanking = List.sortBy (\x y -> compare (snd x) (snd y)) p
- tailFunc n bp ap =
- if (ap == [])
- then bp
- else let place = fst (head ap)
- newPrefs = zip (a !! (place - 1)) [n, n+1 ..]
- in tailFunc (n + length newPrefs) (bp ++ newPrefs) (tail ap)
- in tailFunc 1 [] sortedByRanking
-
-
-
-
--- 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 FullPreferences
-parsePreferences aboveBoxes belowBoxes input =
- Parsec.parse (preference aboveBoxes belowBoxes) "error" input
-
-
-preference a b = do
- x <- Parsec.count a rank
- y <- Parsec.count b rank
- 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))
- yp = (filter ((> 0) . snd) (zip [1,2..] yr))
- return (xp,yp)
-
-
-rank = do
- n <- Parsec.choice [normalRank, weirdRank, nullRank]
- Parsec.choice [Parsec.char ',' >> return (), Parsec.eof]
- return n
-
-
-normalRank = do
- n <- Parsec.oneOf "123456789"
- ns <- Parsec.many Parsec.digit
- return (n:ns)
-
-
--- these symbols are taken to mean '1' according to AEC guidelines
-weirdRank = do
- Parsec.choice [Parsec.char '/', Parsec.char '*']
- return "1"
-
-
--- these ranks are standins that will be filtered out
-nullRank = return "0"
-
-
generated by cgit (git 2.30.0) at 2024-05-10 02:13:19 +0000