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

1-fizzbuzz.hs

-- Fizz Buzz
-- je klasický problém, který se dává na interview
-- Pro číslo i: pokud je dělitelné 3, vypište Fizz, pokud 5, vypište Buzz, jinak vypište číslo

-- Příklad:
-- 1, 2, Fizz, 4, Buzz, 5, Fizz, 7, 8, Fizz, Buzz, 11, Fizz, 13, 14, FizzBuzz, ... 

-- Klasické řešení:
fizzbuzz :: Int -> String
fizzbuzz i
    | i `mod` 3 == 0 && i `mod` 5 == 0 = "FizzBuzz"
    | i `mod` 3 == 0 = "Fizz"
    | i `mod` 5 == 0 = "Buzz"
    | otherwise = show i

-- Problém: Tohle se moc neškáluje.
-- Kdybychom přidali "Wuzz" pro dělitele sedmičky, tak musíme přidat hodně edge casů.

-- Alternativní řešení:
-- 'fizzes' je nekonečný seznam typu 'Maybe String', který má každý třetí prvek Just "Fizz"
-- jinak Nothing
fizzes :: [Maybe String]
fizzes = cycle [Nothing, Nothing, Just "Fizz"]
-- podobně 'buzzes' pro Buzz
buzzes :: [Maybe String]
buzzes = cycle [Nothing, Nothing, Nothing, Nothing, Just "Buzz"]

-- Když zkombinujeme tyto dva nekonečné seznamy pomocí zipWith a `<>`,
-- dostaneme skoro to, co bychom chtěli:
fizzbuzzes :: [Maybe String]
fizzbuzzes = zipWith (<>) fizzes buzzes

-- >>> take 15 $ fizzbuzzes
-- [Nothing,Nothing,Just "Fizz",Nothing,Just "Buzz",Just "Fizz",Nothing,Nothing,Just "Fizz",Just "Buzz",Nothing,Just "Fizz",Nothing,Nothing,Just "FizzBuzz"]

-- Nyní každý Nothing nahradíme samotným číslem
fizzbuzz' :: Int -> [String]
fizzbuzz' n = zipWith fromMaybe (map show [1..n]) fizzbuzzes

-- >>> fizzbuzz' 15
-- ["1","2","Fizz","4","Buzz","Fizz","7","8","Fizz","Buzz","11","Fizz","13","14","FizzBuzz"]

-- Pomocná funkce, která byla na minulém cvičení.
fromMaybe :: a -> Maybe a -> a
fromMaybe def Nothing = def
fromMaybe _ (Just x) = x

-- Máme tedy elegantní řešení využívající nekonečné seznamy, které je celkem jednoduché
-- a hlavně dost rozšířitelné!

2-druhy.hs

{-
Každá hodnota má svůj typ:

>>> :t "Ahoj"
String

>>> :t Just 42
Maybe Int

>>> :t [Just "Ahoj", Nothing]
[Maybe String]

>>> :t \x -> show (x + 2)
Int -> String

Co ale typy? Je něco jako typ typu?

>>> :t Int
error

Ano, říká se mu _druh_, anglicky kind.

>>> :k Int
Int :: *

>>> :k Char
Char :: *

Kind * znamená, že ten typ je konkrétní -- reprezentovatelný

>>> :k Int -> String
Int -> String :: *

>>> :k [String]
[String] :: *

>>> :k Maybe Int
Maybe Int :: *

Ne všechny typy jsou ale rovnou reprezentovatelné,
například samotné 'Maybe':

>>> :k Maybe
Maybe :: * -> *

Tohle znamená, že 'Maybe' dostane konkrétní typ a vrátí konkrétní typ
(podobně jako funkce 'a -> a' vezme hodnotu typu 'a' a vrátí hodnotu typu 'a')

>>> :k []
[] :: * -> *

Podobně jako List není nic "opravdového" v C#/Javě/C++,
ale List<Int> ano.
-}

data Strom a = Konec | Vetev a (Strom a) (Strom a)

