From 64ccf6ef0aa18e898565ff59159dc8165a780f9d Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Mon, 30 Jan 2017 13:47:26 +1100
Subject: checkNoQuota should mark order of election properly now
---
src/Election.hs | 78 +++++++++++++++++++++++++++++----------------------------
1 file changed, 40 insertions(+), 38 deletions(-)
(limited to 'src')
diff --git a/src/Election.hs b/src/Election.hs
index 6d946cd..582b29e 100644
--- a/src/Election.hs
+++ b/src/Election.hs
@@ -21,6 +21,7 @@ import Data.Ratio ( (%) )
import qualified Counter as Sen
import qualified Candidate as Typ
import qualified CSV as CSV
+import Miscellaneous ( (?) )
import qualified Miscellaneous as Misc
@@ -208,7 +209,7 @@ electCandidates e = do
-- may be prudent to put this just in the IO monad instead of EitherT
doElectCandidate :: Election -> ET.EitherT Election IO Election
doElectCandidate e = do
- let (running, notRunning) = List.partition ((== Running) . getStatus) (getEntries e)
+ let running = filter ((== Running) . getStatus) (getEntries e)
electedEntry = List.maximumBy compareVotes running
(beforeEntries, afterEntries) = Misc.partBeforeAfter electedEntry (getEntries e)
@@ -254,14 +255,13 @@ checkIfDone e =
transferVotes :: Election -> ET.EitherT Election IO Election
transferVotes e =
if (length (getTransferQueue e) > 0)
- then doVoteTransfer e
+ then (MIO.liftIO $ doVoteTransfer e) >>= ET.left
else ET.right e
--- may be prudent to put this just in the IO monad instead of EitherT
-doVoteTransfer :: Election -> ET.EitherT Election IO Election
+doVoteTransfer :: Election -> IO Election
doVoteTransfer e = do
let (currentTransfer:remainingTransfers) = getTransferQueue e
fromEntry = Maybe.fromJust (List.find ((== getWhoFrom currentTransfer) . getID) (getEntries e))
@@ -287,50 +287,54 @@ doVoteTransfer e = do
revisedFromEntry = fromEntry
{ getVoteChange = -(getVoteAmount currentTransfer)
- , getTotalVotes = getTotalVotes fromEntry - (getVoteAmount currentTransfer)
- , getCritTrace = (getCritTrace fromEntry) \\ (getWhatToDist currentTransfer) }
- revisedBeforeEntries <- MIO.liftIO $ mapM reviseFunc beforeEntries
- revisedAfterEntries <- MIO.liftIO $ mapM reviseFunc afterEntries
+ , getTotalVotes = getTotalVotes fromEntry - getVoteAmount currentTransfer
+ , getCritTrace = getCritTrace fromEntry \\ getWhatToDist currentTransfer }
+ revisedBeforeEntries <- mapM reviseFunc beforeEntries
+ revisedAfterEntries <- mapM reviseFunc afterEntries
let allRevised = revisedBeforeEntries ++ [revisedFromEntry] ++ revisedAfterEntries
- ET.left (e
+ return (e
{ getEntries = allRevised
, getTransferQueue = remainingTransfers })
+-- needs to properly mark the order that the last candidates were elected
-- needs to be modified to take into account ties
checkNoQuota :: Election -> ET.EitherT Election IO Election
checkNoQuota e = do
- let (running, notRunning) = List.partition ((== Running) . getStatus) (getEntries e)
- minimumEntry = List.minimumBy compareVotes running
- (beforeEntries, afterEntries) = Misc.partBeforeAfter minimumEntry (getEntries e)
-
- makeElect entry = do
- let logmsg = show (getID entry) ++ " elected at logfile #" ++ show (getNextLogNum e)
- MIO.liftIO $ IO.appendFile (getMainLog e) (logmsg ++ "\n")
- MIO.liftIO $ Con.when (isVerbose e) (IO.hPutStrLn IO.stderr logmsg)
- return (entry
- { getStatus = Elected
- , getChanged = True })
- reviseFunc entry =
- if ((getStatus entry == Running) && (entry /= minimumEntry))
- then makeElect entry
- else return entry
-
- revisedMinEntry <-
- if (length running <= getVacancies e)
- then makeElect minimumEntry
- else return minimumEntry
- revisedBeforeEntries <- mapM reviseFunc beforeEntries
- revisedAfterEntries <- mapM reviseFunc afterEntries
- let allRevised = revisedBeforeEntries ++ [revisedMinEntry] ++ revisedAfterEntries
+ let running = filter ((== Running) . getStatus) (getEntries e)
+ sorted = reverse (List.sortBy compareVotes running)
if (length running <= getVacancies e + 1)
- then ET.left (e
- { getEntries = allRevised
- , getVacancies = 0 })
+ then do
+ let makeElect entry n = do
+ let logmsg = show (getID entry) ++ " elected at logfile #" ++ show (getNextLogNum e)
+ IO.appendFile (getMainLog e) (logmsg ++ "\n")
+ Con.when (isVerbose e) (IO.hPutStrLn IO.stderr logmsg)
+ return (entry
+ { getStatus = Elected
+ , getChanged = True
+ , getOrderElected = Just n })
+
+ reviseFunc input output toChange n =
+ if (length input == 0)
+ then return (reverse output)
+ else if ((head input) `elem` toChange)
+ then do
+ r <- makeElect (head input) n
+ reviseFunc (tail input) (r:output) toChange (n + 1)
+ else reviseFunc (tail input) ((head input):output) toChange n
+
+ toChange = if (length running <= getVacancies e) then sorted else init sorted
+
+ allRevised <- MIO.liftIO $ reviseFunc (getEntries e) [] toChange (getNextToElect e)
+
+ ET.left (e
+ { getEntries = allRevised
+ , getVacancies = 0
+ , getNextToElect = getNextToElect e + length toChange })
else ET.right e
@@ -347,9 +351,7 @@ excludeCandidates e = do
let v1 = v + i
n1 = n + 1
if (v1 > appliedBreakpoint)
- then if (n > 0)
- then ET.left e
- else ET.left r
+ then n > 0 ? ET.left e $ ET.left r
else excludeLoop n1 v1 r
if (length running > 0 && all (< getQuota e) (map getTotalVotes running))
--
cgit