Jack/rcv-site
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

move back to preference ranking

Browse source
This commit is contained in:
Jack Wines 2023-06-25 13:36:50 -07:00
parent dfef7d4935
commit 8f5162b6ca
1 changed files with 4 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/InstantRunoff.hs
View file

@ -6,10 +6,8 @@ import qualified Data.Set as S
import qualified Data.Maybe as M
import qualified Data.Ord as O
-- find winner, remove winner from ballots, repeat for next place
solve :: forall a. Ord a => [a] -> LN.NonEmpty (LN.NonEmpty a) -> [S.Set a]
solve candidates votes' = if S.null notVotedForCandidates
solve candidates votes = if S.null notVotedForCandidates
then solved
else solved ++ [notVotedForCandidates]
where
@ -18,18 +16,10 @@ solve candidates votes' = if S.null notVotedForCandidates
notVotedForCandidates :: S.Set a
notVotedForCandidates = S.difference (S.fromList candidates) . S.unions $ solved
solved = solve' votes'
solved = rank votes
solve' :: LN.NonEmpty (LN.NonEmpty a) -> [S.Set a]
solve' votes = maybe [] ((:) winner' . solve') remainingVotes
where
winner' = winner votes
remainingVotes :: Maybe (LN.NonEmpty (LN.NonEmpty a))
remainingVotes = filterVotes (`S.notMember` winner') votes
winner :: forall a. Ord a => LN.NonEmpty (LN.NonEmpty a) -> S.Set a
winner votes = maybe (M.keysSet $ voteCounts) winner . filterVotes (`S.notMember` losers) $ votes
rank :: forall a. Ord a => LN.NonEmpty (LN.NonEmpty a) -> [S.Set a]
rank votes = maybe (L.singleton . M.keysSet $ voteCounts) ((losers :) . rank) . filterVotes (`S.notMember` losers) $ votes
where
firstChoiceLosers :: S.Set a