From b282e055140ff65879296d4654ad269cc7ff8185 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Fri, 27 Jan 2017 17:39:05 +1100
Subject: Code a lot cleaner, algorithm theoretically improved, yet still slow
 as fuck probably due to criteria parsing

---
 src/Counter.hs | 51 ++++++++++++++++++++++++++-------------------------
 1 file changed, 26 insertions(+), 25 deletions(-)

(limited to 'src/Counter.hs')

diff --git a/src/Counter.hs b/src/Counter.hs
index 37b36dc..855b266 100644
--- a/src/Counter.hs
+++ b/src/Counter.hs
@@ -1,5 +1,4 @@
 module Counter(
-    Criteria,
     SenateCounter,
 
     createSenateCounter,
@@ -13,6 +12,7 @@ module Counter(
 
 import qualified Candidate as Typ
 import qualified Preferences as Pref
+import qualified Criteria as Crit
 import qualified CSV as CSV
 import qualified Storage as Vec
 import qualified System.IO as IO
@@ -25,10 +25,6 @@ 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
@@ -40,40 +36,45 @@ data SenateCounter = SenateCounter
 createSenateCounter :: FilePath -> Typ.AboveLineBallot -> Typ.BelowLineBallot -> IO SenateCounter
 createSenateCounter f a b = do
     numLines <- File.countLines f
-    arrayData <- Vec.createStore numLines (length b)
+    prefStore <- 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 ++ "\n")
-                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)
+            let prefs = parseRawLine a b t0
+                result = Maybe.fromJust prefs
+            if (Maybe.isJust prefs)
+                then Vec.setPrefs prefStore n result >> readFunc (n + 1) (p + 1)
                 else readFunc (n + 1) p
     p <- readFunc 1 0
     IO.hClose h
 
-    return (SenateCounter arrayData b p)
+    return (SenateCounter prefStore b p)
+
+
 
 
+parseRawLine :: Typ.AboveLineBallot -> Typ.BelowLineBallot -> String -> Maybe [Pref.Preference]
+parseRawLine a b input =
+    let t1 = CSV.parseRecord CSV.defaultSettings (input ++ "\n")
+        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)
+    in if (Either.isRight t1 && Maybe.isJust t2 && Either.isRight t3)
+        then t4
+        else Nothing
 
 
-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
+doCount :: SenateCounter -> Crit.Criteria -> IO Int
+doCount sen criteria =
+    let tailFunc n r = if (n > numBallots sen) then return r else do
+            prefs <- Vec.getPrefs (prefData sen) n
+            if (Crit.evaluate (ballotMap sen) prefs criteria)
+                then tailFunc (n + 1) (r + 1)
+                else tailFunc (n + 1) r
+    in tailFunc 1 0
 
 
 
-- 
cgit