{- |
Given a row of n (~50) dice,
two players start with a random dice within the first m (~5) dice.
Every player moves along the row, according to the pips on the dice.
They stop if a move would exceed the row.
What is the probability that they stop at the same die?
(It is close to one.)

Kruskal's trick:
<http://faculty.uml.edu/rmontenegro/research/kruskal_count/kruskal.html>

Wuerfelschlange (german):
<http://www.math.de/exponate/wuerfelschlange.html/>
-}
module Numeric.Probability.Example.Kruskal where

import qualified Numeric.Probability.Distribution as Dist
import qualified Numeric.Probability.Transition as Trans
import qualified Numeric.Probability.Random as Random
import qualified Numeric.Probability.Object as Obj
import qualified System.Random as Rnd
import qualified Text.Printf as P
import qualified Data.List as List
import Control.Monad (replicateM, )
import Data.Function.HT (nest, compose2, )
import Data.Tuple.HT (mapSnd, )
import Data.Bool.HT (if', )


type Die = Int

type Probability = Rational
type Dist = Dist.T Probability

die ::
   (Obj.C prob experiment, Fractional prob) =>
   Score -> experiment Die
die :: forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips = forall prob (obj :: * -> *) a.
(C prob obj, Fractional prob) =>
Spread obj a
Obj.uniform [Score
1..Score
maxPips]



type Score = Int

{- |
We reformulate the problem to the following game:
There are two players, both of them collect a number of points.
In every round the player with the smaller score throws a die
and adds the pips to his score.
If the two players somewhen get the same score, then the game ends
and the score is the result of the game (@Just score@).
If one of the players exceeds the maximum score n,
then the game stops and players lose (@Nothing@).
-}
game ::
   (Obj.C prob experiment, Fractional prob) =>
   Score -> Score -> (Score,Score) -> experiment (Maybe Score)
game :: forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> Score -> (Score, Score) -> experiment (Maybe Score)
game Score
maxPips Score
maxScore =
   let go :: (Score, Score) -> m (Maybe Score)
go (Score
x,Score
y) =
          if Score
maxScore forall a. Ord a => a -> a -> Bool
< forall a. Ord a => a -> a -> a
max Score
x Score
y
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            else case forall a. Ord a => a -> a -> Ordering
compare Score
x Score
y of
                    Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Score
x)
                    Ordering
LT -> do
                       Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                       (Score, Score) -> m (Maybe Score)
go (Score
xforall a. Num a => a -> a -> a
+Score
d, Score
y)
                    Ordering
GT -> do
                       Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                       (Score, Score) -> m (Maybe Score)
go (Score
x, Score
yforall a. Num a => a -> a -> a
+Score
d)
   in  forall {prob} {m :: * -> *}.
(C prob m, Fractional prob) =>
(Score, Score) -> m (Maybe Score)
go

gameRound ::
   Score -> Score ->
   Dist (Either (Maybe Score) (Score,Score)) ->
   Dist (Either (Maybe Score) (Score,Score))
gameRound :: Score
-> Score
-> Dist (Either (Maybe Score) (Score, Score))
-> Dist (Either (Maybe Score) (Score, Score))
gameRound Score
maxPips Score
maxScore Dist (Either (Maybe Score) (Score, Score))
current = forall prob a. (Num prob, Ord a) => T prob a -> T prob a
Dist.norm forall a b. (a -> b) -> a -> b
$ do
   Either (Maybe Score) (Score, Score)
e <- Dist (Either (Maybe Score) (Score, Score))
current
   case Either (Maybe Score) (Score, Score)
e of
      Left Maybe Score
end -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Maybe Score
end
      Right (Score
x,Score
y) ->
         if Score
maxScore forall a. Ord a => a -> a -> Bool
< forall a. Ord a => a -> a -> a
max Score
x Score
y
           then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a. Maybe a
Nothing
           else case forall a. Ord a => a -> a -> Ordering
compare Score
x Score
y of
                   Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just Score
x)
                   Ordering
LT -> do
                      Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Score
xforall a. Num a => a -> a -> a
+Score
d, Score
y)
                   Ordering
GT -> do
                      Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Score
x, Score
yforall a. Num a => a -> a -> a
+Score
d)

