. Если оно всегда должно представлять это значение как свой результат, вероятность должна быть равна
>1
!
А что у нас с операцией >>>=
? Выглядит несколько мудрёно, поэтому давайте воспользуемся тем, что для монад выражение >m >>= f
всегда равно выражению >join (fmap f m)
, и подумаем, как бы мы разгладили список вероятностей списков вероятностей. В качестве примера рассмотрим список, где существует 25-процентный шанс, что случится именно >'a'
или >'b'
. И >'a'
, и >'b'
могут появиться с равной вероятностью. Также есть шанс 75%, что случится именно >'c'
или >'d'
. То есть >'c'
и >'d'
также могут появиться с равной вероятностью. Вот рисунок списка вероятностей, который моделирует данный сценарий:
![](data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAR0AAABbCAMAAAB5wqGMAAAACXBIWXMAAAsTAAALFAFP2wrf
AAADAFBMVEUFBQO+vHaZXiLd3dw/QCbZhjBLTEuZmF/l4Y8iIxVpQRe5uLd2dUlJLhGalpC8
dCr3mTd8USEXEAZzcGz///8hIh3kuo7z75ibdD7bpnBra0NmQRq8jVz94cQiFgkyMh3wuoHr
zKv49JyFhYTt7OxhYV6oqKeum4bFeSyFWS2BgE9VVTWtayaMZDTRvKXIyMc8Jg4wMC4XGBYH
CAX4p1NXOx3DpYXZy33qvY+/iFBBQT+qjFD+7t11SRvQsI6NWCHOvXJjYj2TlJPkjTMaEgdX
WFYTDgaPjVnyyqDt6ZOjoJzNgTPd2oq1s3EtLRs8PCUtHQsvIQ18enbOmGGejXykZSXExMOr
dkDNyoFTNBMMDQr09PQ7OzqTbDvKx37mtYITFBOybif4r2MrLCppaWa8pGGpp2qhnmSKiYbo
3oscHRvP0M/k4d6xsK/83by+po1BKQ97TBxLSy5QUE/6xIyaZjDd04Okg0nLfS1jPhbRzoMP
EA2cnJvSwnaJVR/GsWvFwnvx7Jb+8eTVxbMMCgV7ek2TiH2KiVYTFAxbWjgkJSSQWR/Ds6Jx
Rhrq4o3j2IftxJk0NTMiHRVDMBpYNxXHuamJXS/6u3vBdyvojzMxHwzhvpq1q6Gee0RISEf6
1K7eiTGTkluLjIsZGQ8IBwOAgH5xcUbXiTn28pr959B0dHORaDavk1Wtq2wxJBPa14lbXFt5
TyJOMhOmnZJvcG90TCKnaShEKxD70KTht4yEUh5dOhZ7fHsQDglDRELzxJTk5OTTgi4dEwi0
fkfi3oy5t3Suby28vbykn5lQNRiCf082NiG9mnVra2qdm2KWcT0mGQrTzsknKCb4rFzCfDPV
0oXq5pLJtW6lpaRUVFOATx3BqmWzs7P5tG2lombewqQ+KRH08Jf6y5prQxnMzMzh1oW1cCid
YSOTj4uTXCFfPhnXhDBYVzZHSCxmZUCFVSSFhFP6wIT+9erWx3q2m1tkZGNHMBfT09McHBGs
rKxDQyqAfnuxrm5lPxgyIQ3So3OHjQiaAAAS7ElEQVR42u2dfVxb13nHLzAwJBCpfik2rNgT
uJWG6GTHHUk8hRcpctSCpCURRpeXiBC/lNUpwjGWMMZovQzBAjZpSsCNHcDEu8H2TMhiJYJh
o+KyhYG1NLwNTLwIo6neXGbsGWhGd+7V273SRZY0x5d+Pv39ea91OOd7z3POc57nnGNo/epR
zsSV9atL0CqqSwJ0/w90AqaTkxByP2tqsbwtvqfjXufp070NuGop1NB7+vREZ09PW/niVNb9
kISEnN97On8GhWVRUssa73k1rKG2SAlD7QgilJ3k6RXd5jq+AZeVQgZ+XZ2mu5gnM4qQdghR
KotqG545eA/QArCu+IAqZGjV0MkJySofytVBUO+MO5iB+IlaqN3IU5hVVvks+5aA6bcEoWpG
gTzFwI9V8GRxaxEIguCizxp6JxywEoi9MyQka+rAgQM9cHkO3XRyQgbKezobimBY2bvupX8h
W9YLbfG5SkTWXTHbwnx4aha0qBlci/U3H8X+s15mRBAEVgJWmIVuKNquhGHEJqgwhB46OVfu
D4y3DU3kboAheEPDxLqX/vzlt38FPjKRTs7QEcikkYcyv2YJ+tgFlgrcQoMtXMbn6r5m7DEX
fnSWlQOAZE2Np8cPdYbl1m4/AvpK4emtL7z0nWe/+fL1Hc6KkujcU/KZ9Onro5OTcCXkr7IG
FsvT4zswHIW1SmDriHJDYW5Y59ALf/OdHz/71Otvv7LD4zOSLatX9XtKJwcXgBAyMzMwMPXt
8fT0NkBi68FegKJIqYOBjijxoQ/g2P/Ehz9+9ucnntqyhQLJynTCzKuGzv0ZlwYef/zxxXFM
6ZjiMfV0ABejMyysNze3obAQDGBKrD9ggnXKoqLCwobcMECi4722Jz585403vvvFF89//OXr
//329V/t8H0IgEhT1nOaVUJnZgiCXdIp7Sr6DFNDLlBvWFhnZ+fQ0Lrf/nb/f+z/8J++/847
b/zsuz/54k+ATjx/+fJljMQrfqCgEjxApPOqAntm6ZbJ5PTS2Q/Bz/4c1zc/+eSTp06cOHH5
S6DXcb2N6fr166+8Alq/Y8fXWCWERKdDzxSYRUixyiwS0Etnmc1cBSLTiecxHzOlAF+HAfXR
SgdUZDVIRKKTLmMKMN/DivDptSzQiVeDjItEOuNC/GEwEkzzqNwR5Xw8K+tbJXQex4ebJkRz
iw46ShedoS7nrGqC1LTRebOcSGcGwZYRb4FFttD8yOtkKXLRudfteKoR0UhHRqITguC9WNDC
rlhGrKuBDgOxIvTR+ft0UvQCZjjfxCKh9NGZcDjtMnMonXTaSOsVmIs9bDIreHEIxKCfzmMy
ZguNdG68R6LzJj5ZWaI0KktTKI2W5VgOc9W00vlpD4nONgPxZRObbjpAdNLpGiLReYbfl5Ki
MmsUUTyTCII0dNFpcH2lvnb66HzvVRKdie6/lcl4XV0asypFzuijzbK2pTgfs/VgZSOgh05s
J4nOq3YvLLjg0VfFWuuiU+t0JwRNFZploYie/mOeINFxePBx1kdflZRtLjpFFsymVLH6OAiS
KVRymlbsH/WS6NxT2HozDUt0Eh0lFl9iFHeZrQyrgb5V6AdudGw+qkHItKjppGPzu3Dpu+ij
09hAotNpm6WKu5kmK410cgg+e5yFPjopheQ5y+ajijRyEZdGOglwk9Pdgdi0TVnMQ7UkOgdt
dJaNCCRafsSxZUODk84Vlwc4iwiYTWtponOpiOwNOnxUCyI3ND3aqqh6CXScs4LVWFBggLj0
zOi/LMqhpGM4+cirQqBzn0BHJBKBjsyjhc7nygQinVzH9NmtoJPODDl6woBC6bGsz4+QtsY5
PXieik46WeSEUR9ddH4Ah1DSUQvopDNAphOK0OQr/x1CSqQXWpm0ybaowekcEJJfyQJd9nEr
qGSZ7fPt47eQ6RRZVgWdRTc6zYGWGRex2VOSMxDUbpQtd2n4FRYu2xspJOtR0GkOdZPAK53y
uIf0d+OGUQpFi0uDpqurbidKJQs6fOcZYFVcXKzo1gAR13XIFJGOUl4A3pv5LlmtwXIug63u
axH4NxQJQhnBKrOieNmE/fl2N+EViupWWRjOUjWdLjqmh0VnH8u70NGLZZVBe9dUz0VGRqbV
JCYmlhBX4P9ISvfBBRaFoguRLDkliYjQwfi+GAQRxplkVFrmKTQGrMw+rlwutxr4mq5lkwh6
ckG6VBM5t2v6QlBQfjZZV/e2VlfFJEoXIOQk31ad7ntOOm0nnYhdYoOSVXV1dd12meswYRtg
5fICNvU0gtMZHWX5IS1EWEMtjJPpYM+EF1xssY4YHT3aP5IdFHRheE01papiaqQI6JFmoVAI
LWxeSrw91/pVfjiKPqgqKDoaVL2EWNzpLGNDotzME0EuDSaSVYJ/vcFB8Pl04LXIKIvSGLi3
POiES2P8ocM6Q0iTkxNaOB0BEsRijWj9KpKF7rMl3wUiDG14mT8/jcE9YYVrv3JPMZOph9bq
TYnZZQ5RV8gxlISPZA7P3S6R6CAjMTT1l7tYrGkoza+WSCoIdIgJLVvkQNBeiU4jrSw/8Xwq
xKeWuGnQlwcX/IF7Fo9IRnW46OiZTDmjmdldA96K/alEeBA8S6Bzo4qllfpJR0pwhEkpG1vk
oAUq69dB1X7SYYUjuMHKdrHQNEjizy/TFG50huzrGAVo164Iv2oh1hHpKG6z5hakt/0qoaTO
9fuuf/Cgo4b60wYX/O07Dui8KnSNTprozw8TY/GQW48nnRhWuE6nDZyOOZF19sJSZMB0vnfP
gw4DykamdZl+00nEg0NdMV/BrSUx/teHt99Jxx6ixOgMQzpx4HS+IQXWNljlXzM0K6RsbFEn
rm7k0zJkxH86eLHdNZWtqHQugE7novNcrK1yxVWsoBq4P3A6VmDhqG6NX82oIdD5KMxjh0pw
BMq6Cov9ppP2FlZgXQmokMQvu9xscKPTy3fSYVXCGYHTuaRDWWilOGA63+j1oFOxGWVNn2EF
SMcwyGJFR0z788MI3BeQpbvo2KcN3qcsVhk8Ejgdhq4yElNaVWB0fpPrQaduCWXtkgRKxxoB
3McRcTTq8++0C3gE21TupNNgdznA/Me6COcHTkeNtNpc/k/9nSPsKZtCj51xmJexpiRQOpd0
0ghMvs9a4jMFbnQcYSaMjjgmPHA6LUil381Y4rtnr0l09CXT09PD00GB0WHo1gxjWmnOq/d0
lHQMNzqFdmfe1FotxbUmQDpMUSZLXCUt8Wfo2kzwlS8pPejIdAuYlgKjw0YytPtaL6xkWOhO
j0cZtvyMi07OBnuyyDh8oQpXUKB0jMOsbMnZBdIU2h/tfRQkRAB/CRPo2OK5omGxeHRUrA2M
Tl97WRW8sKKTcjNJuwId0biTThHX2TbWVzExf0oqrD/12OTY/KhvdJYxLvkwaZK4W++1GUfk
xHi/Ox2wCK1ekmzeF+C4A1ZpVfsyV6RzjHPc/VGpnc6ig07CEXsLsRVtSYQUIRgGepeDK+mu
1hc6XWeB5UpKiL0FPZXsdakGEQpQQwludNjISFrarsGaAOkwka/AKlSKrmRYnHn3Z2W2lAOB
jiONDopi5ZcOEz2emxyHdvpC59c1rOilhcqMjAwnTG3SpLdWjEKEEP8PIELKZgpLycqx756t
qw6UjnCYdVbn6aOMph47ltqPbuSkur/Jb29xRSlxOo4N3Bgd8RwciZLonE+ur7+5kcP5oQ90
+EtoPha4Q5CzTjqc895akUGMDYZChJQNHu1WSVho5kIJhWmg84eTkvLuHke90pHtuorUTOdn
9JNKOJqEf/BTHM4x999VInjoAxpw0AmxV7AZCWJlRkC6mKqqYWcdJlPxPw8MLNkHOimbUTS/
ElO4i85Gb3RGiMmzFmTGjc5b/8mqQkoqs7Oz3SwbHbN16cZJr3R4VRciIrBoHTGsoj3HOXfq
FE7Io+9kIkwynftQi51OJaus6mxMidQjvKfN43D6faAjX/CYoOo5Sd4mnHykhRAcFxGSEt8W
2ob5MwiCnTgcdrONJM61ybGxu0lJ/+6NjiIGOMvijOx8oheXzDmlRVHtTkDHY9z5CqdjP4SJ
0cmC7HVr9/TltMnz8/Uoa5LDuYb6QGcWEXvSwWwSrb95nBJSJZFO81rCCS08UyJrZWWM4HLD
Psa5hpWHlqZ67TsaKi95nnMKbxuwrJvu76bXutEZQOxW3+4egEWPnsO63+HkRgoLpaKjhjw8
bTBylWon8zAj2Ekxt18l5WHjxj3pUOs8Z48vo7KKyo08zkn6oa2MRo8aDRsJAyBGZ0q0Ep15
54zFyfNpRm+BsinojG20F3LNs5BMEh1Tua90TnGSfaFTQbWABeNE3hiwiMOcJA+D2CXDfnYL
+pGDzrjRsYZ0m/rEeZykY/Ophxuphi9KOgKRx4om2T565uWBYvY8gI6MkJTAMyVe6JT6Qkeu
o3qZitXo3M5znMMer6pP2jZaXHHQKZc56Litj/aAz477c+CrR/tEB08CUPS/xj31KHo8iaIY
Mh1evO907N8LrUe90CmAqN6iqbYpneM54VUV4+sz2EnHkexjuAW+0GucJGyQ7QfFHPVtJUHR
mqPYZypF7ZTrvdP5nw5f6ZznbCzVauuPnk+i7tZ2OmqIOtSpPbrn7t28PM+BMNKdjuNEMUNH
HlJRAHjjnqOlx4DfhPpIh1dF1YtPgfEGTT7MoXALyHSISYn3eN7olGLLG7wHNJZ6CVeHQl7C
VVoKJzNG4UbHsePeg85d1zJCi/pGp8sj/o97bUnXrjXisx/qnc6vCUkJLMu2Mh30aJ5tAbjz
JnVqwbzSQOhLOoth26MHuXbce9BhaSft5gnG1GvzPtHR1KwwKtsgix8wKsdO+EoH1K507NjY
fP0Kn+2P7NFg4bR/dGyB3NntTjqOhI0HHfCFbqZOTp63LUp8osP/L48iHIiTDs9TtIRMx0xI
SrzwADreJXHEO70sYFFxePjFi2VlQUFBFxySmt3ohNWtSMdWyHmf1+hMg5Ti3ySPASWPUn5l
Mh3iSQk8BxkwnTP2rVE3nLlHFI0OH6nMnG6di4ypKVmSSiIizuh0CAJB+BYeh6xudHJV3umA
SXP+6LxP3iDTugH1rxVkOqrch0RHjMy6st/ikczWyBqp5AgAITKaZLyu7sf4KoM1mDvLYLNv
hQqa3Xe7EegUVjyAju+RUybD37QlmQ7xpISNTsxVTHv37l0D1DpHVPWavXszR0a1VDtzMhzb
9x+TpA2CdayRp+CnyNl9Lb7tGePa9pVjdIqCH2BZYrKivdBhmpaCLmoDpmMl0NmKHUAqtnV3
oVBoApItEyWLEwqBXegkSzGt2f1kZTq2YFuFer6c7e9OSHmtk46S60YHjRb359sMNHFJsmFB
R9TC5sS5CxnRK9Fhn0SQM9Ia8E+0AdCx12q9K38twLXyhkA1Q15h5okQHVmwX3f2tKgvWQ22
87k2yeDnOtKzcgCdBJ09cMp40pavkQ5GgE+CCE3Ler2Gb0ixcImSV3SfRKCImtZ8LK6Q704H
/Cm2hR8lA/9E6oskpGZwi9zp+Cg2w00+nPQIVXNTVN1RJ43tEFRU2JB7sHOoo8emsCOdz9RC
E4DOFdge2RWo7Pq34AK1VwMVsCsURlufb1/hkgEBo0Llk0hbtgu2JwRGxx+1MC4ZYqNkIgTW
1T7Tua5tfMDjcs/0QuxaxBCIdIbEL/WpMT3cM5sMwjmSgw/5zjhBH0Nu0OhlIgja3jAx1LaY
FbLihadthY5bYLMQuk6rURgI7KBz/37vQ7qySdDEtdYpeEbQV5QNEx3pizMPvjE3fpuDjiP4
tRqkRhwpmx4IXk4pCPz8CNZTKvjd+C0IysLerT3lwH58vlAxPtdBp9xIOxRBKJtrNZjBB3Yl
tAY+W3gTxnah6xUafoVVjnlufdgmd28zWAs2hfHf4sWJEATeXtjb2VM+NRPA5coz4w46+5fp
wNHXVCC3qszdXTzgtmBTZNyyXvNBHiHq3tuz/kf/euCJ99ZtDcvdVlukfNK+kRpBREZjHLar
3U0yrBww+wAm6Yv+9BRvt0+vi/oaMTQLBC19agaDK7dUYA5Fl37ZZJ/tREIARBH7QeOh3X/8
u5cvv/va+3dIVevtcb88NOFKyMxM1sDA1OLi98vLn2iLJ6mtfBG7WTpn/cMTFMCNmc3N2CkV
bMrCPQvcC7IEWw0GPt+s0SiAovR6/Y1lmSlOKEJsH1y0Nk6G36gN/Kdzu3/x9Isvbtpy+ePX
vvX+X9xZqWoNbfTf635vYrsJa5BCX4yJ53ksw4hJhJBkX9WKcAE3X4j39Rv6KIUCOzdj/giI
03jo0O7dTz/94qZNW7Zcvvz8u6+99r4XGKuSDjSB6P8XUx1+xkflcfYs5RCmjbud+sXToMVA
mzZtehnTU5eBvvz443dB878F2o/pr4Hu3Pn/VW010AEO4U/wBt3BtYouwV8NdNbnlK9fncpN
/8P/J+Hlimv6q/B/1QylgpagLZIAAAAASUVORK5CYII=)
Каковы шансы появления каждой из этих букв? Если бы мы должны были изобразить просто четыре коробки, каждая из которых содержит вероятность, какими были бы эти вероятности? Чтобы узнать это, достаточно умножить каждую вероятность на все вероятности, которые в ней содержатся. Значение >'a'
появилось бы один раз из восьми, как и >'b'
, потому что если мы умножим одну четвёртую на одну четвёртую, то получим одну восьмую. Значение >'c'
появилось бы три раза из восьми, потому что три четвёртых, умноженные на одну вторую, – это три восьмых. Значение >'d'
также появилось бы три раза из восьми. Если мы сложим все вероятности, они по-прежнему будут давать в сумме единицу.
Вот эта ситуация, выраженная в форме списка вероятностей:
>thisSituation :: Prob (Prob Char)
>thisSituation = Prob
> [(Prob [('a',1 % 2),('b',1 % 2)], 1 % 4)
> ,(Prob [('c',1 % 2),('d',1 % 2)], 3 % 4)
> ]
Обратите внимание, её тип – >Prob (Prob Char)
. Поэтому теперь, когда мы поняли, как разгладить вложенный список вероятностей, всё, что нам нужно сделать, – написать для этого код. Затем мы можем определить операцию >>>=
просто как >join
>(fmap f m)
, и заполучим монаду! Итак, вот функция >flatten
, которую мы будем использовать, потому что имя >join
уже занято:
>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
Функция >multAll
принимает кортеж, состоящий из списка вероятностей и вероятности >p
, которая к нему приложена, а затем умножает каждую внутреннюю вероятность на >p
, возвращая список пар элементов и вероятностей. Мы отображаем каждую пару в нашем списке вероятностей с помощью функции >multAll
, а затем просто разглаживаем результирующий вложенный список.
Теперь у нас есть всё, что нам нужно. Мы можем написать экземпляр класса >Monad
!
>instance Monad Prob where