FP_HSE2020Fall_14pr

Fp14pr.hs

{-# LANGUAGE StandaloneDeriving, FlexibleContexts, UndecidableInstances #-}
module Fp14pr where
------------------------------------
{-
Покажите, что типы \mintinline{haskell}!(Integer,Integer)! и 
\mintinline{haskell}!Bool -> Integer! изоморфны, реализовав взаимнообратные
-}
fromP :: (Integer,Integer) -> (Bool -> Integer)
fromP = undefined

toP :: (Bool -> Integer) -> (Integer,Integer)
toP = undefined
{-
Тест:
GHCi> (toP . fromP) (42,100)
(42,100)
GHCi> (fromP . toP) (\x -> if x then 42 else 100) True
42
GHCi> (fromP . toP) (\x -> if x then 42 else 100) False
100
-}

------------------------------
{-
Покажите, что типы \mintinline{haskell}!Tree a! и \mintinline{haskell}!Tree' a! 
изоморфны, реализовав взаимнообратные 
-}
fromT ::  Tree a -> Tree' a
fromT = undefined

toT :: Tree' a -> Tree a
toT = undefined

data Tree a = Empty | Node a (Tree a) (Tree a)
  deriving (Eq, Show)
  
data Tree' a = Empty' | Node' a (Bool -> Tree' a)

instance Show a => Show (Tree' a) where
  showsPrec _ Empty' = showString "Empty'"
  showsPrec d (Node' x f) = showParen (d > app_prec) $ 
    showString "Node' " .
    showsPrec (app_prec + 1) x .
    showChar ' ' .
    showsPrec (app_prec + 1) (f True) .
    showChar ' ' .
    showsPrec (app_prec + 1) (f False)
   where app_prec = 10 

instance Eq a => Eq (Tree' a) where
  Empty'      == Empty'      = True
  Empty'      == _           = False
  _           == Empty'      = False
  (Node' x f) == (Node' y g) = x == y 
                               && f True  == g True
                               && f False == g False
{-
Тест:
GHCi> (toT . fromT) (Node 42 Empty (Node 100 Empty Empty))
Node 42 Empty (Node 100 Empty Empty)
GHCi> tst' = Node' 42 (\b -> if b then Empty' else (Node' 100 (\b -> Empty')))
GHCi> tst'
Node' 42 Empty' (Node' 100 Empty' Empty')
GHCi> (fromT . toT) tst'
Node' 42 Empty' (Node' 100 Empty' Empty')
GHCi> (fromT . toT) tst' == tst'
True
-}

--------------------------------------
newtype Fix f = In (f (Fix f))

deriving instance Show (f (Fix f)) => Show (Fix f)
deriving instance Eq (f (Fix f)) => Eq (Fix f)

out :: Fix f -> f (Fix f)
out (In x) = x

{-
Для описания рекурсивного типа эквивалентного, например, 
data List a = Nil | Cons a (List a)
задаём нерекурсивный тип
-}

data L a l = Nil | Cons a l deriving (Eq,Show)

instance Functor (L a) where
 fmap _ Nil        = Nil
 fmap g (Cons x l) = Cons x (g l)
{-
и вводим рекурсивный через неподвижную точку функтора \mintinline{haskell}!N! на уровне типов:
-}
type List a = Fix (L a) 

-- Ката- и анаморфизмы
type Algebra f a = f a -> a
cata :: Functor f => Algebra f a -> Fix f -> a
cata phi (In x) = phi (cata phi <$> x)
type Coalgebra f a = a -> f a 
ana :: Functor f => Coalgebra f a -> a -> Fix f
ana psi x = In (ana psi <$> psi x)

---------------------------------------------
{-
Покажите, что типы \mintinline{haskell}![a]! и \mintinline{haskell}!List a! изоморфны, 
реализовав взаимнообратные 
-}
from ::  [a] -> List a
from = undefined

to :: List a -> [a]
to = undefined

{-
Тест:
GHCi> from "hi"
In (Cons 'h' (In (Cons 'i' (In Nil))))
GHCi> to $ In (Cons 'h' (In (Cons 'i' (In Nil))))
"hi"
GHCi> (to . from) [1,2,3]
[1,2,3]
GHCi> (from . to) $ In (Cons 1 (In (Cons 2 (In (Cons 3 (In Nil))))))
In (Cons 1 (In (Cons 2 (In (Cons 3 (In Nil))))))
-}