{-

>>> :k Strom
Strom :: * -> *


Druhy mohou být ale i o trochu složitější!


-}

data Pair a b = Pair a b

{-
>>> :k Pair
Pair :: * -> * -> *

Pair potřebuje dva typy, aby z něj byl konkrétní typ!

Tohle je podobné jako třeba Pair<T, U> v Javě/C# nebo std::pair<T, U> v C++

>>> :k Pair Int
Pair Int :: * -> *

"potřebuje ještě jeden konkrétní typ, aby to byl konkrétní typ"


>>> :k (->)
(->) :: * -> * -> *

Funkční šipka má stejný druh jako Pair

>>> :k ((->) Int) String
((->) Int) String :: *

(->) Int String se zapisuje obvykle jako Int -> String ;)
-}


-- Typové třídy také mají svůj druh:
-- >>> :k Semigroup
-- Semigroup :: * -> Constraint

-- Reálně to znamená něco jako "dej mi konkrétní typ a já ti dám omezení (Constraint)"

3-functor.hs

-- Mnoho typů je kontejnerovitých -- mají druh * -> *
-- Co kdybychom chtěli tuto "kontejnerovitost" nějak vyjádřit typovou třídou?

-- Od toho je třída Functor!

{-
class Functor (f :: * -> *) where
  fmap :: (a -> b) -> f a -> f b
  ...
-}

-- 'fmap' je něco jako zobecněné 'map'
-- pro libovolný kontejnerovitý typ

{-

instance Functor [] where
  fmap = map
  
instance Functor Maybe where
  fmap f (Just x) = Just $ f x
  fmap _ Nothing  = Nothing

-}

-- >>> fmap (+2) [1, 2, 3]
-- [3, 4, 5]

-- >>> fmap (+2) (Just 3)
-- Just 5

-- >>> fmap (+2) Nothing
-- Nothing

-- >>> fmap (fmap (+2)) [Just 5, Nothing, Just 3]
-- [Just 7, Nothing, Just 5]

data Strom a = Konec 
             | Vetev (Strom a) a (Strom a)
  deriving (Eq, Show)

-- Všimněte si, že tady je 'Functor Strom' a ne 'Functor (Strom a)'!
instance Functor Strom where
    fmap _ Konec = Konec
    fmap f (Vetev l x r) = Vetev (fmap f l) (f x) (fmap f r)

-- Pro funktory musí platit následující pravidla:
-- fmap id = id
-- fmap (f . g) = fmap f . fmap g

-- Cvičení:
-- Napište si instanci pro Functor pro následující k-nární strom:
data RoseTree a = Node a [RoseTree a]
  deriving (Eq, Show)

4-andThen.hs

