В этой главе мы закрепим на примерах то, что мы узнали о монадах и функторах. Напомню, что с помощью монад и функторов мы можем комбинировать специальные функции вида (a -> m b) с другими специальными функциями.
У нас есть функции тождества (pure, return) и применения (fmap, =<<):
class Functor f where
fmap :: (a -> b) -> f a -> f b
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
class Monad m where
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
(=<<) :: (a -> m b) -> m a -> m b
(=<<) = flip (>>=)
Вспомним основные производные функции для этих классов:
Или в терминах класса Kleisli:
-- Композиция (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) (<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) -- Константные функции (*>) :: Applicative f => f a -> f b -> f b (<*) :: Applicative f => f a -> f b -> f a -- Применение обычных функций к специальным значениям (<$>) :: Functor f => (a -> b) -> f a -> f b liftA :: Applicative f => (a -> b) -> f a -> f b liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d -- Преобразование элементов списка специальной функцией mapM :: Monad m => (a -> m b) -> [a] -> m [b]
Нам понадобится модуль с определениями типов и экземпляров монад для всех типов, которые мы рассмотрели в предыдущей главе. Экземпляры для [] и Maybe уже определены в Prelude, а типы State, Reader и Writer можно найти в библиотеках mtl и transformers. Пока мы не знаем как устанавливать библиотеки, определим эти типы и экземпляры для Monad самостоятельно. Возможно, вы уже определили их, выполняя одно из упражнений предыдущей главы, если это так, то сейчас вы можете сверить ответы. Определим модуль Types:
module Types(
State(..), Reader(..), Writer(..),
runState, runWriter, runReader,
module Control.Applicative,
module Control.Monad,
module Data.Monoid)
where
import Data.Monoid
import Control.Applicative
import Control.Monad
-------------------------------------------------
-- Функции с состоянием
--
-- a -> State s b
data State s a = State (s -> (a, s))
runState :: State s a -> s -> (a, s)
runState (State f) = f
instance Monad (State s) where
return a = State $ \s -> (a, s)
ma >>= mf = State $ \s0 ->
let (b, s1) = runState ma s0
in runState (mf b) s1
---------------------------------------------------
-- Функции с окружением
--
-- 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 нам станут доступными все функции из этих модулей.
С помощью монады 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 мы можем определить функцию подбрасывания монетки:
data Coin = Heads | Tails
deriving (Show)
dropCoin :: Random Coin
dropCoin = fmap drop' next
where drop' x
| x < 0.5 = Heads
| otherwise = Tails
У монетки две стороны орёл (Heads) и решка (Tails). Поскольку шансы на выпадание той или иной стороны равны, мы для определения стороны разделяем интервал от 0 до 1 в равных пропорциях.
Подбросим монетку пять раз:
*Random> let res = sequence $ replicate 5 dropCoin
Функция replicate n a составляет список из n повторяющихся элементов a. Посмотрим что у нас получилось:
*Random> runState res 0.4 ([Heads,Heads,Heads,Heads,Tails],0.5184926967068364) *Random> runState res 0.5 ([Tails,Tails,Heads,Tails,Tails],0.6226652135290891)
С помощью монады State можно описывать конечные автоматы (finite-state machine). Конечный автомат находится в каком-то начальном состоянии. Он принимает на вход ленту событий. Одно событие происходит за другим. На каждое событие автомат реагирует переходом из одного состояния в другое.
type FSM s = State s s fsm :: (ev -> s -> s) -> (ev -> FSM s) fsm transition = \e -> State $ \s -> (s, transition e s)
Функция fsm принимает функцию переходов состояний transition и возвращает функцию, которая принимает состояние и возвращает конечный автомат. В качестве значения конечный автомат FSM будет возвращать текущее состояние.
С помощью конечных автоматов можно описывать различные устройства. Лентой событий будет ввод пользователя (нажатие на кнопки, включение/выключение питания).
Приведём простой пример. Рассмотрим колонки, у них есть розетка, кнопка вкл/выкл и регулятор громкости. Возможные состояния:
type Speaker = (SpeakerState, Level)
data SpeakerState = Sleep | Work
deriving (Show)
data Level = Level Int
deriving (Show)
Тип колонок складывается из двух значений: состояния и уровня громкости. Колонки могут быть выключенными (Sleep) или работать на определённой громкости (Work). Считаем, что максимальный уровень громкости составляет 10 единиц, а минимальный ноль единиц. Границы диапазона громкости описываются такими функциями:
quieter :: Level -> Level quieter (Level n) = Level $ max 0 (n-1) louder :: Level -> Level louder (Level n) = Level $ min 10 (n+1)
Мы будем обновлять значения уровня громкости не напрямую, а с помощью вспомогательных функций louder и quieter. Так мы не сможем выйти за пределы заданного диапазона.
Возможные события:
data User = Button | Quieter | Louder
deriving (Show)
Пользователь может либо нажать на кнопку вкл/выкл или повернуть реле громкости влево, чтобы приглушить звук (Quieter) или вправо, чтобы сделать погромче (Louder). Будем считать, что колонки всегда включены в розетку.
Составим функцию переходов:
speaker :: User -> FSM Speaker
speaker = fsm $ trans
where trans Button (Sleep, n) = (Work, n)
trans Button (Work, n) = (Sleep, n)
trans Louder (s, n) = (s, louder n)
trans Quieter (s, n) = (s, quieter n)
Мы считаем, что при выключении колонок реле остаётся некотором положении, так что при следующем включении они будут работать на той же громкости. Реле можно крутить и в состоянии Sleep. Посмотрим на типичную сессию работы колонок:
*FSM> let res = mapM speaker [Button, Louder, Quieter, Quieter, Button]
Сначала мы включаем колонки, затем прибавляем громкость, затем дважды делаем тише и в конце выключаем. Посмотрим что получилось:
*FSM> runState res (Sleep, Level 2) ([(Sleep,Level 2),(Work,Level 2),(Work,Level 3),(Work,Level 2), (Work,Level 1)],(Sleep,Level 1)) *FSM> runState res (Sleep, Level 0) ([(Sleep,Level 0),(Work,Level 0),(Work,Level 1),(Work,Level 0), (Work,Level 0)],(Sleep,Level 0))
Смотрите, изменив начальное значение, мы изменили весь список значений. Обратите внимание на то, что во втором прогоне мы не ушли в минус по громкости, не смотря на то, что пытались крутить реле за установленный предел.
Определим колонки другого типа. Наши новые колонки будут безопаснее предыдущих. Представьте ситуацию, что мы выключили колонки на высоком уровне громкости. Мы слушали домашнюю запись с низким уровнем звука. Мы выключили и забыли. Потом мы решили послушать другую мелодию, которая записана с нормальным уровнем звука. При включении колонок нас оглушил шквал звука. Чтобы этого избежать мы решили воспользоваться другими колонками.
Колонки при выключении будут выставлять уровень громкости на ноль и реле можно будет крутить только если колонки включены.
safeSpeaker :: User -> FSM Speaker
safeSpeaker = fsm $ trans
where trans Button (Sleep, _) = (Work, Level 0)
trans Button (Work, _) = (Sleep, Level 0)
trans Quieter (Work, n) = (Work, quieter n)
trans Louder (Work, n) = (Work, louder n)
trans _ (Sleep, n) = (Sleep, n)
При нажатии на кнопку вкл/выкл уровень громкости выводится в положение 0. Колонки реагируют на запросы изменения уровня громкости только в состоянии Work. Посмотрим как работают наши новые колонки:
*FSM> let res = mapM safeSpeaker [Button, Louder, Quieter, Button, Louder]
Мы включаем колонки, делаем по-громче, затем по-тише, затем выключаем и пытаемся изменить громкость после выключения. Посмотрим как они сработают, представим, что мы выключили колонки на уровне громкости 10:
*FSM> runState res (Sleep, Level 10) ([(Sleep,Level 10),(Work,Level 0),(Work,Level 1),(Work,Level 0), (Sleep,Level 0)],(Sleep,Level 0))
Первое значение в списке является стартовым состоянием, которое мы задали. После этого колонки включаются и мы видим, что уровень громкости переключился на ноль. Затем мы увеличиваем громкость, сбавляем её и выключаем. Попытка изменить громкость выключенных колонок не проходит. Это видно по последнему элементу списка и итоговому состоянию колонок, которое находится во втором элементе пары.
Предположим, что колонки работают с самого начала, тогда первым действием мы выключаем их. Посмотрим, что случится дальше:
*FSM> runState res (Work, Level 10) ([(Work,Level 10),(Sleep,Level 0),(Sleep,Level 0),(Sleep,Level 0), (Work,Level 0)],(Work,Level 1))
Дальше мы пытаемся изменить громкость но у нас ничего не выходит.
В этом примере мы будем выполнять арифметические операции на целых числах. Мы будем их складывать, вычитать и умножать. Но вместо того, чтобы сразу вычислять выражения мы будем составлять их описание. Мы будем кодировать операции конструкторами.
data Exp = Var String
| Lit Int
| Neg Exp
| Add Exp Exp
| Mul Exp Exp
deriving (Show, Eq)
У нас есть тип Exp, который может быть либо переменной Var с данным строчным именем, либо целочисленной константой Lit, либо одной из трёх операций: вычитанием (Neg), сложением (Add) или умножением (Mul).
Такие типы называют абстрактными синтаксическими деревьями (abstract syntax tree, AST). Они содержат описание выражений. Теперь вместо того чтобы сразу проводить вычисления мы будем собирать выражения в значении типа Exp. Сделаем экземпляр для Num:
instance Num Exp where
negate = Neg
(+) = Add
(*) = Mul
fromInteger = Lit . fromInteger
abs = undefined
signum = undefined
Также определим вспомогательные функции для обозначения переменных:
var :: String -> Exp var = Var n :: Int -> Exp n = var . show
Функция var составляет переменную с данным именем, а функция n составляет переменную, у которой имя является целым числом. Сохраним эти определения в модуле Exp. Теперь у нас всё готово для составления выражений:
*Exp> n 1 Var "1" *Exp> n 1 + 2 Add (Var "1") (Lit 2) *Exp> 3 * (n 1 + 2) Mul (Lit 3) (Add (Var "1") (Lit 2)) *Exp> - n 2 * 3 * (n 1 + 2) Neg (Mul (Mul (Var "2") (Lit 3)) (Add (Var "1") (Lit 2)))
Теперь давайте создадим функцию для вычисления таких выражений. Она будет принимать выражение и возвращать целое число.
eval :: Exp -> Int eval (Lit n) = n eval (Neg n) = negate $ eval n eval (Add a b) = eval a + eval b eval (Mul a b) = eval a * eval b eval (Var name) = ???
Как быть с конструктором Var? Нам нужно откуда-то узнать какое значение связано с переменной. Функция eval должна также принимать набор значений для всех переменных, которые используются в выражении. Этот набор значений мы будем называть окружением.
Обратите внимание на то, что в каждом составном конструкторе мы рекурсивно вызываем функцию eval, мы словно обходим всё дерево выражения. Спускаемся вниз, до самых листьев в которых расположены либо значения (Lit), либо переменные (Var). Нам было бы удобно иметь возможность пользоваться окружением из любого узла дерева. В этом нам поможет тип Reader.
Представим что у нас есть значение типа Env и функция, которая позволяет читать значения переменных по имени:
value :: Env -> String -> Int
Теперь определим функцию eval:
eval :: Exp -> Reader Env Int eval (Lit n) = pure n eval (Neg n) = liftA negate $ eval n eval (Add a b) = liftA2 (+) (eval a) (eval b) eval (Mul a b) = liftA2 (*) (eval a) (eval b) eval (Var name) = Reader $ \env -> value env name
Определение сильно изменилось, оно стало не таким наглядным. Теперь значение eval стало специальным, поэтому при рекурсивном вызове функции eval нам приходится поднимать в мир специальных функций обычные функции вычитания, сложения и умножения. Мы можем записать это выражение
немного по другому:
eval :: Exp -> Reader Env Int eval (Lit n) = pure n eval (Neg n) = negateA $ eval n eval (Add a b) = eval a `addA` eval b eval (Mul a b) = eval a `mulA` eval b eval (Var name) = Reader $ \env -> value env name addA = liftA2 (+) mulA = liftA2 (*) negateA = liftA negate
Для того чтобы закончить определение функции eval нам нужно определить тип Env и функцию value. Для этого мы воспользуемся типом Map, он предназначен для хранения значений по ключу.
Этот тип живёт в стандартном модуле Data.Map. Посмотрим на его описание:
data Map k a = ..
Первый параметр типа k это ключ, а второй это значение. Мы можем создать значение типа Map из списка пар ключ значение с помощью функции fromList.
Посмотрим на основные функции:
-- Создаём значения типа Map -- создаём empty :: Map k a -- пустой Map fromList :: Ord k => [(k, a)] -> Map k a -- по списку (ключ, значение) -- Узнаём значение по ключу (!) :: Ord k => Map k a -> k -> a lookup :: Ord k => k -> Map k a -> Maybe a -- Добавляем элементы insert :: Ord k => k -> a -> Map k a -> Map k a -- Удаляем элементы delete :: Ord k => k -> Map k a -> Map k a
Обратите внимание на ограничение Ord k в этих функциях, ключ должен быть экземпляром класса Ord. Посмотрим как эти функции работают:
*Exp> :m +Data.Map *Exp Data.Map> :m -Exp Data.Map> let v = fromList [(1, "Hello"), (2, "Bye")] Data.Map> v ! 1 "Hello" Data.Map> v ! 3 "*** Exception: Map.find: element not in the map Data.Map> lookup 3 v Nothing Data.Map> let v1 = insert 3 "Yo" v Data.Map> v1 ! 3 "Yo"
Функция lookup является стабильным аналогом функции !. В том смысле, что она определена с помощью Maybe. Она не приведёт к падению программы, если для данного ключа не найдётся значение.
Теперь мы можем определить функцию value:
import qualified Data.Map as M(Map, lookup, fromList)
...
type Env = M.Map String Int
value :: Env -> String -> Int
value env name = maybe errorMsg $ M.lookup env name
where errorMsg = error $ "value is undefined for " ++ name
Обычно функции из модуля Data.Map включаются с директивой qualified, поскольку имена многих функций из этого модуля совпадают с именами из модуля Prelude. Теперь все определения из модуля Data.Map пишутся с приставкой M..
Создадим вспомогательную функцию, которая упростит вычисление выражений:
runExp :: Exp -> [(String, Int)] -> Int runExp a env = runReader (eval a) $ M.fromList env
Сохраним определение новых функций в модуле Exp. И посмотрим что у нас получилось:
*Exp> let env a b = [("1", a), ("2", b)]
*Exp> let exp = 2 * (n 1 + n 2) - n 1
*Exp> runExp exp (env 1 2)
5
*Exp> runExp exp (env 10 5)
20
Так мы можем пользоваться функциями с окружением для того, чтобы читать значения из общего источника. Впрочем мы можем просто передавать окружение дополнительным аргументом и не пользоваться монадами:
eval :: Env -> Exp -> Int
eval env x = case x of
Lit n -> n
Neg n -> negate $ eval' n
Add a b -> eval' a + eval' b
Mul a b -> eval' a + eval' b
Var name -> value env name
where eval' = eval env
Рассмотрим по-подробнее тип Writer. Он выполняет задачу обратную к типу Reader. Когда мы пользовались типом Reader, мы могли в любом месте функции извлекать данные из окружения. Теперь же мы будем не извлекать данные из окружения, а записывать их.
Рассмотрим такую задачу нам нужно обойти дерево типа Exp и подсчитать все бинарные операции. Мы прибавляем к накопителю результата единицу за каждый конструктор Add или Mul. Тип сообщений будет числом. Нам нужно сделать экземпляр класса Monoid для чисел.
Напомню, что тип накопителя должен быть экземпляром класса Monoid:
class Monoid a where
mempty :: a
mappend :: a -> a -> a
mconcat :: [a] -> a
mconcat = foldr mappend mempty
Но для чисел возможно несколько вариантов, которые удовлетворяют свойствам. Для сложения:
instance Num a => Monoid a where
mempty = 0
mappend = (+)
И умножения:
instance Num a => Monoid a where
mempty = 1
mappend = (*)
Для нашей задачи подойдёт первый вариант, но не исключена возможность того, что для другой задачи нам понадобится второй. Но тогда мы уже не сможем определить такой экземпляр. Для решения этой проблемы в модуле Data.Monoid определено два типа обёртки:
newtype Sum a = Sum { getSum :: a }
newtype Prod a = Prod { getProd :: a }
В этом определении есть два новых элемента. Первый это ключевое слово newtype, а второй это фигурные скобки. Что всё это значит?
Ключевое слово newtype вводит новый тип-обёртку. Тип-обёртка может иметь только один конструктор, у которого лишь один аргумент. Запись:
newtype Sum a = Sum a
Это тоже самое, что и
data Sum a = Sum a
Единственное отличие заключается в том, что в случае newtype вычислитель не видит разницы между Sum a и a. Её видит лишь компилятор. Это означает, что на разворачивание и заворачивание такого значения в тип обёртку не тратится никаких усилий. Такие типы подходят для решения двух задач:
Более точная проверка типов.
Например у нас есть типы, которые описывают физические величины, все они являются числами, но у них также есть и размерности. Мы можем написать:
type Velocity = Double type Time = Double type Length = Double velocity :: Length -> Time -> Velocity velocity leng time = leng / time
В этом случае мы спокойно можем подставить на место времени путь и наоборот. Но с помощью типов обёрток мы можем исключить эти случаи:
newtype Velocity = Velocity Double newtype Time = Time Double newtype Length = Length Double velocity :: Length -> Time -> Velocity velocity (Length leng) (Time time) = Velocity $ leng / time
В этом случае мы проводим проверку по размерностям, компилятор не допустит смешивания данных.
Определение нескольких экземпляров одного класса для одного типа. Этот случай мы как раз и рассматриваем для класса Monoid. Нам нужно сделать два экземпляра для одного и того же типа Num a => a.
Сделаем две обёртки!
newtype Sum a = Sum a newtype Prod a = Prod a
Тогда мы можем определить два экземпляра для двух разных типов:
Один для Sum:
instance Num a => Monoid (Sum a) where
mempty = Sum 0
mappend (Sum a) (Sum b) = Sum (a + b)
А другой для Prod:
instance Num a => Monoid (Prod a) where
mempty = Prod 1
mappend (Prod a) (Prod b) = Prod (a * b)Вторая новинка заключалась в фигурных скобках. С помощью фигурных скобок в Haskell обозначаются записи (records). Запись это произведение типа, но с выделенными именами для полей.
Например мы можем сделать тип для описания паспорта:
data Passport = Person {
surname :: String, -- Фамилия
givenName :: String, -- Имя
nationality :: String, -- Национальность
dateOfBirth :: Date, -- Дата рождения
sex :: Bool, -- Пол
placeOfBirth :: String, -- Место рождения
authority :: String, -- Место выдачи документа
dateOfIssue :: Date, -- Дата выдачи
dateOfExpiry :: Date -- Дата окончания срока
} deriving (Eq, Show) -- действия
data Date = Date {
day :: Int,
month :: Int,
year :: Int
} deriving (Show, Eq)
В фигурных скобках через запятую мы указываем поля. Поле состоит из имени и типа. Теперь нам доступны две операции:
Чтение полей
hello :: Passport -> String hello p = "Hello, " ++ givenName p ++ "!"
Для чтения мы просто подставляем в имя поля данное значение. В этой функции мы приветствуем человека и обращаемся к нему по имени. Для того, чтобы узнать его имя мы подсмотрели в паспорт, в поле givenName.
Обновление полей. Для обновления полей мы пользуемся таким синтаксисом:
value { fieldName1 = newValue1, fieldName2 = newValue2, ... }
Мы присваиваем в значении value полю с именем fieldName новое значение newFieldValue. К примеру продлим срок действия паспорта на десять лет:
prolongate :: Passport -> Passport
prolongate p = p{ dateOfExpiry = newDate }
where newDate = oldDate { year = year oldDate + 10 }
oldDate = dateOfExpiry p Вернёмся к типам Sum и Prod:
newtype Sum a = Sum { getSum :: a }
newtype Prod a = Prod { getProd :: a }
Этой записью мы определили два типа-обёртки. У нас есть две функции, которые заворачивают обычное значение, это Sum и Prod. С помощью записей мы тут же в определении типа определили функции которые разворачивают значения, это getSum и getProd.
Вспомним определение для типа State:
data State s a = State (s -> (a, s)) runState :: State s a -> (s -> (a, s)) runState (State f) = f
Было бы гораздо лучше определить его так:
newtype State s a = State{ runState :: s -> (a, s) }
Но вернёмся к нашей задаче. Мы будем накапливать сумму в значении типа Sum. Поскольку нас интересует лишь значение накопителя, наша функция будет возвращать значение единичного типа ().
countBiFuns :: Exp -> Int
countBiFuns = getSum . execWriter . countBiFuns'
countBiFuns' :: Exp -> Writer (Sum Int) ()
countBiFuns' x = case x of
Add a b -> tell (Sum 1) *> bi a b
Mul a b -> tell (Sum 1) *> bi a b
Neg a -> un a
_ -> pure ()
where bi a b = countBiFuns' a *> countBiFuns' b
un = countBiFuns'
tell :: Monoid a => a -> Writer a ()
tell a = Writer ((), a)
execWriter :: Writer msg a -> msg
execWriter (Writer (a, msg)) = msg
Первая функция countBiFuns извлекает значение из типов Writer и Sum. А вторая функция countBiFuns' вычисляет значение.
Мы определили две вспомогательные функции tell, которая записывает сообщение в накопитель и execWriter, которая возвращает лишь сообщение. Это стандартные для Writer функции.
Посмотрим как работает эта функция:
*Exp> countBiFuns (n 2) 0 *Exp> countBiFuns (n 2 + n 1 + 2 + 3) 3
В модуле Data.Monoid определены два типа для накопления логических значений. Это типы All и Any. С помощью типа All мы можем проверить выполняется ли некоторое свойство для всех значений. А с помощью типа Any мы можем узнать, что существует хотя бы один элемент, для которых это свойство выполнено.
Посмотрим на определение экземпляров класса Monoid для этих типов:
newtype All = All { getAll :: Bool }
instance Monoid All where
mempty = All True
All x `mappend` All y = All (x && y)
В типе All мы накапливаем значения с помощью логического “и”. Нейтральным элементом является конструктор True. Итоговое значение накопителя будет равно True только в том случае, если все накапливаемые сообщения были равны True.
В типе Any всё наоборот:
instance Monoid Any where
mempty = Any False
Any x `mappend` Any y = Any (x || y)
Посмотрим как работают эти типы. Составим функцию, которая проверяет отсутствие оператора минус в выражении:
noNeg :: Exp -> Bool
noNeg = not . getAny . execWriter . anyNeg
anyNeg :: Exp -> Writer Any ()
anyNeg x = case x of
Neg _ -> tell (Any True)
Add a b -> bi a b
Mul a b -> bi a b
_ -> pure ()
where bi a b = anyNeg a *> anyNeg b
Функция anyNeg проверяет есть ли в выражении хотя бы один конструктор Neg. В функции noNeg мы извлекаем результат и берём его отрицание, чтобы убедиться в том что в выражении не встретилось ни одного конструктора Neg.
*Exp> noNeg (n 2 + n 1 + 2 + 3) True *Exp> noNeg (n 2 - n 1 + 2 + 3) False
Экземпляр класса Monoid определён и для списков. Предположим у нас есть дерево, в каждом узле которого находятся числа, давайте соберём все числа больше 5, но меньше 10. Деревья мы возьмём из модуля Data.Tree:
data Tree a = Node
{ rootLabel :: a -- значение метки
, subForest :: Forest a -- ноль или несколько дочерних деревьев
}
type Forest a = [Tree a]
Интересный тип. Тип Tree определён через Forest, а Forest определён через Tree. По этому типу мы видим, что каждый узел содержит некоторое значение типа a, и список дочерних деревьев.
Составим дерево:
*Exp> :m Data.Tree Prelude Data.Tree> let t a = Node a [] Prelude Data.Tree> let list a = Node a [] Prelude Data.Tree> let bi v a b = Node v [a, b] Prelude Data.Tree> let un v a = Node v [a] Prelude Data.Tree> Prelude Data.Tree> let tree1 = bi 10 (un 2 $ un 6 $ list 7) (list 5) Prelude Data.Tree> let tree2 = bi 12 tree1 (bi 8 tree1 tree1)
Теперь составим функцию, которая будет обходить дерево, и собирать числа из заданного диапазона:
type Diap a = (a, a)
inDiap :: Ord a => Diap a -> Tree a -> [a]
inDiap d = execWriter . inDiap' d
inDiap' :: Ord a => Diap a -> Tree a -> Writer [a] ()
inDiap' d (Node v xs) = pick d v *> mapM_ (inDiap' d) xs
where pick (a, b) v
| (a <= v) && (v <= b) = tell [v]
| otherwise = pure ()
Как и раньше у нас две функции, одна выполняет вычисления, другая извлекает результат из Writer. В функции pick мы проверяем число на принадлежность интервалу, если это так мы добавляем число к результату, а если нет пропускаем его, добавляя нейтральный элемент (в функции pure). Обратите внимание на то как мы обрабатываем список дочерних поддеревьев. Функция mapM_ является аналогом функции mapM, Она используется, если результат функции не важен, а важны те действия, которые происходят при преобразовании списка. В нашем случае это накопление результата. Посмотрим на определение этой функции:
mapM_ :: Monad m => (a -> m b) -> [a] -> m () mapM_ f = sequence_ . map f sequence_ :: Monad m => [m a] -> m () sequence_ = foldr (>>) (return ())
Основное отличие состоит в функции sequence_. Раньше мы собирали значения в список, а теперь отбрасываем их с помощью константной функции >>. В конце мы возвращаем значение единичного типа ().
Теперь сохраним в модуле Tree определение функции и вспомогательные функции создания деревьев un, bi, и list и посмотрим как наша функция работает:
*Tree> inDiap (4, 10) tree2 [10,6,7,5,8,10,6,7,5,10,6,7,5] *Tree> inDiap (5, 8) tree2 [6,7,5,8,6,7,5,6,7,5] *Tree> inDiap (0, 3) tree2 [2,2,2]
Возможно читатели, для которых “родным” является один из императивных языков, немного заскучали по изменяемым значениям. Мы говорили, что в Haskell ничего не изменяется, мы даём всё более и более сложные имена статическим значениям, а потом вычислитель редуцирует имена к настоящим значениям. Но есть алгоритмы, которые очень элегантно описываются в терминах изменяемых значений. Примером такого алгоритма может быть быстрая сортировка. Задача состоит в перестановке элементов массива так, чтобы на выходе любой последующий элемент массива был больше предыдущего (для списков эту задачу решают функции sort и sortBy).
Само по себе явление обновления значения является побочным эффектом. Оно ломает представление о статичности мира, у нас появляются фазы: до обновления и после обновления. Но представьте, что обновление происходит локально, мы постоянно меняем только одно значение, при этом за время обновления ни одна другая переменная не может пользоваться промежуточными значениями и обновления происходят с помощью чистых функций. Представьте функцию, которая принимает значение, выделяет внутри себя память, и при построении результата начинает обновлять значение внутри этой памяти (с помощью чистых функций) и считать что-то ещё полезное на основе этих обновлений, как только вычисления закончатся, память стирается, и возвращается значение. Будет ли такая функция чистой? Интуиция подсказывает, что да. Это было доказано, но для реализации этого требуется небольшой трюк на уровне типов. Получается, что не смотря на то, что функция содержит побочные эффекты, она является чистой, поскольку все побочные эффекты локальны, они происходят только внутри вызова функции и только в самой функции.
Для симуляции обновления значения в Haskell нам нужно решить две проблемы. Как упорядочить обновление значения? И как локализовать его? В императивных языках порядок вычисления выражений строго связан с порядком следования выражений, на примитивном уровне, грубо упрощая, можно сказать, что вычислитель читает код как ленту и выполняет выражение за выражением. В Haskell всё совсем по-другому. Мы можем писать функции в любом порядке, также в любом порядке мы можем объявлять локальные переменные в where или let-выражениях. Компилятор определяет порядок редукции синонимов по функциональным зависимостям. Синоним f не будет раскрыт раньше синонима g только в том случае, если результат g требуется в f. Но с обновлением значения этот вариант не пройдёт, посмотрим на выражение:
fun :: Int -> Int
fun arg =
let mem = new arg
x = read mem
y = x + 1
?? = write mem y
z = read mem
in z
Предполагается, что в этой функции мы получаем значение arg, выделяем память mem c помощью специальной функции new, которая принимает начальное значение, которое будет храниться в памяти. Затем читаем из памяти, прибавляем к значению единицу, снова записываем в память, потом опять читаем из памяти, сохранив значение в переменной z, и в самом конце возвращаем ответ. Налицо две проблемы: z не зависит от y, поэтому мы можем считать значение z в любой момент после инициализации памяти и вторая проблема: что должна возвращать функция write?
Для того чтобы упорядочить эти вычисления мы воспользуемся типом State. Каждое выражение будет принимать фиктивное состояние и возвращать его. Тогда функция fun запишется так:
fun :: Int -> State s Int
fun arg = State $ \s0 ->
let (mem, s1) = runState (new arg) s0
((), s2) = runState (write mem arg) s1
(x, s3) = runState (read mem) s2
y = x + 1
((), s4) = runState (write mem y) s3
(z, s5) = runState (read mem) s4
in (z, s5)
new :: a -> State s (Mem a)
write :: Mem a -> a -> State s ()
read :: Mem a -> State s a
Тип Mem параметризован типом значения, которое хранится в памяти. В этом варианте мы не можем изменить порядок следования выражений, поскольку нам приходится передавать состояние. Мы могли бы записать это выражение гораздо короче с помощью методов класса Monad, но мне хотелось подчеркнуть как передача состояния навязывает порядок вычисления. Функция write теперь возвращает пустой кортеж. Но порядок не теряется за счёт состояния. Пустой кортеж намекает на то, что единственное назначение функции write – это обновление состояния.
Однако этого не достаточно. Мы хотим, чтобы обновление значения было скрыто от пользователя в чистой функции. Мы хотим, чтобы тип функции fun не содержал типа State. Для этого нам откуда-то нужно взять начальное значение состояния. Мы можем решить эту проблему, зафиксировав тип s. Пусть это будет тип FakeState, скрытый от пользователя.
module Mutable(
Mutable, Mem, purge,
new, read, write)
where
newtype Mutable a = Mutable (State FakeState a)
data FakeState = FakeState
purge :: Mutable a -> a
purge (Mutable a) = fst $ runState a FakeState
new :: a -> Mutable (Mem a)
read :: Mem a -> Mutable a
write :: Mem a -> a -> Mutable ()
Мы предоставим пользователю лишь тип Mutable без конструктора и функцию purge, которая “очищает” значение от побочных эффектов и примитивные функции для работы с памятью. Также мы определим экземпляры классов типа State для Mutable, сделать это будет совсем не трудно, ведь Mutable – это просто обёртка. С помощью этих экземпляров пользователь сможет комбинировать вычисления, которые связаны с изменением памяти. Пока вроде всё хорошо, но обеспечиваем ли мы локальность изменения значений? Нам важно, чтобы, один раз начав работать с памятью типа Mem, мы не смогли бы нигде воспользоваться этой памятью после выполнения функции purge. Оказывается, что мы можем разрушить локальность. Посмотрите на пример:
let mem = purge allocate in purge (read mem)
Мы возвращаем из функции purge ссылку на память и спокойно пользуемся ею в другой ветке Mutable-вычислений. Можно ли этого избежать? Оказывается, что можно. Причём решение весьма элегантно. Мы можем построить типы Mem и Mutable так, чтобы ссылке на память не удалось просочиться через функцию purge. Для этого мы вернёмся к общему типу State c двумя параметрами. Причём первый параметр мы прицепим и к Mem:
data Mem s a = .. newtype Mutable s a = .. new :: a -> Mutable s (Mem s a) write :: Mem s a -> a -> Mutable s () read :: Mem s a -> Mutable s a
Теперь при создании типы Mem и Mutable связаны общим параметром s. Посмотрим на тип функции purge
purge :: (forall s. Mutable s a) -> a
Она имеет необычный тип. Слово forall означает “для любых”. Это слово называют квантором всеобщности. Этим мы говорим, что функция извлечения значения не может делать никаких предположений о типе фиктивного состояния. Как дополнительный forall может нам помочь? Функция purge забывает тип фиктивного состояния s из типа Mutable, но в случае типа Mem, этот параметр продолжает своё путешествие по программе в типе значения v :: Mem s a. По типу v компилятор может сказать, что существует такое s, для которого значение v имеет смысл (правильно типизировано). Но оно не любое! Функцию purge с трюком интересует не некоторый тип, а все возможные типы s, поэтому пример не пройдёт проверку типов. Компилятор будет следить за “чистотой” наших обновлений.
При таком подходе остаётся вопрос: откуда мы возьмём начальное значение, ведь теперь у нас нет типа FakeState? В Haskell специально для этого типа было сделано исключение. Мы возьмём его из воздуха. Это чисто фиктивный параметр, нам главное, что он скрыт от пользователя, и он нигде не может им воспользоваться. Поскольку у нас нет конструктора Mutable мы никогда не сможем добраться до внутренней функции типа State и извлечь состояние. Состояние скрыто за интерфейсом класса Monad и отбрасывается в функции purge.
Выше я пользовался вымышленными типами для упрощения объяснений, на самом деле в Haskell за обновление значений отвечает тип ST (сокращение от state transformer). Он живёт в модуле Control.Monad.ST. Из документации видно, что у него два параметра, и нет конструкторов:
data ST s a
Это наш тип Mutable, теперь посмотрим на тип Mem. Он называется ST-ссылкой и определён в модуле Data.STRef (сокращение от ST reference). Посмотрим на основные функции:
newSTRef :: a -> ST s (STRef s a) readSTRef :: STRef s a -> ST s a writeSTRef :: STRef s a -> a -> ST s ()
Такие функции иногда называют смышлёными конструкторами (smart constructors) они позволяют строить значение, но скрывают от пользователя реализацию за счёт скрытия конструкторов типа (модуль экспортирует лишь имя типа STRef).
Для иллюстрации этих функций реализуем одну вспомогательную функцию из модуля Data.STRef, функцию обновления значения по ссылке:
modifySTRef :: STRef s a -> (a -> a) -> ST s () modifySTRef ref f = writeSTRef . f =<< readSTRef ref
Мы воспользовались тем, что ST является экземпляром Monad. Также как и для State для ST определены экземпляры классов Functor, Applicative и Monad. Какое совпадение! Посмотрим на функцию purge:
runST :: (forall s. ST s a) -> a
Реализуем for цикл из языка C:
Result s;
for (i = 0 ; i < n; i++)
update(i, s);
return s;У нас есть стартовое значение счётчика и результата, функция обновления счётчика, предикат останова и функция обновления результата. Мы инициализируем счётчик и затем обновляем счётчик и состояние до тех пор пока предикат счётчика не станет ложным. Напишем чистую функцию, которая реализует этот процесс. В этой функции мы воспользуемся специальным синтаксическим сахаром, который называется do-нотация, не пугайтесь это всё ещё Haskell, для понимания этого примера загляните в раздел “сахар для монад” главы~17.
module Loop where
import Control.Monad
import Data.STRef
import Control.Monad.ST
forLoop :: i -> (i -> Bool) -> (i -> i) -> (i -> s -> s) -> s -> s
forLoop i0 pred next update s0 = runST $ do
refI <- newSTRef i0
refS <- newSTRef s0
iter refI refS
readSTRef refS
where iter refI refS = do
i <- readSTRef refI
s <- readSTRef refS
when (pred i) $ do
writeSTRef refI $ next i
writeSTRef refS $ update i s
iter refI refS
Впрочем, код выше можно понять, если читать его как обычный императивный код. Выражения do-блока выполняются последовательно, одно за другим. Сначала мы инициализируем два изменяемых значения: для счётчика цикла и для состояния. Затем в функции iter мы читаем значения и выполняем проверку предиката pred. Функция when – это стандартная функция из модуля Control.Monad. Она проверяет предикат, и если он возвращает True выполняет серию действий, в которых мы записываем обновлённые значения. Обратите внимание на то, что связка when-do это не специальная конструкция языка. Как было сказано when – это просто функция, но она ожидает одно действие, а мы хотим выполнить сразу несколько. Следующее за ней do начинает блок действий (границы блока определяются по отступам), который будет интерпретироваться как одно действие. В настоящем императивном цикле в обновлении и предикате счётчика может участвовать переменная результата, но это считается признаком дурного стиля, поэтому наши функции определены на типе счётчика. Решим типичную задачу, посчитаем числа от одного до десяти:
*Loop> forLoop 1 (<=10) succ (+) 0 55
Посчитаем факториал:
*Loop> forLoop 1 (<=10) succ (*) 1 3628800 *Loop> forLoop 1 (<=100) succ (*) 1 9332621544394415268169923885626670049071596826 4381621468592963895217599993229915608941463976 1565182862536979208272237582511852109168640000 00000000000000000000
Теперь напишем while-цикл:
Result s;
while (pred(s))
update(s);
return s;В этом цикле участвует один предикат и одна функция обновления результата, мы обновляем результат до тех пор пока предикат не станет ложным.
whileLoop :: (s -> Bool) -> (s -> s) -> s -> s
whileLoop pred update s0 = runST $ do
ref <- newSTRef s0
iter ref
readSTRef ref
where iter ref = do
s <- readSTRef ref
when (pred s) $ do
writeSTRef ref $ update s
iter ref
Посчитаем сумму чисел через while-цикл:
*Loop> whileLoop ((>0) . fst) (\(n, s) -> (pred n, n + s)) (10, 0) (0,55)
Первый элемент пары играет роль счётчика, а во втором мы накапливаем результат.
Реализуем императивный алгоритм быстрой сортировки. Алгоритм быстрой сортировки хорош не только тем, что он работает очень быстро, но и минимальным расходом памяти. Сортировка проводится в самом массиве, с помощью обмена элементов местами. Но для этого нам понадобятся изменяемые массивы. Этот тип определён в модуле Data.Array.ST. В Haskell есть несколько типов изменяемых массивов (как впрочем и неизменяемых), это связано с различными нюансами размещения элементов в массивах, о которых мы пока умолчим. Следующий класс определяет общий интерфейс к различным массивам:
class (HasBounds a, Monad m) => MArray a e m where
newArray :: Ix i => (i, i) -> e -> m (a i e)
newArray_ :: Ix i => (i, i) -> m (a i e)
MArray – это сокращение от mutable (изменяемый) array. Метод newArray создаёт массив типа a, который завёрнут в тип-монаду m. Первый аргумент указывает на диапазон значений индексов массива, а вторым аргументом передаётся элемент, который будет записан во все ячейки массива. Вторая функция записывает в массив элемент undefined.
Посмотрим на вспомогательные классы:
class Ord a => Ix a where
range :: (a, a) -> [a]
index :: (a, a) -> a -> Int
inRange :: (a, a) -> a -> Bool
rangeSize :: (a, a) -> Int
class HasBounds a where
bounds :: Ix i => a i e -> (i, i)
Класс Ix описывает тип индекса из непрерывного диапазона значений. Наверняка по имени функции и типу вы догадаетесь о назначении методов (можете свериться с интерпретатором на типах Int или (Int, Int)). Класс HasBounds обозначает массивы размер, которых фиксирован. Но вернёмся к массивам. Мы можем не только выделять память под массив, но и читать элементы и обновлять их:
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
В случае ST-ссылок у нас была функция runST. Она возвращала значение из памяти, но что будет возвращать аналогичная функция для массива? Посмотрим на неё:
freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e)
Возможно за всеми классами схожесть с функцией runST прослеживается не так чётко. Новый класс IArray обозначает неизменяемые (immutable) массивы. Функцией freeze мы превращаем изменяемый массив в неизменяемый, но завёрнутый в специальный тип-монаду. В нашем случае этим типом будет ST. В модуле Data.Array.ST определена специальная версия этой функции:
runSTArray :: Ix i => (forall s . ST s (STArray s i e)) -> Array i e
Здесь Array – это обычный неизменяемый массив. Он живёт в модуле Data.Array мы можем строить массивы из списков значений, преобразовывать их разными способами, превращать в обратно в списки и многое другое. Об о всём этом можно узнать из документации к модулю. Обратите на появление слова forall и в этой функции. Оно несёт тот же смысл, что и в функции runST.
Для тренировки напишем функцию, которая меняет местами два элемента массива:
module Qsort where
import Data.STRef
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.Array.MArray
swapElems :: Ix i => i -> i -> STArray s i e -> ST s ()
swapElems i j arr = do
vi <- readArray arr i
vj <- readArray arr j
writeArray arr i vj
writeArray arr j vi
Протестируем на небольшом массиве:
test :: Int -> Int -> [a] -> [a]
test i j xs = elems $ runSTArray $ do
arr <- newListArray (0, length xs - 1) xs
swapElems i j arr
return arr
Тир функции test ничем не выдаёт её содержание. Вроде функция как функция:
test :: Int -> Int -> [a] -> [a]
Посмотрим на то, как она работает:
*Qsort> test 0 3 [0,1,2,3,4] [3,1,2,0,4] *Qsort> test 0 4 [0,1,2,3,4] [4,1,2,3,0]
Теперь перейдём к сортировке. Суть метода в том, что мы выбираем один элемент массива, называемый осью (pivot) и переставляем остальные элементы массива так, чтобы все элементы меньше осевого были слева от него, а все, что больше оказались справа. Затем мы повторяем эту процедуру на массивах поменьше, тех, что находятся слева и справа от осевого элемента и так пока все элементы не отсортируются. В алгоритме очень хитрая процедура перестановки элементов, наша задача переставить элементы в массиве, то есть не пользуясь никакими дополнительными структурами данных. Я не буду говорить как это делается, просто выпишу код, а вы можете почитать об этом где-нибудь, в любом случае из кода будет понятно как это происходит:
qsort :: Ord a => [a] -> [a]
qsort xs = elems $ runSTArray $ do
arr <- newListArray (left, right) xs
qsortST left right arr
return arr
where left = 0
right = length xs - 1
qsortST :: Ord a => Int -> Int -> STArray s Int a -> ST s ()
qsortST left right arr = do
when (left <= right) $ do
swapArray left (div (left + right) 2) arr
vLeft <- readArray arr left
(last, _) <- forLoop (left + 1) (<= right) succ
(update vLeft) (return (left, arr))
swapArray left last arr
qsortST left (last - 1) arr
qsortST (last + 1) right arr
where update vLeft i st = do
(last, arr) <- st
vi <- readArray arr i
if (vi < vLeft)
then do
swapArray (succ last) i arr
return (succ last, arr)
else do
return (last, arr)
Это далеко не самый быстрый вариант быстрой сортировки, но самый простой. Мы просто учимся обращаться с изменяемыми массивами. Протестируем:
*Qsort> qsort "abracadabra" "aaaaabbcdrr" *Qsort> let x = 1000000 *Qsort> last $ qsort [x, pred x .. 0] -- двадцать лет спустя 1000000
Мы посмотрели на примерах как применяются типы State, Reader и Writer. Также мы познакомились с монадой изменяемых значений ST. Она позволяет писать в императивном стиле на Haskell. Мы узнали два новых элемента построения типов:
Типы-обёртки, которые определяются через ключевое слово newtype.
Записи, они являются произведением типов с именованными полями.
Также мы узнали несколько полезных типов:
Map – хранение значений по ключу (из модуля Data.Map).
Tree – деревья (из модуля Data.Tree).
Array – массивы (из модуля Data.Array).
Типы для накопления результата (из модуля Data.Monoid).
Отметим, что экземпляр класса Monad определён и для функций. Мы можем записать функцию двух аргументов (a -> b -> c) как (a -> (->) b c). Тогда тип (->) b будет типом с одним параметром, как раз то, что нужно для класса Monad. По смыслу экземпляр класса Monad для функций совпадает с экземпляром типа Reader. Первый аргумент стрелочного типа b играет роль окружения.
Напишите с помощью типа Random функцию игры в кости, два игрока бросают по очереди кости (два кубика с шестью гранями, грани пронумерованы от 1 до 6). Они бросают кубики 10 раз выигрывает тот, у кого в сумме выпадет больше очков. Функция принимает начальное состояние и выводит результат игры: суммарные баллы игроков.
Напишите с помощью типа Random функцию, которая будет создавать случайные деревья заданной глубины. Значение в узле является случайным числом от 0 до 100, также число дочерних деревьев в каждом узле случайно, оно изменяется от 0 до 10.
Опишите в виде конечного автомата поведение амёбы. Амёба может двигаться на плоскости по четырём направлениям. Если она чувствует свет в определённой стороне, то она ползёт туда. Если по-близости нет света, она ползает в произвольном направлении. Амёба улавливает интенсивность света, если по всем четырём сторонам интенсивность одинаковая, она стоит на месте и греется.
Казалось бы, зачем нам сохранять вычисления в выражениях, почему бы нам просто не вычислить их сразу? Если у нас есть описание выражения мы можем применить различные техники оптимизации, которые могут сокращать число вычислений. Например нам известно, что двойное отрицание не влияет на аргумент, мы можем выразить это так:
instance Num Exp where
negate (Neg a) = a
negate x = Neg x
...
...
Так мы сократили вычисления на две операции. Возможны и более сложные техники оптимизации. Мы можем учесть ноль и единицу при сложении и умножении или дистрибутивность сложения относительно умножения.
В этом упражнении вам предлагается провести подобную оптимизацию для логических значений. У нас есть абстрактное синтаксическое дерево:
data Log = True
| False
| Not Log
| Or Log Log
| And Log Log
Напишите функцию, которая оптимизирует выражение Log. Эта функция приводит Log к конъюнктивной нормальной форме (КНФ). Дерево в КНФ обладает такими свойствами: все узлы с Or находятся ближе к корню чем узлы с And и все узлы с And находятся ближе к корню чем узлы с Not. В КНФ выражения имеют вид:
(True `And` Not False `And` True) `Or` True `Or` (True `And` False) (True `And` True `And` False) `Or` True
Как бы мы не шли от корня к листу сначала нам будут встречаться только операции Or, затем только операции And, затем только Not.
КНФ замечательна тем, что её вычисление может пройти досрочно. КНФ можно представить так:
data Or' a = Or' [a] data And' a = And' [a] data Not' a = Not' a data Lit = True' | False' type CNF = Or' (And' (Not' Lit))
Сначала идёт список выражений разделённых конструктором Or (вычислять весь список не нужно, нам нужно найти первый элемент, который вернёт True). Затем идёт список выражений, разделённых And (опять же его не надо вычислять целиком, нам нужно найти первое выражение, которое вернёт False). В самом конце стоят отрицания.
В нашем случае приведение к КНФ состоит из двух этапов:
Сначала построим выражение, в котором все конструкторы Or и And стоят ближе к корню чем конструктор Not. Для этого необходимо воспользоваться такими правилами:
-- удаление двойного отрицания Not (Not a) ==> a -- правила де Моргана Not (And a b) ==> Or (Not a) (Not b) Not (Or a b) ==> And (Not a) (Not b)
Делаем так чтобы все конструкторы Or были бы ближе к корню чем конструкторы And. Для этого мы воспользуемся правилом дистрибутивности:
And a (Or b c) ==> Or (And a b) (And a c)
При этом мы будем учитывать коммутативность And и Or:
And a b == And b a Or a b == Or b a
Когда вы закончите определение функции:
transform :: Log -> CNF
Напишите функцию, которая будет сравнивать вычисление исходного выражения напрямую и вычисление через КНФ. Эта функция будет принимать исходное значение типа Log и будет возвращать два числа, число операций необходимых для вычисления выражения:
evalCount :: Log -> (Int, Int) evalCount a = (evalCountLog a, evalCountCNF a) evalCountLog :: Log -> Int evalCountLog a = ... evalCountCNF :: Log -> Int evalCountCNF a = ...
При написании этих функций воспользуйтесь функциями-накопителями.
В модуле Data.Monoid определён специальный тип с помощью которого можно накапливать функции. Только функции должны быть специального типа. Они должны принимать и возвращать значения одного типа. Такие функции называют эндоморфизмами.
Посмотрим на их определение:
newtype Endo a = Endo { appEndo :: a -> a }
instance Monoid (Endo a) where
mempty = Endo id
Endo f `mappend` Endo g = Endo (f . g)
В качестве нейтрального элемента выступает функция тождества, а функцией объединения значений является функция композиции. Попробуйте переписать примеры из главы накопление чисел с помощью этого типа.
Реализуйте с помощью монады ST какой-нибудь алгоритм в императивном стиле. Например алгоритм поиска корней уравнения методом деления пополам. Если функция $f$ непрерывна и в двух точках $a$ и $b$ ($a < b$) значения функции имеют разные знаки, то это говорит о том, что где-то на отрезке $[a,\ b]$ уравнение $f(x) = 0$ имеет решение. Мы можем найти его так. Посмотрим какой знак у значения функции в середине отрезка. Если значение равно нулю, то нам повезло и мы нашли решение, если нет, то из двух концов отрезка выберем тот, у которого знак значения функции $f$ отличается от знака значения в середине отрезка. Далее повторим эту процедуру на новом отрезке. И так пока мы не найдём корень или отрезок не стянется в точку. Внутри функции выделите память под концы отрезка и последовательно изменяйте их внутри типа ST.