Cvičení z Neprocedurálního programování - 10

1-maybe.hs

-- Chceme modelovat data, která ale mohou chybět.
-- data Maybe a = Nothing | Just a
-- std::optional v C++
-- Naše "homemade" varianta:
data Mozna a = Nic | Neco a
    deriving (Show, Eq)

-- Typická funkce, která může selhat:
-- Pokud je číslo nezáporné, vrátíme jeho odmocninu
-- Jinak vrátíme 'Nothing'
odmocnina :: Double -> Maybe Double
odmocnina x
    | x >= 0.0  = Just $ sqrt x
    | otherwise = Nothing

-- Další příklad: alternativa k funkci 'head',
-- která je bezpečná (nikdy nevyhazuje runtime error)
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:_) = Just x

-- Volajícího to nutí k inspekci výsledné hodnoty
{-
case safeHead xs of
  Just h -> <[oukej, mám hlavu seznamu, tak s ní jdu něco dělat]>
  Nothing -> <[uf, seznam byl prázdný, musím to nějak ošetřit]>
-}

-- Pokud máme nějakou hodnotu, pak ji vrátíme.
-- Pokud ne, vrátíme default
-- fromMaybe ve std knihovně
orElse :: Maybe a -> a -> a
orElse (Just x) _   = x
orElse Nothing  def = def

-- Verze funkce 'odmocnina', která vrátí
safeOdmocnina :: Double -> Double
safeOdmocnina x = orElse (odmocnina x) 0.0
-- Poznámka: Tohle by vypadalo hezky jako:
--
-- safeOdmocnina x = odmocnina x `orElse` 0.0
--
-- vypadá to pak jako '?:' operátor z JS, ne..? :)

2-elim.hs

-- Zamyslíme se nad tím, jaký typ má "obecný pattern match" nad `Maybe a`:
maybe' n j Nothing = n
maybe' n j (Just x) = j x

{-
Vzhledem k tomu, že funkce musí vždy vracet hodnotu stejného typu, tak `n` musí mýt stejný typ jako `j x`.
Označme jej jako α. [Budu pro typy používat řecká písmenka aby se to nepletlo :)]

`j` je funkce (bere argument!), která dle úvahy výše vrací typ α.
Označme typ jejího argumentu jako β. Tedy `f` má typ β -> α.

Zbývá nám tedy otypovat třetí argument našeho výrazu. Jistě to musí být `Maybe` z něčeho,
ale jaký je ten vnitřní typ? No, nutně to musí být β, protože `x` má typ β z úvahy výše
a tedy `Just x` má typ `Maybe β`.

Celý typ `maybe'` dohromady je tedy:
maybe' :: α -> (β -> α) -> Maybe β -> α
-}

-- Naše teze je, že tato funkce jde použít jako obecný nástroj jak pracovat s něčím typu `Maybe a`.
-- Zkusme tedy `maybeLength :: Maybe [a] -> Int`.

-- Nejprve pattern matchem:
maybeLengthPat :: Maybe [a] -> Int
maybeLengthPat Nothing = 0
maybeLengthPat (Just xs) = length xs

-- Nyní chceme použít maybe':
maybeLengthAttempt :: Maybe [a] -> Int
maybeLengthAttempt maybeList = maybe' _n _j maybeList

-- Teď musíme vymyslet co dosadit do díry `_n` a co do díry `_j`:
-- Zkusme to pomocí "rovnice" s `maybe'` a `maybeLengthPat`:

-- Víme, že má platit: maybe' n j Nothing = n
-- a my dle `maybeLengthPat` chceme, aby to vrátilo `0` (řádek 25)
-- Tedy `_n = 0`

-- Dále víme, že má platit: maybe' n j (Just x) = j x
-- a my dle `maybeLengthPat` chceme, aby to vrátilo `length x`
-- Tedy `_j = (\x -> length x) = length`

-- Dohromady dostáváme:
maybeLength :: Maybe [a] -> Int
maybeLength maybeList = maybe' 0 length maybeList

-- Obdobně chceme funkci `flattenMaybe` napsat nejprve pomocí pattern matchování
-- a potom pomocí `maybe'`:
flattenMaybePat :: Maybe (Maybe a) -> Maybe a
flattenMaybePat Nothing = Nothing
flattenMaybePat (Just m) = m

