From c95d1cc837f09c3a8b79ed03b6ab9076b37e61c0 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 23 Jan 2017 19:34:39 +1100 Subject: Improved verbosity and documentation --- notes.txt | 7 +++++++ readme.txt | 29 ++++++++++++++++++++++++++++- src/Election.hs | 39 ++++++++++++++++++++++++--------------- src/main.hs | 44 ++++++++++++++++++++++++++++++-------------- 4 files changed, 89 insertions(+), 30 deletions(-) diff --git a/notes.txt b/notes.txt index 430e13e..de865b0 100644 --- a/notes.txt +++ b/notes.txt @@ -1,4 +1,5 @@ + potential anomaly detected for Honan, Pat, NT @@ -17,6 +18,8 @@ Seselja, Zed, ACT AEC count 82932 my count 82931 +it's probably a programming error on my part + @@ -25,4 +28,8 @@ future direction util to list paper ids that fit specific criteria to doublecheck potential errors +replace the use of floats for transfer values with fixed points for increased accuracy + +add proper tiebreaker handling + diff --git a/readme.txt b/readme.txt index c3aff22..bea7150 100644 --- a/readme.txt +++ b/readme.txt @@ -1,6 +1,5 @@ - To compile this program, the following dependencies are needed: ghc (of course) @@ -22,3 +21,31 @@ Aside from base, the cabal packages required to compile this program are: containers + +Compilation is done by 'make all'. Further instruction on how to use this +program can be obtained from the '--help' switch, once compiled. + + + +The required data files this program expects can be obtained from + + http://results.aec.gov.au/20499/Website/SenateDownloadsMenu-20499-Csv.htm + +Specifically, the files listed under 'Formal Preferences'. At the moment this +program can only handle AEC Senate data from 2016 or later. Processing of State +Legislative Council data and more general STV data is a goal of future versions. + + + +Note that the number of count logs this program outputs differs slightly from +the number that the AEC provides. This is because the AEC's program merges a +few more logs compared to this one, eg the initial count, and counts that +elect candidates. + + + +Finally, be aware that processing STV data takes a long time and a lot of +memory. If you want to be sure that progress is happening, either turn on +the '--verbose' switch or monitor the output log directory. + + diff --git a/src/Election.hs b/src/Election.hs index 60fd78f..350d652 100644 --- a/src/Election.hs +++ b/src/Election.hs @@ -29,12 +29,14 @@ data Election = Election , getLogDir :: FilePath , getTotalPapers :: Int , getQuota :: Int + , getMainLog :: String , getNextLogNum :: Int , getSeats :: Int , getVacancies :: Int , getTransferQueue :: [Transfer] , getNextToElect :: Int - , isDone :: Bool } + , isDone :: Bool + , isVerbose :: Bool } data Entry = Entry { getID :: Typ.CandidateID @@ -66,10 +68,11 @@ type TransferMap = Map.Map Typ.CandidateID [(Int,Trace)] -createElection :: FilePath -> Sen.SenateCounter -> Int -> IO Election -createElection outDir counter numToElect = do +createElection :: FilePath -> Sen.SenateCounter -> Int -> Bool -> IO Election +createElection outDir counter numToElect verbosity = do entries <- mapM (candToEntry counter) (Sen.getBallot counter) - let total = Sen.getTotal counter + let mainLog = outDir ++ "/" ++ "log.txt" + total = Sen.getTotal counter quota = droopQuota total numToElect return (Election { getEntries = entries @@ -77,12 +80,14 @@ createElection outDir counter numToElect = do , getLogDir = outDir , getTotalPapers = total , getQuota = quota + , getMainLog = mainLog , getNextLogNum = 1 , getSeats = numToElect , getVacancies = numToElect , getTransferQueue = [] , getNextToElect = 1 - , isDone = False }) + , isDone = False + , isVerbose = verbosity }) @@ -112,11 +117,10 @@ candToEntry counter candidate = do doCount :: Election -> IO () -doCount e = do - writeLog e - let e1 = e { getNextLogNum = 1 + getNextLogNum e } - - Con.when (not (isDone e1)) $ do +doCount e = + Con.when (not (isDone e)) $ do + writeLog e + let e1 = e { getNextLogNum = 1 + getNextLogNum e } -- these following calculations probably aren't the -- intended use of Either monads, but the pattern fits @@ -216,11 +220,15 @@ doElectCandidate e = do allRevised = beforeEntries ++ [revisedElectedEntry] ++ afterEntries if (getTotalVotes electedEntry >= getQuota e) - then ET.right (e - { getEntries = allRevised - , getTransferQueue = (getTransferQueue e) ++ [newTransfer] - , getNextToElect = 1 + getNextToElect e - , getVacancies = getVacancies e - 1 }) + then do + let logmsg = show (getID electedEntry) ++ " elected at logfile #" ++ show (getNextLogNum e) + MIO.liftIO $ IO.appendFile (getMainLog e) (logmsg ++ "\n") + MIO.liftIO $ Con.when (isVerbose e) (putStrLn logmsg) + ET.right (e + { getEntries = allRevised + , getTransferQueue = (getTransferQueue e) ++ [newTransfer] + , getNextToElect = 1 + getNextToElect e + , getVacancies = getVacancies e - 1 }) else ET.left e @@ -265,6 +273,7 @@ doVoteTransfer e = do revisedFromEntry = fromEntry { getVoteChange = -(getVoteAmount currentTransfer) , getTotalVotes = getTotalVotes fromEntry - (getVoteAmount currentTransfer) + -- this last bit needs to be replaced with something more accurate , getCritTrace = [] } allRevised = (map reviseFunc beforeEntries) ++ [revisedFromEntry] ++ (map reviseFunc afterEntries) diff --git a/src/main.hs b/src/main.hs index 7b08e64..b0baaa4 100644 --- a/src/main.hs +++ b/src/main.hs @@ -67,7 +67,10 @@ stateOpt str = -optionHeader = "Usage: stv [OPTION...]" +optionHeader = + "Usage: stv [OPTION...]\n\n" ++ + "Note that the -c, -p, -o, -e, -s options are all\n" ++ + "required for normal operation.\n" optionData :: [Opt.OptDescr (Options -> Options)] optionData = @@ -85,18 +88,18 @@ optionData = , Opt.Option ['c'] ["candidates"] (Opt.ReqArg (\c opts -> opts { getCandFile = Just c }) "FILE") - "file containing AEC candidate data" + ".csv file containing AEC candidate data" , Opt.Option ['p'] ["preferences"] (Opt.ReqArg (\p opts -> opts { getPrefFile = Just p}) "FILE") - "file containing AEC formal preferences" + ".csv file containing AEC formal preferences" , Opt.Option ['o'] ["outdir"] (Opt.ReqArg (\d opts -> opts { getOutDir = Just d}) "DIR") - "directory to output count logging" + "new directory to output count logging" , Opt.Option ['e'] ["elect"] - (Opt.ReqArg electOpt "NUM") + (Opt.ReqArg electOpt "INT") "number of candidates to elect" , Opt.Option ['s'] ["state"] @@ -115,6 +118,14 @@ getOpts argv = +furtherHelp :: String +furtherHelp = + "Please be sure to provide all required options to run the election counter.\n" ++ + "For further information consult '--help'.\n" + + + + main = do rawArgs <- Env.getArgs (options, arguments) <- getOpts rawArgs @@ -134,42 +145,47 @@ main = do -- both present and valid let candidateFile = Maybe.fromJust (getCandFile options) Con.when (Maybe.isNothing (getCandFile options)) $ - Ex.die "Candidate data file not provided" + Ex.die ("Candidate data file not provided.\n\n" ++ furtherHelp) doesExist <- Dir.doesFileExist candidateFile Con.when (not doesExist) $ - Ex.die "Candidate data file does not exist" + Ex.die ("Candidate data file does not exist.\n\n" ++ furtherHelp) let preferenceFile = Maybe.fromJust (getPrefFile options) Con.when (Maybe.isNothing (getPrefFile options)) $ - Ex.die "Formal preference data file not provided" + Ex.die ("Formal preference data file not provided.\n\n" ++ furtherHelp) doesExist <- Dir.doesFileExist preferenceFile Con.when (not doesExist) $ - Ex.die "Formal preference data file does not exist" + Ex.die ("Formal preference data file does not exist.\n\n" ++ furtherHelp) let outputDir = Maybe.fromJust (getOutDir options) Con.when (Maybe.isNothing (getOutDir options)) $ - Ex.die "Output logging directory not provided" + Ex.die ("Output logging directory not provided.\n\n" ++ furtherHelp) doesExist <- Dir.doesDirectoryExist outputDir Con.when doesExist $ - Ex.die "Output directory already exists" + Ex.die ("Output directory already exists.\n\n" ++ furtherHelp) let numToElect = Maybe.fromJust (getNumToElect options) Con.when (Maybe.isNothing (getNumToElect options)) $ - Ex.die "Invalid number of candidates to elect or number not provided" + Ex.die ("Invalid number of candidates to elect or number not provided.\n\n" ++ furtherHelp) let state = Maybe.fromJust (getState options) Con.when (Maybe.isNothing (getState options)) $ - Ex.die "Invalid state/territory or state/territory not provided" + Ex.die ("Invalid state/territory or state/territory not provided.\n\n" ++ furtherHelp) -- set up the election processing (aboveBallot, belowBallot) <- Cand.readCandidates candidateFile state + Con.when (isVerbose options) $ putStrLn "Reading preference data..." counter <- Sen.createSenateCounter preferenceFile aboveBallot belowBallot + Con.when (isVerbose options) $ putStrLn "Done.\n" Dir.createDirectory outputDir - election <- Elt.createElection outputDir counter numToElect + Con.when (isVerbose options) $ putStrLn "Setting up election..." + election <- Elt.createElection outputDir counter numToElect (isVerbose options) + Con.when (isVerbose options) $ putStrLn "Done.\n" -- run the show + Con.when (isVerbose options) $ putStrLn "Running...\n" Elt.doCount election -- cgit