Cleaning things up, splitting code into more modules

8 files changed, 241 insertions, 161 deletions

diff --git a/makefile b/makefile
index 04001c7..9475db8 100644
--- a/makefile
+++ b/makefile
@@ -1,24 +1,11 @@
 
 
-all: main
+all: stv
 
 
 
-main:
-	ghc --make src/main.hs -isrc:build -odir build -outputdir build \
-		-hidir build -stubdir build -dumpdir build -o bin/counter
-
-
-
-#testmain: ada_array
-#	ghc --make src/testmain.hs -isrc:build -odir build -outputdir build \
-#		-hidir build -stubdir build -dumpdir build -o bin/testmain build/ada_array.o
-
-
-
-#ada_array:
-#	gnatmake -Isrc -D build -c preference_arrays
-#	gnatbind -n build/preference_arrays
-#	gnatlink -r -nostdlib -o build/ada_array.o build/preference_arrays.ali
+stv:
+	ghc -O2 --make src/main.hs -isrc:build -odir build -outputdir build \
+		-hidir build -stubdir build -dumpdir build -o bin/stv
 
 
diff --git a/notes.txt b/notes.txt
new file mode 100644
index 0000000..dc132d1
--- /dev/null
+++ b/notes.txt
@@ -0,0 +1,35 @@
+
+potential anomaly detected for
+
+Honan, Pat, NT
+	AEC count 328
+	my count 327
+
+Marshall, Tristan, NT
+	AEC count 161
+	my count 160
+
+Gallagher, Katy, ACT
+	AEC count 95749
+	my count 95748
+
+Seselja, Zed, ACT
+	AEC count 82932
+	my count 82931
+
+
+
+
+future direction
+----------------
+
+vector preference storage
+vector election data storage
+
+preference module
+candidate module
+(containing parsing functions, types, and whatnot)
+
+util to list paper ids that fit specific criteria to doublecheck potential errors
+
+
diff --git a/src/File.hs b/src/File.hs
new file mode 100644
index 0000000..e1245e8
--- /dev/null
+++ b/src/File.hs
@@ -0,0 +1,31 @@
+module File(
+    countLines
+    ) where
+
+
+
+
+import qualified System.IO as IO
+
+
+
+
+countLines :: FilePath -> IO Int
+countLines f = do
+    h <- IO.openFile f IO.ReadMode
+    e <- IO.hIsEOF h
+    if e
+        then IO.hClose h >> return 0
+        else countLinesTail h 0
+
+
+
+
+countLinesTail :: IO.Handle -> Int -> IO Int
+countLinesTail h n = do
+    t <- IO.hGetLine h
+    e <- IO.hIsEOF h
+    if e
+        then IO.hClose h >> return (n + 1)
+        else countLinesTail h (n + 1)
+
diff --git a/src/Miscellaneous.hs b/src/Miscellaneous.hs
new file mode 100644
index 0000000..94e9672
--- /dev/null
+++ b/src/Miscellaneous.hs
@@ -0,0 +1,19 @@
+module Miscellaneous(
+    if'
+    (?)
+    ) where\
+
+
+
+
+if' :: Bool -> t -> t -> t
+if' a b c = if a then b else c
+
+
+
+
+infixr 1 ?
+(?) :: Bool -> t -> t -> t
+(?) = if'
+
+
diff --git a/src/Preferences.hs b/src/Preferences.hs
new file mode 100644
index 0000000..7a67e63
--- /dev/null
+++ b/src/Preferences.hs
@@ -0,0 +1,117 @@
+module Preferences(
+    Preference,
+    FullPreferences,
+
+    normalise,
+    parsePreferences
+    ) where
+
+
+
+
+import qualified SenateTypes as Typ
+import qualified Text.ParserCombinators.Parsec as Parsec
+import qualified Data.List as List
+
+
+
+
+type Preference = (Typ.Position,Typ.Ranking)
+type FullPreferences = ([Preference],[Preference])
+
+
+
+
+minAboveTheLine = 1
+minBelowTheLine = 6
+
+
+
+
+--  converts a set of above+below-the-line preferences to just formal below-the-line
+normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Maybe [Preference]
+normalise a b f =
+    let na = extractFormal (fst f)
+        nb = extractFormal (snd f)
+    in if (isValidFormal minBelowTheLine b nb)
+            then Just nb
+            else if (isValidFormal minAboveTheLine a na)
+                    then Just (fromAboveToBelow a na)
+                    else Nothing
+
+
+
+
+extractFormal :: [Preference] -> [Preference]
+extractFormal pref =
+    let formTail n r p =
+            let (matches,rest) = List.partition ((== n) . snd) p
+            in if (p == [] || (length matches) /= 1)
+                then r
+                else formTail (n + 1) ((head matches):r) rest
+    in formTail 1 [] pref
+
+
+
+
+isValidFormal :: Foldable t => Int -> t a -> [Preference] -> Bool
+isValidFormal minLimit ballot pref =
+    (length pref >= minLimit) || (length pref == length ballot)
+
+
+
+
+--  inefficient?
+fromAboveToBelow :: Typ.AboveLineBallot -> [Preference] -> [Preference]
+fromAboveToBelow a p =
+    let sortedByRanking = List.sortBy (\x y -> compare (snd x) (snd y)) p
+        tailFunc n bp ap =
+            if (ap == [])
+                then bp
+                else let place = fst (head ap)
+                         newPrefs = zip (a !! (place - 1)) [n, n+1 ..]
+                     in tailFunc (n + length newPrefs) (bp ++ newPrefs) (tail ap)
+    in tailFunc 1 [] sortedByRanking
+
+
+
+
+--  the two int arguments are the number of boxes above the line and the number
+--  of boxes below the line respectively
+parsePreferences :: Int -> Int -> String -> Either Parsec.ParseError FullPreferences
+parsePreferences aboveBoxes belowBoxes input =
+    Parsec.parse (preference aboveBoxes belowBoxes) "error" input
+
+
+preference a b = do
+    x <- Parsec.count a rank
+    y <- Parsec.count b rank
+    Parsec.eof
+    let xr = map (read :: String -> Typ.Ranking) x
+        yr = map (read :: String -> Typ.Ranking) y
+        xp = (filter ((> 0) . snd) (zip [1,2..] xr))
+        yp = (filter ((> 0) . snd) (zip [1,2..] yr))
+    return (xp,yp)
+
+
+rank = do
+    n <- Parsec.choice [normalRank, weirdRank, nullRank]
+    Parsec.choice [Parsec.char ',' >> return (), Parsec.eof]
+    return n
+
+
+normalRank = do
+    n <- Parsec.oneOf "123456789"
+    ns <- Parsec.many Parsec.digit
+    return (n:ns)
+
+
+--  these symbols are taken to mean '1' according to AEC guidelines
+weirdRank = do
+    Parsec.choice [Parsec.char '/', Parsec.char '*']
+    return "1"
+
+
+--  these ranks are standins that will be filtered out
+nullRank = return "0"
+
diff --git a/src/Senate.hs b/src/Senate.hs
index f10aa6a..bd048b5 100644
--- a/src/Senate.hs
+++ b/src/Senate.hs
@@ -1,5 +1,6 @@
 module Senate(
     SenateCounter,
+
     createSenateCounter,
     doCount
     ) where
