Dice stats

app/Main.hs

@@ -16,7 +16,7 @@ main :: IO ()
 main = forever $ do
   loadEnv
   dToken <- pack <$> getEnv "DISCORD_TOKEN"
-  unless (encodeUtf8 dToken =~ "^[A-Za-z0-9_-]{24}[.][A-Za-z0-9_-]{6}[.][A-Za-z0-9_-]{27}$") $
+  unless (encodeUtf8 dToken =~ ("^[A-Za-z0-9_-]{24}[.][A-Za-z0-9_-]{6}[.][A-Za-z0-9_-]{27}$" :: String)) $
     die "Invalid token format. Please check it is a bot token"
   prefix <- pack . fromMaybe "!" <$> lookupEnv "PREFIX"
   dbpath <- getEnv "SQLITE_FILENAME"

docs/Roll.md

@@ -4,6 +4,8 @@ The roll command has a staggering amount of flexibility, as well as additional f
 
 Below are listed the current full capabilities of the bot for rolling dice and evaluation expressions. All operations (currently) result in integers or a list. A list of functions is available in the [functions section](#Functions).
 
+You can also generate statistics of an expression. See the [Statistics](#Statistics) section for more information.
+
 ## Basic Operators
 
 - Addition
@@ -83,3 +85,30 @@ Here are all the functions, what they take, and what they return.
 - reverse (list) - reverse the list
 - sort (list) - sort the list in ascending order
 - take (integer, list) - take the first `n` values from a list, where `n` is the integer given
+- between (integer, integer) - generate a list between the two given integers
+
+# Statistics
+
+As well as generating values, statistics based off of expressions can be found. There is a total time limit of 10 seconds for this command, with 5 seconds given to calculations and 5 seconds given to generating the bar chart.
+
+To get these statistics, calling the `roll` command with the `stats` subcommand will generate the requested statistics. The expression given has to return an integer.
+
+The bot will give the mean, the standard deviation, and the top ten most common values of the distribution, as well as graphing the entire distribution.
+
+For example, the result of calling `roll stats 2d20kh1` (roll two twenty sided dice and keep the higher die) can be seen below.
+
+!["The results of asking for stats of 2d20kh1 (roll two twenty sided dice and keep the highest one). The ten most common rolls are 20 to 11. The mean is 13.825. The standard deviation is about 4.7. The bar chart has values on each integer from 1 to 20, with the height of each bar increasing linearly."](./resources/dicestats_2d20kh1.jpg "the result of asking for stats of 2d20kh1")
+
+(above: The results of asking for stats of 2d20kh1 (roll two twenty sided dice and keep the highest one). The ten most common rolls are 20 to 11. The mean is 13.825. The standard deviation is about 4.7. The bar chart has values on each integer from 1 to 20, with the height of each bar increasing linearly.)
+
+Currently, the statistics generation supports all valid expressions.
+
+If invalid states occur (such as with division by zero, negative exponents, or infinite rerolls) the bot will alert the user only if the entire distribution becomes empty. For example, in `1d20rr<(21-d{0,1})`, half of the time infinite rerolls will occur. In this case, these invalid cases are ignored, as they can never be actually rolled, and the only value output is `20`. If the expression given is instead `1/0`, the entire distribution will be empty, as there is no valid output from this expression.
+
+As well as statistics for a given expression, multiple expressions can be shown in the same instance.
+
+For example, the result of calling `roll stats 2d20kh1 4d6dl1` is as follows.
+
+!["The results of asking for stats of 2d20kh1 and 4d6dl1 (roll two twenty sided dice and keep the highest one, and roll four dice with six sides, and drop the lowest value of each). The most common rolls for each expression are 20 to 16, and 13, 12, 14, 11, and 15. The means are about 13.8 and 12.2. The standard deviation are about 4.7 and 2.8. The bar chart has blue values on each integer from 1 to 20, with the height of each bar increasing linearly, and green values that form a weighted bell curve centered on 13."](./resources/dicestats_2d20kh1_4d6dl1.jpg "the result of asking for stats of 2d20kh1 and 4d6dl1")
+
+(above: The results of asking for stats of 2d20kh1 and 4d6dl1 (roll two twenty sided dice and keep the highest one, and roll four dice with six sides, and drop the lowest value of each). The most common rolls for each expression are 20 to 16, and 13, 12, 14, 11, and 15. The means are about 13.8 and 12.2. The standard deviation are about 4.7 and 2.8. The bar chart has blue values on each integer from 1 to 20, with the height of each bar increasing linearly, and green values that form a weighted bell curve centered on 13.)

package.yaml

@@ -57,14 +57,25 @@ dependencies:
 - safe
 - edit-distance
 - unliftio
+- Chart
+- Chart-diagrams
+- diagrams-core
+- diagrams-lib
+- diagrams-postscript
+- diagrams-svg
+- diagrams-rasterific
+- SVGFonts
+- graphviz
+- JuicyPixels
 - split
 - regex-pcre
+- distribution
 
 library:
   source-dirs: src
   default-extensions:
-  - OverloadedStrings
   - ImportQualifiedPost
+  - OverloadedStrings
   - LambdaCase
   - EmptyDataDecls
   - FlexibleContexts
@@ -96,6 +107,8 @@ executables:
   tablebot-exe:
     main:                Main.hs
     source-dirs:         app
+    default-extensions:
+    - ImportQualifiedPost
     ghc-options:
     - -threaded
     - -rtsopts
@@ -107,6 +120,8 @@ tests:
   tablebot-test:
     main:                Spec.hs
     source-dirs:         test
+    default-extensions:
+    - ImportQualifiedPost
     ghc-options:
     - -threaded
     - -rtsopts

src/Tablebot/Plugins/Roll/Dice/DiceData.hs

@@ -22,7 +22,7 @@ data ArgValue = AVExpr Expr | AVListValues ListValues
   deriving (Show)
 
 -- | The type for list values.
-data ListValues = MultipleValues NumBase Base | LVFunc (FuncInfoBase IO [Integer]) [ArgValue] | LVBase ListValuesBase
+data ListValues = MultipleValues NumBase Base | LVFunc (FuncInfoBase [Integer]) [ArgValue] | LVBase ListValuesBase
   deriving (Show)
 
 -- | The type for basic list values (that can be used as is for custom dice).
@@ -47,7 +47,7 @@ data Expo = Expo Func Expo | NoExpo Func
   deriving (Show)
 
 -- | The type representing a single function application, or a base item.
-data Func = Func (FuncInfo IO) [ArgValue] | NoFunc Base
+data Func = Func FuncInfo [ArgValue] | NoFunc Base
   deriving (Show)
 
 -- | The type representing an integer value or an expression in brackets.

src/Tablebot/Plugins/Roll/Dice/DiceEval.hs

@@ -8,7 +8,7 @@
 --
 -- Functions, type classes, and other utilities to evaluate dice values and
 -- expressions.
-module Tablebot.Plugins.Roll.Dice.DiceEval (PrettyShow (prettyShow), evalList, evalInteger) where
+module Tablebot.Plugins.Roll.Dice.DiceEval (PrettyShow (prettyShow), evalList, evalInteger, evaluationException, propagateException) where
 
 import Control.Monad (when)
 import Control.Monad.Exception (MonadException)
@@ -359,7 +359,7 @@ instance IOEval Func where
   evalShow' rngCount (NoFunc b) = evalShow rngCount b
 
 -- | Evaluate a function when given a list of parameters
-evaluateFunction :: RNGCount -> FuncInfoBase IO j -> [ArgValue] -> IO (j, Text, RNGCount)
+evaluateFunction :: RNGCount -> FuncInfoBase j -> [ArgValue] -> IO (j, Text, RNGCount)
 evaluateFunction rngCount fi exprs = do
   (exprs', rngCount') <- evalShowList'' (\r a -> evalArgValue r a >>= \(i, r') -> return (i, "", r')) rngCount exprs
   f <- funcInfoFunc fi (fst <$> exprs')

src/Tablebot/Plugins/Roll/Dice/DiceFunctions.hs

@@ -36,16 +36,16 @@ factorialLimit = 50
 
 -- | Mapping from function names to the functions themselves for integer
 -- functions.
-integerFunctions :: MonadException m => Map Text (FuncInfo m)
+integerFunctions :: Map Text FuncInfo
 integerFunctions = M.fromList $ fmap (\fi -> (funcInfoName fi, fi)) integerFunctions'
 
 -- | The names of the integer functions currently supported.
 integerFunctionsList :: [Text]
-integerFunctionsList = M.keys (integerFunctions @IO)
+integerFunctionsList = M.keys integerFunctions
 
 -- | The base details of the integer functions, containing all the information
 -- for each function that returns an integer.
-integerFunctions' :: MonadException m => [FuncInfo m]
+integerFunctions' :: [FuncInfo]
 integerFunctions' =
   funcInfoIndex :
   constructFuncInfo "length" (genericLength @Integer @Integer) :
@@ -63,23 +63,26 @@ integerFunctions' =
       | otherwise = n * fact (n - 1)
 
 -- | Mapping from function names to the functions themselves for list functions.
-listFunctions :: MonadException m => Map Text (FuncInfoBase m [Integer])
+listFunctions :: Map Text (FuncInfoBase [Integer])
 listFunctions = M.fromList $ fmap (\fi -> (funcInfoName fi, fi)) listFunctions'
 
 -- | The names of the list functions currently supported.
 listFunctionsList :: [Text]
-listFunctionsList = M.keys (listFunctions @IO)
+listFunctionsList = M.keys listFunctions
 
 -- | The base details of the list functions, containing all the information for
 -- each function that returns an integer.
-listFunctions' :: MonadException m => [FuncInfoBase m [Integer]]
+listFunctions' :: [FuncInfoBase [Integer]]
 listFunctions' =
-  constructFuncInfo @[Integer] "drop" (genericDrop @Integer) :
+  constructFuncInfo "between" between :
+  constructFuncInfo "drop" (genericDrop @Integer) :
   constructFuncInfo "take" (genericTake @Integer) :
   (uncurry constructFuncInfo <$> [("sort", sort), ("reverse", reverse)])
+  where
+    between i i' = let (mi, ma, rev) = (min i i', max i i', if i > i' then reverse else id) in rev [mi .. ma]
 
 -- | The `FuncInfo` of the function that indexes into a list.
-funcInfoIndex :: FuncInfo m
+funcInfoIndex :: FuncInfo
 funcInfoIndex = FuncInfo "index" [ATInteger, ATIntegerList] ATInteger fiIndex
   where
     fiIndex (LIInteger i : [LIList is])
@@ -89,20 +92,20 @@ funcInfoIndex = FuncInfo "index" [ATInteger, ATIntegerList] ATInteger fiIndex
 
 -- | A data structure to contain the information about a given function,
 -- including types, the function name, and the function itself.
-data FuncInfoBase m j = FuncInfo {funcInfoName :: Text, funcInfoParameters :: [ArgType], funcReturnType :: ArgType, funcInfoFunc :: MonadException m => [ListInteger] -> m j}
+data FuncInfoBase j = FuncInfo {funcInfoName :: Text, funcInfoParameters :: [ArgType], funcReturnType :: ArgType, funcInfoFunc :: forall m. (MonadException m) => [ListInteger] -> m j}
 
-type FuncInfo m = FuncInfoBase m Integer
+type FuncInfo = FuncInfoBase Integer
 
-instance Show (FuncInfoBase m j) where
+instance Show (FuncInfoBase j) where
   show (FuncInfo fin ft frt _) = "FuncInfo " <> unpack fin <> " " <> show ft <> " " <> show frt
 
 -- | A simple way to construct a function that returns a value j, and has no
 -- constraints on the given values.
-constructFuncInfo :: forall j f m. (MonadException m, ApplyFunc m f, Returns f ~ j) => Text -> f -> FuncInfoBase m j
+constructFuncInfo :: forall j f. (ApplyFunc f, Returns f ~ j) => Text -> f -> FuncInfoBase j
 constructFuncInfo s f = constructFuncInfo' s f (Nothing, Nothing, const False)
 
 -- | Construct a function info when given optional constraints.
-constructFuncInfo' :: forall j f m. (MonadException m, ApplyFunc m f, Returns f ~ j) => Text -> f -> (Maybe Integer, Maybe Integer, Integer -> Bool) -> FuncInfoBase m j
+constructFuncInfo' :: forall j f. (ApplyFunc f, Returns f ~ j) => Text -> f -> (Maybe Integer, Maybe Integer, Integer -> Bool) -> FuncInfoBase j
 constructFuncInfo' s f bs = FuncInfo s params (last types) (applyFunc f (fromIntegral (length params)) bs)
   where
     types = getTypes f
@@ -144,12 +147,12 @@ instance ArgCount f => ArgCount ([Integer] -> f) where
 --
 -- If the number of inputs is incorrect or the value given out of the range, an
 -- exception is thrown.
-class ArgCount f => ApplyFunc m f where
+class ArgCount f => ApplyFunc f where
   -- | Takes a function, the number of arguments in the function overall, bounds
   -- on integer values to the function, and a list of `ListInteger`s (which are
   -- either a list of integers or an integer), and returns a wrapped `j` value,
   -- which is a value that the function originally returns.
-  applyFunc :: (MonadException m, Returns f ~ j) => f -> Integer -> (Maybe Integer, Maybe Integer, Integer -> Bool) -> [ListInteger] -> m j
+  applyFunc :: forall m j. (MonadException m, Returns f ~ j) => f -> Integer -> (Maybe Integer, Maybe Integer, Integer -> Bool) -> [ListInteger] -> m j
 
 -- | Check whether a given value is within the given bounds.
 checkBounds :: (MonadException m) => Integer -> (Maybe Integer, Maybe Integer, Integer -> Bool) -> m Integer
@@ -159,22 +162,22 @@ checkBounds i (ml, mh, bs)
   | bs i = throwBot $ EvaluationException ("invalid value for function: `" <> show i ++ "`") []
   | otherwise = return i
 
-instance {-# OVERLAPPING #-} ApplyFunc m Integer where
+instance {-# OVERLAPPING #-} ApplyFunc Integer where
   applyFunc f _ _ [] = return f
   applyFunc _ args _ _ = throwBot $ EvaluationException ("incorrect number of arguments to function. expected " <> show args <> ", got more than that") []
 
-instance {-# OVERLAPPING #-} ApplyFunc m [Integer] where
+instance {-# OVERLAPPING #-} ApplyFunc [Integer] where
   applyFunc f _ _ [] = return f
   applyFunc _ args _ _ = throwBot $ EvaluationException ("incorrect number of arguments to function. expected " <> show args <> ", got more than that") []
 
-instance {-# OVERLAPPABLE #-} (ApplyFunc m f) => ApplyFunc m (Integer -> f) where
+instance {-# OVERLAPPABLE #-} (ApplyFunc f) => ApplyFunc (Integer -> f) where
   applyFunc f args _ [] = throwBot $ EvaluationException ("incorrect number of arguments to function. got " <> show dif <> ", expected " <> show args) []
     where
       dif = args - getArgs f
   applyFunc f args bs ((LIInteger x) : xs) = checkBounds x bs >>= \x' -> applyFunc (f x') args bs xs
   applyFunc _ _ _ (_ : _) = throwBot $ EvaluationException "incorrect type given to function. expected an integer, got a list" []
 
-instance {-# OVERLAPPABLE #-} (ApplyFunc m f) => ApplyFunc m ([Integer] -> f) where
+instance {-# OVERLAPPABLE #-} (ApplyFunc f) => ApplyFunc ([Integer] -> f) where
   applyFunc f args _ [] = throwBot $ EvaluationException ("incorrect number of arguments to function. got " <> show dif <> ", expected " <> show args) []
     where
       dif = args - getArgs f