summaryrefslogtreecommitdiff
path: root/src/Counter.hs
blob: 021ac45ca11a65d6d88e6c1a0b43e45fc28fa2d9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
module Counter(
    Criteria,
    SenateCounter,

    createSenateCounter,
    doCount
    ) where




import qualified Candidate 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 Data.Either.Unwrap as Either
import qualified Data.Maybe as Maybe
import qualified Data.List as List




--  represents a criteria used for finding ballots that voted a specific
--  way, for example voted for candidate C as #1, candidate F as #2, etc
type Criteria = [(Typ.Ranking,Typ.CandidateID)]

data SenateCounter = SenateCounter
    { prefData   :: Vec.Store
    , ballotMap  :: Typ.BelowLineBallot
    , numBallots :: Int }




createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter
createSenateCounter f a b = do
    numLines <- File.countLines f
    arrayData <- Vec.createStore numLines (length b)

    h <- IO.openFile f IO.ReadMode
    let readFunc n p = if (n > numLines) then return p else do
            t0 <- IO.hGetLine h
            let t1 = CSV.parseRecord CSV.defaultSettings t0
                t2 = Maybe.listToMaybe . reverse . Either.fromRight $ t1
                t3 = Pref.parsePreferences (length a) (length b) (Maybe.fromJust t2)
                t4 = Pref.normalise a b (Either.fromRight t3)
                t5 = Maybe.fromJust t4
            if (Either.isRight t1) && (Maybe.isJust t2) && (Either.isRight t3) && (Maybe.isJust t4)
                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)




doCount :: SenateCounter -> Criteria -> IO Int
doCount sen criteria = do
    let isValidCriteria = all (\(x,y) -> y `List.elem` (ballotMap sen)) criteria

    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 (Vec.checkPref (prefData sen) n) neededPrefs)
            if t then checkFunc (n + 1) (r + 1) else checkFunc (n + 1) r

    if isValidCriteria
        then checkFunc 1 0
        else return 0