summaryrefslogtreecommitdiff
path: root/src/Sequence/Formula.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Sequence/Formula.hs')
-rw-r--r--src/Sequence/Formula.hs13
1 files changed, 11 insertions, 2 deletions
diff --git a/src/Sequence/Formula.hs b/src/Sequence/Formula.hs
index 878ec7f..5c06503 100644
--- a/src/Sequence/Formula.hs
+++ b/src/Sequence/Formula.hs
@@ -1,14 +1,14 @@
1{-# LANGUAGE RecordWildCards, RankNTypes, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, ViewPatterns, TypeFamilies, GADTs, TypeOperators, ExistentialQuantification, FlexibleContexts, IncoherentInstances #-} 1{-# LANGUAGE RecordWildCards, RankNTypes, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, ViewPatterns, TypeFamilies, GADTs, TypeOperators, ExistentialQuantification, FlexibleContexts, IncoherentInstances #-}
2 2
3module Sequence.Formula 3module Sequence.Formula
4 ( FormulaM, Formula, quot' 4 ( FormulaM, FormulaMT, Formula, quot'
5 , (:<:)(..), Context(..), ctx 5 , (:<:)(..), Context(..), ctx
6 , evalFormula, evalFormula' 6 , evalFormula, evalFormula'
7 , findDistribution, findDistribution' 7 , findDistribution, findDistribution'
8 , findAverage 8 , findAverage
9 , val 9 , val
10 , d, z 10 , d, z
11 , Table, table 11 , Table, table, cTable
12 ) where 12 ) where
13 13
14import Control.Lens hiding (Context(..)) 14import Control.Lens hiding (Context(..))
@@ -31,6 +31,7 @@ import Data.List
31import Data.Maybe 31import Data.Maybe
32import Data.Either 32import Data.Either
33import Data.Tuple 33import Data.Tuple
34import Data.Ratio
34 35
35import Data.Map (Map) 36import Data.Map (Map)
36import qualified Data.Map as Map 37import qualified Data.Map as Map
@@ -38,6 +39,8 @@ import qualified Data.Map as Map
38import Data.Set (Set) 39import Data.Set (Set)
39import qualified Data.Set as Set 40import qualified Data.Set as Set
40 41
42import Debug.Trace
43
41class (:<:) small large where 44class (:<:) small large where
42 ctx' :: Traversal' large small 45 ctx' :: Traversal' large small
43 46
@@ -68,6 +71,7 @@ ctxStore :: Traversal' (Context input) (Formula input)
68ctxStore modifyF (Context large fSt) = Context large <$> _Just modifyF fSt 71ctxStore modifyF (Context large fSt) = Context large <$> _Just modifyF fSt
69 72
70type FormulaM input a = StateT (Set [String]) (ReaderT (Context input) (ExceptT (Question input) EventM)) a 73type FormulaM input a = StateT (Set [String]) (ReaderT (Context input) (ExceptT (Question input) EventM)) a
74type FormulaMT t input a = t (StateT (Set [String]) (ReaderT (Context input) (ExceptT (Question input) EventM))) a
71 75
72type Formula input = FormulaM input Int 76type Formula input = FormulaM input Int
73 77
@@ -154,3 +158,8 @@ type Table a = Map a Rational
154 158
155table :: Ord a => Table a -> FormulaM input a 159table :: Ord a => Table a -> FormulaM input a
156table = liftBase . makeEventProb . Map.assocs 160table = liftBase . makeEventProb . Map.assocs
161
162cTable :: Ord v => [(Integer, Integer, v)] -> Table v
163cTable results = Map.fromList $ map (\(from, to, value) -> (value, (abs (to - from) + 1) % (range + 1))) results
164 where
165 range = maximum [ max from to | (from, to, _) <- results ] - minimum [ min from to | (from, to, _) <- results ]