-- Nyní chceme použít maybe':
flattenMaybeAttempt :: Maybe (Maybe a) -> Maybe a
flattenMaybeAttempt = maybe' _n _j 

-- Opět potřebujeme dosadit za `_n` a za `_j`:

-- Víme, že má platit: maybe' n j Nothing = n
-- a my dle `flattenMaybePat` chceme, aby to vrátilo `Nothing` (řádek 50)
-- Tedy `_n = Nothing`

-- Dále víme, že má platit: maybe' n j (Just x) = j x
-- a my dle `flattenMaybePat` chceme, aby to vrátilo `x`
-- Tedy `_j = (\x -> x) = id`

-- Dohromady dostáváme:

flattenMaybe :: Maybe (Maybe a) -> Maybe a
flattenMaybe = maybe' Nothing id

-- Sami můžete zkusit `maybeToList' :: Maybe a -> [a]` tak, aby splňovala následující testy:
-- >>> maybeToList' Nothing == []
-- >>> maybeToList' (Just 42) == [42]

-- [Na cvičení jsme to zvládli s malou nápovědou ;)]

-- Postupně byste měli umět psát rovnou funkce pomocí `maybe'`.
-- (Ale asi to nikdo nebude chtít, používáme to jen abychom ukázali kontext :D)


-- Jde tohle zobecnit? Jak by vypadala podobná funkce třeba pro typ
data NejvyseDva a = Zadny | Jeden a | Dva a a
  deriving (Show, Eq) -- kouzelné zaklínadlo, vysvětlíme později ;)

{-
nejvyseDva :: r -- 'Zadny' nebere žádný argument, tedy ho musíme nahradit nějakou konstantou
           -> (a -> r) -- 'Jeden' bere jeden argument typu a, který změníme na výsledný typ
           -> (a -> a -> r) -- 'Dva' bere dva argumenty typu a, které změníme na výsledný typ
           -> Dva a -- To je to co rozbalujeme
           -> r -- výsledek
-}

-- Všimněte si, že tenhle typ jde odvodit mechanicky přímo z definice `NejvyseDva`.

-- Co kdybychom to zkusili pro seznamy?
data List a = Nil | Cons a (List a)
  deriving (Show, Eq)
  
list :: r -- za Nil
     -> (a -> List a -> r) -- za Cons
     -> List a  -- to co pattern matchujeme
     -> r -- výsledek
list n c Nil = n
list n c (Cons x xs) = c x xs

-- Tohle je hezké, ale nezbavíme se tím toho seznamu úplně. :(
-- => co kdybychom se zarekurzili?

listRec :: r -- za Nil
        -> (a -> r -> r) -- [ZMĚNA] za Cons
        -> List a  -- to co pattern matchujeme
        -> r -- výsledek
listRec n c Nil = n
listRec n c (Cons x xs) = c x (list n c xs) -- [ZMĚNA]

-- najednou `listRec` nemusí uživatelé říkat co dělat s `cons`em,
-- prostě se zarekurzíme :)

-- Obecně se tomuhle konceptu říká "type eliminator" v logice / teorii typů
-- a hodí se to třeba i jako způsob, kterým v lambda kalkulu popsat nějaká složitější data
-- (místo dat používáte funkci, která je eliminuje)

3-fold.hs

-- Výše uvedené funkci `listRec` se říká `foldr` -- "pravý fold".
-- Napišme si ji ještě jednou:

-- | Naše verze funkce 'foldr' --
-- postupně "skládá" seznam s operací, která je asociativní zprava
foldRight :: (a -> b -> b) -> b -> [a] -> b
foldRight _ acc [] = acc
foldRight f acc (x:xs) = f x (foldRight f acc xs)

{-
Ekvivalent v Pythonu je cca:

acc = None
for x in xs:
    acc = f(x, acc)
return acc
-}

{-
Jak to vypadá:
foldRight f acc xs =
    foldRight f acc [x1, x2, x3, x4, x5] =
    x1 `f` (x2 `f` (x3 `f` (x4 `f` (x5 `f` acc)))) = 
    f x1 (f x2 (f x3 (f x4 (f x5 acc))))
    
Reálně tedy z:
    xs  =   x1  :  (x2  :  (x3  :  (x4  :  (x5  :  [] ))))
vyrábí:
      ==>   x1 `f` (x2 `f` (x3 `f` (x4 `f` (x5 `f` acc))))
      
Tedy každý `:` nahradí za `f` a `[]` nahradí za `acc`.
To je přesně ta "esence" pattern-matchování z předchozího souboru!
-}

