diff --git a/README.md b/README.md index b5355967a8286201efdc260674f332a77f8c21a9..198ac1c658a823906190a9502b4b75071b076440 100644 --- a/README.md +++ b/README.md @@ -1 +1,3 @@ -# majorityJudgment +# Majority Judgment Haskell Implementation + + diff --git a/app/Main.hs b/app/Main.hs index de1c1ab35c4ad21e14ec824121b9710418b75c39..9d74405d6f4e4abefdc4d72d7119257607295cf0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -3,4 +3,4 @@ module Main where import Lib main :: IO () -main = someFunc +main = undefined diff --git a/package.yaml b/package.yaml index 2f66314b1a54f6ca4b1cd76a5ec456256eaf318b..8e6774cd2d5c972968db1b630e6ef9737bb9b608 100644 --- a/package.yaml +++ b/package.yaml @@ -24,6 +24,7 @@ dependencies: - containers - text - safe +- extra library: source-dirs: src diff --git a/src/Lib.hs b/src/Lib.hs index 9f655bca51b5922a3815a5c06ad2be11794d30b0..18fb14cb57baf29796842b0623485d1bc9b4d10f 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,3 +1,16 @@ +{-| +Module : Majority Vote +Description : Majority vote +Copyright : (c) CNRS, 2018-Present +License : AGPL + CECILL v3 +Maintainer : alexandre+dev@delanoe.org +Stability : experimental +Portability : POSIX + +-} + +{-# LANGUAGE OverloadedStrings #-} + module Lib where import Safe (headMay) @@ -8,32 +21,61 @@ import Data.Map (Map) import qualified Data.Map as DM import Prelude -someFunc :: IO () -someFunc = putStrLn "someFunc" - - ------------------------------------------------------ -- | Majority Judgment suppose a list of choices and a Ballot for each choice. -- List should be a Set type MajorityJudgment = [Ballot] -- | Definition of a ballot - data Ballot = Ballot { label :: Text , votes :: [Vote] -} deriving (Show) - -data Vote = Poor | Fair | Good | Excellent - deriving (Eq, Ord, Enum, Show, Bounded) +} -example :: MajorityJudgment -example = undefined +instance Show Ballot where + show (Ballot l vs) = show (l, score vs) --- | Number of vote per Ballot must be equal ? +data Vote = Poor | Fair | Good | Excellent + deriving (Eq, Ord, Enum, Bounded, Show) + +------------------------------------------------------------------------ +-- | Example application +-- https://en.wikipedia.org/wiki/Majority_judgment +ballots :: MajorityJudgment +ballots = [ Ballot "Memphis" (ratedAs [(42, Excellent),(26, Poor) , (15, Poor) , (17, Poor)]) + , Ballot "Nashville" (ratedAs [(42, Fair ),(26, Excellent), (15, Fair) , (17, Fair)]) + , Ballot "Chattanooga" (ratedAs [(42, Poor ),(26, Fair) , (15, Excellent), (17, Good)]) + , Ballot "Knoxville" (ratedAs [(42, Poor ),(26, Fair) , (15, Good) , (17, Excellent)]) + ] + +-- | Ballots2 test +-- If voters were more strategic, those from Knoxville and Chattanooga +-- might rate Nashville as "Poor" and Chattanooga as "Excellent", in +-- an attempt to make their preferred candidate Chattanooga win. Also, +-- Nashville voters might rate Knoxville as "poor" to distinguish it from +-- Chattanooga. In spite of these attempts at strategy, the winner would +-- still be Nashville +ballots2 :: MajorityJudgment +ballots2 = [ Ballot "Memphis" (ratedAs [(42, Excellent),(26, Poor) , (15, Poor) , (17, Poor)]) + , Ballot "Nashville" (ratedAs [(42, Fair ),(26, Excellent), (15, Poor) , (17, Poor)]) + , Ballot "Chattanooga" (ratedAs [(42, Poor ),(26, Poor) , (15, Excellent), (17, Good)]) + , Ballot "Knoxville" (ratedAs [(42, Poor ),(26, Poor) , (15, Excellent), (17, Excellent)]) + ] + +ratedAs = concat . map (\(n,v) -> (take n . repeat) v) + +------------------------------------------------------------------------ + +-- | Asserts is the Election with Majority Judgment is Fair +-- e.g. methodology of vote is respected to collect the ballots +-- Number of vote per Ballot must be equal +-- add an axiom: must not be Poor at least by one voter ? +-- TODO isFair :: MajorityJudgment -> Bool isFair = undefined -- all . map (length . votes) --- | TODO: sortBy and intersect according to Result +-- | Select the Winner +-- TODO: sortBy and intersect according to Result +-- sort then take While equality winnerIs :: MajorityJudgment -> Maybe Ballot winnerIs = headMay . reverse . sort @@ -43,12 +85,39 @@ instance Eq Ballot where instance Ord Ballot where (compare) (Ballot _ v1) (Ballot _ v2) = case (==) (score v1) (score v2) of False -> compare (score v1) (score v2) - True -> compare (score $ (\\) v1 (intersect v1 v2)) - (score $ (\\) v2 (intersect v1 v2)) + True -> compare (score v1') (score v2') + where + (v1', v2') = diff (v1, v2) score :: [Vote] -> Maybe Rational score = median . map voteToRational +------------------------------------------------------------------------ + +diff :: Ord a => ([a],[a]) -> ([a],[a]) +diff (m1,m2) = (fromMap m1', fromMap m2') + where + (m1', m2') = diffMap (toMap m1, toMap m2) + +diffMap :: Ord a => (Map a Int, Map a Int) -> (Map a Int, Map a Int) +diffMap (m1,m2) = (m1',m2') + where + m1' = DM.unionWith outer m1 m13 + m2' = DM.unionWith outer m2 m23 + + m13 = DM.intersectionWith (-) m1 m2 + m23 = DM.intersectionWith (-) m2 m1 + + outer a b = if b > 0 then b else 0 + +toMap :: Ord a => [a] -> Map a Int +toMap = foldl' (\m a -> DM.insertWith (+) a 1 m) DM.empty + +fromMap :: Map a Int -> [a] +fromMap = concat . map (\(k,n) -> (take n . repeat) k) . DM.toList + +------------------------------------------------------------------------ + -- Make instance ScoreVote voteToRational :: (Ord k, Bounded k, Enum k) => k -> Rational voteToRational v = fromJust $ DM.lookup v $ DM.fromList $ zip vs [minimum + 1 .. minimum + (toRational . length) vs]