75 lines
2.9 KiB
Haskell
75 lines
2.9 KiB
Haskell
import System.Random
|
|
import Control.Monad.State
|
|
|
|
numRuns = 10000
|
|
numPrisoners = 100
|
|
numDrawerTries = 50
|
|
type Drawers = [Int]
|
|
type Prisoner = Int
|
|
type Prisoners = [Int]
|
|
|
|
main = do
|
|
gen <- getStdGen
|
|
putStrLn $ "Chance of winning when choosing randomly: " ++ (show $ evalState runRandomly gen)
|
|
putStrLn $ "Chance of winning when choosing optimally: " ++ (show $ evalState runOptimally gen)
|
|
|
|
|
|
runRandomly :: State StdGen Double
|
|
runRandomly =
|
|
let runResults = replicateM numRuns $ do
|
|
drawers <- state $ shuffle [1..numPrisoners]
|
|
allM (\prisoner -> openDrawersRandomly drawers prisoner numDrawerTries) [1..numPrisoners]
|
|
in ((/ fromIntegral numRuns) . fromIntegral . sum . map fromEnum) `liftM` runResults
|
|
|
|
openDrawersRandomly :: Drawers -> Prisoner -> Int -> State StdGen Bool
|
|
openDrawersRandomly drawers prisoner triesLeft = go triesLeft []
|
|
where go 0 _ = return False
|
|
go triesLeft seenDrawers = do
|
|
try <- state $ randomR (1, numPrisoners)
|
|
case try of
|
|
x | x == prisoner -> return True
|
|
| x `elem` seenDrawers -> go triesLeft seenDrawers
|
|
| otherwise -> go (triesLeft - 1) (x:seenDrawers)
|
|
|
|
runOptimally :: State StdGen Double
|
|
runOptimally =
|
|
let runResults = replicateM numRuns $ do
|
|
drawers <- state $ shuffle [1..numPrisoners]
|
|
return $ all (\prisoner -> openDrawersOptimally drawers prisoner numDrawerTries) [1..numPrisoners]
|
|
in ((/ fromIntegral numRuns) . fromIntegral . sum . map fromEnum) `liftM` runResults
|
|
|
|
openDrawersOptimally :: Drawers -> Prisoner -> Int -> Bool
|
|
openDrawersOptimally drawers prisoner triesLeft = go triesLeft prisoner
|
|
where go 0 _ = False
|
|
go triesLeft drawerToTry =
|
|
let thisDrawer = drawers !! (drawerToTry - 1)
|
|
in if thisDrawer == prisoner then True else go (triesLeft - 1) thisDrawer
|
|
|
|
|
|
-- Haskel stdlib is lacking big time, so here some necessary 'library' functions
|
|
|
|
-- make a list of 'len' random values in range 'range' from 'gen'
|
|
randomLR :: Integral a => Random b => a -> (b, b) -> StdGen -> ([b], StdGen)
|
|
randomLR 0 range gen = ([], gen)
|
|
randomLR len range gen =
|
|
let (x, newGen) = randomR range gen
|
|
(xs, lastGen) = randomLR (len - 1) range newGen
|
|
in (x : xs, lastGen)
|
|
|
|
|
|
-- shuffle a list by a generator
|
|
shuffle :: [a] -> StdGen -> ([a], StdGen)
|
|
shuffle list gen = (shuffleByNumbers numbers list, finalGen)
|
|
where
|
|
n = length list
|
|
(numbers, finalGen) = randomLR n (0, n-1) gen
|
|
shuffleByNumbers :: [Int] -> [a] -> [a]
|
|
shuffleByNumbers [] _ = []
|
|
shuffleByNumbers _ [] = []
|
|
shuffleByNumbers (i:is) xs = let (start, x:rest) = splitAt (i `mod` length xs) xs
|
|
in x : shuffleByNumbers is (start ++ rest)
|
|
|
|
-- short-circuit monadic all
|
|
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
|
|
allM func [] = return True
|
|
allM func (x:xs) = func x >>= \res -> if res then allM func xs else return False
|