Skip to content

Instantly share code, notes, and snippets.

@jiribenes
Last active May 13, 2022 12:25
Show Gist options
  • Save jiribenes/52084fe5038645f53e930cb945e53803 to your computer and use it in GitHub Desktop.
Save jiribenes/52084fe5038645f53e930cb945e53803 to your computer and use it in GitHub Desktop.
Cvičení z Neprocedurálního programování - 13
{-# LANGUAGE InstanceSigs #-}
-- Motivace: Chceme si udělat vlastní generátor pseudonáhodných čísel (PRNG).
type Seed = Int
-- Tomuto kódu víceméně nemusíte rozumět:
-- Berte to tak, že vygeneruje náhodné číslo [0..max]
-- Potřebuje ale 'Seed' a potřebuje také vrátit nový 'Seed'
randInt :: Int -> Seed -> (Seed, Int)
randInt max seed = (newSeed, n)
where
newSeed = (1664525 * seed + 1013904223) `mod` (2 ^ 32)
n = newSeed `mod` max
-- Problém/neproblém: když to zavoláme vícekrát se stejným seedem, dostaneme stejnou hodnotu.
-- Tedy, ehm, to není problém, to je _korektní_ chování :D
-- Prostě si musíme ty seedy předávat dál, no
-- >>> randInt 100 1
-- (1015568748, 48)
-- -- ^ seed ^ náhodné číslo
-- A chceme další číslo, tak dosadíme "starý seed"
-- >>> randInt 100 1015568748
-- (1586005467, 67)
-- -- ^ seed ^ náhodné číslo
-- | Náhodná trojice čísel
randTriple :: Int -> Seed -> (Seed, (Int, Int, Int))
randTriple max seed = (seed3, (n1, n2, n3))
where
(seed1, n1) = randInt max seed
(seed2, n2) = randInt max seed1
(seed3, n3) = randInt max seed2
-- Tohle je vopruz.
-- Přece nechceme takhle manuálně propagovat seedy.
-- Obecně je to nějaký stavový výpočet!
-- Vezme to předchozí stav a vrátí dvojici,
-- ve které je nový stav a výsledná hodnota.
-- Software Engineering řešení: abstrahujme to!
-- | Typ pro stavový výpočet nad stavem 's':
newtype State s a = State { runState :: s -> (s, a) }
-- Tvrdím, že tohle je monáda a že můžeme použít monády
-- a do notaci k tomu, abychom si masivně ušetřili práci.
instance Functor (State s) where
fmap f (State m) = State $ \s -> -- vezmeme 's :: s' a
let (s', a) = m s -- spustíme stavový výpočet 'm :: s -> (s, a)' na 's :: s', čímž dostaneme 'a :: a' a nový stav 's' :: s'
in (s', f a) -- a vrátíme stav s' a (f a)
instance Monad (State s) where
-- return je jednoduchý, vytvoříme "dummy" výpočet, který jen vrátí 'x' :)
return :: a -> State s a
return x = State $ \s -> (s, x)
(>>=) :: State s a -> (a -> State s b) -> State s b
State m >>= f = State $ \s ->
let (s', a) = m s -- spustíme stavový výpočet 'm :: s -> (s, a)' na 's :: s', čímž dostaneme 'a :: a' a nový stav 's' :: s'
in runState (f a) s' -- potom spustíme stav daný 'f a' na ten nový stav
-- Tato instance dává o trochu více smysl, když si namalujete jak se mají předávat stavy.
-- Je jednoznačně určená, protože chcete stavy posílat "dopředu",
-- tak jak to slušné programy dělají
-- | Pomocná funkce 'get' vrátí aktuální stav
get :: State s s
get = State $ \s -> (s, s)
-- | Pomocná funkce 'set' _nastaví_ aktuální stav
set :: a -> State a ()
set a = State $ \_ -> (a, ())
-- | Konečně, 'randInt' jako stavový výpočet:
randIntS :: Int -> State Seed Int
randIntS max = do
seed <- get
let (newSeed, k) = randInt max seed
set newSeed
return k
-- No uznejte, nevypadá to jako procedurální jazyk?
-- Zakázali nám proměnné, tak jsme si je vytvořili sami :)
-- >>> runState (randIntS 100) 1
-- (1015568748,48)
-- >>> runState (randIntS 100 >>= \_ -> randIntS 100) 1
-- (1586005467,67)
-- Příklady jsou stejné jako výše, takže jde poznat, že jsme to udělali stejně dobře jako manuálně :)
-- | Náhodná trojice čísel pomocí stavového výpočtu:
randTripleS :: Int -> State Seed (Int, Int, Int)
randTripleS max = do
n1 <- randIntS max
n2 <- randIntS max
n3 <- randIntS max
return (n1, n2, n3)
-- Tohle vypadá fakt hodně jako C++ :D
-- Technická poznámka:
--
-- Tady se přiznám, že jsem pro zjednodušení trochu lhal.
-- Technicky vzato je mezistupeň mezi Functor a Monad, kterému se říká
-- Applicative (česky "aplikativní funktor").
-- Každá monáda je aplikativní funktor, ale Haskell to neví.
--
-- Používáme tedy dummy implementaci níže, která se dá použít vždycky,
-- když už máme 'Monad' instanci :)
instance Applicative (State s) where
pure = return
mf <*> ma = do
f <- mf
a <- ma
return (f a)
{-# LANGUAGE InstanceSigs #-} -- Jako na minulém cvičení chceme typové anotace u instancí typových tříd
-- Opakování: stavové výpočty
newtype State s a = State { runState :: s -> (s, a) }
-- Připomínám: runState :: State s a -> s -> (s, a)
-- Jako na minulém cvičení:
instance Functor (State s) where
-- fmap :: (a -> b) -> (s -> (s, a)) -> s -> (s, b)
fmap :: (a -> b) -> State s a -> State s b
fmap f stavovyVypocet = State $ \s -> -- Nový stavový výpočet bere stav
let (s', a) = runState stavovyVypocet s -- spustí starý výpočet, čímž dostane nový stav a ačko
in (s', f a) -- a vrátí nový stav a 'f a :: b'
instance Monad (State s) where
return :: a -> State s a
return a = State $ \s -> (s, a)
(>>=) :: State s a -> (a -> State s b) -> State s b
stavovyVypocet >>= f = State $ \s ->
let (s', a) = runState stavovyVypocet s -- spustíme starý výpočet, dostaneme nový stav a ačko
stavovyVypocet' = f a -- aplikací f na a dostaneme nový stavový výpočet
in runState stavovyVypocet' s' -- který spustíme aplikací na nový stav
-- | Vrátí aktuální stav
get :: State s s
get = State $ \s -> (s, s)
-- | Nastaví nový stav
set :: s -> State s ()
set s = State $ \_ -> (s, ())
-- | Příklad: přičte jedničku ke stavu
--
-- Konkrétněji je to jako `state++` v C++ (tedy postinkrementace)
increment :: State Int Int
increment = do
i <- get
set (i + 1)
return i
-- Alternativně:
-- increment = State $ \s -> (s + 1, s)
-- | Typ pro binární strom jako z domácího úkolu
data Strom a = Konec | Vetev (Strom a) a (Strom a)
deriving (Eq, Show)
-- | Chceme funkci, která do každého vnitřního vrcholu stromu
-- vloží i číslo, které odpovídá inorder průchodu.
--
-- Tohle se hodí modelovat jako stavový výpočet,
-- abychom si nemuseli stav protahovat programem ručně.
label :: Strom a -> Strom (a, Int)
label strom = snd $ runState (labelStatefully strom) initialState
where
initialState :: Int
initialState = 1
labelStatefully :: Strom a -> State Int (Strom (a, Int))
labelStatefully Konec = return Konec
labelStatefully (Vetev l x r) = do
l' <- labelStatefully l -- rekurze do levého podstromu
inorder <- increment -- vrátí aktuální stav a zvýší jej o 1
r' <- labelStatefully r -- rekurze do pravého podstromu
let x' = (x, inorder)
return (Vetev l' x' r')
-- Poznámka: Všimněte si, že pouhým prohozením řádek dostanete preorder a postorder průchod!
{- Pro testování:
testovaciStrom:
'd'
/ \
'c' 'e'
/ \
'a' 'b'
-}
testovaciStrom :: Strom Char
testovaciStrom = Vetev (Vetev (Vetev Konec 'a' Konec) 'b' (Vetev Konec 'c' Konec))
'd'
(Vetev Konec 'e' Konec)
{-
>>> label testovaciStrom
Vetev (Vetev (Vetev Konec ('a', 1) Konec) ('b', 2) (Vetev Konec ('c', 3) Konec))
('d', 4)
(Vetev Konec ('e', 5) Konec)
-}
-- Opět schovávám instanci Applicative,
-- třídy, která je mezi Functor a Monad.
-- Více viz předchozí soubor :)
instance Applicative (State s) where
pure = return
mf <*> mx = do
f <- mf
x <- mx
return $ f x
module Main where
import System.IO
-- IO je příklad běžně používané monády
-- Výpočet v IO má neomezené vedlejší efekty (může libovolně interreagovat se systémem)
--
-- Kdybychom mohli předávat celý svět jako stav, pak:
-- IO a == RealWorld -> (RealWorld, a)
-- Samozřejmě, reálná implementace IO je složitější a daná implementací.
{-
Dvě základní funkce pro práci se vstupem:
>>> :t getLine
getLine :: IO String
>>> :t putStrLn
putStrLn :: String -> IO ()
-}
-- | Funkce, která se zeptá na jméno uživatele a pozdraví jej
pozdrav :: IO ()
pozdrav = do
putStrLn "Ahoj, jak se jmenuješ?"
jmeno <- getLine
let pozdrav = "Ahoj, " <> jmeno <> "!"
putStrLn pozdrav
-- | Funkce 'main' je entrypoint do Haskellového programu
--
-- Pokud máte něco typu 'IO a', pak to nutně musí "probublat" až do mainu.
main :: IO ()
main = do
pozdrav
{-
Spouštění Haskellového programu v terminálu:
~> ghc <názevsouboru>.hs -o mujprogram
~> ./mujprogram
Ahoj, jak se jmenuješ?
> Jirka
Ahoj, Jirka!
-}
{-
Dávejte si pozor na následující: String není to samé jako IO String,
podobně jako recept na dort není to samé jako dort.
IO String je akce s vedlejšími efekty, která když se povede, tak vrátí String.
Podobně recept na dort je jen popis akce, která musí být provedena,
aby byl vytvořen dort.
Jinými slovy: funkce typu 'IO a -> a' nedává smysl
a nemůže existovat její bezpečná varianta!
-}
-- | Vrátí tři řádky vstupu
getThreeLines :: IO [String]
getThreeLines = do
l1 <- getLine
l2 <- getLine
l3 <- getLine
return [l1, l2, l3]
{-
Obecná návrhová věc:
V IO by měl být jen ten kód, který tam být _musí_.
Návrh programu by tedy měl mít imperativní skořápku s IO,
ale funkcionální jádro bez IO.
Příklad:
-- | Načte vstup
readData :: IO Input
readData = ...
-- | Vezme vstup a vrátí výstup.
-- Obecně je tohle nějaká "business logic"
--
-- Nepotřebuje IO!
process :: Input -> Output
process = ...
-- | Velká funkce (skořápka), která načte vstup,
-- předá je `process` a vrátí výstup.
--
-- Typicky je tohle někde poblíž, či rovnou v 'main'u.
readAndProcess :: IO Output
readAndProcess = do
data <- readData
let data' = process data
return data'
-}
-- Následující funkce se hodí pro každou monádu
-- a obzvlášť se hodí v 'do'-notaci
-- | Pokud platí podmínka, proveď akci, jinak nedělej nic.
when :: Monad m => Bool -> m () -> m ()
when cond action = if cond then action else return ()
{-
Typické použití:
```
when (userId `notIn` database) $ do
throwError "Stala se chyba"
redirect
...
```
-}
-- | Pokud _neplatí_ podmínka, proveď akci, jinak nedělej nic.
unless :: Monad m => Bool -> m () -> m ()
unless = when . not
-- | Příklad skoro rozumné IO akce.
--
-- Načte řádek a vypíše jej.
-- Pokud řádek není prázdný, zavolá se znovu.
-- To má podobný efekt jako 'while True:' loop
echo :: IO ()
echo = do
l <- getLine
putStrLn l
unless (null l) echo
-- | Obecná abstrakce pro 'while True: ...'
forever :: Monad m => m () -> m ()
forever m = do
m
forever m
{-
Užitečné funkce pro práci s monádami:
'mapM' je jako 'map', ale zároveň skládá vedlejší efekty:
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
'sequence' vezme seznam akcí a vrátí akci seznamu:
sequence :: Monad m => [m a] -> m [a]
Poznámka:
Funkce s 'M' jsou typicky nějaká varianta klasické funkce pro monády.
Například 'mapM', či 'foldM'.
Funkce s '_' na konci jsou takové, které jen provedou vedlejší efekty
a samotnou hodnotu zahodí.
Příklad funkcí s '_' jsou 'mapM_' a 'sequence_':
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
sequence_ :: Monad m => [m a] -> m ()
-}
-- | 'getThreeLines' výše za pomocí 'sequence' :)
getThreeLines' :: IO [String]
getThreeLines' = sequence [getLine, getLine, getLine]
{- Práce se soubory:
Soubory jdou otevřít v různých módech:
data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
Soubory jdou otevřít a zavřít:
openFile :: FilePath -> IOMode -> IO Handle
hClose :: Handle -> IO ()
Do souborů jde psát a jde z nich i číst:
hPutStrLn :: Handle -> String -> IO ()
hGetLine :: Handle -> IO String
-}
-- | Příklad: Vezme string na vstupu a připíše jej do logu
logLine :: String -> IO ()
logLine myLine = do
h <- openFile "myprogram.log" WriteMode
hPutStrLn h myLine
hClose h
-- Užitečný kombinátor:
-- withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
-- se chová jako 'with' konstrukce v Pythonu.
-- S ní nezapomenete na to zavřít soubor :)
-- | Homemade verze 'withFile':
withFile' :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile' path iomode action = do
h <- openFile path iomode
result <- action h
hClose h
return result
-- | 'logLine', ale pomocí 'withFile'
logLine' :: String -> IO ()
logLine' myLine = do
withFile "myprogram.log" WriteMode $ \h -> do
hPutStrLn h myLine
-- Povídali jsme si o Parseru, ale nestihli jsme ho.
-- Místo toho si monadický parser vyrobíte v posledním úkolu :)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment