Merge pull request #105 from L0neGamer/dice-stats

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
@@ -62,6 +64,8 @@ As well as simple expressions, basic list expressions can be formed. You can for
 
 As an addendum to custom dice, if a list value is bracketed then it can be used in custom dice. For example, `5d(4#4d6)` rolls five dice, whose sides are determined by rolling 4d6 4 times. Do note that laziness still applies here, meaning that the RNG cap can be very quickly reached.
 
+Lists are limited to 50 items long currently (which is configurable).
+
 ## Functions
 
 Here are all the functions, what they take, and what they return.
@@ -70,6 +74,8 @@ Here are all the functions, what they take, and what they return.
 - abs (integer) - the absolute value of an integer
 - fact (integer < 50) - the factorial of an integer
 - id (integer) - the integer
+- max (integer, integer) - get the maximum item between two items
+- min (integer, integer) - get the minimum item between two items
 - maximum (list) - get the maximum item in a list
 - minimum (list) - get the minimum item in a list
 - mod (two integers, second /= 0) - get the modulo of two integers
@@ -83,3 +89,31 @@ 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 (inclusive)
+- concat (list, list) - concatenate two lists together
+
+# 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,20 @@ dependencies:
 - safe
 - edit-distance
 - unliftio
+- Chart
+- Chart-diagrams
+- diagrams-core
+- diagrams-lib
+- diagrams-rasterific
+- JuicyPixels
 - split
 - regex-pcre
+- distribution
 
 library:
   source-dirs: src
   default-extensions:
   - OverloadedStrings
-  - ImportQualifiedPost
   - LambdaCase
   - EmptyDataDecls
   - FlexibleContexts
@@ -88,6 +94,7 @@ library:
   - ScopedTypeVariables
   - TypeOperators
   - RankNTypes
+  - BangPatterns
   ghc-options:
   - -Wall
 

src/Tablebot/Internal/Handler/Command.hs

@@ -68,30 +68,9 @@ parseCommands cs m prefix = case parse (parser cs) "" (messageText m) of
     parser cs' =
       do
         _ <- chunk prefix
