Skip to content

Instantly share code, notes, and snippets.

@jiribenes
Last active May 15, 2021 19:13
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jiribenes/a9bf77053c2a5a615beb4fa282aa687b to your computer and use it in GitHub Desktop.
Save jiribenes/a9bf77053c2a5a615beb4fa282aa687b to your computer and use it in GitHub Desktop.
Cvičení z Neprocedurálního programování - 10
-- 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)
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!"
-- 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
-- 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..? :)
-- 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment