Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- import Control.Applicative
- import Control.Monad
- import Data.List
- import Data.Function (on)
- import Data.Ratio
- import Data.Char
- newtype P a = P {probabilities :: [(Rational,a)] }
- instance Functor P where
- fmap f (P a) = P ((fmap . fmap) f a)
- instance Applicative P where
- pure = P . (:[]) . ((,) 1)
- P f <*> P a = P (filter ((/= 0) . fst) (do
- (pf,f') <- f
- (pa,a') <- pf `seq` a
- let pr = pf * pa in pr `seq` return (pr, f' a')
- ))
- instance Monad P where
- return = pure
- P a >>= f = P (filter ((/= 0) . fst) (do
- (pa,a') <- a
- (pb,b') <- pa `seq` probabilities (f a')
- let pr = pa * pb in pr `seq` return (pr, b')
- ))
- uniform l = let
- s = 1 % genericLength l
- in P $ map ((,) s) l
- distributed :: (Real f) => [(f,a)] -> P a
- distributed l = let
- s = 1 / sum (map (toRational . fst) l)
- in P (map (\(r,a) -> (toRational r * s,a)) l)
- collate :: (Eq a) => P a -> P a
- collate = P . go . probabilities where
- go :: Eq a => [(Rational,a)] -> [(Rational,a)]
- go [] = []
- go ((pa,a):r) = let
- (m,n) = partition ((== a) . snd) r
- in (pa + sum (map fst m), a) : go n
- collate' :: (Ord a) => P a -> P a
- collate' = P .
- map (\((pa,a):r) -> (pa + sum (map fst r), a)) .
- groupBy ((==) `on` snd) .
- sortBy (compare `on` snd) .
- probabilities
- select :: [a] -> [(a,[a])]
- select = go id where
- go _ [] = []
- go acc (a:r) = (a, acc r) : go (acc . (a :)) r
- oneCard :: [(Integer,Integer,Integer)] -> P [(Integer,Integer,Integer)]
- oneCard l = collate' $ do
- ((h,s,n),r) <- distributed $
- map (\v@((_,s,n),_) -> (s * n, v)) $
- select l
- return $ sort $ case n of
- 1 -> (h + 1, s - 1, 1) : r
- _ -> (h + 1, s - 1, 1) : (h, s, n - 1) : r
- oneHand :: [(Integer,Integer)] -> P (Integer,[(Integer,Integer)])
- oneHand l' = collate' $ do
- let l = map (\(s,n) -> (0,s,n)) l'
- l2 <- foldl' (\a _ -> collate $ a >>= oneCard) (return l) (replicate 5 ())
- let
- ri = if (sort $ filter (/= 0) $ map (\(a,_,_) -> a) l2) == [2,3]
- then 1
- else 0
- rl = map (\((s,n):r) -> (s,n + sum (map snd r))) $
- groupBy ((==) `on` fst) $
- sortBy (compare `on` fst) $
- filter (/= (0,0)) $
- map (\(_,s,n) -> (s,n)) l2
- return (ri,rl)
- hands :: Integer -> [(Integer,Integer)] -> P Integer
- hands n = collate' . fmap fst . go . return . ((,) 0) where
- go = flip (foldl' (\s _ -> collate' $ s >>= \(f,d) -> do
- (i,r) <- oneHand d
- return (i + f, r)
- )) [1 .. n]
- distribution :: [(Integer,Integer)] -> [P Integer]
- distribution d = let
- mp = (sum $ map (uncurry (*)) d) `div` 5
- in genericTake mp $
- tail $
- map (collate' . fmap fst) $
- iterate (\e -> collate' $
- e >>= \(f,d) -> do
- (i,r) <- oneHand d
- return (i + f, r)
- ) $
- return (0,d)
- show3sf :: Rational -> String
- show3sf r = let
- w = floor r :: Integer
- m = r - toRational w
- sw = show w
- s0 = if w == 0 then 3 else max 1 (3 - length sw)
- go1 0 = "0"
- go1 m' = case floor m' of
- 0 -> '0' : go1 (m' * 10)
- d -> intToDigit d :
- go2 (s0 - 2) ((m' - toRational d) * 10)
- go2 _ 0 = "0"
- go2 0 m' = [intToDigit $ min 9 $ round m']
- go2 rd m' = let
- d = floor m'
- in intToDigit d : go2 (rd - 1) ((m' - toRational d) * 10)
- in sw ++ "." ++ case w of
- 0 -> go1 (m * 10)
- _ -> go2 (s0 - 1) (m * 10)
- main = forM_ (zip [1..] $ distribution [(13,4)]) $ \(p,d) -> do
- putStrLn $ "Probability distribution for full houses: " ++ show p ++ " hands"
- forM_ (probabilities d) $ \(f,c) ->
- putStrLn $ show c ++ ": " ++ show3sf (f * 100) ++ "%"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement