--
a -> Reader env b
data Reader env a = Reader (env -> a)
runReader :: Reader env a -> env -> a
runReader (Reader f) = f
instance Monad (Reader env) where
return a
= Reader $ const a
ma >>= mf
= Reader $ \env ->
let b = runReader ma env
in
runReader (mf b) env
---------------------------------------------------
-- Функции-накопители
--
--
Monoid msg => a -> Writer msg b
data Writer msg a = Writer (a, msg)
deriving (Show)
runWriter :: Writer msg a -> (a, msg)
runWriter (Writer f) = f
instance Monoid msg => Monad (Writer msg) where
return a
= Writer (a, mempty)
ma >>= mf
= Writer (c, msgA ‘mappend‘ msgF)
where (b, msgA) = runWriter ma
(c, msgF) = runWriter $ mf b
Я пропустил определения для экземпляров классов Functor и Applicative, их можно получить из экзем-
пляра для класса Monad с помощью стандартных функций liftM, return и ap из модуля Control.Monad.
Нам встретилась новая запись в экспорте модуля. Для удобства мы экспортируем модули
Control.Applicative, Control.Monad и Data.Monoid целиком. Для этого мы написали ключевое слово
module перед экспортируемым модулем. Теперь если мы в каком-нибудь другом модуле импортируем
модуль Types нам станут доступными все функции из этих модулей.
Мы определили экземпляры для Functor и Applicative с помощью производных функций класса Monad.
106 | Глава 7: Функторы и монады: примеры
7.1 Случайные числа
С помощью монады State можно имитировать случайные числа. Мы будем генерировать случайные числа
из интервала от 0 до 1 с помощью алгоритма:
nextRandom :: Double -> Double
nextRandom = snd . properFraction . (105.947 * )
Функция properFraction возвращает пару, которая состоит из целой части и остатка числа. Взяв второй
элемент пары с помощью snd, мы выделяем остаток. Функция nextRandom представляет собой генератор
случайных чисел, который принимает значение с предыдущего шага и строит по нему следующее значение.
Построим тип для случайных чисел:
type Random a = State Double a
next :: Random Double
next = State $ \s -> (s, nextRandom s)
Теперь определим функцию, которая прибавляет к данному числу случайное число из интервала от 0 до
1:
addRandom :: Double -> Random Double
addRandom x = fmap (+x) next
Посмотрим как эта функция работает в интерпретаторе:
*Random> runState (addRandom 5) 0.5
(5.5,0.9735000000000014)
*Random> runState (addRandom 5) 0.7
(5.7,0.16289999999999338)
*Random> runState (mapM addRandom [1 .. 5]) 0.5
([1.5,2.9735000000000014,3.139404500000154,4.769488561516319,
5.5250046269694195],0.6226652135290891)
В последней строчке мы с помощью функции mapM прибавили ко всем элементам списка разные случайные
числа, обновление счётчика происходило за кадром, с помощью функции mapM и экземпляра Monad для State.
Также мы можем определить функцию, которая складывает два случайных числа, одно из интервала
[-1+a, 1+a], а другое из интервала [-2+b,2+b]:
addRandom2 :: Double -> Double -> Random Double
addRandom2 a b = liftA2 add next next
where add
a b = \x y -> diap a 1 x + diap b 1 y
diap c r = \x
-> x * 2 * r - r + c
Функция diap перемещает интервал от 0 до 1 в интервал от c-r до c+r. Обратите внимание на то как мы
сначала составили обычную функцию add, которая перемещает значения из интервала от 0 до 1 в нужный
диапазон и складывает. И только в самый последний момент мы применили к этой функции случайные
значения. Посмотрим как работает эта функция:
*Random> runState (addRandom2 0 10) 0.5
(10.947000000000003,0.13940450000015403)
*Random> runState (addRandom2 0 10) 0.7
(9.725799999999987,0.2587662999992979)
Прибавим два списка и получим сумму:
*Random> let res = fmap sum $ zipWithM addRandom2 [1.. 3] [11 .. 13]
*Random> runState res 0.5
(43.060125804029965,0.969511377766409)
*Random> runState res 0.7
(39.86034841613788,0.26599261421101517)
Функция zipWithM является аналогом функции zipWith. Она устроена также как и функция mapM, сначала
применяется обычная функция zipWith, а затем функция sequence.
С помощью типа Random мы можем определить функцию подбрасывания монетки:
Случайные числа | 107
data Coin = Heads | Tails
deriving (Show)
dropCoin :: Random Coin
dropCoin = fmap drop’ next
where drop’ x