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
|
module Preferences(
Preference,
FullPreferences,
normalise,
parsePreferences
) where
-- This source is licensed under Creative Commons CC0 v1.0.
-- To read the full text, see license.txt in the main directory of this repository
-- or go to https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt
-- For a human readable summary, go to https://creativecommons.org/publicdomain/zero/1.0/
import qualified Candidate 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"
|
