Ballot counting working, but results differ slightly from AEC counts

8 files changed, 279 insertions, 56 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..a681d78
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,13 @@
+
+
+# ignore intermediate compilation files
+
+*.hi
+*.o
+
+
+# ignore any test data
+
+*.csv
+*.csv#
+
diff --git a/src/csv.hs b/src/CSV.hs
index ddef1d2..ae2bbea 100644
--- a/src/csv.hs
+++ b/src/CSV.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 module CSV(
     Settings(..),
     specialChars,
diff --git a/src/Senate.hs b/src/Senate.hs
new file mode 100644
index 0000000..21c8f4b
--- /dev/null
+++ b/src/Senate.hs
@@ -0,0 +1,159 @@
+module Senate(
+    SenateCounter,
+    createSenateCounter,
+    doCount
+    ) where
+
+
+
+
+import qualified SenateTypes as Typ
+import qualified CSV as CSV
+import qualified Text.ParserCombinators.Parsec as Parsec
+import qualified Data.Either as Either
+import qualified Data.Maybe as Maybe
+import qualified Data.List as List
+
+
+
+
+data SenateCounter = SenateCounter { inputData :: FilePath
+                                   , upperMap  :: Typ.UpperMap
+                                   , lowerMap  :: Typ.LowerMap }
+
+
+
+
+headerLines = 2
+fieldsInRecord = 6
+minBelowTheLine = 6
+
+
+
+
+createSenateCounter :: FilePath -> Typ.UpperMap -> Typ.LowerMap -> IO (Maybe SenateCounter)
+createSenateCounter f a b = do
+    raw <- readFile f
+    let recs = drop headerLines (lines raw)
+    if (and (map isValidRecord recs))
+        then return (Just (SenateCounter f a b))
+        else return Nothing
+
+
+
+
+--  preference data may contain odd symbols like '/' or '*' so
+--  testing for that stuff is relegated to when actual counts are
+--  performed, while this routine only checks that the CSV format
+--  is valid and that the required number of fields are present
+isValidRecord :: String -> Bool
+isValidRecord record =
+    case (CSV.parseRecord CSV.defaultSettings record) of
+        Left _ -> False
+        Right x -> length x == fieldsInRecord
+
+
+
+
+doCount :: SenateCounter -> Typ.Trace -> IO Int
+doCount sen tr = do
+    raw <- readFile (inputData sen)
+    let recs = drop headerLines (lines raw)
+        parsedRecs = Either.rights (map (CSV.parseRecord CSV.defaultSettings) recs)
+        prefs = Either.rights
+                    (filter Either.isRight
+                        (map ((parsePreferences
+                                (length (upperMap sen))
+                                (length (lowerMap sen))) . last)
+                            parsedRecs))
+        fits = filter (tester (lowerMap sen) tr) (map (normalise (upperMap sen) (lowerMap sen)) prefs)
+    return (length fits)
+
+
+
+
+--  tests to see if a given set of preferences matches a specified trace criteria
+tester :: Typ.LowerMap -> Typ.Trace -> Typ.BelowPreferences -> Bool
+tester _ [] _ = True
+tester m tr p =
+    let result = do
+            index <- List.elemIndex (snd (head tr)) m
+            hasRank <- List.lookup (index + 1) p
+            if (hasRank == (fst (head tr)))
+                then Just True
+                else Nothing
+    in if (Maybe.isJust result)
+        then tester m (tail tr) p
+        else False
+
+
+
+
+--  converts a set of above+below-the-line preferences to just below-the-line
+normalise :: Typ.UpperMap -> Typ.LowerMap -> Typ.FullPreferences -> Typ.BelowPreferences
+normalise a b f =
+    if (isValidBelowPreference b (snd f))
+        then (snd f)
+        else (fromAboveToBelow a (fst f))
+
+
+
+
+isValidBelowPreference :: Typ.LowerMap -> Typ.BelowPreferences -> Bool
+isValidBelowPreference b p =
+    (((length b) < minBelowTheLine) && ((length b) == (length p))) || ((length p) >= minBelowTheLine)
+
+
+
+
+fromAboveToBelow :: Typ.UpperMap -> Typ.AbovePreferences -> Typ.BelowPreferences
+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 Typ.FullPreferences
+parsePreferences a b input = Parsec.parse (preference a b) "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)) :: Typ.AbovePreferences
+        yp = (filter ((> 0) . snd) (zip [1,2..] yr)) :: Typ.BelowPreferences
+    return (xp,yp)
+
+
+rank = do
+    n <- Parsec.choice [normalRank, weirdRank, nullRank]
+    Parsec.char ','
+    return n
+
+
+normalRank = do
+    n <- Parsec.oneOf "123456789"
+    ns <- Parsec.many Parsec.digit
+    return (n:ns)
+
+
+--  currently assuming that these symbols always mean '1'
+weirdRank = do
+    Parsec.choice [Parsec.char '/', Parsec.char '*']
+    return "1"
+
+
+nullRank = return "-1"
+
diff --git a/src/SenateTypes.hs b/src/SenateTypes.hs
new file mode 100644
index 0000000..764e733
--- /dev/null
+++ b/src/SenateTypes.hs
@@ -0,0 +1,42 @@
+module SenateTypes(
+    Ranking,
+    Position,
+    CandidateID,
+    AbovePreferences,
+    BelowPreferences,
+    FullPreferences,
+    UpperMap,
+    LowerMap,
+    Trace
+    ) where
+
+
+
+--  fairly obvious, rankings, positions and candidateIDs are all numbers
+type Ranking = Int
+type Position = Int
+type CandidateID = String
+
+
+
+type AbovePreferences = [(Position,Ranking)]
+type BelowPreferences = [(Position,Ranking)]
+type FullPreferences = (AbovePreferences,BelowPreferences)
+
+
+
+--  positions in the uppermap list correspond to the boxes above the line,
+--  and the lists of candidateIDs are the boxes below the line
+type UpperMap = [[Position]]
+
+
+
+--  a list of candidates in the order of how they were placed below the line
+type LowerMap = [CandidateID]
+
+
+
+--  represents a criteria used for finding ballots that voted a specific
+--  way, for example voted for candidate C as #1, candidate F as #2, etc
+type Trace = [(Ranking,CandidateID)]
+
diff --git a/src/current_output.txt b/src/current_output.txt
new file mode 100644
index 0000000..0a99977
--- /dev/null
+++ b/src/current_output.txt
@@ -0,0 +1,19 @@
+Pile, Jan 6585
+Gimini, Jimmy 205
+Kavasilas, Andrew 4802
+Jones, Timothy 190
+Campbell, Trudy 1239
+Barry, Ian 73
+Connard, Michael 10649
+Bannister, Kathy 402
+Scullion, Nigel 36895
+Lillis, Jenni 309
+McCarthy, Malarndirri 37811
+Honan, Pat 392
+Ordish, Carol 1648
+Ordish, John 70
+Lee, TS 312
+Marshall, Tristan 187
+Ryan, Maurie Japarta 185
+MacDonald, Marney 122
+Strettles, Greg 376
diff --git a/src/main.hs b/src/main.hs
new file mode 100644
index 0000000..ecfec97
--- /dev/null
+++ b/src/main.hs
@@ -0,0 +1,44 @@
+
+
+import qualified System.Environment as Env
+import qualified Senate as Sen
+import qualified SenateTypes as Typ
+import qualified Data.Maybe as Maybe
+
+
+
+
+--  maps for NT Senate data
+--  will be removed when candidate info parsing complete
+above = [[1,2],[3,4],[5,6],[7,8],[9,10],[11,12],[13,14]]
+below = [ "Pile, Jan"
+        , "Gimini, Jimmy"
+        , "Kavasilas, Andrew"
+        , "Jones, Timothy"
+        , "Campbell, Trudy"
+        , "Barry, Ian"
+        , "Connard, Michael"
+        , "Bannister, Kathy"
+        , "Scullion, Nigel"
+        , "Lillis, Jenni"
+        , "McCarthy, Malarndirri"
+        , "Honan, Pat"
+        , "Ordish, Carol"
+        , "Ordish, John"
+        , "Lee, TS"
+        , "Marshall, Tristan"
+        , "Ryan, Maurie Japarta"
+        , "MacDonald, Marney"
+        , "Strettles, Greg" ]
+
+
+
+
+main = do
+    args <- Env.getArgs
+    counter <- Sen.createSenateCounter (head args) above below
+    let testTraces = map (:[]) (zip [1,1..] below)
+        theCounter = Maybe.fromJust counter
+        results = map (\x -> (Sen.doCount theCounter x) >>= (putStrLn . (((snd . head $ x) ++ " ") ++) . show)) testTraces
+    sequence_ results
+
diff --git a/src/senate.hs b/src/senate.hs
deleted file mode 100644
index 8f24d88..0000000
--- a/src/senate.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module Senate(
-    SenateCounter,
-    createSenateCounter,
-    doCount
-    ) where
-
-
-
-import qualified System.IO as IO
-import qualified SenateTypes as STY
-import qualified CSV as CSV
-
-
-
-data SenateCounter = SenateCounter { inputData : IO.FilePath
-                                   , upperMap  : STY.UpperMap
-                                   , lowerMap  : STY.LowerMap }
-
-
-
-createSenateCounter :: IO.FilePath -> STY.UpperMap -> STY.LowerMap -> SenateCounter
-createSenateCounter = SenateCounter
---  use this function to errorcheck the input data
-
-
-
-doCount :: SenateCounter -> STY.Trace -> Int
-
diff --git a/src/senatetypes.hs b/src/senatetypes.hs
deleted file mode 100644
index 23ef738..0000000
--- a/src/senatetypes.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module SenateTypes(
-    CandidateID,
-    UpperLowerMap
-    ) where
-
-
-
---  fairly obvious, rankings and candidateIDs are both numbers
-type Ranking = Int
-type CandidateID = Int
-
-
-
---  positions in the uppermap list correspond to the boxes above the line,
---  and the lists of candidateIDs are the boxes below the line
-type UpperMap = [[CandidateID]]
-
-
-
---  merely a list in the order of how candidates were placed below the line
-type LowerMap = [CandidateID]
-
-
-
---  represents a criteria used for finding ballots that voted a specific
---  way, for example voted for candidate C as #1, candidate F as #2, etc
-type Trace = [(Ranking,CandidateID)]
-