From 651c86b136e0c63cfc277f20f92b40b3bfebf3e5 Mon Sep 17 00:00:00 2001
From: Jack Wines <jack@winesj.com>
Date: Sat, 17 Jun 2023 01:58:55 -0700
Subject: [PATCH] fixed instant runoff bug

Candidates that were no ones first choice should have been eliminated
first. Instead, they were skipped.
---
 src/InstantRunoff.hs | 26 +++++++++++++++-----------
 src/Main.hs          |  2 +-
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/src/InstantRunoff.hs b/src/InstantRunoff.hs
index e366c50..a7ad0fc 100644
--- a/src/InstantRunoff.hs
+++ b/src/InstantRunoff.hs
@@ -2,30 +2,34 @@ module InstantRunoff where
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as LN
 import qualified Data.Map.Strict as M
-import qualified Data.Maybe as My
 import qualified Data.Set as S
-import qualified Data.Foldable as F
-import Data.Ord
-import Data.Maybe hiding (catMaybes)
-import Data.Ratio
 import qualified Data.Maybe as L
 
-solve :: Ord a => Show a => LN.NonEmpty (LN.NonEmpty a) -> [S.Set a]
+solve :: forall a. Ord a => Show a => LN.NonEmpty (LN.NonEmpty a) -> [S.Set a]
 solve votes = maybe (L.singleton . M.keysSet $ voteCounts) ((firstChoiceLosers : ) . solve) . remove $ firstChoiceLosers
     where
 
     -- if Nothing, then all options in votes are valued equally
-    -- remove :: S.Set a -> LN.NonEmpty (LN.NonEmpty a) -> Maybe (LN.NonEmpty (LN.NonEmpty a))
+    remove :: S.Set a -> Maybe (LN.NonEmpty (LN.NonEmpty a))
     remove toRemove = catMaybes . LN.map (LN.nonEmpty . LN.filter (`S.notMember` toRemove)) $ votes
 
-    -- firstChoiceLosers :: S.Set a
+    firstChoiceLosers :: S.Set a
     firstChoiceLosers = M.keysSet . M.filter ((==) . L.minimum . M.elems $ voteCounts) $ voteCounts
 
-    -- firstChoices :: LN.NonEmpty a
+    firstChoices :: LN.NonEmpty a
     firstChoices = LN.map LN.head votes
 
-    -- voteCounts :: M.Map a Word
-    voteCounts = M.unionsWith (+) . map (`M.singleton` (1 :: Word)) . LN.toList $ firstChoices
+    voteCounts :: M.Map a Word
+    voteCounts = M.unionWith (+) candidatesMinimumVoteCounts . M.unionsWith (+) . map (`M.singleton` 1) . LN.toList $ firstChoices
+
+    -- candidates that are no ones first choice should be eliminated first
+    -- so we make sure to grab all of them here
+    candidates :: S.Set a
+    candidates = S.unions (map (S.fromList . LN.toList) . LN.toList $ votes)
+
+    candidatesMinimumVoteCounts :: M.Map a Word
+    candidatesMinimumVoteCounts = (M.fromSet (const 0) candidates)
+
 
 catMaybes :: LN.NonEmpty (Maybe a) -> Maybe (LN.NonEmpty a)
 catMaybes = LN.nonEmpty . L.catMaybes . LN.toList
diff --git a/src/Main.hs b/src/Main.hs
index b909ce4..eb235ca 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -62,7 +62,7 @@ results pollId = do
     Nothing -> fullPage "poll doesn't have any votes"
     Just votesList -> do
       let voteless = notVotedFor poll
-      let results' = (IR.solve $ votesList) ++ noVotesAsBallot voteless
+      let results' = (reverse . IR.solve $ votesList) ++ noVotesAsBallot voteless
       fullPage $ do
         h2_ "results"
         toHtml $ T.append (T.pack . show . length . P.votes $ poll) " ballots submitted"