Bulk exclusions implemented using applied breakpoints

2 files changed, 33 insertions, 9 deletions

diff --git a/notes.txt b/notes.txt
index d80fd23..cc49536 100644
--- a/notes.txt
+++ b/notes.txt
@@ -39,6 +39,8 @@ tracking of exhausted/fractional-loss ballots?
 
 multithreaded operation to speed counting up, possibly using unsafePerformIO
 
-bulk exclusions to hopefully increase speed a bit
+group votes by uniqueness to reduce memory requirements, speed things up, and accommodate group tickets?
+
+make the goddamn results correct
 
 
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] })