lec08.hs

import Prelude hiding (showString, showChar)
import Data.Foldable
import Data.Semigroup
import Data.Monoid

-- Домашнее задание находится в конце файла.

-------------------------------------------------
-- Конспект лекции 8 от 05.04.2021
-------------------------------------------------

-- Содержание

-- 1. Разностные списки.
-- 2. Класс типов Monoid и его элементы.
-- 3. Класс Foldable.
-- 4. Моноид эндоморфизмов.

-------------------------------------------------
-- 1. Разностные списки
-------------------------------------------------

-- В домашнем задании 6 рассматривались следующие определения.

-- type ShowS = String -> String
-- shows :: Show a => a -> ShowS

-- Тип ShowS является типом так называемых разностных списков. При
-- таком подходе строка s (обычный список Char) представляется
-- функцией (s ++) :: ShowS, которая добавляет s к своему аргументу.
-- Если f1 :: ShowS представляет s1 :: String, а f2 :: ShowS
-- представляет s2 :: String, то строке s1 ++ s2 соответствует функция
-- f1 . f2. Чтобы получить явный вид f :: ShowS в виде String, f
-- применяется к "". Пример: ("abc" ++) . ("def" ++) $ "" возвращает
-- "abcdef".

-- Зачем нужна функция shows и почему недостаточно просто
-- show :: Show a => a -> String? Рассмотрим следующие функции.

testLeft n = length $ foldl (++) "" $ replicate n "a"

testRight n = length $ foldr (++) "" $ replicate n "a"

-- Будем измерять сложность вычисления какого-либо выражения количеством
-- вызовов конструктора (:).

-- Напоминание: f(n) = Θ(g(n)) означает, что существуют такие a, b, n0 > 0,
-- что a*g(n) <= f(n) <= b*g(n) для любого n > n0.

-- Еще одно напоминание: функция (++) определена примерно следующим образом.

append [] ys  = ys
append (x : xs) ys = x : (append xs ys)

-- Таким образом, на первом аргументе длины n сложность append равна n.

-- Сложность вычисления (...(("a" ++ "a") ++ "a") ++ ... ++ "a") ++ "a",
-- где строка "a" встречается n раз, есть 1 + 2 + ... + n-1 =
-- Θ(n^2). С другой стороны, сложность вычисление выражения
-- "a" ++ ("a" ... ++ ("a" ++ ("a" ++ "a"))...) есть Θ(n).
-- На моем компьютере testRight (10^7) требует в несколько раз меньше
-- времени, чем testLeft (10^4). (Команда :set +s говорит ghci
-- показывать время вычисления каждого выражения.)

-- Что происходит при использовании разностных списков?

testLeft1 n = length $ (foldl (.) id $ replicate n ("a" ++)) ""

testRight1 n = length $ (foldr (.) id $ replicate n ("a" ++)) ""

-- Обозначим ("a" ++) через f. Тогда testLeft1 3 приводит к вычислению

-- ((f . f) . f) ""
-- = (f . f) (f "")
-- = (f . f) "a"
-- = f (f "a")
-- = f "aa"
-- = "aaa"

-- testRight1 3 приводит к вычислению

-- (f . (f . f)) ""
-- = f ((f . f) "")
-- = f (f (f ""))
-- = f (f "a")
-- = f "aa"
-- = "aaa"

-- Таким образом, сложность вычисления обоих функций testLeft1 n и
-- testRight1 n есть Θ(n).

-- Аналогичный эффект возникает при наивной реализации обхода дерева.
-- Рассмотрим следующий тип.

data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) deriving Show

-- Вот пример значения этого типа.

t :: Tree Int
t = Node (Node (Leaf 3) 2 Empty) 1 (Node (Leaf 5) 4 (Leaf 6))

-- Кроной (fringe) дерева называется последовательность всех листьев в
-- том порядке, в котором они встречаются в дереве.

fringe :: Tree a -> [a]
fringe Empty = []
fringe (Leaf x) = [x] -- то есть x : []
fringe (Node t1 _ t2) = fringe t1 ++ fringe t2

