diff options
| -rw-r--r-- | notes.txt | 4 | ||||
| -rw-r--r-- | src/Election.hs | 38 |
2 files changed, 33 insertions, 9 deletions
@@ -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] }) |