-        res <- parser' cs'
-        case res of
-          Nothing -> fail "No command with that name was found!"
-          Just p -> return p
-    parser' :: [CompiledCommand] -> Parser (Maybe (Message -> CompiledDatabaseDiscord ()))
-    parser' cs' =
-      do
-        -- 1. Parse the command name (fails if no such command exists).
-        res <- choice (map matchCommand cs') <|> return Nothing
-        case res of
-          Nothing -> return Nothing
-          Just (command, subcommands) ->
-            do
-              -- 2. Try to get a subcommand.
-              maybeComm <- parser' subcommands
-              case maybeComm of
-                -- 2.1. If there's a subcommand, use that.
-                Just pars -> return (Just pars)
-                -- 2.2. Otherwise, use the main command.
-                Nothing -> Just <$> command
-    matchCommand :: CompiledCommand -> Parser (Maybe (Parser (Message -> CompiledDatabaseDiscord ()), [CompiledCommand]))
-    matchCommand c = do
-      try (chunk (commandName c) *> (skipSpace1 <|> eof))
-      return (Just (commandParser c, commandSubcommands c))
+        choice (map toErroringParser cs') <?> "No command with that name was found!"
+    toErroringParser :: CompiledCommand -> Parser (Message -> CompiledDatabaseDiscord ())
+    toErroringParser c = try (chunk $ commandName c) *> (skipSpace1 <|> eof) *> (try (choice $ map toErroringParser $ commandSubcommands c) <|> commandParser c)
 
 data ReadableError = UnknownError | KnownError String [String]
   deriving (Show, Eq, Ord)
@@ -136,7 +115,7 @@ makeReadable (TrivialError i _ good) =
     getLabel :: [ErrorItem (Token Text)] -> (Maybe String, [String])
     getLabel [] = (Nothing, [])
     getLabel ((Tokens nel) : xs) = (Nothing, [NE.toList nel]) <> getLabel xs
-    getLabel ((Label ls) : xs) = (Just (NE.toList ls), []) <> getLabel xs
+    getLabel ((Label ls) : xs) = (Just (NE.toList ls <> "\n"), []) <> getLabel xs
     getLabel (EndOfInput : xs) = (Nothing, ["no more input"]) <> getLabel xs
 makeReadable e = (mapParseError (const UnknownError) e, Nothing)
 

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

@@ -22,10 +22,21 @@ 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
+  = -- | Represents `N#B`, where N is a NumBase (numbers, parentheses) and B is a Base (numbase or dice value)
+    MultipleValues NumBase Base
+  | -- | Represents a function call with the given arguments
+    LVFunc (FuncInfoBase [Integer]) [ArgValue]
+  | -- | A base ListValues value - parentheses or a list of expressions
+    LVBase ListValuesBase
   deriving (Show)
 
 -- | The type for basic list values (that can be used as is for custom dice).
+--
+-- A basic list value can be understood as one that is indivisible, and/or
+-- atomic. They represent either a list value in parentheses, or a list of
+-- expressions. Effectively what this is used for is so that these can be used
+-- as dice side values.
 data ListValuesBase = LVBParen (Paren ListValues) | LVBList [Expr]
   deriving (Show)
 
@@ -47,7 +58,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)
@@ -37,6 +37,9 @@ newtype RNGCount = RNGCount {getRNGCount :: Integer} deriving (Eq, Ord)
 maximumRNG :: RNGCount
 maximumRNG = RNGCount 150
 
+maximumListLength :: Integer
+maximumListLength = 50
+
 -- | Increment the rngcount by 1.
 incRNGCount :: RNGCount -> RNGCount
 incRNGCount (RNGCount i) = RNGCount (i + 1)
@@ -136,7 +139,9 @@ class IOEvalList a where
   -- displayed. This function adds the current location to the exception
   -- callstack.
   evalShowL :: PrettyShow a => RNGCount -> a -> IO ([(Integer, Text)], Maybe Text, RNGCount)
-  evalShowL rngCount a = propagateException (prettyShow a) (evalShowL' rngCount a)
+  evalShowL rngCount a = do
+    (is, mt, rngCount') <- propagateException (prettyShow a) (evalShowL' rngCount a)
+    return (genericTake maximumListLength is, mt, rngCount')
 
   evalShowL' :: PrettyShow a => RNGCount -> a -> IO ([(Integer, Text)], Maybe Text, RNGCount)
 
@@ -359,7 +364,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,20 +36,22 @@ 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) :
   constructFuncInfo "sum" (sum @[] @Integer) :
+  constructFuncInfo "max" (max @Integer) :
+  constructFuncInfo "min" (min @Integer) :
   constructFuncInfo "maximum" (maximum @[] @Integer) :
   constructFuncInfo "minimum" (minimum @[] @Integer) :
   constructFuncInfo' "mod" (mod @Integer) (Nothing, Nothing, (== 0)) :
@@ -63,23 +65,27 @@ 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 "concat" (++) :
+  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 +95,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 +150,16 @@ 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
+  --
+  -- The bounds represent the exclusive lower bound, the exclusive upper bound,
+  -- and an arbitrary function which results in an exception when it is true;
+  -- say, with division when you want to deny just 0 as a value.
+  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 +169,34 @@ checkBounds i (ml, mh, bs)
   | bs i = throwBot $ EvaluationException ("invalid value for function: `" <> show i ++ "`") []
   | otherwise = return i
 
-instance {-# OVERLAPPING #-} ApplyFunc m Integer where
+-- This is one of two base cases for applyFunc. This is the case where the
+-- return value is an integer. As it is the return value, no arguments are
+-- accepted.
+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
+-- This is one of two base cases for applyFunc. This is the case where the
+-- return value is a list of integers. As it is the return value, no arguments
+-- are  accepted.
+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
+-- This is one of two recursive cases for applyFunc. This is the case where the
+-- argument value is an integer. If there are no arguments or the argument is
+-- of the wrong type, an exception is thrown.
+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
+-- This is one of two recursive cases for applyFunc. This is the case where the
+-- argument value is a list of integers. If there are no arguments or the
+-- argument is of the wrong type, an exception is thrown.
+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