{-# LANGUAGE InstanceSigs #-} -- umožňuje psát typové anotace u metod typových tříd

-- | Vezme klíč 'k', který je porovnatelný
-- a seznam dvojic (k, v).
-- Pokud je 'k' v seznamu dvojic, vrátí jeho "hodnotu",
-- jinak vrátí Nothing
lookUp :: Eq k => k -> [(k, v)] -> Maybe v
lookUp _ [] = Nothing
lookUp k ((x, v):xs)
    | k == x = Just v
    | otherwise = lookUp k xs

-- Seznam pro testování
mujSeznam :: [(Int, Char)]
mujSeznam = zip [1..] "abcde"

-- Poznámka: funkce 'enumerate' v Pythonu je jen 'zip [1..]'

{-
>>> lookUp 2 mujSeznam
Just 'b'

>>> lookUp (-1) mujSeznam
Nothing
-}

-- | Co kdybychom chtěli udělat následující věc:
-- Najít hodnotu x pro k a potom najít hodnotu x' pro x, atd.
-- než to provedeme čtyřikrát?
--
-- Metafora: seznam [(a, a)] je seznam dvojic [(syn, otec)]
-- a chceme čtyřikrát zavolat otec (najít pra-pra-dědu)
lookUp4 :: Eq a => a -> [(a, a)] -> Maybe a
lookUp4 k xs =
    case lookUp k xs of
        Nothing -> Nothing
        Just k1 ->
            case lookUp k1 xs of
                Nothing -> Nothing
                Just k2 ->
                    case lookUp k2 xs of
                        Nothing -> Nothing
                        Just k3 -> lookUp k3 xs
-- Podobný problém v C++/C#/Javě:
{-
if (x != null) {
    if (x.y != null) {
        if (x.y.z != null) {
            if (x.y.z.w != null) {
                return x.y.z.w;    
            }    
        }    
    }
}
-}

-- Tohle není moc hezké, co kdybychom si udělali nějakou funkci,
-- která by nám pomohla tohle napsat slušněji?
andThen :: Maybe a -> (a -> Maybe b) -> Maybe b
andThen Nothing _ = Nothing
andThen (Just x) f = f x

-- Nyní můžeme lookup4 napsat takhle:
lookUp4' :: Eq a => a -> [(a, a)] -> Maybe a
lookUp4' k xs =
    lookUp k xs `andThen` \k1 ->
        lookUp k1 xs `andThen` \k2 ->
            lookUp k2 xs `andThen` \k3 ->
                lookUp k3 xs
-- Prosím, fakt se podívejte výše a přesvědčte se o tom,
-- že funkce lookUp4 a lookUp4' dělají to samé

{- Alternativní způsob jak zapsat lookUp4':

lookUp4' :: Eq a => a -> [(a, a)] -> Maybe a
lookUp4' k xs =
    lookUp k xs `andThen`
    \k1 -> lookUp k1 xs `andThen`
    \k2 -> lookUp k2 xs `andThen`
    \k3 -> lookUp k3 xs
    
`andThen` nápadně připomíná "chytrý středník" ;)
-}

-- Dále si všimněme, že:
-- 'Just :: a -> Maybe a' je "neutrální operace"
-- Just x `andThen` f     === f x
--    v   `andThen` Just  === v

-- Označme si ji jako 'done'
done :: a -> Maybe a
done = Just

-- | Verze lookUp4, která používá 'done', aby byla hezky symetrická
lookUp4'' :: Eq a => a -> [(a, a)] -> Maybe a
lookUp4'' k xs =
    lookUp k xs `andThen`
    \k1 -> lookUp k1 xs `andThen`
    \k2 -> lookUp k2 xs `andThen`
    \k3 -> lookUp k3 xs `andThen`
    \k4 -> done k4
-- Nevypadá 'done' trochu jako 'return'? ;)

{-
Jiný pohled na 'Maybe a' je, že je to _výpočet_ hodnoty typu 'a', který se nemusí povést.
Tento pohled se nám bude hodit později. ;)
-}

-- Zdánlivě z jiného soudku:

-- Vezměme si následující funkci, která vrací sousedy daného políčka na šachovnici
-- zapsáno pomocí List Comprehension (viděli jsme dříve)
neighbours :: (Int, Int) -> [(Int, Int)]
neighbours (x, y) = [ (x + 1, y), (x, y + 1), (x - 1, y), (x, y - 1) ]

-- Příklad:
-- >>> neighbours (0, 0)
-- [(1,0),(0,1),(-1,0),(0,-1)]

-- Co kdybychom chtěli funkci, která vrátí políčka, která jsou dosažitelná dvěma kroky?
-- (nebudeme řešit duplicity)
twoStepNeighbours :: (Int, Int) -> [(Int, Int)]
twoStepNeighbours position = concat $ map neighbours (neighbours position)
-- ^ Na každého souseda position zavoláme neighbours, tím dostaneme seznam seznamů pozicí
-- a ten pak sploštíme pomocí concat (concat :: [[a]] -> [a]).

-- Příklad:
-- >>> twoStepNeighbours (0, 0)
-- [(2,0),(1,1),(0,0),(1,-1),(1,1),(0,2),(-1,1),(0,0),(0,0),(-1,1),(-2,0),(-1,-1),(1,-1),(0,0),(-1,-1),(0,-2)]

