diff options
Diffstat (limited to 'src/Counter.hs')
| -rw-r--r-- | src/Counter.hs | 163 |
1 files changed, 0 insertions, 163 deletions
diff --git a/src/Counter.hs b/src/Counter.hs deleted file mode 100644 index bf2ee7e..0000000 --- a/src/Counter.hs +++ /dev/null @@ -1,163 +0,0 @@ -module Counter( - SenateCounter, - Criteria, - - createSenateCounter, - doCount, - getBallot, - getTotal, - - matchID, - matchList - ) where - - - - --- This source is licensed under Creative Commons CC0 v1.0. - --- To read the full text, see license.txt in the main directory of this repository --- or go to https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt - --- For a human readable summary, go to https://creativecommons.org/publicdomain/zero/1.0/ - - - - -import qualified Candidate 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 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 - - - - -data SenateCounter = SenateCounter - { prefData :: Vec.Store - , ballotMap :: Typ.BelowLineBallot - , numBallots :: Int } - - - - -type Criteria = [Either Typ.CandidateID [Typ.CandidateID]] - - - - -createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter -createSenateCounter f a b = do - numLines <- File.countLines f - prefStore <- Vec.createStore numLines (length b) - - h <- IO.openFile f IO.ReadMode - let readFunc n p = if (n > numLines) then return p else do - t0 <- IO.hGetLine h - let prefs = parseRawLine a b t0 - result = Maybe.fromJust prefs - if (Maybe.isJust prefs) - then Vec.setPrefs prefStore (p + 1) result >> readFunc (n + 1) (p + 1) - else readFunc (n + 1) p - p <- readFunc 1 0 - IO.hClose h - - return (SenateCounter - { prefData = prefStore - , ballotMap = b - , numBallots = p }) - - - - -parseRawLine :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> String -> Maybe [Pref.Preference] -parseRawLine a b input = - let t1 = CSV.parseRecord CSV.defaultSettings (input ++ "\n") - t2 = Maybe.listToMaybe . reverse . Either.fromRight $ t1 - t3 = Pref.parsePreferences (length a) (length b) (Maybe.fromJust t2) - t4 = Pref.normalise a b (Either.fromRight t3) - in if (Either.isRight t1 && Maybe.isJust t2 && Either.isRight t3) - then t4 - else Nothing - - - - -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 - - if (all (isValid (ballotMap sen)) criteria) - then tailFunc 1 0 - else return 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) - - - - -isValid :: Typ.BelowLineBallot -> Either Typ.CandidateID [Typ.CandidateID] -> Bool -isValid ballot (Left x) = x `elem` ballot -isValid ballot (Right xs) = all (`elem` ballot) xs - - - - -getBallot :: SenateCounter -> Typ.BelowLineBallot -getBallot = ballotMap - - - - -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 - - |