diff options
| -rw-r--r-- | makefile | 21 | ||||
| -rw-r--r-- | notes.txt | 35 | ||||
| -rw-r--r-- | src/File.hs | 31 | ||||
| -rw-r--r-- | src/Miscellaneous.hs | 19 | ||||
| -rw-r--r-- | src/Preferences.hs | 117 | ||||
| -rw-r--r-- | src/Senate.hs | 143 | ||||
| -rw-r--r-- | src/Storage.hs | 30 | ||||
| -rw-r--r-- | src/main.hs | 6 |
8 files changed, 241 insertions, 161 deletions
@@ -1,24 +1,11 @@ -all: main +all: stv -main: - ghc --make src/main.hs -isrc:build -odir build -outputdir build \ - -hidir build -stubdir build -dumpdir build -o bin/counter - - - -#testmain: ada_array -# ghc --make src/testmain.hs -isrc:build -odir build -outputdir build \ -# -hidir build -stubdir build -dumpdir build -o bin/testmain build/ada_array.o - - - -#ada_array: -# gnatmake -Isrc -D build -c preference_arrays -# gnatbind -n build/preference_arrays -# gnatlink -r -nostdlib -o build/ada_array.o build/preference_arrays.ali +stv: + ghc -O2 --make src/main.hs -isrc:build -odir build -outputdir build \ + -hidir build -stubdir build -dumpdir build -o bin/stv diff --git a/notes.txt b/notes.txt new file mode 100644 index 0000000..dc132d1 --- /dev/null +++ b/notes.txt @@ -0,0 +1,35 @@ + +potential anomaly detected for + +Honan, Pat, NT + AEC count 328 + my count 327 + +Marshall, Tristan, NT + AEC count 161 + my count 160 + +Gallagher, Katy, ACT + AEC count 95749 + my count 95748 + +Seselja, Zed, ACT + AEC count 82932 + my count 82931 + + + + +future direction +---------------- + +vector preference storage +vector election data storage + +preference module +candidate module +(containing parsing functions, types, and whatnot) + +util to list paper ids that fit specific criteria to doublecheck potential errors + + diff --git a/src/File.hs b/src/File.hs new file mode 100644 index 0000000..e1245e8 --- /dev/null +++ b/src/File.hs @@ -0,0 +1,31 @@ +module File( + countLines + ) where + + + + +import qualified System.IO as IO + + + + +countLines :: FilePath -> IO Int +countLines f = do + h <- IO.openFile f IO.ReadMode + e <- IO.hIsEOF h + if e + then IO.hClose h >> return 0 + else countLinesTail h 0 + + + + +countLinesTail :: IO.Handle -> Int -> IO Int +countLinesTail h n = do + t <- IO.hGetLine h + e <- IO.hIsEOF h + if e + then IO.hClose h >> return (n + 1) + else countLinesTail h (n + 1) + diff --git a/src/Miscellaneous.hs b/src/Miscellaneous.hs new file mode 100644 index 0000000..94e9672 --- /dev/null +++ b/src/Miscellaneous.hs @@ -0,0 +1,19 @@ +module Miscellaneous( + if' + (?) + ) where\ + + + + +if' :: Bool -> t -> t -> t +if' a b c = if a then b else c + + + + +infixr 1 ? +(?) :: Bool -> t -> t -> t +(?) = if' + + diff --git a/src/Preferences.hs b/src/Preferences.hs new file mode 100644 index 0000000..7a67e63 --- /dev/null +++ b/src/Preferences.hs @@ -0,0 +1,117 @@ +module Preferences( + Preference, + FullPreferences, + + normalise, + parsePreferences + ) where + + + + +import qualified SenateTypes as Typ +import qualified Text.ParserCombinators.Parsec as Parsec +import qualified Data.List as List + + + + +type Preference = (Typ.Position,Typ.Ranking) +type FullPreferences = ([Preference],[Preference]) + + + + +minAboveTheLine = 1 +minBelowTheLine = 6 + + + + +-- converts a set of above+below-the-line preferences to just formal below-the-line +normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Maybe [Preference] +normalise a b f = + let na = extractFormal (fst f) + nb = extractFormal (snd f) + in if (isValidFormal minBelowTheLine b nb) + then Just nb + else if (isValidFormal minAboveTheLine a na) + then Just (fromAboveToBelow a na) + else Nothing + + + + +extractFormal :: [Preference] -> [Preference] +extractFormal pref = + let formTail n r p = + let (matches,rest) = List.partition ((== n) . snd) p + in if (p == [] || (length matches) /= 1) + then r + else formTail (n + 1) ((head matches):r) rest + in formTail 1 [] pref + + + + +isValidFormal :: Foldable t => Int -> t a -> [Preference] -> Bool +isValidFormal minLimit ballot pref = + (length pref >= minLimit) || (length pref == length ballot) + + + + +-- inefficient? +fromAboveToBelow :: Typ.AboveLineBallot -> [Preference] -> [Preference] +fromAboveToBelow a p = + let sortedByRanking = List.sortBy (\x y -> compare (snd x) (snd y)) p + tailFunc n bp ap = + if (ap == []) + then bp + else let place = fst (head ap) + newPrefs = zip (a !! (place - 1)) [n, n+1 ..] + in tailFunc (n + length newPrefs) (bp ++ newPrefs) (tail ap) + in tailFunc 1 [] sortedByRanking + + + + +-- the two int arguments are the number of boxes above the line and the number +-- of boxes below the line respectively +parsePreferences :: Int -> Int -> String -> Either Parsec.ParseError FullPreferences +parsePreferences aboveBoxes belowBoxes input = + Parsec.parse (preference aboveBoxes belowBoxes) "error" input + + +preference a b = do + x <- Parsec.count a rank + y <- Parsec.count b rank + Parsec.eof + let xr = map (read :: String -> Typ.Ranking) x + yr = map (read :: String -> Typ.Ranking) y + xp = (filter ((> 0) . snd) (zip [1,2..] xr)) + yp = (filter ((> 0) . snd) (zip [1,2..] yr)) + return (xp,yp) + + +rank = do + n <- Parsec.choice [normalRank, weirdRank, nullRank] + Parsec.choice [Parsec.char ',' >> return (), Parsec.eof] + return n + + +normalRank = do + n <- Parsec.oneOf "123456789" + ns <- Parsec.many Parsec.digit + return (n:ns) + + +-- these symbols are taken to mean '1' according to AEC guidelines +weirdRank = do + Parsec.choice [Parsec.char '/', Parsec.char '*'] + return "1" + + +-- these ranks are standins that will be filtered out +nullRank = return "0" + diff --git a/src/Senate.hs b/src/Senate.hs index f10aa6a..bd048b5 100644 --- a/src/Senate.hs +++ b/src/Senate.hs @@ -1,5 +1,6 @@ module Senate( SenateCounter, + createSenateCounter, doCount ) where @@ -8,21 +9,19 @@ module Senate( import qualified SenateTypes as Typ +import qualified Preferences as Pref import qualified CSV as CSV import qualified Storage as Vec import qualified System.IO as IO +import qualified File as File import qualified Control.Monad as Con -import qualified Text.ParserCombinators.Parsec as Parsec -import qualified Data.Either as Either +import qualified Data.Either.Unwrap as Either import qualified Data.Maybe as Maybe import qualified Data.List as List -type Preferences = [(Typ.Position,Typ.Ranking)] -type FullPreferences = (Preferences,Preferences) - data SenateCounter = SenateCounter { prefData :: Vec.Store , ballotMap :: Typ.BelowLineBallot , numBallots :: Int } @@ -30,30 +29,24 @@ data SenateCounter = SenateCounter { prefData :: Vec.Store -minAboveTheLine = 1 -minBelowTheLine = 6 - - - - createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter createSenateCounter f a b = do -- - numLines <- countLines f + numLines <- File.countLines f arrayData <- Vec.createStore numLines (length b) -- h <- IO.openFile f IO.ReadMode - let readFunc n p h = if (n > numLines) then return p else do + let readFunc n p = if (n > numLines) then return p else do t0 <- IO.hGetLine h let t1 = CSV.parseRecord CSV.defaultSettings t0 - t2 = last (head (Either.rights [t1])) - t3 = parsePreferences (length a) (length b) t2 - t4 = normalise a b (head (Either.rights [t3])) + t2 = last (Either.fromRight t1) + t3 = Pref.parsePreferences (length a) (length b) t2 + t4 = Pref.normalise a b (Either.fromRight t3) t5 = Maybe.fromJust t4 if (Either.isRight t1) && (Either.isRight t3) && (Maybe.isJust t4) - then (mapM_ (uncurry (Vec.setPref arrayData n)) t5) >> (readFunc (n + 1) (p + 1) h) - else readFunc (n + 1) p h - p <- readFunc 1 0 h + then mapM_ (Vec.setPref arrayData n) t5 >> readFunc (n + 1) (p + 1) + else readFunc (n + 1) p + p <- readFunc 1 0 IO.hClose h -- return (SenateCounter arrayData b p) @@ -61,28 +54,15 @@ createSenateCounter f a b = do -countLines :: FilePath -> IO Int -countLines f = do - let tailFunc x h = do - t <- IO.hGetLine h - e <- IO.hIsEOF h - if e then (IO.hClose h >> return (x + 1)) else tailFunc (x + 1) h - h <- IO.openFile f IO.ReadMode - e <- IO.hIsEOF h - if e then (IO.hClose h >> return 0) else tailFunc 0 h - - - - doCount :: SenateCounter -> Typ.Criteria -> IO Int -doCount sen crit = do +doCount sen criteria = do -- - let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) crit + let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) criteria -- - let critToPref (r,c) = (Maybe.fromJust (List.elemIndex c (ballotMap sen)) + 1, r) - neededPrefs = map critToPref crit + let critToPref (a,b) = (Maybe.fromJust (List.elemIndex b (ballotMap sen)) + 1, a) + neededPrefs = map critToPref criteria checkFunc n r = if (n > (numBallots sen)) then return r else do - t <- Con.liftM and (mapM (uncurry (Vec.checkPref (prefData sen) n)) neededPrefs) + t <- Con.liftM and (mapM (Vec.checkPref (prefData sen) n) neededPrefs) if t then checkFunc (n + 1) (r + 1) else checkFunc (n + 1) r -- if isValidCriteria @@ -90,92 +70,3 @@ doCount sen crit = do else return 0 - - --- converts a set of above+below-the-line preferences to just formal below-the-line -normalise :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> FullPreferences -> Maybe Preferences -normalise a b f = - let na = extractFormal (fst f) - nb = extractFormal (snd f) - in if (isValidFormal minBelowTheLine b nb) - then Just nb - else if (isValidFormal minAboveTheLine a na) - then Just (fromAboveToBelow a na) - else Nothing - - - - -extractFormal :: Preferences -> Preferences -extractFormal p = - let funcTail n r p = - let (matches,rest) = List.partition ((== n) . snd) p - in if (p == [] || (length matches) /= 1) - then r - else funcTail (n + 1) ((head matches):r) rest - in funcTail 1 [] p - - - - -isValidFormal :: Foldable t => Int -> t a -> Preferences -> Bool -isValidFormal minLimit ballot pref = - (length pref >= minLimit) || (length pref == length ballot) - - - - -fromAboveToBelow :: Typ.AboveLineBallot -> Preferences -> Preferences -fromAboveToBelow a p = - let sortedByRanking = List.sortBy (\x y -> compare (snd x) (snd y)) p - tailFunc n bp ap = - if (ap == []) - then bp - else let place = fst (head ap) - newPrefs = zip (a !! (place - 1)) [n, n+1 ..] - in tailFunc (n + length newPrefs) (bp ++ newPrefs) (tail ap) - in tailFunc 1 [] sortedByRanking - - - - --- the two int arguments are the number of boxes above the line and the number --- of boxes below the line respectively -parsePreferences :: Int -> Int -> String -> Either Parsec.ParseError FullPreferences -parsePreferences aboveBoxes belowBoxes input = - Parsec.parse (preference aboveBoxes belowBoxes) "error" input - - -preference a b = do - x <- Parsec.count a rank - y <- Parsec.count b rank - Parsec.eof - let xr = map (read :: String -> Typ.Ranking) x - yr = map (read :: String -> Typ.Ranking) y - xp = (filter ((> 0) . snd) (zip [1,2..] xr)) - yp = (filter ((> 0) . snd) (zip [1,2..] yr)) - return (xp,yp) - - -rank = do - n <- Parsec.choice [normalRank, weirdRank, nullRank] - Parsec.choice [Parsec.char ',' >> return (), Parsec.eof] - return n - - -normalRank = do - n <- Parsec.oneOf "123456789" - ns <- Parsec.many Parsec.digit - return (n:ns) - - --- these symbols are taken to mean '1' according to AEC guidelines -weirdRank = do - Parsec.choice [Parsec.char '/', Parsec.char '*'] - return "1" - - --- these ranks are standins that will be filtered out -nullRank = return "0" - - diff --git a/src/Storage.hs b/src/Storage.hs index a97a5fc..75b452b 100644 --- a/src/Storage.hs +++ b/src/Storage.hs @@ -9,39 +9,39 @@ module Storage( -import qualified Control.Monad.Primitive as Prim +import Data.Int ( Int8 ) +import Preferences ( Preference ) import qualified Data.Vector.Unboxed.Mutable as Vec -import qualified Data.Int as Ints -data Store = Store { pointer :: Vec.MVector Prim.RealWorld Ints.Int8 - , sizeOfBallot :: Int} +data Store = Store { getPointer :: Vec.IOVector Int8 + , getBallotSize :: Int } createStore :: Int -> Int -> IO Store -createStore numberOfEntries ballotSize = do - v <- Vec.new (numberOfEntries * ballotSize) +createStore maxCapacity ballotSize = do + v <- Vec.new (maxCapacity * ballotSize) return (Store v ballotSize) -setPref :: Store -> Int -> Int -> Int -> IO () -setPref prefStore ballot position rank = do - let place = (ballot - 1) * (sizeOfBallot prefStore) + (position - 1) - Vec.write (pointer prefStore) place (fromIntegral rank) +setPref :: Store -> Int -> Preference -> IO () +setPref prefStore ballot (position,rank) = do + let place = (ballot - 1) * (getBallotSize prefStore) + (position - 1) + Vec.write (getPointer prefStore) place (fromIntegral rank) -checkPref :: Store -> Int -> Int -> Int -> IO Bool -checkPref prefStore ballot position rank = do - let place = (ballot - 1) * (sizeOfBallot prefStore) + (position - 1) - value <- Vec.read (pointer prefStore) place - return (value == (fromIntegral rank)) +checkPref :: Store -> Int -> Preference -> IO Bool +checkPref prefStore ballot (position,rank) = do + let place = (ballot - 1) * (getBallotSize prefStore) + (position - 1) + value <- Vec.read (getPointer prefStore) place + return (value == fromIntegral rank) diff --git a/src/main.hs b/src/main.hs index c3db4ad..603151d 100644 --- a/src/main.hs +++ b/src/main.hs @@ -65,11 +65,11 @@ below2 = [ "Donnelly, Matt" main = do args <- Env.getArgs - counter <- Sen.createSenateCounter (head args) above below - let testTraces = (map (:[]) (zip [1,1..] below)) + counter <- Sen.createSenateCounter (head args) above2 below2 + let testTraces = (map (:[]) (zip [1,1..] below2)) results <- mapM (Sen.doCount counter) testTraces let func (n,c) = putStrLn (c ++ " " ++ (show n)) - output = map func (zip results below) + output = map func (zip results below2) sequence_ output |