Skip to content

Instantly share code, notes, and snippets.

@jiribenes
Created May 6, 2022 22:38
Show Gist options
  • Save jiribenes/09343d02ca5cee6551c5dc8e49bc2e74 to your computer and use it in GitHub Desktop.
Save jiribenes/09343d02ca5cee6551c5dc8e49bc2e74 to your computer and use it in GitHub Desktop.
Cvičení z Neprocedurálního programování - 12
-- 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é!
{-
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)"
-- 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)
{-# 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)
{-# 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
{-# 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!
-- | 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!
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment