checkNoQuota should mark order of election properly now

2 files changed, 41 insertions, 39 deletions

diff --git a/notes.txt b/notes.txt
index cc49536..e644ad7 100644
--- a/notes.txt
+++ b/notes.txt
@@ -37,7 +37,7 @@ more counters/parsers/options to handle state elections, general stv data
 more detailed logging for preference distribution?
 tracking of exhausted/fractional-loss ballots?
 
-multithreaded operation to speed counting up, possibly using unsafePerformIO
+multithreaded operation to speed counting up, possibly using unsafePerformIO and/or forkIO
 
 group votes by uniqueness to reduce memory requirements, speed things up, and accommodate group tickets?
 
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))