https://wiki.haskell.org/index.php?title=Haskell_Quiz/Dice_Roller/Solution_Abhinav&feed=atom&action=historyHaskell Quiz/Dice Roller/Solution Abhinav - Revision history2024-03-29T15:35:37ZRevision history for this page on the wikiMediaWiki 1.35.5https://wiki.haskell.org/index.php?title=Haskell_Quiz/Dice_Roller/Solution_Abhinav&diff=54558&oldid=prevAbhinav.sarkar: New page: <haskell> {- A solution to rubyquiz 61 (http://rubyquiz.com/quiz61.html). The task for this Quiz is to write a dice roller. The program should take two arguments: a dice expression ...2012-10-26T14:33:46Z<p>New page: <haskell> {- A solution to rubyquiz 61 (http://rubyquiz.com/quiz61.html). The task for this Quiz is to write a dice roller. The program should take two arguments: a dice expression ...</p>
<p><b>New page</b></p><div><haskell><br />
{-<br />
A solution to rubyquiz 61 (http://rubyquiz.com/quiz61.html).<br />
<br />
The task for this Quiz is to write a dice roller. The program should take<br />
two arguments: a dice expression followed by the number of times to roll it<br />
(being optional, with a default of 1).<br />
<br />
The solution is done using Parsec for parsing the expression into an AST and<br />
then evaluating it recursively.<br />
<br />
Usage: bin/DiceRoller "(5d5-4)d(16/d4)+3" 10<br />
bin/DiceRoller 3d3<br />
<br />
Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net><br />
-}<br />
<br />
{-# LANGUAGE NoMonomorphismRestriction #-}<br />
<br />
module Main (main) where<br />
<br />
import Control.Applicative ((<$>), (<*), (*>), (<|>))<br />
import Control.Monad (foldM, liftM2, liftM, when)<br />
import Control.Monad.State (State, get, put, runState)<br />
import System.Random (Random, StdGen, randomR, newStdGen)<br />
import Text.Parsec (many1, digit, spaces, char, parse)<br />
import Text.Parsec.Expr (Assoc(..), Operator(..), buildExpressionParser)<br />
import System.Environment (getArgs)<br />
<br />
-- Randomness setup for dice roll --<br />
<br />
type RandomState = State StdGen<br />
<br />
getRandomR :: Random a => (a, a) -> RandomState a<br />
getRandomR limits = do<br />
gen <- get<br />
let (val, gen') = randomR limits gen<br />
put gen'<br />
return val<br />
<br />
-- AST --<br />
<br />
-- Expression AST types<br />
data Expr = Lit Int | -- An integer literal<br />
Add Expr Expr | -- Binary addition<br />
Sub Expr Expr | -- Binary subtraction<br />
Mul Expr Expr | -- Binary multiplication<br />
Div Expr Expr | -- Binary integer division<br />
Rol Expr | -- Unary single dice roll<br />
MRol Expr Expr -- Binary multiple dice rolls<br />
deriving (Show)<br />
<br />
-- Recursively evaluates the AST to get its value<br />
eval :: Expr -> RandomState Int<br />
eval (Lit i) = return i<br />
eval (Add e1 e2) = liftM2 (+) (eval e1) (eval e2)<br />
eval (Sub e1 e2) = liftM2 (-) (eval e1) (eval e2)<br />
eval (Mul e1 e2) = liftM2 (*) (eval e1) (eval e2)<br />
eval (Div e1 e2) = liftM2 div (eval e1) (eval e2)<br />
<br />
-- Evaluates sides and choose a random number between 1 and sides<br />
eval (Rol sides) = eval sides >>= \s -> getRandomR (1, s)<br />
<br />
-- Evaluates dices and sides and accumulates over choosing random numbers between<br />
-- 1 and sides, dice times<br />
eval (MRol dices sides) = do<br />
d <- eval dices<br />
s <- eval sides<br />
foldM (\sum _ -> liftM (sum +) $ getRandomR (1, s)) 0 [1..d]<br />
<br />
-- Parsers --<br />
<br />
-- A parser that modifies the argument parser to accept whitespace after it<br />
spaced = (<* spaces)<br />
<br />
-- A parser to parse the integer literals<br />
literal = (Lit . read) <$> spaced (many1 digit)<br />
<br />
-- A parse to parse a factor, where a factor is either a literal or an expression<br />
-- enclosed in brackets<br />
factor = spaced (char '(') *> spaced expr <* spaced (char ')')<br />
<|> literal<br />
<br />
-- Operators table in descending order of precedence<br />
table = [[uop 'd' Rol], -- single roll<br />
[bop 'd' MRol AssocLeft], -- multiple rolls<br />
[bop '*' Mul AssocLeft, bop '/' Div AssocLeft], -- multiplication and division<br />
[bop '+' Add AssocLeft, bop '-' Sub AssocLeft]] -- addition and subtraction<br />
where bop c f = Infix (spaced (char c) *> return f) -- binary operators<br />
uop c f = Prefix (spaced (char c) *> return f) -- unary operators<br />
<br />
-- A parser to parse the full expression<br />
expr = buildExpressionParser table factor<br />
<br />
-- Main --<br />
<br />
-- Reads the expression from program arguments, parses it and if successful,<br />
-- evaluates the AST and displays the resultant values<br />
main = do<br />
args <- getArgs<br />
when (null args) (error "Usage: DiceRoller <expr> [<times>]")<br />
<br />
let (str, times) = if length args == 1 then (head args, 1) else (args !! 0, read $ args !! 1)<br />
<br />
case parse expr "DiceRollParser" str of<br />
Left err -> putStrLn $ "Error while parsing: " ++ show err<br />
Right ast -> do<br />
g <- newStdGen<br />
foldM (\g' _ -> do<br />
let (val, g'') = runState (eval ast) g'<br />
putStr $ show val ++ " "<br />
return g'')<br />
g [1 .. times]<br />
return ()<br />
</haskell><br />
<br />
'''Description:''' The program uses Parsec for parsing the expression into an AST and then evaluates it recursively to get the value.<br />
<br />
Source: https://github.com/abhin4v/rubyquiz/blob/master/DiceRoller.hs<br />
<br />
[[Category:Code]]</div>Abhinav.sarkar