lec13.hs

import Control.Monad

-------------------------------------------------
-- Конспект лекции 13 от 17.05.2021
-------------------------------------------------

-- Содержание: примеры монад, имеющих вид пары

-- 1. Напишем функцию, которая возвращает пару из числа Фибоначчи
-- и количества сложений, которые нужно сделать согласно
-- обычному рекурсивному определению.

fib :: Integer -> Integer
fib 0 = 0
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

--               n | 0 | 1 | 2 | 3 | 4 | 5 |  6 |  7 |  8 |  9 | 10
--           fib n | 0 | 1 | 1 | 2 | 3 | 5 |  8 | 13 | 21 | 34 | 55
-- Кол-во сложений | 0 | 0 | 1 | 2 | 4 | 7 | 12 | 20 | 33 | 54 | 88

-- Сформулируйте гипотезу о количестве сложений, требуемых для
-- вычисления n-го числа Фибоначчи.

-- Для решения этой задачи определим новую монаду, представляющую
-- пару, состоящую из полезного значения (числа Фибоначчи) и служебной
-- информации (количества сложений). Также отметим, что ниоткуда не
-- следует, что монадные выражения можно составлять только из >>=,
-- return и fail. Можно определить другие нужные функции, возвращающие
-- монадные значения и использовать их наряду или вместо return.

-- Определим монаду Additions, где функция >>= будет складывать
-- количество сложений в первом и втором аргументах.

newtype Additions a = A (a, Int) deriving Show

-- В дальнейшем a будет Int. Как было сказано выше, первая компонента
-- будет содержать число Фибоначчи, а вторая — количество сложений,
-- которые потребовались для его вычисления.

instance Functor Additions where
    fmap  = liftM
instance Applicative Additions where
    pure x = A (x, 0) -- определение return
    (<*>) = ap
instance Monad Additions where
  -- (>>=) :: A a -> (a -> A b) -> A b
  A (x, n) >>= f = let A (y, m) = f x in A (y, n + m)

-- Здесь n и m есть количества сложений, сделанных при вычислении
-- чисел Фибоначчи x и y, соответственно. >>= просто складывает
-- количества сложений.

-- Также напишем выражение tick, которая добавляет одно сложение и
-- возвращает чистое значение, которое в дальнейшем не будет
-- использоваться, например, ().

tick :: Additions ()
tick = A ((), 1)

-- Тогда подсчет сложений при вычислении числа Фибоначчи записывается
-- следующим образом.

fibA :: Int -> Additions Int
fibA 0 = return 0 -- (0, 0)
fibA 1 = return 1 -- (1, 0)
fibA n = do
  p1 <- fibA (n-1)
  p2 <- fibA (n-2)
  tick
  return (p1 + p2)

-- При расшифровке do-записи последние две строчки преобразуются в

-- tick >> return (p1 + p2) =
-- A ((), 1) >>= (\_ -> A (p1 + p2, 0)) =
-- A (p1 + p2, 1)

-- Добавим предыдущую строчку.

-- p2 <- fibA (n-2)
-- A (p1 + p2, 1)

-- переписывается как

-- fibA (n-2) >>= (\p2 -> A (p1 + p2, 1))

-- Если fibA (n-2) = (p2, n2), то возвращается A (p1 + p2, n2 + 1).

-- Наконец, все do-выражение есть

-- p1 <- fibA (n-1)
-- A (p1 + p2, n2 + 1)

-- или

-- fibA (n-1) >>= \p1 -> A (p1 + p2, n2 + 1).

-- Если fibA (n-1) = (p1, n1), то значение всего выражения есть
-- A (p1 + p2, n1 + n2 + 1). Таким образом, количество сложений,
-- требуемых для вычислений p1 + p2, действительно на единицу больше,
-- чем сумма количеств сложения для p1 и p2.

-- Таблица выше была получена в результате вызова (map fibA [1..10]).
-- При ее анализе возникает следующая гипотеза: количество сложений
-- при вычислении fib n есть fib (n+1) - 1. Она доказывается индукцией
-- по n.

-- 2. Рассмотрим обобщение последовательности Фибоначчи с начальными
-- значениями a и b вместо 0 и 1. Она вычисляется следующей функцией.

fibIter a b 0 = a
fibIter a b 1 = b
fibIter a b n = fibIter b (a+b) (n-1)

-- Поскольку единственной операцией при вычислении n-го члена
-- последовательности является сложение, ясно, что он является
-- линейной комбинацией a и b с целыми коэффициентами. По аналогии с
-- предыдущим заданием определим функцию, которая возвращает тройку из
-- n-го члена последовательности и этих коэффициентов. Например,
-- fibIter 0 1 6 = 8 = 5 * 0 + 8 * 1, поэтому на аргументах 0, 1, 6
-- функция должна возвращать тройку (8, 5, 8).

-- Ясно, что коэффициенты f n и g n, для которых fibIter a b n =
-- f n * a + g n * b, не зависят от a и b. На самом деле, вид g n
-- очевиден при подстановке a = 0 и b = 1, а вид f n также легко
-- получить при при подстановке a = 1 и b = 0, но задача состоит в
-- получении экспериментального подтверждения этим гипотезам.

-- Определим новую монаду. LC означает "линейная комбинация".

newtype LC a = LC (a, Int, Int) deriving Show

-- LC (x, y, z) означает, что x есть число в последовательности
-- a, b, a+b, a+2b, 2a+3b, 3a+5b, 5a+8b, ...
-- и x = y*a + z*b.

instance Functor LC where
    fmap  = liftM
instance Applicative LC where
    pure x = LC (x, 0, 0) -- определение return
    (<*>) = ap
instance Monad LC where
  LC (x, x0, x1) >>= f = let LC (y, y0, y1) = f x in LC (y, x0+y0, x1+y1)

-- Коэффициенты x и y складываются почленно.

-- fibLC a b n вычисляет n-ый член последовательности, аналогичной
-- последовательности Фибоначчи, где первые два элемента
-- последовательности есть a и b

fibLC :: Int -> Int -> Int -> LC Int
fibLC a b n = go n where
  go 0 = LC (a, 1, 0) -- a = 1*a + 0*b
  go 1 = LC (b, 0, 1) -- b = 0*a + 1*b
  go n = do
    p1 <- go (n-1)
    p2 <- go (n-2)
    return (p1 + p2)

-- При анализе коэффициентов возникает следующая гипотеза:
-- fibIter a b n = (fib (n-1)) * a + (fib n) * b.
-- Она доказывается индукцией по n.

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

-- Докажите формулу

-- fibIter a b n = (fib (n-1)) * a + (fib n) * b

-- индукцией по n, используя только определения функций.
-- Используя это равенство, докажите

-- fibIter 0 1 n = fib n.