condorcet (empty) → 0.0.1

raw patch · 5 files changed

+196/−0 lines, 5 filesdep +arraydep +basesetup-changed

Dependencies added: array, base

Files

• Condorcet.hs +106/−0
• Demo.hs +44/−0
• LICENSE +19/−0
• Setup.hs +5/−0
• condorcet.cabal +22/−0

@@ -0,0 +1,106 @@+-- Condorcet voting.+-- Copyright (C) 2005 Evan Martin <martine@danga.com>+module Condorcet(Candidate, Ballot, run) where++import GHC.ST+import Data.Array.ST+import Data.Array.Unboxed++-- | Candidates are represented as integers.+type Candidate = Int+{-| Ballots are a ranking of candidates.++Ballots are lists, where each element is a list of candidates the rank+the same.  Earlier entries in the ballot list are ranked higher.++E.g., this ballot:++> [ [1,3], [4], [2] ]++Means that 1 and 3 are tied for first, outranking 4, and everyone beats 2.+-}+type Ballot = [[Candidate]]++-- Entry (i,j) having value k means that i beats j in k votes.+type VoteArray = UArray (Int,Int) Int+type STVoteArray s = STUArray s (Int,Int) Int++loadVotes :: STVoteArray s -> [[Candidate]] -> ST s ()+loadVotes _ []        = return ()+loadVotes vs (cs:rest) = do+  loadVoteSet cs rest  -- each candidate at this ranks beat the ones below+  loadVotes vs rest    -- and recurse on lower ranks+    where+    -- loadVoteSet cs rest: store that each candidate in cs beat each in rest.+    loadVoteSet ds rst =+      mapM_ loadVote [(a,b) | a <- ds, b <- concat rst]++    -- loadVote (a,b): store that a beat b in the vote matrix.+    loadVote pair = do+      v <- readArray vs pair+      writeArray vs pair (v+1)++dim :: VoteArray -> [Int]+dim vs = [minim..maxim] where ((minim, _), (maxim, _)) = bounds vs++initPaths :: VoteArray -> STVoteArray s -> ST s ()+initPaths vs paths = mapM_ writeDelta (indices vs) where+    writeDelta (i,j) = writeArray paths (i,j) (max 0 (vs!(i,j) - vs!(j,i)))++floyd :: VoteArray -> STVoteArray s -> ST s ()+floyd vs paths =+  mapM_ update [(i,j,k) | i<-ranges, j<-ranges, i/=j, k<-ranges, i/=k, j/=k] where+    ranges = dim vs+    update (i,j,k) = do+      a <- readArray paths (j,i)+      b <- readArray paths (i,k)+      let s = min a b+      cur <- readArray paths (j,k)+      if cur < s+        then writeArray paths (j,k) s+        else return ()++strongPath :: VoteArray -> ST s VoteArray+strongPath vs = do+  paths <- thaw vs    -- make a copy of vs+  initPaths vs paths  -- load delta votes into paths+  floyd vs paths      -- run floyd over paths+  unsafeFreeze paths  -- and return paths++winners :: VoteArray -> [Candidate]+winners paths = filter isWinner candidates where+  isWinner c  = (c `beats`) `all` candidates+  i `beats` j = paths!(i,j) >= paths!(j,i)+  candidates  = dim paths++-- join :: String -> [String] -> String+-- join sep []       = ""+-- join sep [a]      = a+-- join sep (a:b:as) = a ++ sep ++ (join sep (b:as))++-- showVA :: VoteArray -> String+-- showVA vs = join "\n" (map showRow positions) where+--     showRow y = join ", " (map (\x -> show $ vs ! (x,y)) positions)+--     positions = dim vs++-- loadBallots :: [Ballot] -> ST s (STVoteArray s)+-- loadBallots ballots = do+--   let size = maximum $ concat $ concat ballots+--   votes <- newArray ((1,1),(size,size)) 0+--   mapM_ (loadVotes votes) ballots+--   return votes++-- | 'run' runs the process, taking a list of 'Ballot's and returning a+-- list of winning candidates.+run :: [Ballot]     -- ^ A list of ballots+    -> [Candidate]  -- ^ The winning candidates+run ballots = runST realrun where+  realrun = do+    let size = maximum $ concat $ concat ballots+    votes <- newArray ((1,1),(size,size)) 0+    mapM_ (loadVotes votes) ballots+    fvotes <- unsafeFreeze votes+    paths <- strongPath fvotes+    return $ winners paths++-- vim: set ts=2 sw=2 et :

@@ -0,0 +1,44 @@+-- Condorcet voting.+-- Copyright (C) 2005 Evan Martin <martine@danga.com>++module Main where++import qualified Condorcet++import Text.ParserCombinators.Parsec+import Control.Monad.Error++{- | Parses a simple form of ballots as strings.+   Ballot strings are comma-separated list in order of preference;+   equally-ranked candidates are separated with an equals sign.+   E.g., "3=4=5,1,2" -}+parseBallot :: String -> Either ParseError Condorcet.Ballot+parseBallot input = parse ballot "" input where+  ballot :: Parser [[Int]]+  ballot = do { b <- sepBy1 rank (char ','); eof; return b }+  rank :: Parser [Int]+  rank = sepBy1 number (char '=')+  number :: Parser Int+  number = do { ds <- many1 digit; return (read ds) }++-- parse a set of ballots, halting on failure (using the Error monad).+parseBallots :: [String] -> Either String [Condorcet.Ballot]+parseBallots bs = mapM pb bs >>= return where+  pb ballot = case parseBallot ballot of+                Left err -> throwError (show err)+                Right x  -> return x++main :: IO ()+main = do+  case parseBallots ["1,2,3", "2=1,3", "2,1,3"] of+    Left e -> putStrLn e+    Right ballots -> do+      putStrLn $ "Parsed " ++ (show (length ballots)) ++ " ballots:"+      mapM_ print ballots+      putStrLn "Computing winners..."+      let winners = Condorcet.run ballots+      putStrLn "Winners:"+      putStrLn $ show winners++-- vim: set ts=2 sw=2 et :+

@@ -0,0 +1,19 @@+Copyright (c) 2006 Evan Martin <martine@danga.com>++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks simpleUserHooks

@@ -0,0 +1,22 @@+name:                condorcet+version:             0.0.1+stability:           Experimental+category:            Data+synopsis:            Library for Condorcet voting+description:         This is a small library for determining the winner of a Condorcet election;+                     for what a Condorcet election is, see <https://secure.wikimedia.org/wikipedia/en/wiki/Condorcet_method>+license:             BSD3+license-file:        LICENSE+author:              Evan Martin+maintainer:          Evan Martin <martine@danga.com>+homepage:            http://neugierig.org/software/darcs/condorcet++build-depends:       base, array+build-type:          Simple+tested-with:         GHC==6.8.2++exposed-modules:     Condorcet+extra-source-files:  Demo.hs++ghc-options:         -O2 -Wall -optl-Wl,-s+ghc-prof-options:    -prof -auto-all