summaryrefslogtreecommitdiff
path: root/src/Election.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Election.hs')
-rw-r--r--src/Election.hs24
1 files changed, 10 insertions, 14 deletions
diff --git a/src/Election.hs b/src/Election.hs
index 0789fcf..5ffba0d 100644
--- a/src/Election.hs
+++ b/src/Election.hs
@@ -18,7 +18,6 @@ import qualified Data.Maybe as Maybe
import qualified Data.Either.Unwrap as Either
import qualified Counter as Sen
import qualified Candidate as Typ
-import qualified Criteria as Crit
import qualified CSV as CSV
import Miscellaneous ( (.:) )
import qualified Miscellaneous as Misc
@@ -52,15 +51,9 @@ data Entry = Entry
deriving (Eq)
data Trace = Trace
- { getCriteria :: Crit.Criteria
+ { getCriteria :: Sen.Criteria
, getTransferVal :: Float }
-
--- can't check for equality on functions, unfortunately,
--- so this'll have to do
-instance Eq Trace where
- a == b =
- (length (getCriteria a) == length (getCriteria b))
- && (getTransferVal a == getTransferVal b)
+ deriving (Eq)
data Status = Running | Elected | Eliminated
deriving (Show, Eq)
@@ -110,7 +103,7 @@ compareVotes x y = compare (getTotalVotes x) (getTotalVotes y)
candToEntry :: Sen.SenateCounter -> Typ.CandidateID -> IO Entry
candToEntry counter candidate = do
- let criteria = [Crit.matchID candidate]
+ let criteria = [Sen.matchID candidate]
trace = Trace criteria 1
firstPrefs <- Sen.doCount counter criteria
return (Entry
@@ -270,18 +263,21 @@ doVoteTransfer e = do
notRunningIDs = map getID (filter ((/= Running) . getStatus) (getEntries e))
reviseTrace candID trace = trace
- { getCriteria = getCriteria trace ++
- [Crit.many (Crit.matchFromList notRunningIDs), Crit.matchID candID]
+ { getCriteria = getCriteria trace ++ [Sen.matchList notRunningIDs, Sen.matchID candID]
, getTransferVal = getTransferVal trace * getNewValue currentTransfer }
reviseFunc entry = do
let newTraces = map (reviseTrace (getID entry)) (getWhatToDist currentTransfer)
rawVoteChanges <- mapM (Sen.doCount (getCounter e)) (map getCriteria newTraces)
- let totalVoteChange = sum (zipWith (floor .: (*)) (map fromIntegral rawVoteChanges) (map getTransferVal newTraces))
+ let tracesAndChanges = zip (map fromIntegral rawVoteChanges) newTraces
+ adjustedChanges = map (\(r,t) -> (floor (r * getTransferVal t), t)) tracesAndChanges
+ filteredChanges = filter ((/= 0) . fst) adjustedChanges
+ totalVoteChange = sum (map fst filteredChanges)
+ addedTraces = map snd filteredChanges
return (entry
{ getVoteChange = totalVoteChange
, getTotalVotes = getTotalVotes entry + totalVoteChange
- , getCritTrace = getCritTrace entry ++ newTraces })
+ , getCritTrace = getCritTrace entry ++ addedTraces })
revisedFromEntry = fromEntry
{ getVoteChange = -(getVoteAmount currentTransfer)