summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2017-01-06 15:04:20 +1100
committerJed Barber <jjbarber@y7mail.com>2017-01-06 15:04:20 +1100
commit93a9b586e82b5d113d9140ceac95acabc7d51917 (patch)
treeecfc00f7e7396c9d7ef194a39e3ee8a6fcac0d6f
parented35d03fbdafce4d6d41d8731318304a8eb7ff61 (diff)
Count results now line up with AEC distribution of preferences
-rw-r--r--src/Senate.hs52
-rw-r--r--src/current_output.txt19
-rw-r--r--src/main.hs6
3 files changed, 52 insertions, 25 deletions
diff --git a/src/Senate.hs b/src/Senate.hs
index 21c8f4b..b3aad8c 100644
--- a/src/Senate.hs
+++ b/src/Senate.hs
@@ -26,6 +26,7 @@ data SenateCounter = SenateCounter { inputData :: FilePath
headerLines = 2
fieldsInRecord = 6
+minAboveTheLine = 1
minBelowTheLine = 6
@@ -92,9 +93,46 @@ tester m tr p =
-- 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))
+ let na = normaliseAbove (fst f)
+ nb = normaliseBelow (snd f)
+ in if (isValidBelowPreference b nb)
+ then nb
+ else if (isValidAbovePreference a na)
+ then (fromAboveToBelow a na)
+ else [] -- empty preference if both above/below are invalid
+
+
+
+
+-- this needs to be merged with normaliseBelow
+normaliseAbove :: Typ.AbovePreferences -> Typ.AbovePreferences
+normaliseAbove 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
+
+
+
+
+-- this needs to be merged with normaliseAbove
+normaliseBelow :: Typ.BelowPreferences -> Typ.BelowPreferences
+normaliseBelow 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
+
+
+
+
+isValidAbovePreference :: Typ.UpperMap -> Typ.AbovePreferences -> Bool
+isValidAbovePreference a p =
+ (((length a) < minAboveTheLine) && ((length a) == (length p))) || ((length p) >= minAboveTheLine)
@@ -123,7 +161,8 @@ fromAboveToBelow a p =
-- 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 ++ ",")
+parsePreferences aboveBoxes belowBoxes input =
+ Parsec.parse (preference aboveBoxes belowBoxes) "error" input
preference a b = do
@@ -139,7 +178,7 @@ preference a b = do
rank = do
n <- Parsec.choice [normalRank, weirdRank, nullRank]
- Parsec.char ','
+ Parsec.choice [Parsec.char ',' >> return (), Parsec.eof]
return n
@@ -149,11 +188,12 @@ normalRank = do
return (n:ns)
--- currently assuming that these symbols always mean '1'
+-- 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 "-1"
diff --git a/src/current_output.txt b/src/current_output.txt
deleted file mode 100644
index 0a99977..0000000
--- a/src/current_output.txt
+++ /dev/null
@@ -1,19 +0,0 @@
-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
index ecfec97..99a6681 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -8,6 +8,11 @@ import qualified Data.Maybe as Maybe
+-- this is all messy test code
+
+
+
+
-- 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]]
@@ -42,3 +47,4 @@ main = do
results = map (\x -> (Sen.doCount theCounter x) >>= (putStrLn . (((snd . head $ x) ++ " ") ++) . show)) testTraces
sequence_ results
+