What is a Fair Election?

src/Lib.hs

@@ -13,6 +13,7 @@ Portability : POSIX
 
 module Lib where
 
+import Data.Either
 import Safe (headMay)
 import Data.Maybe (fromJust)
 import Data.List
@@ -32,7 +33,7 @@ data Ballot = Ballot { label :: Text
 }
 
 instance Show Ballot where
-  show (Ballot l vs) = show (l, score vs)
+  show (Ballot l vs) = show (l, toMap vs)
 
 data Vote = Poor | Fair | Good | Excellent
   deriving (Eq, Ord, Enum, Bounded, Show)
@@ -63,21 +64,38 @@ ballots2 = [ Ballot "Memphis"     (ratedAs [(42, Excellent),(26, Poor)     , (15
 
 ratedAs = concat . map (\(n,v) -> (take n . repeat) v)
 
+-- | Unfair election
+ballots3 :: MajorityJudgment
+ballots3 = [ Ballot "Dictatorship" (ratedAs [(1, Excellent)])]
+
+ballots4 :: MajorityJudgment
+ballots4 = [ Ballot "Dictatorship" (ratedAs [(100, Excellent)])
+           , Ballot "Democracy"    (ratedAs [(1, Excellent)])
+           ]
+
 ------------------------------------------------------------------------
 
 -- | 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
+-- TODO: be more explicit why election is not fair
 isFair :: MajorityJudgment -> Bool
-isFair = undefined -- all . map (length . votes)
+isFair mj = length vs > 2 && all (== head vs) vs
+  where
+    vs = map (length . votes) mj
+
+data Unfair = NoChoice | NoRepresentativity
+
+-- undefined -- all . map (length . votes)
 
 -- | Select the Winner
 -- TODO: sortBy and intersect according to Result
 -- sort then take While equality
-winnerIs :: MajorityJudgment -> Maybe Ballot
-winnerIs = headMay . reverse . sort
+winnerIs :: MajorityJudgment -> Either Text (Maybe Ballot)
+winnerIs mj = case isFair mj of
+                False -> Left  "Unfair Election"
+                True  -> Right $ (headMay . reverse . sort) mj
 
 instance Eq Ballot where
   (==) (Ballot _ v1) (Ballot _ v2) = (==) (score v1) (score v2)
@@ -102,12 +120,9 @@ xor (m1,m2) = (fromMap m1', fromMap m2')
 xorMap :: Ord a => (Map a Int, Map a Int) -> (Map a Int, Map a Int)
 xorMap (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
-    
+    m1' = DM.unionWith outer m1 $ DM.intersectionWith (-) m1 m2
+    m2' = DM.unionWith outer m2 $ DM.intersectionWith (-) m2 m1
+
     outer a b = if b > 0 then b else 0
 
 toMap :: Ord a => [a] -> Map a Int
@@ -117,8 +132,7 @@ fromMap :: Map a Int -> [a]
 fromMap = concat . map (\(k,n) -> (take n . repeat) k) . DM.toList
 
 ------------------------------------------------------------------------
-
--- Make instance ScoreVote
+-- | TODO Make instance ScoreVote
 voteToRational :: (Ord k, Bounded k, Enum k) => k -> Rational
 voteToRational v = fromJust $ DM.lookup v
                             $ DM.fromList
@@ -135,4 +149,3 @@ medianFromSorted (a:xs) = medianFromSorted (init xs) -- init is not efficient
 median :: Ord a => Fractional a => [a] -> Maybe a
 median = medianFromSorted . sort
 
-