diff options
Diffstat (limited to 'src/Counter.hs')
-rw-r--r-- | src/Counter.hs | 70 |
1 files changed, 60 insertions, 10 deletions
diff --git a/src/Counter.hs b/src/Counter.hs index 855b266..0f3e0d9 100644 --- a/src/Counter.hs +++ b/src/Counter.hs @@ -1,10 +1,14 @@ module Counter( SenateCounter, + Criteria, createSenateCounter, doCount, getBallot, - getTotal + getTotal, + + matchID, + matchList ) where @@ -12,7 +16,6 @@ module Counter( import qualified Candidate as Typ import qualified Preferences as Pref -import qualified Criteria as Crit import qualified CSV as CSV import qualified Storage as Vec import qualified System.IO as IO @@ -21,6 +24,8 @@ import qualified Control.Monad as Con import qualified Data.Either.Unwrap as Either import qualified Data.Maybe as Maybe import qualified Data.List as List +import Data.Array ( (!) ) +import qualified Data.Array as Arr @@ -33,6 +38,11 @@ data SenateCounter = SenateCounter +type Criteria = [Either Typ.CandidateID [Typ.CandidateID]] + + + + createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter createSenateCounter f a b = do numLines <- File.countLines f @@ -67,14 +77,42 @@ parseRawLine a b input = -doCount :: SenateCounter -> Crit.Criteria -> IO Int -doCount sen criteria = - let tailFunc n r = if (n > numBallots sen) then return r else do - prefs <- Vec.getPrefs (prefData sen) n - if (Crit.evaluate (ballotMap sen) prefs criteria) - then tailFunc (n + 1) (r + 1) - else tailFunc (n + 1) r - in tailFunc 1 0 +doCount :: SenateCounter -> Criteria -> IO Int +doCount sen criteria = do + let checkList = map (toInternal (ballotMap sen)) criteria + upperBound = length checkList + checkArray = Arr.listArray (1,upperBound) checkList + + testFunc bal check rank = if (check > upperBound) then return True else do + case (checkArray ! check) of + Left x -> do + r <- Vec.checkPref (prefData sen) bal (x,rank) + if r + then testFunc bal (check + 1) (rank + 1) + else return False + Right xs -> do + rs <- mapM (\p -> Vec.checkPref (prefData sen) bal (p,rank)) xs + if (or rs) + then testFunc bal check (rank + 1) + else testFunc bal (check + 1) rank + + tailFunc n p = if (n > numBallots sen) then return p else do + r <- testFunc n 1 1 + if r then tailFunc (n + 1) (p + 1) else tailFunc (n + 1) p + + tailFunc 1 0 + + + + +toInternal :: Typ.BelowLineBallot -> Either Typ.CandidateID [Typ.CandidateID] -> Either Typ.Position (Arr.Array Int Typ.Position) +toInternal ballot (Left c) = + let r = Maybe.fromJust (List.elemIndex c ballot) + in Left (r + 1) +toInternal ballot (Right cs) = + let f x = Maybe.fromJust (List.elemIndex x ballot) + r = map ((+ 1) . f) cs + in Right (Arr.listArray (1,length r) r) @@ -89,3 +127,15 @@ getTotal :: SenateCounter -> Int getTotal = numBallots + + +matchID :: Typ.CandidateID -> Either Typ.CandidateID [Typ.CandidateID] +matchID = Left + + + + +matchList :: [Typ.CandidateID] -> Either Typ.CandidateID [Typ.CandidateID] +matchList = Right + + |