gameFast :: Score -> Score -> Dist (Score,Score) -> Dist (Maybe Score)
gameFast :: Score -> Score -> Dist (Score, Score) -> Dist (Maybe Score)
gameFast Score
maxPips Score
maxScore Dist (Score, Score)
start =
   forall prob a b.
Fractional prob =>
(a -> Maybe b) -> T prob a -> T prob b
Dist.mapMaybe (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> Maybe a
Just (forall a. HasCallStack => String -> a
error String
"the game must be finished after maxScore moves")) forall a b. (a -> b) -> a -> b
$
   forall a. Score -> (a -> a) -> a -> a
nest (Score
maxScoreforall a. Num a => a -> a -> a
+Score
1) (Score
-> Score
-> Dist (Either (Maybe Score) (Score, Score))
-> Dist (Either (Maybe Score) (Score, Score))
gameRound Score
maxPips Score
maxScore) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right Dist (Score, Score)
start)

gameFastEither :: Score -> Score -> Dist (Score,Score) -> Dist (Maybe Score)
gameFastEither :: Score -> Score -> Dist (Score, Score) -> Dist (Maybe Score)
gameFastEither Score
maxPips Score
maxScore = forall prob a b.
(Num prob, Ord a, Ord b) =>
(a -> T prob (Either b a)) -> T prob a -> T prob b
Trans.untilLeft forall a b. (a -> b) -> a -> b
$ \(Score
x,Score
y) ->
   if Score
maxScore forall a. Ord a => a -> a -> Bool
< forall a. Ord a => a -> a -> a
max Score
x Score
y
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a. Maybe a
Nothing
     else case forall a. Ord a => a -> a -> Ordering
compare Score
x Score
y of
             Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just Score
x)
             Ordering
LT -> do
                Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Score
xforall a. Num a => a -> a -> a
+Score
d, Score
y)
             Ordering
GT -> do
                Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Score
x, Score
yforall a. Num a => a -> a -> a
+Score
d)

{- |
This version could be generalized
to both Random and Distribution monad
while remaining efficient.
-}
gameFastFix :: Score -> Score -> Dist (Score,Score) -> Dist (Maybe Score)
gameFastFix :: Score -> Score -> Dist (Score, Score) -> Dist (Maybe Score)
gameFastFix Score
maxPips Score
maxScore =
   forall prob a b.
(Num prob, Ord a, Ord b) =>
((a -> ExceptT a (T prob) b) -> a -> ExceptT a (T prob) b)
-> T prob a -> T prob b
Trans.fix forall a b. (a -> b) -> a -> b
$ \(Score, Score)
-> ExceptT (Score, Score) (T Probability) (Maybe Score)
go (Score
x,Score
y) ->
      if Score
maxScore forall a. Ord a => a -> a -> Bool
< forall a. Ord a => a -> a -> a
max Score
x Score
y
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        else case forall a. Ord a => a -> a -> Ordering
compare Score
x Score
y of
                Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Score
x)
                Ordering
LT -> do
                   Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                   (Score, Score)
-> ExceptT (Score, Score) (T Probability) (Maybe Score)
go (Score
xforall a. Num a => a -> a -> a
+Score
d, Score
y)
                Ordering
GT -> do
                   Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                   (Score, Score)
-> ExceptT (Score, Score) (T Probability) (Maybe Score)
go (Score
x, Score
yforall a. Num a => a -> a -> a
+Score
d)

