From 5d675432d376a19a733ba46615d1e0387c764348 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Sun, 29 Jan 2017 23:37:05 +1100
Subject: Bulk exclusions implemented using applied breakpoints

---
 src/Election.hs | 38 ++++++++++++++++++++++++++++++--------
 1 file changed, 30 insertions(+), 8 deletions(-)

(limited to 'src')

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] })
 
 
-- 
cgit