-- Příklad:
sum' :: [Int] -> Int
sum' xs = foldRight (+) 0 xs -- počáteční akumulátor je = 0 a skládací operace je sčítání!

-- Tohle sice jde vidět rovnou, ale můžeme si to také ukázat tou technikou kterou jsme si ukazovali
-- v předchozím souboru!

-- 1. Napíšeme pomocí pattern-matchování a explicitní rekurze:
sumPat :: [Int] -> Int
sumPat [] = 0
sumPat (x : xs) = x + sumPat xs

-- 2. Napíšeme template která využije `foldr` a typové díry:
sumAttempt :: [Int] -> Int
sumAttempt xs = foldRight _f _acc xs

-- 3. Nyní vyřešíme pomocí rovnic:
-- 3a. Víme, že `foldRight _ acc [] = acc`.
-- Zároveň ale naše funkce `sumPat` vrací `0`, když dostane prázdný seznam.
-- Tedy nutně `_acc = 0`

-- 3b. Víme, že `foldRight f acc (x:xs) = f x (foldRight f acc xs)`.
-- Zároveň ale naše funkce `sumPat` vrací `x + sumPat xs` když dostane neprázdný seznam.
-- Tedy nutně:              `x + sumPat xs     = f x (foldRight f acc xs)`
-- Napišme `+` jako funkci: `(+) x (sumPat xs) = f x (foldRight f acc xs)`
-- Z čehož dostáváme rovnici pro `f`:
-- => `_f = (+)`

-- To, že `sumPat xs = foldRight f acc xs` víme, protože tak to přeci definujeme! :D

-- Tedy finální verze vypadá takhle:
sum'' :: [Int] -> Int
sum'' xs = foldRight (+) 0 xs

-- Což je přesně to, co jsme měli výše \o/

-- Další funkce už takhle ukazovat nebudu, ale tohle je obecná technika, kterou můžete používat :)


product' :: [Int] -> Int
product' xs = foldRight (*) 1 xs


length' :: [a] -> Int
length' xs = foldRight (\_ acc -> acc + 1) 0 xs

-- Verze pro fajnšmekry:
length'' = foldRight (const (+ 1)) 0
-- Kde const je funkce zahazující svůj _druhý_ argument:
const :: a -> b -> a
const x _ = x

minimum' :: [Int] -> Int
minimum' [] = error "minimum': empty list" -- vrátí runtime error, není moc hezké!
minimum' (h:t) = foldRight min h t

maximum' :: [Int] -> Maybe Int
maximum' [] = Nothing -- vrátí `Nothing`, mnohem hezčí -- uživatel si to musí rozbalit :)
maximum' (x:xs) = Just (foldRight max x xs)

-- Tahle funkce je identita na seznamech.
-- Cvičení: Proč? :)
identitaNaSeznamech :: [a] -> [a]
identitaNaSeznamech = foldRight (:) []

-- Dokonce i `map` jde napsat pomocí foldr!
map' :: (a -> b) -> [a] -> [b]
map' f = foldRight (\x acc -> f x : acc) []

-- | Vrátí True pokud prvek x je v seznamu
elem' :: Int -> [Int] -> Bool
elem' x = foldRight (\y acc -> x == y || acc) False 

4-foldl.hs

-- | Fold zleva -- foldl ve std knihovně
-- Není to to samé jako foldr!
foldLeft :: (b -> a -> b) -> b -> [a] -> b
foldLeft _ acc [] = acc
foldLeft f acc (x:xs) = foldLeft f (f acc x) xs

{-
Jak to vypadá:
foldLeft f acc xs =
    foldLeft f acc [x1, x2, x3, x4, x5] =
    ((((acc `f` x1) `f` x2) `f` x3) `f` x4) `f` x5
    
Reálně tedy z:
    xs  =               x1  :  (x2  :  (x3  :  (x4  :  (x5  :  [] ))))
vyrábí:
      ==>   ((((acc `f` x1 `f` x2) `f` x3) `f` x4) `f` x5
-}

-- Rozmyslete si podobnost s akumulátorem v Prologu!

-- Příkladná funkce:

reverse' :: [a] -> [a]
reverse' = foldLeft (\acc x -> x : acc)

{-
reverse' [1, 2, 3]
  = foldLeft (\acc x -> x : acc) [] [1, 2, 3]
  = (([] `f` 1) `f` 2) `f` 3)
  = 3 : (2 : (1 : []))
  = [3, 2, 1]
  
-}