{- |
In 'gameFastFix' we group the scores by rounds.
This leads to a growing probability distribution,
but we do not need the round number.
We could process the game in a different way:
We only consider the game states
where the lower score matches the round number.
-}
gameLeastScore :: Score -> Score -> Dist (Score,Score) -> Dist (Maybe Score)
gameLeastScore :: Score -> Score -> Dist (Score, Score) -> Dist (Maybe Score)
gameLeastScore Score
maxPips Score
maxScore =
   (forall prob a b.
(Num prob, Ord a, Ord b) =>
((a -> ExceptT a (T prob) b) -> a -> ExceptT a (T prob) b)
-> T prob a -> T prob b
Trans.fix forall a b. (a -> b) -> a -> b
$ \(Score, (Score, Score))
-> ExceptT (Score, (Score, Score)) (T Probability) (Maybe Score)
go (Score
n,(Score
x,Score
y)) ->
      if Score
n forall a. Ord a => a -> a -> Bool
> Score
maxScore
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        else
           let next :: (Score, Score)
-> ExceptT (Score, (Score, Score)) (T Probability) (Maybe Score)
next = (Score, (Score, Score))
-> ExceptT (Score, (Score, Score)) (T Probability) (Maybe Score)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (forall a. Enum a => a -> a
succ Score
n)
           in  case (Score
xforall a. Eq a => a -> a -> Bool
==Score
n, Score
yforall a. Eq a => a -> a -> Bool
==Score
n) of
                  (Bool
False, Bool
False) -> (Score, Score)
-> ExceptT (Score, (Score, Score)) (T Probability) (Maybe Score)
next (Score
x,Score
y)
                  (Bool
True, Bool
False) -> do
                     Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                     (Score, Score)
-> ExceptT (Score, (Score, Score)) (T Probability) (Maybe Score)
next (Score
xforall a. Num a => a -> a -> a
+Score
d, Score
y)
                  (Bool
False, Bool
True) -> do
                     Score
d <- forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
                     (Score, Score)
-> ExceptT (Score, (Score, Score)) (T Probability) (Maybe Score)
next (Score
x, Score
yforall a. Num a => a -> a -> a
+Score
d)
                  (Bool
True, Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Score
x))
   forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Score
0)

{- |
'gameLeastScore' can be written in terms of a matrix power.
For n pips we need a n² × n² matrix.
Using symmetries, we reduce it to a square matrix with size n·(n+1)/2.

/ p[n+1,(n+1,n+1)] \          / p[n,(n+0,n+0)] \
| p[n+1,(n+1,n+2)] |          | p[n,(n+0,n+1)] |
| p[n+1,(n+1,n+3)] |          | p[n,(n+0,n+2)] |
|        ...       |          |       ...      |
| p[n+1,(n+1,n+6)] |  = M/6 · | p[n,(n+0,n+5)] |
| p[n+1,(n+2,n+2)] |          | p[n,(n+1,n+1)] |
|        ...       |          |       ...      |
| p[n+1,(n+2,n+6)] |          | p[n,(n+1,n+5)] |
|        ...       |          |       ...      |
\ p[n+1,(n+6,n+6)] /          \ p[n,(n+5,n+5)] /

M[(n+1,(x,y)),(n,(x,y))] = 6

M[(n+1,(min y (n+d), max y (n+d))), (n,(n,y))] = 1

M[(n+1,(x1,y1)),(n,(x0,y0))] = 0
-}
flattenedMatrix :: Score -> [Int]
flattenedMatrix :: Score -> [Score]
flattenedMatrix Score
maxPips = do
   Score
x1 <- [Score
1..Score
maxPips]
   Score
y1 <- [Score
x1..Score
maxPips]
   Score
x0 <- [Score
0..Score
maxPipsforall a. Num a => a -> a -> a
-Score
1]
   Score
y0 <- [Score
x0..Score
maxPipsforall a. Num a => a -> a -> a
-Score
1]
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      forall a. Bool -> a -> a -> a
if' ((Score
x0,Score
y0) forall a. Eq a => a -> a -> Bool
== (Score
x1,Score
y1)) Score
maxPips forall a b. (a -> b) -> a -> b
$
      forall a. Bool -> a -> a -> a
if' (Score
x0forall a. Eq a => a -> a -> Bool
==Score
0 Bool -> Bool -> Bool
&& (Score
y0forall a. Eq a => a -> a -> Bool
==Score
x1 Bool -> Bool -> Bool
|| Score
y0forall a. Eq a => a -> a -> Bool
==Score
y1)) Score
1 Score
0

{-
let e0 = [1,0,0,...,0]

The cumulated probability is
e0 * (I + M + M^2 + ... + M^(n-1)) * startVector
and with M = V*D*V^-1 we get
e0 * V * (I + D + D^2 + ... + D^(n-1)) * V^-1 * startVector

e0 * (I - M^n) * (I-M)^(-1) * startVector
-}
startVector :: Score -> [Int]
startVector :: Score -> [Score]
startVector Score
maxPips = do
   Score
x <- [Score
0..Score
maxPipsforall a. Num a => a -> a -> a
-Score
1]
   Score
