lec07.hs

{-# LANGUAGE GADTs #-}

import Prelude hiding (not, lookup, Monoid)

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

-------------------------------------------------
-- Решение отдельных задач из домашнего задания 6
-------------------------------------------------

-- 1. Для каждого из следующих типов напишите какой-нибудь терм, имеющий этот тип.

-- (a -> a) -> a -> a

term1 = \f -> \x -> f x

-- или

term1' = \f -> f

-- Haskell выдает для этого term1 более общий тип (a -> b) -> a -> b,
-- но (a -> a) -> a -> a также подходит, как показывает команда
-- :t term1 :: (a -> a) -> a -> a. Аналогично, term1' имеет более
-- общий тип a -> a.

-- (a -> b) -> a -> b

-- Здесь годится term1.
  
-- ((a -> b) -> a) -> (a -> b) -> b

term3 = \f -> \g -> g (f g)
  
-- ((a -> b) -> (b -> c)) -> (a -> b) -> a -> c

term4 = \f -> \g -> \x -> (f g) (g x)

-- 3. Используя foldr и не используя явно рекурсию, напишите функцию
-- composeAll :: [a -> a] -> (a -> a), берущую список функций и
-- возвращающая их последовательную композицию (функция, являющаяся
-- головой списка, применяется последней). Например, composeAll [(^2),
-- (*2), (+3)] 0 = 36.

-- Более подробное решение:

-- composeAll fs = foldr (\f -> \comp -> f . comp) id fs

-- Здесь f есть голова списка, а comp есть композиция функций из хвоста списка.
-- Это необычная рекурсия, так как она определяет значение функционального типа.
-- Так, базой является функция id :: a -> a, и каждый рекурсивный вызов foldr
-- также возвращает функцию типа a -> a. В языках функционального программирования
-- рекурсия может вестить по любыми типам.

-- Более компактное решение:

composeAll :: [a -> a] -> (a -> a)
composeAll = foldr (.) id

-- Это решение получается следующим образом.

-- \f -> \comp -> f . comp
-- = \f -> \comp -> (.) f comp
-- =η \f -> (.) f
-- =η (.)

-- \fs -> foldr (.) id fs =η foldr (.) id

-- Это определение использует бесточечную запись.

-- 4. Функция shows имеет тип a -> String -> String, если a — тип печатаемых
-- значений. shows x s возвращает строку, являющуюся конкатенацией
-- текстового представления x и s.

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

-- g :: Show a => [a] -> String
-- g = (foldr ((.) . shows) id) ""

-- В этом определении есть ошибка типов. Исправьте ее, внеся минимальные
-- изменения, и напишите тип каждого подвыражения исправленной правой
-- части. Эти типы должны соответствовать типу всего выражения.
-- Например, если в данной функции id требует тип String -> String, то
-- нужно писать именно так, несмотря на то, что в документации id
-- имеет тип a -> a.

-- Напишем несколько вариантов функции g.

g1 :: Show a => [a] -> String
g1 xs = go xs "" where
  go :: Show a => [a] -> String -> String
  go [] = id
  go (x : xs) = shows x . go xs

-- Как и в предыдущем задании, рекурсия осуществляется по функциональному типу.

g2 :: Show a => [a] -> String
g2 xs = go xs "" where
  go :: Show a => [a] -> String -> String
  go = foldr (\x s -> shows x . s) id

-- Заметим, что
-- \x s -> shows x . s
-- = \x s -> (.) (shows x) s
-- =η \x -> (.) (shows x)
-- =β (.) (.) shows
-- = (.) . shows

-- Поэтому

g :: Show a => [a] -> String
g xs = foldr ((.) . shows) id xs ""

-- Теперь понятно, где была ошибка в определении g в условии задачи.
-- Выражение foldr ((.) . shows) id сначала применяется к xs, а потом к "",
-- а не наоборот. Если бы xs было последним аргументом, то его можно было
-- убрать из обеих частей равенства по η-редукции, однако в правильном
-- определении выше это невозможно.

-- Пусть аргумент xs функции g имеет тип [a]. Считая тип a фиксированным,
-- выпишем типы всех подвыражений правой части g. Для краткости будем
-- использовать определение ShowS = String -> String из Prelude.

-- xs :: [a]
-- "" :: String
-- shows :: a -> ShowS
-- (.) :: ShowS -> ShowS -> ShowS
-- (.) :: (ShowS -> ShowS -> ShowS) -> (a -> ShowS) -> (a -> ShowS -> ShowS)
-- (.) . shows = (.) (.) shows :: (a -> ShowS -> ShowS)
-- foldr :: (a -> ShowS -> ShowS) -> ShowS -> [a] -> ShowS
-- foldr ((.) . shows) :: ShowS -> [a] -> ShowS
-- id :: ShowS
-- foldr ((.) . shows) id :: [a] -> ShowS
-- foldr ((.) . shows) id xs :: ShowS
-- foldr ((.) . shows) id xs "" :: String

-- 5. Подставьте определение (.) в терм (.) . shows и найдите нормальную
-- форму полученного терма.

-- (.) . shows
-- = (.) (.) shows
-- = (\f g x -> f (g x)) (.) shows
-- =β (\g x -> (.) (g x)) shows
-- =β \x -> (.) (shows x)
-- = \x -> (\f g y -> f (g y)) (shows x)
-- =β \x -> \g y -> shows x (g y)
-- = \x g y -> shows x (g y)

-------------------------------------------------
-- Конспект лекции 7 от 29.03.2021
-------------------------------------------------

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

-- 1. Классы типов.
-- 2. Алгебраические типы.
-- 3. Синонимы типов (type) и обертки вокруг типов (newtype).
-- 4. Бинарные операторы.
-- 5. Объявление классов типов и их экземпляров.

-------------------------------------------------
-- 1. Классы типов
-------------------------------------------------

-- Прочитайте разделы 1.4 и 1.5 (с. 18–20) про классы типов в книге
-- А. Холомьёва «Учебник по Haskell»
-- http://anton-k.github.io/ru-haskell-book/book/home.html
-- (эта ссылка есть на source.unn.ru).

-- Прочитайте описание функций show и read на с. 43-45 в книге
-- Г.А. Макеева «Основы функционального программирования на языке
-- Haskell» http://ru-declarative.livejournal.com/109716.html
-- (эта ссылка также есть на source.unn.ru).
-- Этот материал пересекается с описанием в книге Холомьёва.

-- Рассмотрим следующий тип.

-- elem :: Eq a => a -> [a] -> Bool

-- Возможность подставлять вместо переменной a произвольные типы,
-- являющиеся членами класса Eq, называется полиморфизмом, основанном
-- на классах типов.

-- Одно и то же выражение может иметь разные типы.

-- read "54" :: Int
-- read "54" :: Integer
-- read "54" :: Float

-- Это тоже полиморфизм. В данном случае все эти типы числовые, но
-- в общем случае они могут быть совершенно разными.

-------------------------------------------------
-- 2. Алгебраические типы
-------------------------------------------------

-- Дальнейший материал про алгебраические типы данных (algebraic
-- datatypes) также содержится в книге Макеева на с. 66–74.

-- Напоминание: Bool — стандартный тип.

-- data Bool = False | True

-- Каждый тип имеет конструкторы, служащие для создания значений этого
-- типа, и деструкторы, служащие для анализа значений. Например, False
-- и True — конструкторы типа Bool. Типы и конструкторы пишутся с
-- большой буквы.

-- Аналог enum в С и Java

data Piece = Pawn | Rook | Knight | Bishop | Queen | King

-- Типы и конструкторы могут иметь одинаковое имя.

data SameName = SameName

data Day = Day Int

-- Здесь SameName :: SameName

-- Пустой кортеж () :: ()

-- Конструкторы могут использоваться как образцы в определении функции.
-- Так реализуются деструкторы.

not :: Bool -> Bool
not True = False
not False = True

-- Конструктор с аргументами: точка в двумерном пространстве.

data Point = Pt Float Float deriving Show

-- Pt :: Float -> Float -> Point

px :: Point -> Float
px (Pt x _) = x

-- Именованные поля (записи)

data Point2D = P2D {p1 :: Float, p2 :: Float} deriving Show

-- То же, что data Point2D = P2D Float Float,
-- но автоматически генерируются проекторы
-- p1 :: Point2D -> Float
-- p2 :: Point2D -> Float

point1 :: Point2D
point1 = P2D 1.0 2.0

point2 :: Point2D
point2 = P2D {p2 = 2.0, p1 = 1.0} -- поля можно задавать в любом порядке

-- Создание новой записи, которая отличается значением p1

point3 :: Point2D
point3 = point1 {p1 = 3.0}

-- Тип Maybe в Prelude для функций, которые могут не возвращать значение

-- data  Maybe a  =  Nothing | Just a deriving (Eq, Ord)

-- Пример использования: функция lookup (есть в Prelude)

lookup :: Eq a => a -> [(a,b)] -> Maybe b
lookup key [] = Nothing
lookup key ((k,v) : dict)
  | key == k = Just v
  | otherwise = lookup key dict

-- data Either a b  = Left a | Right b deriving (Eq, Ord, Read, Show)

-- Часто используется для возвращения полезного значения Right v
-- или сообщения об ошибке Left "error message".

-- Рекурсивные (индуктивные) типы

-- Унарное представление натуральных чисел (как в арифметике Пеано)

data Nat = Zero | Succ Nat deriving Show

-- Nat — это тип. Zero и Succ — его конструкторы. Zero — это
-- константа, а Succ (от слова successor) принимает один аргумент типа
-- Nat. Директива deriving Show автоматически объявляет членство Nat в
-- классе Show. Таким образом, значения Nat можно печатать в
-- интерпретаторе. Если требуется членство в нескольких классах, их
-- надо заключать в круглые скобки.

one :: Nat
one = Succ Zero

two :: Nat
two = Succ (Succ Zero)

three :: Nat
three = Succ (Succ (Succ Zero))

-- Сравнение элементов Nat

eqNat :: Nat -> Nat -> Bool
eqNat Zero Zero = True
eqNat (Succ x) (Succ y) = eqNat x y
eqNat _ _ = False

-- Сложение

add :: Nat -> Nat -> Nat
add Zero y = y
add (Succ x) y = Succ (add x y)

-- Списки

data List a = Nil | Cons a (List a) deriving Show

-- Cons 'a' (Cons 'b' (Cons 'c' Nil)) :: List Char

-- Если команде ghci дать опцию -XGADTs в командной строке или добавить
-- первую строчку, как этом файле, то можно записывать алгебраические типы
-- в следующем виде.

data List' a where
  Nil' :: List' a
  Cons' :: a -> List' a -> List' a

-- Бинарное дерево

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

-- Дерево с произвольным конечным количеством детей в каждом узле

data FinTree a = FinNode a [FinTree a]

-- Дерево со счетным числом детей

data InfTree a where
  Leaf' :: a -> InfTree a
  Children :: (Integer -> InfTree a) -> InfTree a

-------------------------------------------------
-- 3. Синонимы типов (type) и обертки вокруг типов (newtype)
-------------------------------------------------

-- Пример из книги Холомьёва, с. 112

-- Синонимы типа

type Velocity = Double
type Time = Double
type Distance = Double

velocity :: Distance -> Time -> Velocity
velocity dist time = dist / time

d :: Distance
d = 10

t :: Time
t = 5

v :: Velocity
v = velocity t d -- не вызывает ошибку несмотря на неправильные единицы

-- Обёртка вокруг типа. Имеет один конструктор, у которого один аргумент.
-- Конструктор имеет значение только при проверке типов и прозрачен во
-- время исполнения.

newtype Velocity' = Velocity' Double
newtype Time' = Time' Double
newtype Distance' = Distance' Double

velocity' :: Distance' -> Time' -> Velocity'
velocity' (Distance' dist) (Time' time) = Velocity' $ dist / time

d' :: Distance'
d' = Distance' 10

t' :: Time'
t' = Time' 5

v' :: Velocity'
-- v' = velocity' t' d' вызывает ошибку
v' = velocity' d' t'

-------------------------------------------------
-- 4. Бинарные операторы
-------------------------------------------------

-- Должны состоять из специальных символов: !#$%&⋆+./<=>?@\^|-~:
-- Не должны начинаться с двоеточия.

-- infix: неассоциативный оператор
-- infixl: левоассоциативный оператор
-- infixr: правоассоциативный оператор

-- Приоритет: от 0 до 9. Чем выше приоритет, тем сильнее связывает
-- оператор. Аппликация имеет наивысший приоритет (даже выше 9).

infixl 6 #

-- Приоритет можно увидеть в интерпретаторе, если дать команду :i (#).

-- Операторы также можно использовать как конструкторы алгебраических
-- типов. В этом случае они наоборот должны начинаться с двоеточия.

infixl 5 :*:

data Foo a b = a :*: b

foo :: Foo Int Bool
foo = 1 :*: True

-------------------------------------------------
-- 5. Объявление классов типов и их экземпляров
-------------------------------------------------

-- Объявим класс Monoid, который является является подклассом Eq.
-- Строго говоря, импликация направлена в другую сторону:
-- если a есть тип класса Monoid, то он также тип класса Eq.
-- См. https://ru.wikipedia.org/wiki/Моноид.

class Eq a => Monoid a where
  (#) :: a -> a -> a
  e :: a

-- Чтобы объявить Nat моноидом, его нужно сначала объявить членом
-- класса Eq. Для этого объявим функцию (==). Её можно определить
-- прямо здесь или заранее, а здесь указать только имя ранее
-- определенной функции.

instance Eq Nat where
  (==) = eqNat
-- Или прямо здесь
-- Zero == Zero = True
-- Succ x == Succ y = x == y
-- _ == _ = False

instance Monoid Nat where
  e = Zero
  (#) = add

instance Monoid Bool where
  e = False
  x # y = x || y

-- Теперь можно писать

nn = one # two
 
bb = True # False

instance Eq a => Monoid [a] where
  e = []
  (#) = (++)
 
double :: Monoid a => a -> a
double x = x # x
  
-------------------------------------------------
-- Домашнее задание 7
-------------------------------------------------

-- 1. Определите умножение на Nat.

-- 2. Объявите Nat членом класса Monoid двумя способами:
-- с операцией сложения и нулём, а также умножения и единицей.
-- Воспользуйтесь обёрткой newtype вокруг Nat.
-- См. Холомьёв, с. 113.

-- Следующий тип определяет арифметические выражения, состоящие из
-- целых чисел, сложения, вычитания и умножения.

data Exp =
  Const Int
  | Add Exp Exp
  | Sub Exp Exp
  | Mul Exp Exp

-- Например, выражение (5-3)((1+2)+4) представляется

e1 :: Exp
e1 = Mul (Sub (Const 5) (Const 3)) (Add (Add (Const 1) (Const 2)) (Const 4))

-- Чтобы вводить выражения, используя конкретный (обычный), а не
-- абстрактный синтаксис, воспользуемся следующим трюком
-- (Холомьёв, с. 109): объявим Exp членом класса Num. Таким образом
-- можно будет использовать синтаксический анализатор самого Haskell.
-- Минимальное определение членства типа a в классе Num включает
-- в себя определение следующих функций.
-- (+) :: a -> a -> a
-- (-) :: a -> a -> a
-- (*) :: a -> a -> a
-- fromInteger :: Integer -> a
-- abs :: a -> a
-- signum :: a -> a

instance Num Exp where
  (+) = Add
  (*) = Mul
  (-) = Sub
  fromInteger = Const . fromInteger
  abs = undefined
  signum = undefined

-- Теперь вместо e1 выше можно прямо писать

e2 :: Exp
e2 = (5-3)*(1+2+4)

-- 3. Напишите функцию showExp :: Exp -> String, которая выдает
-- инфиксную запись выражения. Каждое подвыражение должно быть окружено
-- скобками. Например, на выражении выше функция должна выдавать
-- ((5-3)*((1+2)+4)).

-- 4. Зарегистрируйте тип Exp в качестве члена класса Show, используя
-- showExp как реализацию функции show. Проверьте, что выражения,
-- заданные в командной строке, печатаются должным образом.

-- 5. Напишите рекурсивную функцию eval :: Exp -> Int, вычисляющую
-- значение выражения.

-- 6. Напишите рекурсивную функцию applyDistr :: Exp -> Exp, которая
-- применяет законы дистрибутивности (слева) умножения относительно
-- сложения и вычитания:
-- x(y+z) = xy + xz
-- x(y-z) = xy - xz
-- Функция должна за один проход заменять все подвыражения вида
-- x(y +- z) на соответствующую правую часть. Проверьте на примерах,
-- что значение выражения не меняется после применения applyDistr},
-- то есть проверьте, что eval e == eval (applyDistr e)
-- возвращает True на различных выражениях e.

-- 7. Докажите, что функция applyDistr останавливается на любом входе.