-- Основная теорема о рекуррентных соотношениях.
-- Пусть t(n) = a*t(n/b) + g(n), k = log_b(a) и g(n) = Θ(n^c).
-- (1) Если с < k, то t(n) = Θ(n^k).
-- (2) Если с = k, то t(n) = Θ(n^k*log(n)).

-- Рассмотрим совершенное дерево, то есть такое, которое не содержит
-- Empty и где все листья имеют одинаковую глубину. Пусть f(n) есть
-- сложность работы функции fringe на дереве с n листьями. Тогда
-- f(1) = 1 и f(n) = 2*f(n/2) + n/2 (слагаемое n/2 представляет сложность
-- конкатенации fringe t1 и fringe t2).

-- Следовательно, по п. (2) основной теоремы f(n) = Θ(n*log(n)).

-- Рассмотрим другой вариант функции fringe.

fringe1 :: Tree a -> [a] -> [a]
fringe1 Empty xs = xs
fringe1 (Leaf x) xs = x : xs
fringe1 (Node t1 _ t2) xs = fringe1 t1 (fringe1 t2 xs)

-- Пусть сложность этой функции есть g(n), где n есть по-прежнему
-- число листьев в первом аргументе. Тогда g(1) = 1 и g(n) = 2*g(n/2).
-- По п. (1) основной теоремы g(n) = Θ(n).

-- Определение fringe1 можно переписать следующим образом.

-- fringe1 Empty = \xs -> xs
-- fringe1 (Leaf x) = \xs -> x : xs
-- fringe1 (Node t1 _ t2) = \xs -> fringe1 t1 (fringe1 t2 xs)

-- Заметим, что \xs -> xs = id, \xs -> x : xs = \xs -> (:) x xs =η (x :),
-- а \xs -> fringe1 t1 (fringe1 t2 xs) =β \xs -> (fringe1 t1 . fringe1 t2) xs
-- =η fringe1 t1 . fringe1 t2.
-- Поэтому fringe1 можно переписать следующим образом.

fringe2 :: Tree a -> ([a] -> [a])
fringe2 Empty = id
fringe2 (Leaf x) = (x :)
fringe2 (Node t1 _ t2) = fringe2 t1 . fringe2 t2

-- При этом удобно рассматривать fringe2 как функцию одного аргумента,
-- возвращающую разностный список, вместо того, чтобы каждый раз
-- интерпретировать разностные списки как функции. Именно в этом
-- состоит идея определения типа ShowS = String -> String. Эта идея
-- будет еще неоднократно встречаться в этом курсе.

-- В Prelude имеются функции showString :: String -> ShowS и
-- showChar :: Char -> ShowS, которые конвертируют строку и символ в
-- представление ShowS.

-------------------------------------------------
-- 2. Класс типов Monoid и его элементы
-------------------------------------------------

-- Рассмотрим еще раз класс Monoid, определенный на лекции 7. На самом
-- деле, этот класс, а также его надкласс Semigroup (моноид без
-- единицы), определены в модулях Data.Monoid и Data.Semigroup,
-- соответственно. Они импортируется уже в Prelude. Тип из класса
-- Semigroup должен иметь ассоциативную бинарную операцию (<>)
-- (не путать с /=), а тип из класса Monoid должен дополнительно
-- определять константу mempty. Есть также устаревший синоним (<>) по
-- имени mappend и функция mconcat :: [a] -> a с определением
-- mconcat = foldr (<>) mempty. Оператор <> является правоассоциативным.

-- Типичным представителем Monoid является String и вообще тип списков
-- относительно конкатенации.

-- В Haskell есть класс Num, членами которого являются стандартные
-- числовые типы: Integer, Int, Float и Double. На любом типе a из Num
-- должны быть определены в том числе следующие функции.

-- (+) :: a -> a -> a
-- (-) :: a -> a -> a
-- fromInteger :: Integer -> a

-- Целочисленная константа n :: a понимается как fromInteger (n :: Integer).
-- Поэтому команда :t 5 в интерпретаторе выдает тип 5 :: Num p => p.

-- Целые числа могут рассматриваться как моноид разными способами
-- (например, по сложению и по умножению). Поскольку тип может быть членом
-- класса единственным способом, для включения Int в Monoid используются
-- типы-обертки. (См. Холомьёв А. Учебник по Haskell. 2012. С. 113.) Так,
-- Data.Monoid подключает следующие типы и объявления.