-- #### Kdy použít který fold?

-- foldr: 
-- + funguje na nekonečné seznamy (vyzkoušejte si!)
-- + funguje hezky i pro líné výpočty
-- - není ocáskově rekurzivní 
-- * "závorkuje zprava"

-- foldl:
-- + je ocáskově rekurzivní (je hodně efektivní)
-- - nefunguje na nekonečných seznamech
-- - nefunguje moc hezky pro líné výpočty (musí být vyhodnocen celý seznam)
-- * "závorkuje zleva"

-- => používejte by default foldr, pokud chcete levý fold, tak použijte foldl'
-- (tj. foldl s čárkou) ze std. knihovny, který vypočítává _striktně_ a je tedy rychlejší.

5-slozity-fold.hs

-- Chceme vytvořit 'zip :: [a] -> [b] -> [(a, b)]' pomocí 'foldr'.
-- Trik: Akumulátor je _funkce_!
-- Konkrétně to je funkce typu `[b] -> [(a, b)]`
-- Idea: Foldujeme jen jeden seznam ('[a]') a vytváříme funkci,
-- která když dostane seznam '[b]', tak vrátí seznam dvojic '[(a, b)]'.

-- Na cvičení jsme tuto funkci vymysleli tak, že jsme napsali:
-- `myZip as bs = foldr step done as bs`
-- a pak jsme se podívali jaký typ Haskell očekává pro 'step' a 'done'
-- a dále jsme jen psali kód dle typů!
myZip :: [a] -> [b] -> [(a, b)]
myZip as bs = (foldr step done as) bs
  where
      step :: a -> ([b] -> [(a, b)]) -> ([b] -> [(a, b)])
      step _ _ [] = []
      step x fn (y:ys) = (x, y) : fn ys
      -- ^ fn si můžeme představovat jako funkci, která zařídí "pokračování" zipování

      done :: [b] -> [(a, b)]
      done _ = []
      -- ^ jinou funkci než tuto ani nemůžeme napsat -- kde bychom vzali nějaké 'a'?
{-
Nejlepší náhled na 'myZip' je ve chvíli, kdy odignorujeme druhý argument
a podíváme se co vlastně fold vyrábí:
> myZip [1, 2, 3]
→ \(y : ys) -> (1, y) : ((foldr (…) [2, 3]) ys)
→ \(y : ys) -> (1, y) : \(y' : ys') -> (2, y') : ((foldr (…) [3]) ys')
→ \(y : ys) -> (1, y) : \(y' : ys') -> (2, y') : \(y'' : ys'') -> (3, y'') : ((foldr (…) []) ys'')
→ \(y : ys) -> (1, y) : \(y' : ys') -> (2, y') : \(y'' : ys'') -> (3, y'') : ((\_ -> []) ys'')
→ \(y : y' : y'' : _) -> (1, y) : (2, y') : (3, y'') : []
→ \(y : y' : y'' : _) -> [(1, y), (2, y'), (3, y'')]
To je přesně to, co chceme! :)
-}

-- Hezký odkaz na StackOverflow: https://stackoverflow.com/questions/235148/implement-zip-using-foldr

-- Podobným trikem lze vytvořit 'foldl' z 'foldr'
-- Na cvičení zase vyrobeno jen tak, aby seděly typy :)
myFoldl :: (b -> a -> b) -> b -> [a] -> b
myFoldl f z xs = foldr step done xs z
  where
    step x g = \y -> g (f y x)

    done :: b -> b
    done = id

-- Velmi doporučené cvičení:
-- Rozepište si dle definice co dělá `foldr step done` na seznamu `[1, 2, 3]`!
-- (Podobně jako jsem rozepisoval ten zip výše)
-- Mělo by vám na konci vyjít něco jako: `\z -> f (f (f z 1) 2) 3`

-- Hezký odkaz na StackOverflow: https://stackoverflow.com/questions/6172004/writing-foldl-using-foldr