1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
module Senate(
SenateCounter,
createSenateCounter,
doCount
) where
import qualified SenateTypes as Typ
import qualified CSV as CSV
import qualified Storage as Store
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
type Preferences = [(Typ.Position,Typ.Ranking)]
type FullPreferences = (Preferences,Preferences)
data SenateCounter = SenateCounter { prefData :: Store.PrefStorage
, ballotMap :: Typ.BelowLineBallot
, numBallots :: Integer }
headerLines = 2
minAboveTheLine = 1
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)
--
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)
--
return (SenateCounter arrayData b (length normedPrefs))
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)
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
-- 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"
-- utility functions
fromJusts :: [Maybe a] -> [a]
fromJusts = (map Maybe.fromJust) . (filter Maybe.isJust)
fromRights :: [Either a b] -> [b]
fromRights = Either.rights . (filter Either.isRight)
|