-- newtype Sum     a = Sum     { getSum     :: a } deriving (Eq, Ord, Read, Show, Bounded, Num)
-- newtype Product a = Product { getProduct :: a } deriving (Eq, Ord, Read, Show, Bounded, Num)

-- В стандарте Haskell 2010 автоматическое членство в классах для
-- вновь объявленных типов с помощью директивы deriving возможно
-- только для классов Eq, Ord, Read, Show, Bounded и Enum. Однако
-- реализация GHC с помощью расширения «Generalised derived instances
-- for newtypes», которое включается прагмой {-# LANGUAGE
-- GeneralizedNewtypeDeriving #-} в начале файла, позволяет добавлять
-- к классу C тип T, объявленный с помощью newtype, если к C
-- принадлежит тип единственного поля T. В случае типа Sum добавляется
-- определение, аналогичное следующему.

-- instance Num a => Num (Sum a) where
--   fromInteger = Sum . fromInteger
--   Sum x + Sum y = Sum (x + y)
--   ...

-- Значит, если тип a есть член класса Num и выражение 5 :: a имеет смысл,
-- то можно написать и 5 :: Sum a. Последнее выражение означает Sum (5 :: a),
-- то есть Sum (fromInteger 5).

-- Вспомним, что типы-обертки Sum a и Product a определялись с целью
-- объявить тип a членом классов Semigroup и Monoid двумя различными
-- способами.

-- instance Num a => Semigroup (Sum a) where
--   Sum x <> Sum y = Sum (x + y)

-- instance Num a => Monoid (Sum a) where
--   mempty = Sum 0

-- instance Num a => Monoid (Product a) where
--   Product a <> Product b = Product (a * b)

-- instance Num a => Monoid (Product a) where
--   mempty = Product 1

-- Итак, любые типы, являющиеся членами класса Num, могут
-- рассматриваться как моноид по сложению, и по умножению. Например:

-- > 5 <> 3 :: Sum Int
-- Sum {getSum = 8}
-- > 5 <> 3 :: Product Int
-- Product {getProduct = 15}

-- Здесь мы видим ситуацию, когда благодаря классам типов одно и то
-- же выражение может иметь разные типы и вычисляться по-разному.
-- В лекции 7 мы видели аналогичную ситуацию с функцией read.

-- Также в библиотеке содержатся определения, эквивалентные следующим.

-- instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
--   (a, b) <> (a', b') = (a <> a', b <> b')

-- instance (Monoid a, Monoid b) => Monoid (a, b) where
--   mempty = (mempty, mempty)

-- Таким образом, прямое произведение моноидов является моноидом.
-- Например:

-- > (1 :: Sum Int, 2 :: Product Int) <> (3, 4)
-- (Sum {getSum = 4}, Product {getProduct = 8})

-- Здесь первая компонента пары рассматривается по сложению, а вторая —
-- по умножению.

-------------------------------------------------
-- 3. Класс Foldable
-------------------------------------------------

-- Моноид удобно рассматривать как тип для накопления значений при обходе какой-либо
-- структуры. Для таких типов имеется класс Foldable,

-- Рассмотрим тип Tree, определенный выше.

-- data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a) deriving Show

-- Тип из класса Foldable должен определять одну из двух следующих функций.

-- foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
-- foldr :: (a -> b -> b) -> b -> t a -> b

-- Как в случае класса Eq с двумя функциями (==) и (/=), foldMap и
-- foldr имеют ревлизации по умолчанию, каждая из которых использует
-- другую функцию, поэтому при объявлении типа членом Foldable
-- достаточно определить одну из этих функций.

-- Функция foldMap f t применяет f к каждой вершине дерева t. При этом
-- получается элемент моноида m. Элементы моноида для каждой вершины
-- затем соединяются с помощью моноидной операции. Вот как можно
-- объявить тип Tree a членом класса Foldable.

instance Foldable Tree where
  foldMap f Empty = mempty
  foldMap f (Leaf x) = f x
  foldMap f (Node l k r) = foldMap f l <> f k <> foldMap f r

