summaryrefslogtreecommitdiff
path: root/src/Election.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Election.hs')
-rw-r--r--src/Election.hs38
1 files changed, 30 insertions, 8 deletions
diff --git a/src/Election.hs b/src/Election.hs
index ea23a05..41cbfbe 100644
--- a/src/Election.hs
+++ b/src/Election.hs
@@ -134,7 +134,7 @@ doCount e =
checkIfDone >>=
transferVotes >>=
checkNoQuota >>=
- excludeSomeone
+ excludeCandidates
doCount r
@@ -323,10 +323,34 @@ checkNoQuota e = do
+excludeCandidates :: Election -> ET.EitherT Election IO Election
+excludeCandidates e = do
+ let running = filter ((== Running) . getStatus) (getEntries e)
+ sorted = reverse (List.sortBy compareVotes running)
+ voteGap = getQuota e - getTotalVotes (head sorted)
+
+ excludeLoop n v e = do
+ (i,r) <- MIO.liftIO $ excludeSomeone e
+ let v1 = v + i
+ n1 = n + 1
+ if (v1 > voteGap)
+ then if (n > 0)
+ then ET.left e
+ else ET.left r
+ else excludeLoop n1 v1 r
+
+ if (length running > 0 && all (< getQuota e) (map getTotalVotes running))
+ then excludeLoop 0 0 e
+ else ET.right e
+
+
+
+
-- needs to be modified to take into account ties
-excludeSomeone :: Election -> ET.EitherT Election IO Election
+-- this function is still in the IO monad in case I want to log something in verbose mode later
+excludeSomeone :: Election -> IO (Int, Election)
excludeSomeone e = do
- let (running, notRunning) = List.partition ((== Running) . getStatus) (getEntries e)
+ let running = filter ((== Running) . getStatus) (getEntries e)
excludedEntry = List.minimumBy compareVotes running
(beforeEntries, afterEntries) = Misc.partBeforeAfter excludedEntry (getEntries e)
@@ -341,10 +365,8 @@ excludeSomeone e = do
, getChanged = True }
allRevised = beforeEntries ++ [revisedExcludedEntry] ++ afterEntries
- if (getTotalVotes excludedEntry < getQuota e)
- then ET.left (e
- { getEntries = allRevised
- , getTransferQueue = (getTransferQueue e) ++ [newTransfer] })
- else ET.right e
+ return (getTotalVotes excludedEntry, e
+ { getEntries = allRevised
+ , getTransferQueue = (getTransferQueue e) ++ [newTransfer] })