-- Tenhle vzor vypadá nějak podezřele známý.
-- Zkusme se na něj podívat blíže:
hmm :: [a] -> (a -> [b]) -> [b]
hmm x f = concat $ map f x

{- Podívejme se na typy 'hmm' a 'andThen' pod sebou:

>>> :t andThen
andThen :: Maybe a -> (a -> Maybe b) -> Maybe b

>>> :t hmm
mystery :: [a] -> (a -> [b]) -> [b]
-}

-- | 'andThenL' je podobné jako 'andThen', ale pro seznamy.
andThenL :: [a] -> (a -> [b]) -> [b]
andThenL x f = concat $ map f x

-- | Sousedi vzdálení tři kroky pomocí 'andThenL'
threeStepNeighbours :: (Int, Int) -> [(Int, Int)]
threeStepNeighbours p =
    neighbours p `andThenL` \p1 ->
    neighbours p1 `andThenL` \p2 ->
    neighbours p2

-- | Podobná neutrální operace jako 'done', ale pro seznamy:
doneL :: a -> [a]
doneL x = [x]


-- | Sousedi vzdálení tři kroky pomocí 'andThenL' a 'doneL'
threeStepNeighbours :: (Int, Int) -> [(Int, Int)]
threeStepNeighbours p = do
    neighbours p `andThenL` \p1 ->
    neighbours p1 `andThenL` \p2 ->
    neighbours p2 `andThenL` \p3 ->
    doneL p3

{-
Nabízí se alternativní pohled na hodnoty typů 'Maybe a' a '[a]':

'Maybe a' je výpočet typu 'a', který může selhat
'[a]' je výpočet typu 'a', který může vrátit více variant
-}

-- | Naprogramujme si kartézský součin dvou seznamů:
times :: [a] -> [b] -> [(a, b)]
times xs ys =
    xs `andThenL` \x ->
    ys `andThenL` \y ->
    doneL (x, y)
    
-- >>> times [1, 2, 3] "abc"
-- [(1, 'a'), (2, 'b'), (3, 'c')]

-- Opravdu se přesvědčte, _že_ tohle počítá kartézský součin
-- a rozmyslete si _jak_ to počítá kartézský součin.

{-
Máme tedy:
andThenL ::   [a]   -> (a ->   [b]  ) ->   [b]
andThen  :: Maybe a -> (a -> Maybe b) -> Maybe b

Pokud bychom generalizovali, dostaneme:
obecneAndThen :: m a -> (a -> m b) -> m b

Podobně:
doneL :: a ->   [a]
done  :: a -> Maybe a

Zase po generalizaci dostáváme:
obecneDone :: a -> m a 

Máme i nějaká rozumná pravidla pro tyto typy -- konkrétně:
'obecnyDone' by měla být "identita" pro 'obecneAndThen'
a nějakým způsobem by 'obecneAndThen' mělo být asociativní.

Dostáváme tedy typovou třídu 'Monad':

class Monad m where
    return :: a -> m a                  -- done, doneL
    
    -- ^ pozor, 'return' nesouvisí s návratem z funkce
    -- jako v procedurálních jazycích, jméno je to trochu nešťastné...
    
    (>>=) :: m a -> (a -> m b) -> m b   -- andThen, andThenL
    
    -- ^ tento operátor se čte "bind"
    -- představujte si to jako záchodový zvon 🪠 :)
-}

-- | 'times' napsaný pomocí (>>=) a return
times' :: [a] -> [b] -> [(a, b)]
times' xs ys =
    xs >>= \x ->
    ys >>= \y ->
    return (x, y)

5-do.hs