y <- [Score
x..Score
maxPipsforall a. Num a => a -> a -> a
-Score
1]
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Bool -> a -> a -> a
if' (Score
xforall a. Eq a => a -> a -> Bool
==Score
y) Score
1 Score
2


compareMaybe :: (Ord a) => Maybe a -> Maybe a -> Ordering
compareMaybe :: forall a. Ord a => Maybe a -> Maybe a -> Ordering
compareMaybe Maybe a
Nothing Maybe a
_ = Ordering
GT
compareMaybe Maybe a
_ Maybe a
Nothing = Ordering
LT
compareMaybe (Just a
a) (Just a
b) = forall a. Ord a => a -> a -> Ordering
compare a
a a
b

cumulate :: (Ord a) => Dist (Maybe a) -> [(Maybe a, Probability)]
cumulate :: forall a. Ord a => Dist (Maybe a) -> [(Maybe a, Probability)]
cumulate =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. [a] -> [b] -> [(a, b)]
zip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a. (a -> a -> a) -> [a] -> [a]
scanl1 forall a. Num a => a -> a -> a
(+)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
compose2 forall a. Ord a => Maybe a -> Maybe a -> Ordering
compareMaybe forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prob a. T prob a -> [(a, prob)]
Dist.decons

runExact :: Score -> IO ()
runExact :: Score -> IO ()
runExact Score
maxPips =
   forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Maybe Score
m,Probability
p) ->
      case Maybe Score
m of
         Just Score
n ->
            forall r. PrintfType r => String -> r
P.printf String
"%4d %7.2f   %s\n"
               Score
n (forall a. Fractional a => Probability -> a
fromRational (Probability
100forall a. Num a => a -> a -> a
*Probability
p) :: Double) (forall a. Show a => a -> String
show Probability
p)
         Maybe Score
Nothing -> String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"total: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Probability
p) forall a b. (a -> b) -> a -> b
$
   forall a. Ord a => Dist (Maybe a) -> [(Maybe a, Probability)]
cumulate forall a b. (a -> b) -> a -> b
$
   Score -> Score -> Dist (Score, Score) -> Dist (Maybe Score)
gameFastFix Score
maxPips Score
120 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Score
0) forall a b. (a -> b) -> a -> b
$ forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips


trace :: Score -> [Score] -> [Score]
trace :: Score -> [Score] -> [Score]
trace Score
s xs :: [Score]
xs@(Score
x:[Score]
_) = Score
s forall a. a -> [a] -> [a]
: Score -> [Score] -> [Score]
trace (Score
sforall a. Num a => a -> a -> a
+Score
x) (forall a. Score -> [a] -> [a]
drop Score
x [Score]
xs)
trace Score
s [] = [Score
s]

chop :: [Score] -> [[Score]]
chop :: [Score] -> [[Score]]
chop [] = []
chop xs :: [Score]
xs@(Score
x:[Score]
_) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall a b. (a -> b) -> a -> b
$ forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd [Score] -> [[Score]]
chop forall a b. (a -> b) -> a -> b
$ forall a. Score -> [a] -> ([a], [a])
splitAt Score
x [Score]
xs

meeting :: [Score] -> [Score] -> Maybe Score
meeting :: [Score] -> [Score] -> Maybe Score
meeting xt :: [Score]
xt@(Score
x:[Score]
xs) yt :: [Score]
yt@(Score
y:[Score]
ys) =
   case forall a. Ord a => a -> a -> Ordering
compare Score
x Score
y of
      Ordering
LT -> [Score] -> [Score] -> Maybe Score
meeting [Score]
xs [Score]
yt
      Ordering
GT -> [Score] -> [Score] -> Maybe Score
meeting [Score]
xt [Score]
ys
      Ordering
EQ -> forall a. a -> Maybe a
Just Score
x
meeting [Score]
_ [Score]
_ = forall a. Maybe a
Nothing

{- |
This is a bruteforce implementation of the original game:
We just roll the die @maxScore@ times
and then jump from die to die according to the number of pips.
-}
bruteforce :: Score -> Score -> (Score,Score) -> Random.T (Maybe Score)
bruteforce :: Score -> Score -> (Score, Score) -> T (Maybe Score)
bruteforce Score
maxPips Score
maxScore (Score
x,Score
y) = do
   [Score]
