Should be operating at acceptable speed/memusage rates now

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