newtype Prob a = Prob { getProb :: [(a,Rational)] } deriving (Show,Eq,Functor)
flatten :: Prob (Prob a) -> Prob a
flatten (Prob xs) = Prob $ concat $ map multAll xs
where multAll (Prob innerxs,p) = map (\(x,r) -> (x,p*r)) innerxs
instance Applicative Prob where
liftA2 fn (Prob x) (Prob y) = Prob [(fn a b,prob1 *prob2) |(a,prob1) <- x, (b,prob2) <- y]
pure x = Prob [(x,1%1)]
instance Monad Prob where
m >>= f = flatten (fmap f m)
makedie x = Prob (zip [1..x] (repeat (1%x)))
proboperate2 op a b= sumprobs (liftA2 op a b)
rerolldie op = proboperate2 op <*> id
sumprobs (Prob a) = Prob [(v,sum (map snd (filter ((==v) . fst) a))) |v <- indivalues]
where indivalues = nub (map fst a)
survivedeath :: Integer -> Prob Integer -> Prob Bool
survivedeath dc die = sumprobs (survivegiven (0,0) =<< die)
where
survivegiven :: (Integer,Integer) -> Integer -> Prob Bool
survivegiven (a,_) _ | a >= 3 = return False
survivegiven (_,a) _ | a >= 3 = return True
survivegiven (a,b) 1 = sumprobs ((survivegiven (a+2,b)) =<< die)
survivegiven (a,b) 20 = return True
survivegiven (a,b) n | n >= dc = sumprobs ((survivegiven (a,1+b)) =<< die)
survivegiven (a,b) n = sumprobs ((survivegiven (1+a,b)) =<< die)
survivedeath开始很快就开始花费很长时间。据我所知，sumprobs = on^2，=
<< = ON, if survivedeath goes six times on a d20, it should run 20^2 * 6 or 400 * 6 or 2400 operations, which should happen quickly, why is that not the case?
survivegiven中的递归单独处理每个人，除了1和20左右的特殊情况。
几乎所有这些工作都是浪费的，因为您评估相同的功能很多次。 （a）滚动3，然后滚动4，或（b）滚动4，然后滚动3，或（c）滚动5然后滚动5，然后假设所有这些都小于您的
dc 。但是您将它们分开计算，每个都需要20^4后续卷。一些基本的回忆将有所帮助，或者您可以使用4个侧面的模具（1、20，> = DC和