summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2017-01-08 23:49:21 +1100
committerJed Barber <jjbarber@y7mail.com>2017-01-08 23:49:21 +1100
commit82cb1c4265c0c4a55fcd3fec9bcaec6647d11030 (patch)
tree07f226d863fee627f20fd5a1713290b4c2379ff0 /src
parent1652e49e17e4f4dead4bd23694a2b99a06048023 (diff)
Should be operating at acceptable speed/memusage rates now
Diffstat (limited to 'src')
-rw-r--r--src/Senate.hs81
-rw-r--r--src/Storage.hs47
-rw-r--r--src/main.hs6
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