summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/CSV.hs (renamed from src/csv.hs)2
-rw-r--r--src/Senate.hs159
-rw-r--r--src/SenateTypes.hs42
-rw-r--r--src/current_output.txt19
-rw-r--r--src/main.hs44
-rw-r--r--src/senate.hs28
-rw-r--r--src/senatetypes.hs28
7 files changed, 266 insertions, 56 deletions
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)]
-
generated by cgit (git 2.30.0) at 2024-11-01 16:27:43 +0000