points <- forall (m :: * -> *) a. Applicative m => Score -> m a -> m [a]
replicateM Score
maxScore forall a b. (a -> b) -> a -> b
$ forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips
   let run :: Score -> [Score]
run Score
s = Score -> [Score] -> [Score]
trace Score
s (forall a. Score -> [a] -> [a]
drop Score
s [Score]
points)
   forall (m :: * -> *) a. Monad m => a -> m a
return ([Score] -> [Score] -> Maybe Score
meeting (Score -> [Score]
run Score
x) (Score -> [Score]
run Score
y))

runSimulation :: Score -> IO ()
runSimulation :: Score -> IO ()
runSimulation Score
maxPips =
   forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Maybe Score
m,Probability
p) ->
      case Maybe Score
m of
         Just Score
n ->
            forall r. PrintfType r => String -> r
P.printf String
"%4d %7.2f\n"
               Score
n (forall a. Fractional a => Probability -> a
fromRational (Probability
100forall a. Num a => a -> a -> a
*Probability
p) :: Double)
         Maybe Score
Nothing -> String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"total: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Probability
p) forall a b. (a -> b) -> a -> b
$
   forall a. Ord a => Dist (Maybe a) -> [(Maybe a, Probability)]
cumulate forall a b. (a -> b) -> a -> b
$
   forall a. StdGen -> T a -> a
Random.runSeed (Score -> StdGen
Rnd.mkStdGen Score
42) forall a b. (a -> b) -> a -> b
$ forall prob a.
(Fractional prob, Ord a) =>
[T a] -> Distribution prob a
Random.dist forall a b. (a -> b) -> a -> b
$
   forall a. Score -> a -> [a]
replicate Score
100000 forall a b. (a -> b) -> a -> b
$ Score -> Score -> (Score, Score) -> T (Maybe Score)
bruteforce Score
maxPips Score
120 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Score
0 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
maxPips


latexDie :: Score -> String
latexDie :: Score -> String
latexDie Score
pips =
   String
"\\epsdice{" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Score
pips forall a. [a] -> [a] -> [a]
++ String
"}"

latexMarkedDie :: Score -> String
latexMarkedDie :: Score -> String
latexMarkedDie Score
pips =
   String
"\\epsdice[black]{" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Score
pips forall a. [a] -> [a] -> [a]
++ String
"}"

latexFromChain :: [Score] -> String
latexFromChain :: [Score] -> String
latexFromChain =
   [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Score -> String
latexDie

latexChoppedFromChain :: [Score] -> String
latexChoppedFromChain :: [Score] -> String
latexChoppedFromChain =
   [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Score
p:[Score]
ps) -> Score -> String
latexMarkedDie Score
p forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Score -> String
latexDie [Score]
ps) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [Score] -> [[Score]]
chop

makeChains :: IO ()
makeChains :: IO ()
makeChains = do
   let chains :: [[Score]]
chains =
          forall a b. (a -> b) -> [a] -> [b]
map
             (\Score
seed ->
                forall a. StdGen -> T a -> a
Random.runSeed (Score -> StdGen
Rnd.mkStdGen Score
seed) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. Applicative m => Score -> m a -> m [a]
replicateM Score
42 forall a b. (a -> b) -> a -> b
$ forall prob (experiment :: * -> *).
(C prob experiment, Fractional prob) =>
Score -> experiment Score
die Score
6)
             [Score
30..Score
42]
   String -> String -> IO ()
writeFile String
"KruskalDice.tex" forall a b. (a -> b) -> a -> b
$
      String
"\\noindent\n"
      forall a. [a] -> [a] -> [a]
++
      (forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\\\\[4ex]\n" forall a b. (a -> b) -> a -> b
$
       forall a b. (a -> b) -> [a] -> [b]
map ((String
"$\\rightarrow$" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Score] -> String
latexFromChain) [[Score]]
chains)
      forall a. [a] -> [a] -> [a]
++
      String
"\\newpage\n" forall a. [a] -> [a] -> [a]
++
      String
"\\noindent\n"
      forall a. [a] -> [a] -> [a]
++
      (forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\\\\[4ex]\n" forall a b. (a -> b) -> a -> b
$
       forall a b. (a -> b) -> [a] -> [b]
map ((String
"$\\rightarrow$" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Score] -> String
latexChoppedFromChain) [[Score]]
chains)