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

1-nekonecno.hs

-- Užitečná funkce, která přehodí pořadí argumentů
flip :: (a -> b -> c) -> b -> a -> c
flip f x y = f y x

-- Intermezzo: List Comprehension je způsob,
-- jak hezky zapsat seznamy.
-- Znáte z Pythonu!
foo :: [Int]
foo = filter (>5) (map (*2) [1..10])

foo' :: [Int]
foo' = [2 * x | x <- [1..10], 2 * x > 5]

foo'' :: [Int]
foo'' = [y | x <- [1..10], let y = 2 * x, y > 5]

-- Nekonečný seznam prvočísel
-- pomocí pseudo-Eratosthenova síta
primes :: [Int]
primes = filterPrime [2..]
    where
        filterPrime [] = error "impossible"
        filterPrime (p:xs) = p : filterPrime [x | x <- xs, x `mod` p /= 0]

-- Chceme funkci, která slepí dva seznamy
-- a na prvky "pod sebou" aplikuje funkci.
-- V base jako zipWith
map2 :: (a -> b -> c) -> [a] -> [b] -> [c]
map2 _ [] _ = []
map2 _ _ [] = []
map2 f (x:xs) (y:ys) = f x y : map2 f xs ys

-- >>> map2 (+) [1, 2, 3] [4, 5, 6, 7]
-- [5, 7, 9]

-- Nekonečný seznam fibonacciho čísel!
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

2-dolar-a-tecka.hs

import Data.Char ( toLower, toUpper )
-- ^ importujeme funkce 'toLower, toUpper :: Char -> Char'.

-- `f $ x` znamená aplikaci funkce `f` na argument `x`
-- má velmi nízkou precedenci
-- a je asociativní zprava:

-- f $ g $ h x = f (g (h x))

-- Většinou se používá proto, abychom se vyhli závorce
foo :: [Int]
foo = filter (>5) $ map (*2) [1..10]

-- Operátor "tečka" spojuje dvě funkce dohromady zprava.
-- (f `kolečko` g)(x) = f(g(x))
-- Reálně je to pajpa z UNIXu, jen zprava doleva!

-- Tedy v Haskellu se zapisuje 
-- f (g (h x)) jako (f . g . h)(x)
--             či spíše jako f . g . h $ x

-- Příklad: Podposloupnost s maximálním součtem!
bar :: [Int] -> [Int]
bar = maximum . map sum . segs
  where
    -- Vrací souvislé podposloupnosti (není ale moc efektivní...)
    segs :: [a] -> [[a]]
    segs xs = [seg i j xs | i <- [1..(length xs)], j <- [i..(length xs)]]
    
    seg :: Int -> Int -> [a] -> [a]
    seg i j xs = [xs !! k | k <- [i..j]]

-- sPoNgEbOb CaSe
spongebobCase :: String -> String
spongebobCase = zipWith ($) stridane
    where
        -- Nekonečný seznam funkcí, které upraví znak
        -- Konkrétně: první funkce vrátí malé písmenko, druhá velké, třetí zase malé, ...
        stridane :: [Char -> Char]
        stridane = cycle [toLower, toUpper]
        
-- >>> spongebobCase "Vitejte na cviceni z Neproceduralniho programovani!"
-- "vItEjTe nA CvIcEnI Z NePrOcEdUrAlNiHo pRoGrAmOvAnI!"

3-divne-foldy.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

4-mozna.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..? :)

5-typove-tridy.hs

-- Pozorování: V Haskellu má každý výraz právě jeden nejobecnější typ
-- třeba 'identita' má nejobecnější typ 'a -> a'

-- Problém: Chceme otypovat funkci (+).
-- Možnost A: (+) :: a -> a -> a
--      --> problém: ne všechny typy jdou sečíst
-- Možnost B: (+) má dvě varianty:
--   (+) :: Double -> Double -> Double
--   (+) :: Int -> Int -> Int
--  ---> to je ošklivé a přijdeme o to, že každý výraz má právě jeden nejobecnější typ
-- => Řešení: Některé typy prohlásíme za _Num_erické
-- a řekneme, že typ (+) je Num a => a -> a -> a
-- kde 'Num a =>' znamená "typ 'a' musí být _numerický_".

-- Tohle je obecný mechanismus jak zařídit overloadování funkcí!

-- Typová třída 'MyEq'
-- POZOR: Nesouvisí s OOP třídami!
class MyEq a where
    -- Pokud nějaký typ 'a' splňuje 'MyEq', pak má funkci 'myeq'
    myeq :: a -> a -> Bool
    
-- >>> :t myeq
-- MyEq a => a -> a -> Bool