@@ -8,21 +9,19 @@ module Senate(
 
 
 import qualified SenateTypes 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 Text.ParserCombinators.Parsec as Parsec
-import qualified Data.Either as Either
+import qualified Data.Either.Unwrap as Either
 import qualified Data.Maybe as Maybe
 import qualified Data.List as List
 
 
 
 
-type Preferences = [(Typ.Position,Typ.Ranking)]
-type FullPreferences = (Preferences,Preferences)
-
 data SenateCounter = SenateCounter { prefData   :: Vec.Store
                                    , ballotMap  :: Typ.BelowLineBallot
                                    , numBallots :: Int }
@@ -30,30 +29,24 @@ data SenateCounter = SenateCounter { prefData   :: Vec.Store
 
 
 
-minAboveTheLine = 1
-minBelowTheLine = 6
-
-
-
-
 createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter
 createSenateCounter f a b = do
     --
-    numLines <- countLines f
+    numLines <- File.countLines f
     arrayData <- Vec.createStore numLines (length b)
     --
     h <- IO.openFile f IO.ReadMode
-    let readFunc n p h = if (n > numLines) then return p else do
+    let readFunc n p = 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]))
+                t2 = last (Either.fromRight t1)
+                t3 = Pref.parsePreferences (length a) (length b) t2
+                t4 = Pref.normalise a b (Either.fromRight 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
+                then mapM_ (Vec.setPref arrayData n) t5 >> readFunc (n + 1) (p + 1)
+                else readFunc (n + 1) p
+    p <- readFunc 1 0
     IO.hClose h
     --
     return (SenateCounter arrayData b p)
@@ -61,28 +54,15 @@ createSenateCounter f a b = do
 
 
 
-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
+doCount sen criteria = do
     --
-    let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) crit
+    let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) criteria
     --
-    let critToPref (r,c) = (Maybe.fromJust (List.elemIndex c (ballotMap sen)) + 1, r)
-        neededPrefs = map critToPref crit
+    let critToPref (a,b) = (Maybe.fromJust (List.elemIndex b (ballotMap sen)) + 1, a)
+        neededPrefs = map critToPref criteria
         checkFunc n r = if (n > (numBallots sen)) then return r else do
-            t <- Con.liftM and (mapM (uncurry (Vec.checkPref (prefData sen) n)) neededPrefs)
+            t <- Con.liftM and (mapM (Vec.checkPref (prefData sen) n) neededPrefs)
             if t then checkFunc (n + 1) (r + 1) else checkFunc (n + 1) r
     --
     if isValidCriteria
