summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--notes.txt4
-rw-r--r--src/Election.hs38
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] })