Haskell DSL for evaluating the following math problem: You are given a 100 sided die. After you roll once, you can choose to either get paid the dollar amount of that roll OR pay one dollar for one more roll. What is the expected value of the game?(There is no limit on the number of rolls.)

D100.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell, BangPatterns, EmptyDataDecls #-}
module D100 where

import Control.Applicative
import Control.Arrow
import Control.Lens
import Control.Monad.State
import Control.Monad.Random
import Control.Monad.Free
import Data.List

avg :: (Real a, Fractional b) => [a] -> b
avg = uncurry (/) . foldl' (flip $ \a -> (+realToFrac a) *** (+1)) (0,0)

-- * Strategy DSL

data StrategyF next
  = RollF (Int -> next)
  | AcceptF
  deriving (Functor)

type Strategy = Free StrategyF

-- | Tag type for indicating that if a strategy terminates, it accepts.
data Accepted

roll :: Strategy Int
roll = liftF (RollF id)

-- | Strategy accepts last roll. This is the only way of obtaining
-- a `Strategy Accepted` value besides bottom.
accept :: Strategy Accepted
accept = liftF AcceptF

-- * sampling Strategy evaluator 

evalStrategy :: (MonadRandom m) => Strategy Accepted -> m Int
evalStrategy st = go (-1) (-1) st where
  go n oldRoll st = case st of
    Free (RollF next) -> do
      r <- rollDie
      go (n+1) r (next r)
    Free (AcceptF) -> return $! oldRoll - n
  rollDie = getRandomR (1,100)

avgStrategy :: (MonadRandom m) => Int -> Strategy Accepted -> m Double
avgStrategy n st = avg `liftM` replicateM n (evalStrategy st)

-- * Strategies

-- | Nearly optimal strategy achieving an average gain of 87.36
myStrategy :: Strategy Accepted
myStrategy = go 0 where
  go n = roll >>= \r -> if r >= 87 then accept else go (n+1)


-- * iterative approach for obtaining the accepting threshold used above
f :: Double -> Double -> Double
f n old = (100^2 - n^2) / 200 + n / 100 * (old - 1)

approx :: (Double -> Double) -> Double -> Double -> Double
approx f x0 delta = let x1 = f x0 in
  if abs (x0 - x1) < delta then x1 else approx f x1 delta