Изменения

В нормальной форме нет редукций. Если нормальная форма существует, то её можно достичь при помощи редукций [[#Нормальный порядок редукции|нормальным порядком]], а [[#Аппликативный порядок редукции|аппликативным ]] можно и не достичь.

 ==Натуральные числаPrimitive=====Nat=== data Nat (+.) (-.) (*.)  divides :: Nat -> Nat -> Bool = Zero | Succ Nat deriving ==Rat=== data Rat (%+) (%-) (%*) (Show%/)  euler :: ? ==List== ===Угадайка===Дают тип,Readнадо написать название функции из '''List.hs''' и реализовать её. ===Комбинаторика=== '''Тут можно использовать только набор заранее определённых функций листа( среди которых нет даже ''++'' ) <font color'''  subsequences :: [a] -> [ [ a ] ]  permutations :: [a] -> [ [ a ] ] =green=Algebra== class Monoid a where mempty :: a mappend :: a ->a -> a class Monoid a => Group a where ginv :: a - Определение натуральных чисел</font>a natZero = Zero <font colormconcat :: (Monoid a) =green>List a -- 0</font>a mconcat = foldr mappend mempty instance Monoid Unit where mempty = Unit mappend _ _ = Unit natOne instance Group Unit where ginv _ = Unit instance (Monoid a, Monoid b) => Monoid (Pair a b) where mempty = Succ Zero <font colorPair mempty mempty mappend a b = Pair {fst = fst a `mappend` fst b, snd = snd b `mappend` snd b} instance (Monoid a) =green>Monoid (Maybe a) where mempty = Just mempty mappend (Just a) (Just b) = Just $ mappend a b mappend _ _ = Nothing newtype First a = First { getFirst :: Maybe a} instance Monoid (First a) where mempty = First Nothing mappend (First Nothing) x = x mappend x _ = x newtype Last a = Last { getLast :: Maybe a} instance Monoid (Last a) where mempty = Last Nothing mappend x (Last Nothing) = x mappend _ x = x newtype Any = Any { getAny :: Bool } instance Monoid Any where mempty = Any False mappend (Any a) (Any b) = Any $ a || b newtype All = All { getAll :: Bool } instance Monoid All where mempty = All True mappend (All a) (All b) = All $ a && b -- 1</font>Лексикографическое сравнение instance Monoid Tri where mempty = EQ mappend LT _ = LT mappend EQ a = a mappend GT _ = GT

natCmp newtype Sum a = Sum { getSum :: Nat -> Nat -> Tri <font color=green>-- Сравнивает два натуральных числа</font> natCmp Zero Zero = EQ natCmp Zero (Succ _) = LT natCmp (Succ _) Zero = GT natCmp (Succ n) (Succ m) = natCmp n ma }

natEq :: instance Monoid (Sum Nat -> Nat -> Bool <font color=green>-- n совпадает с m</font> natEq Zero Zero = True natEq Zero (Succ _) = Falsewhere natEq (Succ _) Zero mempty = FalseSum natZero natEq mappend (Succ nSum a) (Succ mSum b) = natEq n mSum $ a +. b

natLt newtype Product a = Product { getProduct :: Nat -> Nat -> Bool <font color=green>-- n меньше m</font> natLt Zero Zero = False natLt Zero (Succ m) = True natLt (Succ n) Zero = False natLt (Succ n) (Succ m) = natLt n ma }

infixl 6 +. <font color=green>-- Сложение для натуральных чисел</font> instance Monoid (+.Product Nat) :: Nat -> Nat -> Natwhere Zero +. m mempty = mProduct natOne mappend (Product a) (Succ nProduct b) +. m = Succ (n +Product $ a *. m)b

infixl 6 -. <font color=green>-- Вычитание для натуральных чисел</font> instance Monoid (-.Sum Int) :: Nat -> Nat -> Nat Zero -. _ = Zerowhere n -. Zero mempty = nSum intZero mappend (Succ nSum a) -. (Succ mSum b) = n -Sum $ a .+. mb

infixl 7 *. <font color=green>-- Умножение для натуральных чисел</font> instance Group (*.Sum Int) :: Nat -> Nat -> Nat Zero *. m = Zerowhere (Succ n) *. m ginv = m +Sum . (n *intNeg . m)getSum

natDivMod :: Nat -> Nat -> Pair Nat Nat <font color=green>-- Целое и остаток от деления n на m</font>instance Monoid (Product Int) where natDivMod n m mempty =Product intOne if mappend (n natLt mProduct a) then Pair Zero n else Pair (Succ divProduct b) mod where Pair div mod = ((n -Product $ a .*. m) natDivMod m)b

natDiv n instance Monoid (Sum Rat) where mempty = Sum ratZero mappend (Sum a) (Sum b) = Sum $ a %+ b instance Group (Sum Rat) where ginv = fst Sum . ratNeg . natDivMod n <font colorgetSum instance Monoid (Product Rat) where mempty = Product ratOne mappend (Product a) (Product b) =green>-- Целое</font>Product $ a %* b natMod n instance Group (Product Rat) where ginv = snd Product . ratInv . natDivMod n <font colorgetProduct instance Monoid (List a) where mempty = Nil mappend =green>-- Остаток</font>(++)

==Целые числаCategories==  class Category cat where id :: cat a a (.) :: cat b c -> cat a b -> cat a c class Functor f where fmap :: (a -> b) -> f a -> f b class Monad m where (>>=) :: m a -> (a -> m b) -> m b return :: a -> m a class (Functor f) => Applicative f where pure :: a -> f a (<*>) :: f (a -> b) -> f a -> f b class Functor m => MonadJoin m where returnJoin :: a -> m a join :: m (m a) -> m a data Identity a = Identity a runIdentity a = a instance Monad Identity where return x = Identity x (Identity x) >>= f = f x data Int Maybe a = Plus Nat Just a | Minus Nat deriving Nothing instance Monad Maybe where Nothing >>= f = Nothing (ShowJust x) >>= f = f x return x = Just x instance Monad [] where m >>= f = concat (map f m) return x = [x] class MonadFish m where returnFish :: a -> m a (>=>) :: (a -> m b) -> (b -> m c) -> (a -> m c) data State s r = State (s -> (r, s)) runState (State f) s = f s instance Monad (State s) where return r = State (\s -> (r, s)) (State x) >>= f = State h where h s0 = let (r1, s1) = x s0 State g = f r1 (r2, s2) = g s1 in (r2,Reads2) newtype IdentityCPS a = IdentityCPS {runIdentityCPS :: forall r . (a -> r)-> r}

intZero = Plus Zero intOne = Plus caseIdentityCPS :: IdentityCPS a -> (Succ Zeroa -> r)-> r intNegOne caseIdentityCPS = Minus (Succ Zero)\x -> \f -> runIdentityCPS x f

intNeg constrIdentityCPS :: Int a -> IntIdentityCPS a intNeg (Plus x) constrIdentityCPS = Minus x intNeg (Minus x) = Plus x\a -> IdentityCPS $ \f -> f a

intCmp :: Int instance Functor IdentityCPS where fmap f ma = IdentityCPS $ \g -> Int caseIdentityCPS ma (\a -> Tri intCmp (Plus Zero) (Minus Zero) = EQ intCmp (Minus Zero) (Plus Zero) = EQ intCmp (Plus Zero) (Minus (Succ x)) = GT intCmp (Minus Zero) (Plus (Succ x)) = LT intCmp (Plus (Succ x)) (Minus Zero) = GT intCmp (Minus (Succ x)) (Plus Zero) = LT intCmp (Plus x) g (Plus yf a) = natCmp x y intCmp (Minus x) (Minus y) = natCmp y x

intEq :: Int -> Int -> Boolinstance Applicative IdentityCPS where intEq (Plus Zero) (Minus Zero) pure = TrueconstrIdentityCPS intEq (Minus Zero) (Plus Zero) mf <*> ma = True intEq IdentityCPS $ \g -> caseIdentityCPS ma (Plus Zero) \a -> caseIdentityCPS mf (Minus (Succ x)) = False intEq \f -> g (Minus Zerof a ) (Plus (Succ x)) = False intEq (Plus (Succ x)) (Minus Zero) = False intEq (Minus (Succ x)) (Plus Zero) = False intEq (Plus x) (Plus y) = natEq x y intEq (Minus x) (Minus y) = natEq x y

intLt :: Int -> Int -> Boolinstance Monad IdentityCPS where intLt (Plus Zero) (Minus Zero) return = FalseconstrIdentityCPS intLt (Minus Zero) (Plus Zero) ma >>= False intLt (Plus Zero) (Minus (Succ x)) f = False intLt IdentityCPS $ \g -> caseIdentityCPS ma (Minus Zero) \a -> runIdentityCPS (Plus (Succ xf a)g) = True intLt (Plus (Succ x)) (Minus Zero) = False intLt (Minus (Succ x)) (Plus Zero) = True intLt (Plus x) (Plus y) = natLt x y intLt (Minus x) (Minus y) = natLt y x

infixl 6 .+., .newtype MaybeCPS r a = MaybeCPS {runMaybeCPS :: (a -. (.+.> r) :: Int -> Int r -> Int (Plus m) .+. (Plus n) = Plus (m +. n) (Minus m) .+. (Minus n) = Minus (m +. n) (Plus (Succ m)) .+. (Minus (Succ n)) = (Plus m) .+. (Minus n) (Minus (Succ m)) .+. (Plus (Succ n)) = (Plus n) .+. (Minus m) x .+. (Plus Zero) = x x .+. (Minus Zero) = x (Plus Zero) .+. y = y (Minus Zero) .+. y = yr}

caseMaybeCPS :: MaybeCPS r a -> (.a -.> r) :: Int -> Int r -> Intr n .caseMaybeCPS = \x -> \f -> \g -. m = n .+. (intNeg m)> runMaybeCPS x f g

infixl 7 .*. (.*.) justCPS :: Int -> Int a -> IntMaybeCPS r a (Plus m) .*. (Plus n) justCPS a = Plus (m *. n)MaybeCPS $ \f -> \g -> f a (Minus m) .*. (Minus n) = Plus (m *. n)nothing :: MaybeCPS r a (Plus m) .*. (Minus n) nothing = Minus (m *. n) (Minus m) .*. (Plus n) = Minus (m *. n) ==Рациональные числа== data Rat = Rat Int NatMaybeCPS $ \f -> \g -> g

ratNeg :: Rat instance Functor (MaybeCPS r) where fmap f ma = MaybeCPS $ \g -> \h -> caseMaybeCPS ma (\a -> Rat ratNeg g (Rat x yf a) = Rat (intNeg x) yh

ratInv :: Rat -> Rat ratInv (Rat instance Applicative (Plus x) yMaybeCPS r) where pure = Rat (Plus y) xjustCPS ratInv mf <*> ma = MaybeCPS $ \g -> \h -> caseMaybeCPS ma (Rat \a -> caseMaybeCPS mf (Minus x\f -> g $ f a) y) = Rat (Minus yh) xh

ratCmp :: Rat instance Monad (MaybeCPS r) where return = justCPS ma >>= f = MaybeCPS $ \g -> Rat \h -> Tri ratCmp caseMaybeCPS ma (Rat \a b) (Rat c d) = intCmp -> runMaybeCPS (f a .*. (Plus d)) (c .*. (Plus b)g h)h

ratEq newtype StateCPS s a = StateCPS {runStateCPS :: Rat forall r . s -> Rat (s -> Bool ratEq (Rat a b) (Rat c d) = intEq (a .*. (Plus d)) (c .*. (Plus b)-> r)-> r}

ratLt caseStateCPS :: Rat (StateCPS s a) -> Rat ((s -> Bool ratLt (Rat s, a b) (Rat c d) -> r) -> r caseStateCPS = intEq \x -> \f -> f $ \s -> runStateCPS x s (\s -> \a .*. -> (Plus d)) (c .*. (Plus bs, a))

internalRatPlus state' :: Rat (s -> Rat (s, a)) -> RatStateCPS s a internalRatPlus state' st = StateCPS $ \s -> \f -> let (Rat s', a b) (Rat c d) = Rat ((st s in f s' a .*. (Plus d)) .+. (c .*. (Plus b))) (b *. d)

internalRatShorten :: Rat -> Rat internalRatShorten instance Functor (Rat (Plus a) bStateCPS s) where fmap f sa = Rat StateCPS $ \s -> \g -> caseStateCPS sa (Plus \st -> let (s', a /. (gcd a b))) (b /. (gcd a b)) internalRatShorten (Rat (Minus a) b) = Rat (Minus (a /. (gcd a b))) (b /. st s in g s' (gcd f a b))

infixl 7 %+instance Applicative (StateCPS s) where pure a = state' $ \s -> (s, %a) sf <*> sa = StateCPS $ \s - > \g -> caseStateCPS sf (%+) :: Rat \stf -> Rat let (s', f) = stf s in caseStateCPS sa (\sta -> Rat n %+ m let (s'', a) = internalRatShorten sta s' in g s'' (internalRatPlus n mf a)))

instance Monad (%StateCPS s) where return a = state' $ \s -> (s, a) sa >>= f = StateCPS $ \s -> \g -> caseStateCPS sa (\sta -> let (s', a) = sta s in runStateCPS (f a) s' g) =Кр4=== deforestation ==Дана функция, необходимо её упростить, пользуясь техникой ''deforestation''. '''Мотивация:''' допустим, есть какая-то функция следующего вида: Rat  <code> foldl 0 (*) . filter (> 0) . map (\ x -> Rat 3 * x -10)</code> Первый map создаёт новый список, потом filter возвращает ещё список, и так далее. Если функций много (а их вполне может быть сколько угодно), то такой подход перестаёт быть эффективным. Идея в том, чтобы написать функцию, которая делает все необходимые действия "за раз": в данном примере можно рассматривать элемент списка, применять к нему функцию, потом проверять на условие в filter, а потом сразу считать произведение. Иногда можно посмотреть на композицию функций и придумать сразу оптимальный вариант. Это и требуется сделать во втором задании. Но можно и не думать, а применить стандартный алгоритм для преобразования, который даёт ответ. [http://www.sciencedirect.com/science/article/pii/030439759090147A По этой ссылке] описаны правила, по которым нужно преобразовывать функцию. Если коротко, то всё сводится к inline'у тел функций, причём мы хотим добиться отсутствия вызовов других функций на месте аргументов внешней функции (рекомендуется для начала почитать ссылку, посмотреть правила и пример оттуда). === Пример ===Будет разобран пример из [https://pp.vk.me/c622121/v622121192/ff98/NtvrRei7bR4.jpg фото].  <code> Rat n %<font color=green>- m - дано</font> func = n %foldr (+ ) 0 . map (ratNeg m\x -> x * 10)

infixl 7 %*, %/ (%*) :: Rat <font color=green>-> Rat -сначала перепишем композицию в обычную аппликацию для дальнейшей ясности</font> Rat func0 l = foldr (Rat a b+) %* 0 (Rat c d) = Rat map (a .\x -> x *. c10) (b *. dl)

<font color=green>-- теперь инлайним foldr, то есть раскрываем его тело</font> func1 l = '''case''' (map (\x -> x * 10) l) '''of''' [] -> 0 (%x:xs) -> x + (foldr (+) 0 xs) <font color=green>-- а теперь инлайним map, заодно раскроем лямбду</font> func2 l = '''case''' ('''case''' l '''of''' [] -> [] (y:ys) -> y * 10 :map (*10) ys) '''of''' [] -> 0 (x: Rat xs) -> Rat x + (foldr (+) 0 xs) <font color=green>--применяем преобразование case'a case'ов, то есть выносим внутренний case на первое место</font> Rat n %func3 l = '''case''' l '''of''' [] -> ('''case''' [] '''of''' [] -> 0 (x:xs) -> x + (foldr (+) 0 xs)) (y:ys) -> ('''case''' (y * 10 : map (*10) ys) '''of''' [] -> 0 (x:xs) -> x + (foldr (+) 0 xs)) <font color=green>-- раскрываем внутренние case'ы: в них pattern-matching сразу срабатывает</ m font> func4 l = '''case''' l '''of''' [] -> 0 (y:ys) -> 10 * y + (foldr (+) 0 (map (*10) ys)) <font color=green>-- замечаем, что у нас получилось в конце выражение foldr (+) 0 (map (*10) ys), а это по сути наша функция func0, которую мы раскрывали изначально, поэтому тому куску можно дать другое имя</font> func5 l = '''case''' l '''of''' [] -> 0 (y:ys) -> 10 * y + func5 ys</code> == stream fusion == n % По сути это то же самое, только вводятся два дополнительных типа, а стандартные функции подстраиваются под них.* [http://code.haskell.org/~dons/papers/icfp088-coutts.pdf Статья]* [http://www2.tcs.ifi.lmu.de/~senjak/haskellbeatsc.pdf Презентация с красивым форматированием (мотивация)]* [http://www.mit.edu/~mtikekar/posts/stream-fusion.html Применение в реальной жизни]* [http://sprunge.us/ZONH Разбор задания с кр] == zippers and functions differentiation == Для каждой структуры данных (datatype'а) в Haskell можно составить соответствующий ей zipper: это другая структура данных, которая позволяет "гулять" по нашей структуре, взяв в фокус текущий элемент и запоминая при этом остальное состояние структуры данных (или контекст). Для списка легко придумывается zipper: мы находимся на какой-то позиции в списке, знаем значение элемента на этой позиции, знаем часть списка слева от текущего элемента и справа (для более глубокого понимания читай LearnYourHaskell). Поэтому zipper для списка имеет следующий вид: <code> '''data''' ZipperList a = ZList a [a] [a]</code> Но не для всех типов получается легко придумать zipper методом пристального взгляда. Чтобы составить zipper для произвольного типа без особых усилий, можно представить тип как функцию от параметра типа, а затем найти производную этого типа. Тогда если типу соответствует функция <tex> f(a) </tex>, то zipper выражается следующим образом: <tex> z(ratInv ma)= a \cdot f'(a) </tex>. Рассмотрим внимательней типа List:<code> '''data''' List a = Nil | Cons a (List a)</code> Ему соотвествует следующее уравнение в функциях типов: <tex> f(a) = 1 + a \cdot f(a) </tex>. Если теперь продифференцировать обе части уравнения, то можно будет найти производную для списка. Обозначим список элементов типа <tex> x </tex> как <tex>L(x)</tex>. Из формулы для списка легко выражется, что <tex> L(x) = \dfrac{1}{1 - x} </tex>. Этим равенством будем пользоваться в дальнейшем. === Пример ===Найдём теперь zipper для какого-нибудь конкретного класса:<code> '''data''' Mice a = Haystack a (Mice a) a | Baboon (Mice a) | List' a a a</code> Запишем уравнение типа для него: <tex> f(a) = a \cdot f(a) \cdot a + f(a) + a \cdot a \cdot a \ (1)</tex>.  На самом деле порядок аргументов в типе не очень важен, мы сами его задаём, поэтому можно написать чуть более сокращенную запись: <tex> f(a) = a^2 \cdot f(a) + f(a) + a^3 </tex> Забудем на некоторое время, что мы работаем с типами. Продифференцируем обе части уравнение по переменной <tex> a </tex>, получим линейное уравнение относительно производной. <tex> f'(a) = 2a \cdot f(a) + a^2 \cdot f'(a) + f'(a) + 3a^2 </tex>

<code> <font color=green>-- Итого ответ:</font> '''Тут я не уверен, можем ли использовать data''natMod'' или надо дополнительно реализовывать её.DMice a = S a (Mice a) | H a (Mice a) | M a a (DMice a) | Y (DMice a) | A a a | K a a | Shmyak a a<br/code>Ещё мы вроде бы не можем использовать дополнительные функции!'''

gcd Забавное, но бесполезное для сдачи ФП, продолжение:: Nat -> Nat -> Nat gcd n Zero = n gcd n m = gcd m (natMod n m)

==permutations== permutations :: List a -<tex> List f'(List a) permutations Nil = Cons Nil Nil permutations \dfrac{2a \cdot f(Cons x aba) = perm Nil x ab where perm left m Nil = map + 3a^2}{1 - (Cons m) (permutations left) perm left m (Cons r rxa^2 + 1) } = (map 2a \cdot f(Cons ma) $ permutations $ left +3a^2) \cdot \dfrac{1}{1 - (a^2 + (Cons r rx)1) ++ (perm } \ (Cons m left) r rx2)</tex>

==А так же==* Дают тип какого-нибудь foldr и просят написать какой-нибудь foldrВ итоге у нас производная является произведением двух функций, а для типа это значит, что он является произведением двух типов. При умножении на константу у нас будет просто несколько одинаковых конструкторов с разными именами.* Написать определения каких-нибудь тайпклассов.<code>* Написать какие <font color=green>-нибудь инстансы.* Доказать эквивалетность каких-нибудь двух определений монады.сначала распишем производную типа, полученного сразу после дифференцирования (1), если соблюдать исходный порядок аргументов в типах</font>* CPS-преобразовать какие-нибудь типы. '''data''' DMice a = S (Mice a) a | H a (DMice a) a | M a (Mice a) | Y (DMice a) | A a a | K a a | Shmyak a a* Написать монадные инстансы для CPS-преобразованных типов.</code>

Теперь распишем первую скобку в (2):<code> '''data''' DMice' =Кр4M1 a (Mice a) | M2 a (Mice a) | C1 a a | C2 a a | C3 a a</code> Дальше идёт дробь. Вспоминаем, что на самом деле ей отвечает тип <tex> L(a^2 + 1) </tex>.Поэтому получаем в итоге:<code> '''data''' DMiceListElem a =DM1 a a | DM0 '''data''' DMiceList a = MNil | MCons (DMiceListElem a) (DMiceList a) '''data''' ZMice a = ZMice a (DMice' a) (DMiceList a)</code> * [http://learnyouahaskell.com/zippers LearnYourHaskell {{---}} Zippers]* [http://sprunge.us/HCDN Пример zipper'a из кр]