-- Zadefinujeme si vlastní barvičky
data MojeBarvy = Zelena | Cervena | Modra | ZaseCervena
    deriving (Show, Eq)

-- Vytvoříme instanci typové třídy 'MyEq' pro datový typ 'MojeBarvy'
instance MyEq MojeBarvy where
    myeq Zelena Zelena = True
    myeq Cervena Cervena = True
    myeq Modra Modra = True
    myeq ZaseCervena ZaseCervena = True

    -- červená == zase_červená
    myeq Cervena ZaseCervena = True
    myeq ZaseCervena Cervena = True

    myeq _ _ = False
    
-- Můžeme přidávat instance i pro již existující typy! :)
instance MyEq Int where
    myeq = (==)

-- Je pravdivá, pokud daný prvek je v daném seznamu.
-- Využívá 'myeq' pro testování rovnosti.
-- Tedy typ 'a' vkládaný do této funkce 
myElem :: MyEq a => a -> [a] -> Bool
myElem _ []     = False
myElem y (x:xs)
    | myeq y x = True
    | otherwise = myElem y xs

-- Zajímavý příkaz v GHCi:
-- :i MyEq ... vypíše popis třídy a její instance!

{-
Zajímavé jednoduché typové třídy,
které jsou ve std. knihovně.
Pro většinu typových tříd platí nějaká pravidla ("zákony"):

- Show a ... 'a' je hezky vypsatelné
         ... `show :: Show a => a -> String`
         ... žádné pravidlo

- Eq a ... 'a' je typ, který podporuje rovnost 
       ...`(==) :: Eq a => a -> a -> Bool`
       ...`(/=) :: Eq a => a -> a -> Bool`
       ... pravidlo: tato relace je ekvivalence 

- Ord a ... 'a' je porovnatelný
        ... `(<=) :: Ord a => a -> a -> Bool`
        ... pravidlo: částečné uspořádání

- Num a ... 'a' je numerický
        ... `(+) :: Num a => a -> a -> a`
        ... `(*) :: Num a => a -> a -> a`
        ... pravidlo: polookruh
--}

-- Naprogramujme si polookruh pro Z5 (sčítání/násobení modulo 5)
data Z5 = Z5 Integer
    deriving (Show, Eq, Ord)

instance Num Z5 where
    (Z5 a) + (Z5 b) = Z5 (a + b `mod` 5)
    (Z5 a) * (Z5 b) = Z5 (a * b `mod` 5)
    (Z5 a) - (Z5 b) = Z5 (a - b `mod` 5)
    abs (Z5 a) = Z5 a
    signum (Z5 0) = 0
    signum (Z5 _) = 1
    fromInteger x = Z5 (x `mod` 5)

-- Pomocná definice
produkt :: Num a => [a] -> a
produkt = foldr (*) 1

cislaVZ5 :: [Z5]
cislaVZ5 = [Z5 1, Z5 4, Z5 3]

-- >>> produkt cislaVZ5
-- Z5 2

-- Když Haskell vidí `1`, tak tam dosadí `(fromInteger 1)`
-- kde `fromInteger :: Num a => Integer -> a`
-- Mohli bychom tedy napsat:
cislaVZ5' :: [Z5]
cislaVZ5' = [1, 4, 3]

-- "Náš" seznam, který obsahuje hodnoty typu 'a'
data Seznam a = Nil | Cons a (Seznam a)

-- Seznamy a-ček podporují rovnost, _pokud_ a podporuje rovnost
instance Eq a => Eq (Seznam a) where
    (==) = eq

eq :: Eq a => Seznam a -> Seznam a -> Bool
Nil `eq` Nil = True
(Cons x xs) `eq` (Cons y ys) = (x == y) && (xs `eq` ys)
_ `eq` _ = False

-- Seznamy a-ček jdou vypsat, _pokud_ a jde vypsat.
instance Show a => Show (Seznam a) where
    show Nil = ""
    show (Cons x Nil) = show x
    show (Cons x xs) = show x ++ ", " ++ show xs

testSeznam :: Seznam Int
testSeznam = Cons 1 (Cons 2 (Cons 3 Nil))

-- >>> show testSeznam
-- "1, 2, 3"

-- Cvičení: Dodefinujte Ord instanci pro tento typ:
data Infinite a = MinusInf | Finite a | PlusInf
  deriving (Eq, Show) -- automaticky vygeneruje Show a Eq instance

-- Kostra:
instance Ord a => Ord (Infinite a) where
    compare _ _ = error "fixme"
    
-- compare :: Ord a => a -> a -> Ordering
-- kde
-- data Ordering = LT | EQ | GT