{-# LANGUAGE InstanceSigs #-}

-- Z minulého souboru:

-- | Vezme klíč 'k', který je porovnatelný
-- a seznam dvojic (k, v).
-- Pokud je 'k' v seznamu dvojic, vrátí jeho "hodnotu",
-- jinak vrátí Nothing
lookUp :: Eq k => k -> [(k, v)] -> Maybe v
lookUp _ [] = Nothing
lookUp k ((x, v):xs)
    | k == x = Just v
    | otherwise = lookUp k xs

{-
Připomínám, že třída 'Monad' vypadá takhle:

class Monad m where
    return :: a -> m a
    (>>=) :: m a -> (a -> m b) -> m b
-}

-- Monády jsou v Haskellu využívány tak často, že existuje syntaktický cukr ve formě
-- takzvané "do-notace", která vypadá _velmi_ imperativně!

-- | Kartézský součin napsaný pomocí (>>=) a return
times' :: [a] -> [b] -> [(a, b)]
times' xs ys =
    xs >>= \x ->
    ys >>= \y ->
    return (x, y)

-- | Kartézský součin pomocí do notace:
times :: [a] -> [b] -> [(a, b)]
times xs ys = do
    x <- xs
    y <- ys
    return (x, y)
    
-- | Čtyřnásobný 'lookUp' pomocí (>>=) a return:
lookUp4 :: Eq a => a -> [(a, a)] -> Maybe a
lookUp4 k xs =
    lookUp k xs >>=
    \k1 -> lookUp k1 xs >>=
    \k2 -> lookUp k2 xs >>=
    \k3 -> lookUp k3 xs >>=
    \k4 -> return k4

-- | Čtyřnásobný 'lookUp' pomocí do notace:
lookUp4''' :: Eq a => a -> [(a, a)] -> Maybe a
lookUp4''' k xs = do
    k1 <- lookUp k xs
    k2 <- lookUp k1 xs
    k3 <- lookUp k2 xs
    k4 <- lookUp k3 xs
    return k4

{- Obecný návod jak se odcukrovává do notace:

do  
    a <- ma
    mb

ma >>= \a -> mb

------------

do
    ma
    mb

ma >>= \_ -> mb

------------

do
    let x = y
    mb

let x = y in mb
-}

vsechnySoucty :: [Int] -> [Int] -> [Int]
vsechnySoucty xs ys = do
    x <- xs
    y <- ys
    let result = x + y
    return result

-- je syntaktický cukr pro:

vsechnySouctyBezCukru :: [Int] -> [Int] -> [Int]
vsechnySouctyBezCukru xs ys =
    xs >>= \x ->
    ys >>= \y ->
    let result = x + y in
    return result

6-monads.hs

{-# LANGUAGE InstanceSigs #-}

-- Z minulého souboru:

andThen :: Maybe a -> (a -> Maybe b) -> Maybe b
andThen Nothing _ = Nothing
andThen (Just x) f = f x

andThenL :: [a] -> (a -> [b]) -> [b]
andThenL x f = concat $ map f x

-- Pár vlastních instancí monád:

class Functor m => MojeMonada m where
    mReturn :: a -> m a
    mBind :: m a -> (a -> m b) -> m b
-- Pozor, všimněte si, že každá monáda musí být funktor.
-- Zároveň musí platit, že 'fmap f xs == xs >>= return . f'
-- Monády jsou ale silnější koncept než funktory
-- (Ne každý funktor je monáda)

-- Tuto instanci už jsme víceméně měli výše:
instance MojeMonada Maybe where
    mReturn :: a -> Maybe a
    mReturn = Just

    mBind :: Maybe a -> (a -> Maybe b) -> Maybe b
    mBind = andThen

-- Tuto instanci už jsme také víceméně měli výše:
instance MojeMonada [] where
    mReturn :: a -> [a]
    mReturn x = [x]

    mBind :: [a] -> (a -> [b]) -> [b]
    mBind = andThenL

-- Připomínám, Either je definován následovně:
-- 'data Either e a = Left e | Right a'
instance MojeMonada (Either e) where
    mReturn :: a -> Either e a
    mReturn x = Right x

    -- errory neupravujeme, na hodnoty aplikujeme funkci:
    mBind :: Either e a -> (a -> Either e b) -> Either e b
    mBind (Left err) _ = Left err
    mBind (Right x) f = f x

-- Příklad funkce, která používá 'Either'
odmocni :: Double -> Either String Double
odmocni x
    | x >= 0.0 = Right x
    | otherwise = Left "ohno, negative"

odmocniDvakrat :: Double -> Either String Double
odmocniDvakrat x = do
    y <- odmocni x
    z <- odmocni y
    return z
    
-- 'Either e a' je výpočet, který může selhat s errorem typu 'e'.
-- Tedy 'Maybe', 'Either e' a '[]' jsou vlastně _nějaké_
-- vedlejší efekty!

7-triples.hs

-- | Pythagorejské trojice menší než @n@, tedy
-- trojice, kde x <= y <= z <= n a x² + y² = z²
--
-- Zapsáno pomocí list comprehension:
triples :: Int -> [(Int, Int, Int)]
triples n = [(x, y, z) | x <- [1..n], y <- [x..n], z <- [y..n],
                (x * x + y * y == z * z)]

-- Příklad:
-- >>> triples 15
-- [(3,4,5),(5,12,13),(6,8,10),(9,12,15)]

-- Nevypadají list comprehensions vlastně trochu jako do notace?
-- Ano!
-- To je schválně -- do notace je vlastně zobecnění list comprehensions!

-- | Vrátí _všechny_ trojice, kde x <= y <= z <= n.
-- Nemusí to být _Pythagorejské_ trojice!
allTriples :: Int -> [(Int, Int, Int)]
allTriples n = do
    x <- [1..n]
    y <- [x..n]
    z <- [y..n]
    return (x, y, z)

-- Příklad:
-- >>> allTripes 3
-- [(1,1,1),(1,1,2),(1,1,3),(1,2,2),(1,2,3),(1,3,3),(2,2,2),(2,2,3),(2,3,3),(3,3,3)]

-- Jak můžeme naprogramovat hlídání podmínky?
-- Použijeme funkci 'guard'!
guard :: Bool -> [()]
guard True = [()] -- <- pokud je podmínka pravdivá, vrať jednu hodnotu!
guard False = [] -- <- pokud ne, nevracej žádnou hodnotu

-- To znamená, že pokud podmínka není splněná, tak nemáme co mapovat dál
-- a tato větev výpočtu vrátí pouze prázdný seznam.
-- Ten je pak zploštěn s jinými seznamy, což odpovídá tomu,
-- že z výsledek této větve není ve výsledném seznamu!

{-
Příklady pro ilustraci:

>>> guard True >>= \_ -> [42]
[42]

>>> guard False >>= \_ -> [42]
[]

>>> [1, 2, 3, 4, 5] >>= \x -> guard (even x)
[(),()]

>>> [1, 2, 3, 4, 5] >>= \x -> guard (even x) >>= \_ -> return x
[2,4]
-}

-- Poznámka: Mohli bychom vracet _jakoukoliv_ hodnotu,
-- volající ji stejně typicky zahazuje

-- Mimochodem, tohle je přesně způsob, jak jsou podmínky implementovány v list comprehension!

-- | Pythagorejské trojice pomocí do notace:
triples' :: Int -> [(Int, Int, Int)]
triples' n = do
    x <- [1..n]
    y <- [x..n]
    z <- [y..n]
    guard (x * x + y * y == z * z) -- to samé jako '_ <- guard (x * x + y * y == z * z)', ignorujeme návratovou hodnotu
    return (x, y, z)
    
    
-- Jiný příklad:
safeDivide :: Int -> Int -> Maybe Int
safeDivide x y
    | y == 0 = Nothing
    | otherwise = Just $ x `div` y
 
-- >>> safeDivide 5 2
-- Just 2
-- (je to celočíselné dělení ;) )

-- >>> safeDivide 5 0
-- Nothing
  
-- Napsaný pomocí do notace a 'guard':
safeDivide' :: Int -> Int -> Maybe Int
safeDivide' x y = do
    guard $ y /= 0
    return $ x `div` y
 
-- Tedy jde vidět, že můžeme používat něco jako list comprehension,
-- ale pro každou monádu!