diff options
-rw-r--r-- | src/Main.hs | 14 | ||||
-rw-r--r-- | src/Sequence/Formula.hs | 4 | ||||
-rw-r--r-- | src/Sequence/Utils.hs | 1 |
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 | |||
577 | printVals :: Sh GameState () | ||
578 | printVals = 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 | |||
137 | findDistribution' :: (MonadIO m, sInput :<: lInput, MonadState lInput m, Ord a) => [String] -> FormulaM sInput a -> m (Map a Rational) | 138 | findDistribution' :: (MonadIO m, sInput :<: lInput, MonadState lInput m, Ord a) => [String] -> FormulaM sInput a -> m (Map a Rational) |
138 | findDistribution' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (findDistribution promptPref) formula =<< get | 139 | findDistribution' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (findDistribution promptPref) formula =<< get |
139 | 140 | ||
141 | findAverage :: (MonadIO m, sInput :<: lInput, MonadState lInput m, Real a) => [String] -> FormulaM sInput a -> m Rational | ||
142 | findAverage promptPref formula = sum . map (\(val, prob) -> toRational val * prob) . Map.toList <$> findDistribution' promptPref formula | ||
143 | |||
140 | val :: Traversal' input (Formula input) -> [String] -> Bool -> Formula input | 144 | val :: Traversal' input (Formula input) -> [String] -> Bool -> Formula input |
141 | val answer prompt keepResult = do | 145 | val 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 |