diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Senate.hs | 81 | ||||
| -rw-r--r-- | src/Storage.hs | 47 | ||||
| -rw-r--r-- | src/main.hs | 6 |
3 files changed, 98 insertions, 36 deletions
diff --git a/src/Senate.hs b/src/Senate.hs index 40f8521..f10aa6a 100644 --- a/src/Senate.hs +++ b/src/Senate.hs @@ -9,7 +9,9 @@ module Senate( import qualified SenateTypes as Typ import qualified CSV as CSV -import qualified Storage as Store +import qualified Storage as Vec +import qualified System.IO as IO +import qualified Control.Monad as Con import qualified Text.ParserCombinators.Parsec as Parsec import qualified Data.Either as Either import qualified Data.Maybe as Maybe @@ -21,14 +23,13 @@ import qualified Data.List as List type Preferences = [(Typ.Position,Typ.Ranking)] type FullPreferences = (Preferences,Preferences) -data SenateCounter = SenateCounter { prefData :: Store.PrefStorage +data SenateCounter = SenateCounter { prefData :: Vec.Store , ballotMap :: Typ.BelowLineBallot - , numBallots :: Integer } + , numBallots :: Int } -headerLines = 2 minAboveTheLine = 1 minBelowTheLine = 6 @@ -38,33 +39,55 @@ minBelowTheLine = 6 createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter createSenateCounter f a b = do -- - raw <- readFile f - let numLines = length (lines raw) - arrayData <- Store.createStorage numLines (length b) + numLines <- countLines f + arrayData <- Vec.createStore 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) + h <- IO.openFile f IO.ReadMode + let readFunc n p h = 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])) + 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 + IO.hClose h -- - return (SenateCounter arrayData b (length normedPrefs)) + return (SenateCounter arrayData b p) -doCount :: SenateCounter -> Typ.Criteria -> Int -doCount sen crit = - let isValidCriteria = all ((`List.elem` (ballotMap sen)) . snd) crit - critToPref (r,c) = (Maybe.fromJust (List.elemIndex c (ballotMap sen)) + 1, r) +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 + -- + let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) crit + -- + let 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 + checkFunc n r = if (n > (numBallots sen)) then return r else do + t <- Con.liftM and (mapM (uncurry (Vec.checkPref (prefData sen) n)) neededPrefs) + if t then checkFunc (n + 1) (r + 1) else checkFunc (n + 1) r + -- + if isValidCriteria + then checkFunc 1 0 + else return 0 @@ -156,13 +179,3 @@ weirdRank = do 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) - diff --git a/src/Storage.hs b/src/Storage.hs new file mode 100644 index 0000000..a97a5fc --- /dev/null +++ b/src/Storage.hs @@ -0,0 +1,47 @@ +module Storage( + Store, + + createStore, + setPref, + checkPref + ) where + + + + +import qualified Control.Monad.Primitive as Prim +import qualified Data.Vector.Unboxed.Mutable as Vec +import qualified Data.Int as Ints + + + + +data Store = Store { pointer :: Vec.MVector Prim.RealWorld Ints.Int8 + , sizeOfBallot :: Int} + + + + +createStore :: Int -> Int -> IO Store +createStore numberOfEntries ballotSize = do + v <- Vec.new (numberOfEntries * ballotSize) + return (Store v ballotSize) + + + + +setPref :: Store -> Int -> Int -> Int -> IO () +setPref prefStore ballot position rank = do + let place = (ballot - 1) * (sizeOfBallot prefStore) + (position - 1) + Vec.write (pointer prefStore) place (fromIntegral rank) + + + + +checkPref :: Store -> Int -> Int -> Int -> IO Bool +checkPref prefStore ballot position rank = do + let place = (ballot - 1) * (sizeOfBallot prefStore) + (position - 1) + value <- Vec.read (pointer prefStore) place + return (value == (fromIntegral rank)) + + diff --git a/src/main.hs b/src/main.hs index 6e95f2a..c3db4ad 100644 --- a/src/main.hs +++ b/src/main.hs @@ -67,7 +67,9 @@ main = do args <- Env.getArgs counter <- Sen.createSenateCounter (head args) above below let testTraces = (map (:[]) (zip [1,1..] below)) - results = map (\x -> putStrLn . (((snd . head $ x) ++ " ") ++) . show . (Sen.doCount counter) $ x) testTraces - sequence_ results + results <- mapM (Sen.doCount counter) testTraces + let func (n,c) = putStrLn (c ++ " " ++ (show n)) + output = map func (zip results below) + sequence_ output |