@@ -90,92 +70,3 @@ doCount sen crit = do
         else return 0
 
 
-
-
---  converts a set of above+below-the-line preferences to just formal below-the-line
-normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Maybe Preferences
-normalise a b f =
-    let na = extractFormal (fst f)
-        nb = extractFormal (snd f)
-    in if (isValidFormal minBelowTheLine b nb)
-            then Just nb
-            else if (isValidFormal minAboveTheLine a na)
-                    then Just (fromAboveToBelow a na)
-                    else Nothing
-
-
-
-
-extractFormal :: Preferences -> Preferences
-extractFormal p =
-    let funcTail n r p =
-            let (matches,rest) = List.partition ((== n) . snd) p
-            in if (p == [] || (length matches) /= 1)
-                then r
-                else funcTail (n + 1) ((head matches):r) rest
-    in funcTail 1 [] p
-
-
-
-
-isValidFormal :: Foldable t => Int -> t a -> Preferences -> Bool
-isValidFormal minLimit ballot pref =
-    (length pref >= minLimit) || (length pref == length ballot)
-
-
-
-
-fromAboveToBelow :: Typ.AboveLineBallot -> Preferences -> Preferences
-fromAboveToBelow a p =
-    let sortedByRanking = List.sortBy (\x y -> compare (snd x) (snd y)) p
-        tailFunc n bp ap =
-            if (ap == [])
-                then bp
-                else let place = fst (head ap)
-                         newPrefs = zip (a !! (place - 1)) [n, n+1 ..]
-                     in tailFunc (n + length newPrefs) (bp ++ newPrefs) (tail ap)
-    in tailFunc 1 [] sortedByRanking
-
-
-
-
---  the two int arguments are the number of boxes above the line and the number
---  of boxes below the line respectively
-parsePreferences :: Int -> Int -> String -> Either Parsec.ParseError FullPreferences
-parsePreferences aboveBoxes belowBoxes input =
-    Parsec.parse (preference aboveBoxes belowBoxes) "error" input
-
-
-preference a b = do
-    x <- Parsec.count a rank
-    y <- Parsec.count b rank
-    Parsec.eof
-    let xr = map (read :: String -> Typ.Ranking) x
-        yr = map (read :: String -> Typ.Ranking) y
-        xp = (filter ((> 0) . snd) (zip [1,2..] xr))
-        yp = (filter ((> 0) . snd) (zip [1,2..] yr))
-    return (xp,yp)
-
-
-rank = do
-    n <- Parsec.choice [normalRank, weirdRank, nullRank]
-    Parsec.choice [Parsec.char ',' >> return (), Parsec.eof]
-    return n
-
-
-normalRank = do
-    n <- Parsec.oneOf "123456789"
-    ns <- Parsec.many Parsec.digit
-    return (n:ns)
-
-
---  these symbols are taken to mean '1' according to AEC guidelines
-weirdRank = do
-    Parsec.choice [Parsec.char '/', Parsec.char '*']
-    return "1"
-
-
---  these ranks are standins that will be filtered out
-nullRank = return "0"
-
-
diff --git a/src/Storage.hs b/src/Storage.hs
index a97a5fc..75b452b 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -9,39 +9,39 @@ module Storage(
 
 
 
-import qualified Control.Monad.Primitive as Prim
+import Data.Int ( Int8 )
+import Preferences ( Preference )
 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}
+data Store = Store { getPointer    :: Vec.IOVector Int8
+                   , getBallotSize :: Int }
 
 
 
 
 createStore :: Int -> Int -> IO Store
-createStore numberOfEntries ballotSize = do
-    v <- Vec.new (numberOfEntries * ballotSize)
+createStore maxCapacity ballotSize = do
+    v <- Vec.new (maxCapacity * 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)
+setPref :: Store -> Int -> Preference -> IO ()
+setPref prefStore ballot (position,rank) = do
+    let place = (ballot - 1) * (getBallotSize prefStore) + (position - 1)
+    Vec.write (getPointer 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))
+checkPref :: Store -> Int -> Preference -> IO Bool
+checkPref prefStore ballot (position,rank) = do
+    let place = (ballot - 1) * (getBallotSize prefStore) + (position - 1)
+    value <- Vec.read (getPointer prefStore) place
+    return (value == fromIntegral rank)
 
 
diff --git a/src/main.hs b/src/main.hs
index c3db4ad..603151d 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -65,11 +65,11 @@ below2 = [ "Donnelly, Matt"
 
 main = do
     args <- Env.getArgs
-    counter <- Sen.createSenateCounter (head args) above below
-    let testTraces = (map (:[]) (zip [1,1..] below))
+    counter <- Sen.createSenateCounter (head args) above2 below2
+    let testTraces = (map (:[]) (zip [1,1..] below2))
     results <- mapM (Sen.doCount counter) testTraces
     let func (n,c) = putStrLn (c ++ " " ++ (show n))
-        output = map func (zip results below)
+        output = map func (zip results below2)
     sequence_ output