-- Вот как можно определить функцию, которая возвращает количество
-- вершин дерева, содержащих информацию, то есть вершин вида Leaf или Node.

numVertices :: Tree a -> Int
numVertices = getSum . foldMap (Sum . const 1)

-- Объясните это определение.

-- Мы уже видели, как функция foldr работает на списках. На типе Tree ее
-- можно определить так.

-- instance Foldable Tree where
--   foldr f z Empty = z
--   foldr f z (Leaf x) = f x z
--   foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l

-------------------------------------------------
-- 4. Моноид эндоморфизмов
-------------------------------------------------

-- Рассмотрим еще один вариант моноида: множество функций на некотором
-- множестве с операцией композиции. Единицей выступает тождественная
-- функция. На языке теории категорий функции называются морфизмами, а
-- морфизмы, у которых совпадает область определения и область
-- значений — эндоморфизмами. Поэтому в Data.Monoid данный тип
-- называется моноидом эндоморфизмов относительно композиции.

-- Как и в случае целых числе по сложению, определим обертку над
-- типом функций (есть в Data.Monoid).

-- newtype Endo a = Endo { appEndo :: a -> a }

-- instance Semigroup (Endo a) where
--   Endo f <> Endo g = Endo (f . g)

-- instance Monoid (Endo a) where
--   mempty = Endo id

-- Например:

-- > appEndo ((Endo (*2)) <> Endo (+1)) 3
-- 8

-- Поскольку тип Endo a изоморфен a -> a, при чтении конструктор Endo
-- и проекцию appEndo следует пропускать. Выражение выше эквивалентно

-- ((*2) . (+1)) 3 = (* 2) ((+1) 3) = (* 2) (3 + 1) = (3 + 1) * 2.

-- Мы уже видели, что строки и списки в целом являются моноидом по
-- конкатенации. Можно также определить моноид разностных списков по
-- композиции. Для этого рассмотрим функцию

-- diff :: Semigroup m => m -> Endo m
-- diff = Endo . (<>)

-- определенную в Data.Semigroup. В качестве m подставим тип String.
-- Рассмотрим выражение diff "abc" :: Endo String.

-- diff "abc"
-- =  (Endo . (<>)) "abc"
-- =β Endo ((<>) "abc")
-- =  Endo ("abc" <>)
-- =  Endo ("abc" ++).

-- Это функция, которая берет строчку и добавляет "abc" к ней слева.
-- Таким образом, с точностью до обертки Endo выражение diff "abc"
-- возвращает разностный список типа ShowS = String -> String. Если
-- рассмотреть частный случай типа diff, где m = String, то

-- diff :: String -> Endo String

-- аналогична

-- showString :: String -> ShowS

-- Обе функции возвращают разностные списки, но в первом случае они являются
-- элементами моноида и на них определена операция <>, например:

-- > appEndo (diff "Hello, " <> diff "Haskell!") ""
-- "Hello, Haskell!"

-------------------------------------------------
-- Домашнее задание 8
-------------------------------------------------

-- 1. Напишите функции showString :: String -> ShowS и
-- showChar :: Char -> ShowS, используя бесточечную запись.

-- 2. Измените функцию showExp из домашнего задания 7 так, чтобы она возвращала
-- значения типа ShowS.

-- 3. Напишите рекурсивную функцию

-- foldMapList :: Monoid m => (a -> m) -> [a] -> m

-- которая может использоваться для объявления членства типа списков
-- в классе Foldable.

-- 4. Для типа Tree, определенно выше, напишите функцию sumTree :: Num
-- a => Tree a -> Int, вычисляющую сумму чисел во всех вершинах
-- дерева. Определение должно использовать foldMap и не использовать
-- рекурсию.

-- 5. Напишите аналоги функция testLeft1 и testRight1, которые
-- используют свертку списка, состоящего из diff "a" :: Endo String.
-- Измерьте время их работы.

-- 6. В Prelude функции foldMap и foldr определены друг через друга
-- следующим образом.

-- foldMap f = foldr ((<>) . f) mempty
-- foldr f z t = appEndo (foldMap (Endo . f) t) z

-- Объясните, почему эти равенства имеют место для foldMap и foldr,
-- определенных на типе Tree.