summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Main.hs14
-rw-r--r--src/Sequence/Formula.hs4
-rw-r--r--src/Sequence/Utils.hs1
3 files changed, 19 insertions, 0 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 9a51332..1c2afd4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -114,6 +114,7 @@ main = do
114 , cmd "heal'" healFatigue "Heal the focused entity of fatigue" 114 , cmd "heal'" healFatigue "Heal the focused entity of fatigue"
115 , cmd "log" dumpLog "Print the combat log" 115 , cmd "log" dumpLog "Print the combat log"
116 , cmd "val" printVal "Find the distribution of a specific value of the current entities" 116 , cmd "val" printVal "Find the distribution of a specific value of the current entities"
117 , cmd "summary" printVals "Find the averages of applicable all values"
117 ] 118 ]
118 , wordBreakChars = wordBreakChars initialShellDescription \\ [',', '\''] 119 , wordBreakChars = wordBreakChars initialShellDescription \\ [',', '\'']
119 } 120 }
@@ -572,3 +573,16 @@ printVal = withArg $ \formula -> withFocus $ \focusId -> do
572 lengths = map (length . show . fst) vals 573 lengths = map (length . show . fst) vals
573 -- normalize p = p / maximum (map snd vals) 574 -- normalize p = p / maximum (map snd vals)
574 normalize = id 575 normalize = id
576
577printVals :: Sh GameState ()
578printVals = withFocus $ \focusId -> do
579 name <- toName focusId
580 sheet <- Map.mapMaybe id <$> mapM (\l -> preuse $ gFocus' . eStats . to l . _Just) statAccessors
581 let
582 maxLength = maximum . map (length . CI.original) $ Map.keys sheet
583 printAvg (str, formula) = do
584 result <- focusState (gFocus' . eStats) (findAverage [name] formula)
585 case result of
586 Just avg -> shellPutStrLn $ printf "%*s: %.2f" maxLength (CI.original str) (fromRational avg :: Double)
587 Nothing -> return ()
588 mapM_ printAvg $ Map.toList sheet
diff --git a/src/Sequence/Formula.hs b/src/Sequence/Formula.hs
index 2ac1210..878ec7f 100644
--- a/src/Sequence/Formula.hs
+++ b/src/Sequence/Formula.hs
@@ -5,6 +5,7 @@ module Sequence.Formula
5 , (:<:)(..), Context(..), ctx 5 , (:<:)(..), Context(..), ctx
6 , evalFormula, evalFormula' 6 , evalFormula, evalFormula'
7 , findDistribution, findDistribution' 7 , findDistribution, findDistribution'
8 , findAverage
8 , val 9 , val
9 , d, z 10 , d, z
10 , Table, table 11 , Table, table
@@ -137,6 +138,9 @@ evalFormula' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (ev
137findDistribution' :: (MonadIO m, sInput :<: lInput, MonadState lInput m, Ord a) => [String] -> FormulaM sInput a -> m (Map a Rational) 138findDistribution' :: (MonadIO m, sInput :<: lInput, MonadState lInput m, Ord a) => [String] -> FormulaM sInput a -> m (Map a Rational)
138findDistribution' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (findDistribution promptPref) formula =<< get 139findDistribution' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (findDistribution promptPref) formula =<< get
139 140
141findAverage :: (MonadIO m, sInput :<: lInput, MonadState lInput m, Real a) => [String] -> FormulaM sInput a -> m Rational
142findAverage promptPref formula = sum . map (\(val, prob) -> toRational val * prob) . Map.toList <$> findDistribution' promptPref formula
143
140val :: Traversal' input (Formula input) -> [String] -> Bool -> Formula input 144val :: Traversal' input (Formula input) -> [String] -> Bool -> Formula input
141val answer prompt keepResult = do 145val answer prompt keepResult = do
142 gets (Set.member prompt) >>= bool (modify $ Set.insert prompt) (modify (Set.delete prompt) >> throwError Question{..}) 146 gets (Set.member prompt) >>= bool (modify $ Set.insert prompt) (modify (Set.delete prompt) >> throwError Question{..})
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs
index f51bcd8..9f03ca7 100644
--- a/src/Sequence/Utils.hs
+++ b/src/Sequence/Utils.hs
@@ -7,6 +7,7 @@ module Sequence.Utils
7 , toName, toDesc 7 , toName, toDesc
8 , outputLogged 8 , outputLogged
9 , scaleTimer 9 , scaleTimer
10 , statAccessors
10 , Argument(..) 11 , Argument(..)
11 , Completion(..) 12 , Completion(..)
12 , module Sequence.Utils.Ask 13 , module Sequence.Utils.Ask