# FLP -- Haskell
## 2024/25
### 1. Riadny termín
1. Definujte datovú štruktúru pre Lambda výraz. Musí umožniť Eq a Show. (4b)
```haskell
data LC a
= Var a
| App (LC a) (LC a)
| Abs a (LC a)
deriving (Show, Eq)
```
2. Definujte funkcie `union` a `symd`. `union` vráti zjednotenie množín. `symd` symetrický rozdiel množín. Množina je reprezentovaná zoznamom. (9b)
```haskell
union [] ys = ys
union (x:xs) ys =
if elem x ys then union xs ys
else x : union xs ys
symd xs ys =
union (df xs ys) (df ys xs)
df [] _ = []
df (x:xs) ys =
if elem x xs then df xs ys
else x : df xs ys
```
3. Vytvorte funkciu `fv`, ktorá nájde voľné premenné v lambda výraze. (5b)
```haskell
fv le = f [] le
where
f b (Var a) = if elem a b then [] else [a]
f b (App e1 e2) = union (f b e1) (f b e2)
f b (Abs a e) = f (a:b) e
```
4. Definujte IO akciu `wr`, ktorá bude mať nasledujúce parametre: zoznam dvojíc (key, lambda výraz), názov vstupného súboru, názov výstupného súboru. Vstupný súbor bude na každom riadku obsahovať čísla v textovej podobe zoradené ľubovoľne. Procedúra do výstupného súboru zapíše na každý riadok lambda výraz podľa jeho čísla (tak aby bolo poradie určené vstupným súborom). Môžeme predpokladať, že pre každé číslo vstupného súboru existuje dvojica s daným kľučom a vstupný súbor má vždy správny tvar. (12b)
```haskell
wr as from to = do
hi <- openFile from ReadMode
ho <- openFile to WriteMode
c <- hGetContents hi
proc as ho (lines c)
hClose ho
hClose hi
proc _ _ [] = return ()
proc as ho (l:ls) =
hPutStrLn ho (show e) >> proc as ho ls
where
nl = (read l) :: Int
(_,e) = head $ filter (\(v,_)-> v == nl) as
```
## 2023/2024
### 1. opravný termín
(prva uloha lambda kalkul za 6b, druha uloha dokaz za 12b)
3. /12b/ V jazyku Haskell, nadefinujte IO akci `fx`, která pro zadané jméno souboru načte jeho obsah a slova rozdělí do skupin podle počtu písmen v nich (nezáleží na pořadí slov). Pak tyto skupiny vypíše na standardní výstup s tím, že před každou skupinu uvede počet písmen v ní do hranatých závorek -- pokud bude mezi najkratšími a nejdelšími slovy nějaká skupina prázdná, tak jen vypíše počet písmen a za ní nic, počítejte klidně od 1, i když bude skupina prázdná, pokud vám to lépe vyhoví. Viz ukázku. Skupiny vypíše od nejkratší po nejdelší. Použijte běžný Haskell spolu s Prelude plus:
```haskell
data IOMode = ReadMode | WriteMode | AppendMode
getChar :: IO Char
putChar :: Char -> IO ()
putStr :: String -> IO ()
lines :: String -> [String]
hPutStr :: Handle -> String -> IO ()
mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
type FilePath = String
openFile :: FilePath -> IOMode -> IO Handle
hClose :: Handle -> IO ()
unlines :: [String] -> String
hGetContents :: Handle -> IO String
```
```haskell
ins :: (Eq t1, Num t1, Enum t1) => t2 -> t1 -> [[t2]] -> [[t2]]
ins word n []
| n==0 = [[word]]
| n==1 = [[],[word]]
| True = map (\_ -> []) [1..(n-1)] ++ [[word]]
ins word n (x:xs)
| n==0 = (word:x):xs
| True = x : ins word (n-1) xs
proc :: Foldable t => [[t a]] -> [t a] -> [[t a]]
proc lst [] = lst
proc lst (w:ws) = proc (ins w (length w) lst) ws
numl :: (Show t, Num t) => t -> [String] -> [String]
numl _ [] = []
numl n (l:ls) = ('[':show n++"] "++l) : numl (n+1) ls
fx :: String -> IO ()
fx fname = do
h <- openFile fname ReadMode
c <- hGetContents h
let res = tail $ proc [[]] $ words c
mapM_ putStrLn $ numl 1 $ map unwords res
hClose h
```
### Řádný termín
2. Definujte funkciu `ins :: Ord a => a -> [(a, Integer)] -> [(a, Integer)]`, ktorá v danom zozname dvojíc (hodnota, počítadlo) inkrementuje počítadlo na danej pozícii. Možno predpokladať, že sekvencia áčok `a_0 < a_1 < a_2 < ... < a_n` je zoradená, a pre našu danú pozíciu `a` platí: `a_i <= a < a_(i+1)`
```haskell
ins :: Ord a => a -> [(a,Integer)] -> [(a,Integer)]
ins val [(l,ctr)] = [(l,ctr+1)]
ins val ((l,cl):rx@((h,ch):_))
| val>=l && val<h = (l,cl+1):rx
| True = (l,cl) : ins val rx
```
3. Definujte funkciu `procL :: [String] -> ([Double], Double, Double)]`, ktorá vezme zoznam reťazcov (každý reťazec = 1 číslo) reprezentujúcich nejaké čísla a vytvorí trojicu kde prvý prvok je zoznam čísel, druhý je minimum a tretí je maximum, pre výpočet nepoužívajte rekurziu (neviem, čo tým myslel?), možno používať: `read, foldl, foldr, Ord`.
```haskell
procL :: [String] -> ([Double],Double,Double)
procL (l:ls) = foldr fn ([val],val,val) ls
where
val = (read l) :: Double
fn ln (cont,mi,ma) = (v:cont,min v mi,max v ma)
where
v = (read ln) :: Double
```
4. Definujte funkciu `prH :: String -> Int -> IO ()`, ktorá vezme názov súboru (každý riadok = 1 reťazec reprezentujúci double) a číslo reprezentujúce počet stĺpcov histogramu a vytvorí podľa minima a maxima histogram s rovnomerným rozdelením hraníc. Ako príklad bol uvedený vstup (not sure) `1.0,1.1.1.2, ..., 10.0` a `4`-> výstup bude `[(1.0, 23), (3.25, 22), (5.5, 22), (7.75, 22)]`
```haskell
prH :: String -> Int -> IO ()
prH fname wi = do
h <- openFile fname ReadMode
c <- hGetContents h
let (cont,mi,ma) = procL $ lines c
let dif = (ma-mi) / (fromIntegral wi)
let empty = map (\k -> (k*dif+mi,0)) [0 .. (fromIntegral wi-1)]
let hist = foldr ins empty cont
putStrLn $ show hist
hClose h
```
(pozn. 1. bol dôkaz, 5. bol bonus na lambda kalkul)
## 2022/2023
### Předtermín
Zadefinujte datovy typ pro vyrazy s celymi cisly, jejich scitanim a nasobenim (2b)
Nadefinujte akci `pp` (pretty-print) prijimajici argument odpovidajici typu z ulohy 3, co na standardni vystup vypise vyraz uzavorkovany tak, aby vyznam zustal zachovan (nesmi ale byt zadne zavorky navic). Mohli jsme pouzit Prelude a navic `putChar`, `putStr`. Na pomocnem papire bylo asi 5 prikladu uzavorkovani, neco jako: (13b)
```https://hackmd.io/JB5CYyAZRoS55_WFMbdUkQ?both#
+
/ \
* 3 -> 1*2+3
/ \
1 2
*
/ \
+ 3 -> (1+2)*3
/ \
1 2
*
/ \
+ + -> (1+2)*(3+4)
/ \ / \
1 2 3 4
+
/ \
+ + -> 1+2+3+4
/ \ / \
1 2 3 4
```
```haskell
data Expr = Val Int | Add Expr Expr | Mul Expr Expr -- 3
pp' :: Expr -> String
pp' (Val val) = show val
pp' (Add e1 e2) = pp' e1 ++ "+" ++ pp' e2
pp' (Mul a1@(Add _ _) a2@(Add _ _)) = "(" ++ pp' a1 ++ ")*(" ++ pp' a2 ++ ")"
pp' (Mul a1@(Add _ _) v) = "(" ++ pp' a1 ++ ")*" ++ pp' v
pp' (Mul v a2@(Add _ _)) = pp' v ++ "*(" ++ pp' a2 ++ ")"
pp' (Mul e1 e2) = pp' e1 ++ "*" ++ pp' e2
pp :: Expr -> IO ()
pp expr = putStr (pp' expr)
```
Premie: Nadefinovat typ pro double linked list (2b). Napsat funkci `l2dll`, co vezme bezny haskellovsky seznam a udela z nej ten nas DLL (8b).
```haskell
data DLL a = Node a (DLL a) (DLL a) | Empty
-- not needed for the task, but printing the structure will endlessly recurse
instance Show a => Show (DLL a) where
show :: Show a => DLL a -> String
show Empty = "Empty"
show (Node v Empty next) = "DLL [ " ++ show v ++ ", " ++ show next
show (Node v _ Empty) = show v ++ " ]"
show (Node v _ next) = show v ++ ", " ++ show next
-- see: "tying the knot"
l2dll :: [a] -> DLL a
-- l2dll list = helper Emtpy list => list was omitted thru eta reduction
l2dll = helper Empty where
helper :: DLL a -> [a] -> DLL a
helper prev [] = Empty
helper prev (a:as) = head where
head = Node a prev tail
tail = helper head as
```
## 2021/2022
### Predtermin
<!--  -->
Funkce `mid`, která pro vstupní seřaditelný seznam vrací takovou hodnotu, která seznam rozdělí na dvě části, kde jedna obsahuje pouze menší prvky, druhá pouze větší prvky a jejichž délka se liší nanejvýš o 1.
Nebylo ale v zadání zmíněno, zda musí být prvky v seznamu unikátní. Pokud by nebyly, imo nebude řešení existovat.
K dispozici afaik holý Haskell.
```haskell
-- ak holy haskell definuj aj head, init, tail
head []= errorEmptyList "head"
head (x:_) = x
tail [] = errorEmptyList "tail"
tail (_:xs) = xs
init :: [Int] -> [Int]
init [] = errorEmptyList "init"
init [x] = []
init (x:xs) = x : init xs
quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) = smaller ++ [x] ++ bigger
where
smaller = quicksort [a | a <- xs, a <= x]
bigger = quicksort [a | a <- xs, a > x]
-- najde median
mida:: [a] -> a
mida l@(_:_:_:_) = mida $ tail $ init l
mida l = head l
mid l = mida $ quicksort l
```
alebo
```haskell
mid :: Ord a => [a] -> a
mid [] = undefined
mid [x] = x
mid [x,y] = x
mid xs = mid (myInit $ myTail $ quick xs)
```
Haskell io
Načíst soubor a vypsat jej, přičemž každý řádek je trimmed o whitespaces (funkce trim k dispozici) a před každým řádkem je jeho počet znaků po trimu.
Např.: " Hello " -> "5:Hello"
Za takto upraveným vypsaným souborem přidat
(Počet řádků celkem) ++ "/" ++ (počet po trimu prázdných řádků)
Např.: "1/0"
K dispozici klasické IO funkce, Prelude (unlines/lines, ...), byly k nim i signatury.
```haskell
trim :: String -> String
trim str =
let dropLastSpace [] = []
dropLastSpace s = if last s == ' ' then dropLastSpace $ init s else s
in dropLastSpace $ dropWhile (\x -> x == ' ') str
length' :: [a] -> Integer
length' [] = 0
length' (_ : xs) = 1 + length' xs
map' :: (a -> b) -> [a] -> [b]
map' _ [] = []
map' f (x : xs) = f x : map' f xs
trim :: String -> String
trim l = f (f l)
where
f = reverse . dropWhile isSpace
processLine :: String -> String
processLine line = show (length' trimmed) ++ ":" ++ trimmed
where
trimmed = trim line
emptyLines :: [String] -> Integer
emptyLines [] = 0
emptyLines ((count : _) : xs)
| count == '0' = emptyLines xs + 1
| otherwise = emptyLines xs
lenls :: FilePath -> IO ()
lenls path = do
handle <- openFile path ReadMode
content <- hGetContents handle
let l = map' processLine (lines content)
let emptyLinesCount = emptyLines l
putStr (unlines l ++ show (length' l) ++ "/" ++ show emptyLinesCount)
```
### Riadny
1. Definuj štruktrúru zásobníka pre riešenie v konštantnom čase (tj. bez rekurzie)
- `empty` - inicializuje prázdny zásobnik
- `top` - vráti vrchol zásobnika
- `push` - pridá položku na vrchol zásobnika
- `pop` - odstráni vrch zásobníka
- `len` - vráti počet položiek v zásobníku
```haskell
data PD a = PD Int [a] deriving (Show,Eq)
empty :: PD a
empty = PD 0 []
top :: PD a -> a
top (PD _ (x:_)) = x
push :: PD a -> a -> PD a
push (PD s l) v = PD (s+1) (v:l)
pop :: PD a -> (a, PD a)
pop (PD s (x:xs)) = (x,PD (s-1) xs)
len :: PD a -> Int
len (PD s _) = s
```
2. definovať funkcie
- pushStr, ktorá vloží reťazec na zásobník
- popStr, ktorá popne reťazec zo zásobníka ak sa zhoduje
```haskell
pushStr pda str =
foldr (\x pda -> push pda x) pda str
--
popStr pda str
| lstr > len pda = Nothing
| not res = Nothing
| True = Just newPda
where
lstr = length str
(res,newPda) = checkPop pda str
checkPop pda [] = (True,pda)
checkPop pda (s:ss) = let
(v,pdaN) = pop pda
in if v==s then checkPop pdaN ss else (False,pda)
```
alternatívna implementácia
```haskell
-- 1.
data Stack a = Stack [a] Int
empty :: Stack a
empty = Stack [] 0
top :: Stack a -> a
top (Stack [] _) = error "empty stack"
top (Stack (x : _) _) = x
push :: Stack a -> a -> Stack a
push (Stack s i) x = Stack (x : s) (i + 1)
pop :: Stack a -> (a, Stack a)
pop (Stack [] _) = error "empty stack"
pop (Stack (x : s) i) = (x, Stack s (i - 1))
len :: Stack a -> Int
len (Stack _ i) = i
-- 2.
pushStr :: Stack a -> [a] -> Stack a
pushStr = foldr (\x s -> push s x)
popStr :: (Eq a) => Stack a -> [a] -> Maybe (Stack a)
popStr stack xs = if len stack < length xs then Nothing else popStr' stack xs
where
popStr' stack [] = Just stack
popStr' stack (x : xs) = let (y, newStack) = pop stack in if x == y then popStr' newStack xs else Nothing
```
3. definovať dátovú štruktúru pre reprezentáciu pravidiel deterministického konečného automatu
(pravdepodobne preklep v zadani, mozno sa myslel (rozsireny) zasobnikovy automat)
```haskell!
-- pravidlo pre RZA: Q x (Sigma U {eps}) x Gamma* -> 2^(Q x Gamma*)
-- nesedi to uplne presne s definiciou
-- asi to bude nejaka zvlastna verzia deterministickeho rozsireneho ZA
data Rule a = R a [a] [a] Int Int deriving (Show,Eq)
-- ak by sa jednalo o DKA prechod a automat, tak:
data RuleDFA = RuleDFA Int Char Int
data DFA = DFA [Int] [Char] [RuleDFA] Int [Int]
-- ak by sa jednalo o NKA prechod a automat, tak:
data RuleNFA = RuleNFA Int Char [Int]
data NFA = NFA [Int] [Char] [RuleNFA] Int [Int]
-- ak by sa jednalo o ZA prechod a automat, tak:
-- delta: Q x (Sigma U {eps}) x Gamma -> 2^(Q x Gamma*)
data RulePA = RulePA Int (Maybe Char) Char [(Int, [Char])]
-- P = (Q, Sigma, Gamma, delta, q0, z0, F)
data PA = PA [Int] [Char] [Char] [RulePA] Int Char [Int]
```
4. IO úloha - spracovat súbor do vnútornej reprezentacie pravidiel (štruktúry z predchádzajúcej úlohy)
```haskell
-- read_symbol:pop_string:push_string:from_state:next_state
-- read symbol je 1 char
-- pop_string, push_string sú reťazce, môžu byť prázdne
-- from_state, next_state - 1 číslo
-- oddelené vždy dvojbodkou
a:ab:ab:1:2
b:::2:3
```
```haskell
readRules fname = do
h <- openFile fname ReadMode
c <- hGetContents h
let lns = lines c
let rules = loadLines lns
(\r ->
(return $! length r) >>= (\_ -> hClose h >> return r)
) $! rules
loadLines [] = []
loadLines (l:ls) = R c popS puS ((read fromS)::Int) ((read l4)::Int) : loadLines ls
where
(c:':':l1) = l
(popS,(_:l2)) = span (/=':') l1
(puS,(_:l3)) = span (/=':') l2
(fromS,(_:l4)) = span (/=':') l3
```
Bonus: isRuleApplicable - najst pravidlo ktore je aplikovatelné pre determinitický konecný automat + napísať štruktúru
```haskell
-- netusime, ci to nejak suvisi s 3. ulohou alebo nie
-- pozn: pre fungovanie DFA prve dva prkvy (stavy, symboly) vobec nemusia byt
-- stav, symbol, dalsi stav
data Rule = Rule Int Char Int
-- stavy, symboly, pravidla, pociatocny stav, koncove stavy
-- z funkcneho hladiska su pre dany priklad stavy a symboly zbytocne,
-- ale nechavame ich tu aby to sedelo s TIN definiciou
data DFA = DFA [Int] [Char] [Rule] Int [Int]
acceptDFA :: DFA -> [Char] -> Bool
acceptDFA (DFA q s d i f) tape = simulateDFA (DFA q s d i f) i tape
simulateDFA :: DFA -> Int -> [Char] -> Bool
simulateDFA (DFA q s d i f) current [] = current `elem` f
simulateDFA (DFA q s d i f) current (t:tape) =
case isRuleApplicable (DFA q s d i f) current t of
Nothing -> False
Just (Rule st sym next) -> simulateDFA (DFA q s d i f) next tape
isRuleApplicable :: DFA -> Int -> Char -> Maybe Rule
isRuleApplicable (DFA q s d i f) state symbol =
case findRule d state symbol of
Nothing -> Nothing
Just a -> Just a
where
findRule :: [Rule] -> Int -> Char -> Maybe Rule
findRule [] _ _ = Nothing
findRule ((Rule st sym res):rules) q a
| st == q && sym == a = Just (Rule st sym res)
| otherwise = findRule rules q a
-- pre vyskusanie v ghci
-- ghci> test = DFA [1,2,3] ['a','b'] [RuleDFA 1 'a' 2, RuleDFA 1 'b' 3, RuleDFA 2 'a' 2, RuleDFA 2 'b' 3, RuleDFA 3 'b' 3] 1 [3]
-- ghci> acceptDFA test "aabb"
-- ghci> acceptDFA test ""
```
### 1. opravný
Implementovať IO funkciu, ktorá spojí nasledujúce riadky ak ich dĺžka dokopy je menej, rovná 120. Tieto riadky očísluje na zaciatku, prida dvojbodku a pridá obsah spojených riadkov. Spojené riadky zapíse do súboru fileinput s koncovkou .out
```haskell
fx fname = do
h <- openFile fname ReadMode
o <- openFile (fname ++ ".out") WriteMode
c <- hGetContents h
hPutStr o $ unlines $ wrap 1 $ lines c
hClose o
hClose h
wrap n (a:b:ls)
| (length a + length b) <= 120 = wrap n ((a++b):ls)
| True = (show n ++ ":" ++ a) : wrap (n+1) (b:ls)
wrap n [l] = [show n ++ ":" ++ l]
wrap _ [] = []
```
<!-- ### 2. opravný -->
## 2020/2021
### Riadny
- zadefinovať datovy typ pre aritmeticke operacie +/-
```haskell
data Expr
= Val Integer
| Add Expr Expr
| Sub Expr Expr
deriving (Show,Eq)
```
- spraviť funkciu eval pre vyhodnocovanie arit. operacii + a -
```haskell
eval :: Expr -> Integer
eval (Val v) = v
eval (Add e1 e2) = eval e1 + eval e2
eval (Sub e1 e2) = eval e1 - eval e2
```
- funkcia load, načítať zo subora v tvare prefix operacii do datoveho typu
napr. `+ 4 2` ~~alebo to bolo možno so zatvorkami `+(4 2)`~~ (malo by to byť jedno v podstate)
```haskell
load :: FilePath -> IO Expr
load f = do
h <- openFile f ReadMode
c <- hGetContents h
--
let (res,_) = parse c
--
(\ ret -> hClose h >> return ret) $! res
parse :: String -> (Expr,String)
parse ('+':_:xs) = (Add l r, cont)
where
(l,rest) = parse xs
(r,cont) = parse rest
parse ('-':_:xs) = (Sub l r, cont)
where
(l,rest) = parse xs
(r,cont) = parse rest
parse is = (Val ((read val) :: Integer), st rest)
where
(val, rest) = span (\x -> elem x ['0'..'9']) is
st [] = []
st (_:t) = t
```
### 1. opravný
1. LE datova struktura
[iné riesenie - 19/20 1. op](https://hackmd.io/JB5CYyAZRoS55_WFMbdUkQ?both#1-opravn%C3%BD-term%C3%ADn)
```haskell
data LE a
= App (LE a) (LE a)
| Abs a (LE a)
| Var a
deriving (Show,Eq)
```
Konkrétny priklad
`\x.xy` = `Abs (x) (App (Var x) (Var y))`
`\xy.x(xy) = (\x.(\y.x(xy)))` = `Abs (x) (Abs (y) (App (Var x) (App (Var x) (Var y))))`
3. union, intersection, delete
```haskell
delete _ [] = []
delete x (y:ys) =
if x == y then ys else y : delete x ys
-- alebo
delete d ys = [ x | x <- ys, x /= d ]
union [] ys = ys
union (x:xs) ys =
if elem x ys then union xs ys else x : union xs ys
-- pomocou generatoru
intrsect xs ys = [ z | z <- xs, z `elem` ys]
-- alebo
intrsect [] _ = []
intrsect (x:xs) ys =
if elem x ys then x: intrsect xs ys else intrsect xs ys
```
4. fv - Vytvorenie zoznamu voľných premenných v lambda výraze
[riesenie](https://hackmd.io/JB5CYyAZRoS55_WFMbdUkQ?both#1-opravn%C3%BD-term%C3%ADn)
```haskell
fv (Var v) = [v]
fv (App e1 e2) = union (fv e1) (fv e2)
fv (Abs x e) = delete x (fv e)
```
5. `isApp E X F` - ci je beta redukcia `F` za `X` aplikovatelna vo vyraze `E`, tak True
```haskell
isApp (App (Abs x e) sub) = isValid e x sub
isApp _ = False
```
6. isValid
[riesenie](https://hackmd.io/JB5CYyAZRoS55_WFMbdUkQ?both#1-opravn%C3%BD-term%C3%ADn)
alebo
```haskell
-- vid validne beta-redukcie
-- vv = "vazany vyskyt" = kontroluje ci dana premenna nie je vo vyraze viazana
-- wh = v akom lambda-vyraze chceme spravit beta-redukciu
-- new = aky vyraz chceme aplikovat ("dosadit" za x v \x.whatever)
-- pozn: vyraz ktory aplikujeme byt len 1 premenna
-- mozeme dosadzovat aj napr. (\x.xy)(abcd) => new = abcd
-- ten zoznam na konci bude obsahovat viazane vyskyty premennych
isValid wh var new = vv wh [] -- na zaciatku nemame viazane vyskyty vo vyraze
where
fvn = fv new -- najdi vsetky premenne vo vyraze ktory aplikujeme
vv (Var v) bnd
-- premenna je viazana, nic extra sa nedeje
| elem v bnd = True
-- ak sa premenna zhoduje s tou v povodnej abstrakcii,
-- tak sa musime uistit, ze vyraz ktory aplikujeme
-- a momentalne viazane premenne nic nezdielaju
| v==var = intrsect bnd fvn == []
| True = True
vv (App e1 e2) bnd = vv e1 bnd && vv e2 bnd
-- ak narazime na abstrakciu, tak musime tu premennu pridat k viazanym
vv (Abs x e) bnd = vv e (if elem x bnd then bnd else x:bnd)
```
7. print suboru s tym ze sa na zaciatku pridaju cisla zarovnane vpravo
napr.:
```
bla
blaa
bla
bla bla
blaa
blaaaa
bla bla bla
bla
balalaa
banana
banana bla
```
výstup:
```
1 bla
2 blaa
3 bla
4
5 bla bla
6 blaa
7 blaaaa
8 bla bla bla
9 bla
10 balalaa
11 banana
12 banana bla
```
```haskell
numlines f = do
h <- openFile f ReadMode
c <- hGetContents h
let lns = lines c -- get list of lines
let numl = length lns -- number of lines
let maxn = length $ show numl -- max str(linenumber) length
writeln maxn 1 lns
hClose h
writeln _ _ [] = return ()
writeln w n (l:ls) = do
putStrLn (align n w ++ " " ++ l)
writeln w (n+1) ls
align n w = [' ' | _ <- [1..(w - length sn)]] ++ sn
where
sn = show n
```
### 2. opravný termín
/6b/ Definovať funkciu `suf`, ktorá prijíma ako argument zoznam a vracia zoznam všetkých sufixov tohto zoznamu. Definovať funkciu `pre`, ktorá prijíma ako argument zoznam a vracia zoznam všetkých prefixov tohto zoznamu. Funkcia `pre` musí korektne fungovať aj pre nekonečné zoznamy, t.j. `take 10 $ pre [1..]` vráti zoznam desiatich zoznamov.
```haskell
suf [] = [[]]
suf l@(_:xs) = l : suf xs
pre [] = []
pre l = mkpr [] l
where
mkpr rp (a:as) = reverse (a:rp) : mkpr (a:rp) as
mkpr _ [] = []
-- alebo
pre _ [] = [[]]
pre c (x:xs) = (c++[x]) : (pre (c++[x]) xs)
```
/4b/ Definovať funkciu `substrs`, ktorá prijíma ako argument reťazec a vracia zoznam všetkých podreťazcov tohto reťazca. Definovať funkciu `subsets`, ktorá prijíma ako argument reťazec a vracia zoznam všetky kombinácie tohto reťazca. Môžte použiť aj funkcie `suf` a `pref` z predošlej úlohy.
```haskell
substrs xs = concat $ map pre $ suf xs
subsets [] = [[]]
subsets (a:as) = ss ++ map (a:) ss
where
ss = subsets as
```
/6b/ Definovať funkciu `ff`, prvý argument je meno súboru v ktorom je každý riadok vo formáte `<key>:<value>` a druhý argument je hľadaný klúč. Funkcia `ff` vráti hodnotu tohto klúča. Ak sa daný klúč v súbore nenachádza, funkcia vráti, že zadaný klúč nenašiel.
```haskell
ff f key = do
h <- openFile f ReadMode
c <- hGetContents h
let lns = lines c
(\res -> hClose h >> return res) $! find (show key) lns
find _ [] = "Not found"
find keystr (l:ls) =
if take (length keystr) l == keystr then
let rest = drop (length keystr) l
in if head rest == ':' then tail rest
else find keystr ls
else
find keystr ls
```
## 2019/2020
### Předtermín
Definovat datovou strukturu, která reprezentuje neorientovaný graf (prostě množina vrcholů a množina hran, kde hrana je dvojice - vrchol, vrchol).
```haskell
data Graph v = UG {vertices::[v], edges :: [(v,v)]}
deriving (Eq,Show)
```
Vytvořit funkci, co maže izolované uzly v neorientovaném grafu:
```haskell
delIso :: Eq v => Graph v -> Graph v
delIso (UG vs es) = UG (del vs es) es
where
del [] _ = []
del (v:vs) es =
if elemVEs v es then v : del vs es else del vs es
elemVEs :: Eq v => v -> [(v, v)] -> Bool
elemVEs v ((v1,v2):es) = v==v1 || v==v2 || elemVEs v es
elemVEs _ [] = False
```
Dán typ pro neorientovaný graf, soubor, v něm po řádcích jména uzlů, volný řádek, dvojice jmen oddělených dvojtečkou dává hrany.
Zkontrolovat funkcí checkUG, zda-li je to jinak korektní graf. Vrátit graf.
```haskell
loadG :: FilePath -> IO (Maybe (GraphString))
loadG file = do
h <- openFile file ReadMode
c <- hGetContents h
let (vs,es) = parse $ lines c
let g = UG vs es
let gok = check g
if gok then hClose h >> (return $ Just g) else hClose h >> return Nothing
parse :: [String] -> ([String], [(String, String)])
parse ("":es) = ([], pe es)
parse (v:vs) = let
(vxs,es) = parse vs
in (v:vxs,es)
pe :: [String] -> [(String, String)]
pe (e:es) =let
(v1,x) = span (/=':') e
in (v1,tail x) : pe es
pe [] = []
```
Alebo
```haskell
loadG file = do
h <- openFile file ReadMode
c <- hGetContents h
let lns = lines c
let (vs, es) = parse lns
let g = UG vs es
let gok = checkUG g
if gok then hClose h >> (return $ Just g) else hClose h >> return Nothing
parse lns = (vs, es)
where
(vs, (_:rest)) = span (/="") lns
es = pe rest
pe ((v1:':':v2):re) = (v1,v2) : pe re
pe [] = []
```
### Řádný termín
Dáno (CS - context sensitive grammar):
```haskell
data CSgrammar nt t = CSG nt [Rule nt t]
deriving (Show, Eq)
data Rule nt t = Rule [Either nt t] [Either nt t]
deriving (Show, Eq)
```
Úkoly:
```haskell
appRule :: (Eq nt, Eq t) => [Either nt t] -> Rule nt t -> [[Either nt t]]
appRule sf (Rule lft rgt) = proc [] sf
where
-- test every suffix of the sf whether its prefix is not a LHS of the rule,
-- if yes then do a derivation else continue
proc _ [] = []
proc pref sf@(s:ss) =
if repl then (reverse pref ++ rgt ++ rest) : proc (s:pref) ss
else proc (s:pref) ss
where
(repl,rest) = replT lft sf
-- if it is a prefix, return rest behind the prefix and True
-- otherwise False (and something)
replT [] rest = (True,rest)
replT (x:xs) (r:rs) =
if x==r && res then w else (False,rs)
where
w@(res,xxs) = replT xs rs
replT _ [] = (False,[])
----------
appAll :: (Eq nt, Eq t) => CSgrammar nt t -> [Either nt t] -> [[Either nt t]]
appAll (CSG _ rules) sf =
-- apply or rules, if possible
if null applicable then [] else concatMap (appRule sf) applicable
where
-- select only applicable rules
applicable = filter (isApp sf) rules
----------
genNew :: (Eq nt, Eq t2) => CSgrammar nt t2 -> [[Either nt t2]] -> [[Either nt t2]]
genNew gram inSFs = cleanRep newSFs
where
newSFs = concatMap (appAll gram) inSFs
cleanRep [] = []
cleanRep (sf:sfs) =
if elem sf inSFs || elem sf sfs then cleanRep sfs else sf : cleanRep sfs
----------
testInL :: (Eq a, Eq t) => CSgrammar a t -> [Either a t] -> Bool
testInL gram@(CSG st _) sentence =
if not $ isTerminal sentence
then error "Not a sentence on input in testInL"
else proc [[Left st]] []
where
sentLen = length sentence
proc sfs done
| elem sentence terms = True
| null nterms = False
| True = proc notdone (notdone ++ done)
where
step = genNew gram sfs
leqsfs = filter (\s -> length s <= sentLen) step
terms = filter isTerminal leqsfs
nterms = filter (not . isTerminal) leqsfs
notdone = filter (\sf -> not (elem sf done)) nterms
```
### 1. opravný termín
**/3b/** Funkcie na prienik a zjednotenie množín v čistom Haskelli. Jedna musela byť napísaná s využitím generátorov zoznamov a druhá iným spôsobom.
```haskell
uni [] l = l
uni l [] = l
uni (x:xs) l =
if x `elem` l then uni xs l else x : uni xs l
--
int xs ys = [ z | z <- xs, z `elem` ys]
```
**/2b/** Datová štruktúra pre lambda výrazy.
[iné riesenie - 20/21 1. op](https://hackmd.io/JB5CYyAZRoS55_WFMbdUkQ?view#1-opravn%C3%BD)
```haskell
data LE a
= App (LE a) (LE a)
| Abs a (LE a)
| Var a
deriving (Show,Eq)
```
**/4b/** Vytvorenie zoznamu voľných premenných v lambda výraze
```haskell
fv (Var v) = [v]
fv (App e1 e2) = uni (fv e1) $ fv e2
fv (Abs v e) = [x | x <- fv e, x /= v]
```
**/8b/** .....
```haskell
isValid (Var _) _ _ = True
isValid (App e1 e2) ne v = isValid e1 ne v && isValid e2 ne v
isValid (Abs w ee) ne v = proc [w] ee
where
fvne = fv ne
proc bound (Var x)
| x == v && x `elem` bound = True
| x == v = null $ bound `int` fvne
| otherwise = True
proc bound (App e1 e2) =
proc bound e1 && proc bound e2
proc bound (Abs x ex) = proc (x:bound) ex
```
**/6b/** Niečo s leftmost outermost deriváciou/aplikáciou
```haskell
lmom w@(Var _) = w
lmom (App e1 e2) =
case e1 of
(Abs v e) -> if isValid e e2 v then subst e e2 v else (App e1 e2)
_ -> App (lmom e1) e2
lmom (Abs w ee) =
Abs w (lmom ee)
```
## 2018/2019
### Řádný termín
- Nadefinovat strukturu pre DirTree.
- Urobit funkciu, ktora spocita velkost obsahu složky.
- Urobit funkciu ktora vrati zoznam suborov a složek, ktory obsahuju zadany prefix.
- Funkcia na rekurzivny vypis obsahu priecinka, nieco ako:
```
(tohle je soucast zadani jeste)
-* Root
+ +-* SubDir
+ + + file2
+ file1
+
```
```haskell
data DirTree a
= File String Integer a
| Dir String Integer a [DirTree a]
deriving (Show,Eq)
dirSize (File _ s _) = s
dirSize (Dir _ s _ dir) = foldr (+) s $ map dirSize dir
findAllPref file dir =
findPath "" dir
where
cmpp [] _ = True
cmpp _ [] = False
cmpp (p:ps) (f:fs) = p==f && cmpp ps fs
findPath p (File name _ _) =
if cmpp file name then [p++name] else []
findPath p (Dir name _ _ dir) =
let
cur = if cmpp file name then [p++name++"/"] else []
other = concatMap (findPath $ p++name++"/") dir
in
cur++other
printDir (File name size _) = putStrLn $ "+ " ++name++" "++show size
printDir d@(Dir _ _ _ _) =
prd "" d
where
prd pref (File name size _) = putStrLn $ pref++" "++name++" "++show size
prd pref (Dir name _ _ dir) = do
putStrLn $ pref++"-* "++name
mapM_ (prd $ pref++" +") dir
putStrLn $ pref++" ."
```
- BONUS: Red–black tree:
```haskell
data Color
= Black
| Red
deriving (Show,Eq,Ord,Bounded,Read,Enum)
data RBT a
= Nil
| Nd Color a (RBT a) (RBT a)
deriving (Show,Eq)
countBlack Nil = Just 1
countBlack (Nd Red _ l r) =
cmpLR 0 (countBlack l) (countBlack r)
countBlack (Nd _ _ l r) =
cmpLR 1 (countBlack l) (countBlack r)
cmpLR x (Just lv) (Just rv) = if lv == rv then Just $ x+lv else Nothing
cmpLR _ _ _ = Nothing
```
### 1. Opravný termín
2-6) Pomocí haskell implementovat lambda výrazy a nějakou práci nad nima, myslím, že tam byl `subst` = substituce
```haskell
data LE
= Var String
| App LE LE
| Abs String LE
deriving (Eq,Show)
remove _ [] = []
remove x (y:ys) =
if x == y then ys else y : remove x ys
union [] ys = ys
union (x:xs) ys =
if elem x ys then union xs ys else x : union xs ys
fv (Var v) = [v]
fv (App e1 e2) = -- alebo jednoduchsie: = union (fv e1) (fv e2)
let
f1 = fv e1
f2 = fv e2
in
union f1 f2
fv (Abs v e) =
remove v (fv e)
----------------------------------------------
-- subst what var where
subst w var ins = run ins
where
fvs = fv w
comb (Just e1) (Just e2) = Just $ App e1 e2
comb _ _ = Nothing
run vv@(Var v) = if v == var then Just w else Just vv
run vv@(Abs v e) =
if elem var (fv e) && elem v fvs then Nothing else
if v == var then Just vv else
case run e of
Nothing -> Nothing
Just e -> Just $ Abs v e
run (App e1 e2) = comb re1 re2
where
re1 = run e1
re2 = run e2
----------------------------------------------
-- varianta bez bonusu
pp' x = ppp x >> putStrLn ""
ppp (Var v) = putStr v
ppp (App e1 e2) = do
putStr "("
ppp e1
putStr " "
ppp e2
putStr ")"
ppp (Abs v e) = do
putStr "(\\ "
putStr v
putStr " -> "
ppp e
putStr")"
----------------------------------------------
-- varianta na bonus
pp (Var v) = putStrLn v
pp (App e1 e2) = do
apply e1
mkp True e2
putStrLn ""
pp e = do
mkp False e
putStrLn ""
mkp f (Var v) = do
if f then putStr " " else return ()
putStr v
mkp f (Abs v e) = do
if f then putStr " ( " else return ()
putStr $ "\\ "++v
nest e
if f then putStr " )" else return ()
mkpf (App e1 e2) = do
if f then putStr " (" else return ()
if f then mkp f e1 else apply e1
mkp True e2
if f then putStr " )" else return ()
nest (Abs v e) = do
putStr $ " "++v
nest e
neste = do
putStr " -> "
mkp False e
apply (Var v) = do
putStr v
apply (App e1 e2) = do
apply e1
mkp True e2
apply (Abs v e) = do
putStr "( "
putStr $ "\\ "++v
nest e
putStr" )"
```
### 2. Opravný termín
1. Nadefinovat typ BTree, který má předem daný počet potomků a předem zadanou hloubku stromu (zadáno při tvorbě). Listy mají jako hodnotu seznam dvojic (klíč, hodnota), které jsou předem neznámého typu. Uzly mají pak jako hodnotu seznam, který odpovídá potomkům a v každá hodnota v seznamu značí maximální klič, který může daný potomek obsahovat.
2. Vytvoření funkce `create :: Integer -> Integer -> Int -> Int -> BTree`. Kde parametry jsou po sobě: Max klíč, min klíč, hloubka, počet potomků.
**BONUS:** za řešení, které se vypořádá s tím, když je počet potomků/pater nesoudělný s celkovým počtem klíčů.
3. Vytvoření funkce `ins :: (typ neuveden)`, která dostává argumenty: klíč, data, strom a která podle zadaného klíče buď upraví hodnotu ve stromu, nebo ji přidá.
4. Vytvoření funkce `allList :: (typ neuveden)`, která ze zadaného stromu vybere z listů všechny hodnoty a vrátí je jako jediný konkatenovaný seznam hodnot.
**BONUS:** pokud tato funkce bude pracovat s lineární časovou složitostí
## 2017/2018
### Řádný termín
/4b/ Funkce sort v holem Haskellu, bere seznam hodnot nad tridou Ord a vraci serazene od nejmensiho po nejvetsi. K dispozici fold*, map a operace nad tridou Ord.
```haskell
ins x [] = [x]
ins x l@(y:ys) =
if x < y then x : l else y : ins x ys
sort l = foldr ins [] l
```
/13b/ Nadefinovat funkciu `pt`, ktora berie nazov suboru ako argument. Z tohoto suboru nacita zaznamy ve formatu `Cislo_typu_Integer#String`, pripadne prazdny riadok. Zaznam reprezentovat datovym typom `DLog`. Vypsat zaznamy s cisly, ktere jsou nasobkem 5 (cislo mod 5 == 0). Odelene budu tentoraz dvojbodkou (:).
Je potrebne uviest typove defincie pre kazdu pouzitu funkciu.
Zadane byly typove definicie nekterych funkci pro praci s IO (`openFile, hGetContents, lines, unlines, ReadMode, WriteMode`, atp.).
```haskell
data DLog
= Empty -- Empty constructor could probably be omitted
| IT Integer String
deriving (Show,Eq)
pr :: [DLog] -> IO () -- print out DLog content
pr [] = return ()
pr (Empty:xs) = pr xs
pr ((IT i s):xs) =
if i `mod` 5 == 0
then putStrLn (show i ++ ":" ++ s) >> pr xs
else pr xs
pl :: String -> IO () -- this should probably be called `pt` as in the assignment
pl fn = do
h <- openFile fn ReadMode
c <- hGetContents h
pr $ proc $ lines c
hClose h
proc :: [String] -> [DLog] -- convert file representation to list of logs
proc [] = []
proc (l:ls) =
if null l
then Empty : proc ls -- it would be easier to just skip empty lines
else (mk l) : proc ls
mk :: String -> DLog -- parse one line from the log
mk l = IT ((read (takeWhile (/='#') l))::Integer)
(tail $ dropWhile (/='#') l)
-- Varianta SPAN
pl' :: String -> IO()
pl' fn = do
h <- openFile fn ReadMode
c <- hGetContents h
pr $ map mkDL $ lines c
hClose h
mkDL :: String -> DLog
mkDL [] = Empty
mkDL l = let (n,s) = span (/='#') l
in IT ((read n)::Integer) (tail s)
```
/6b/ BONUS otazka - Vytvorit datovou strukturu pro reprezentaci stromu. Vytvorit funkci initTree, ktera dostane jako parametr hodnotu a vytvori nekonecny strom, kde vsechny uzly obsahuji tuto hodnotu. Vytvorit funkci takeLev, ktera vrati strom az po urcitou uroven danou parametrem.
```haskell
data Tree a
= Nd a (Tree a) (Tree a)
| Lf
deriving (Show,Eq)
takeLev :: Int -> Tree a -> Tree a
takeLev 0 _ = Lf
takeLev _ Lf = Lf
takeLev n (Nd v l r) =
Nd v (takeLev (n-1) l) (takeLev (n-1) r)
initTree :: a -> Tree a
initTree val = Nd val (initTree val) (initTree val)
```
### 1. opravný termín
Vytvořit nekonečný seznam prvočísel.
```haskell
primes = 2:[x | x <- [3,5..], isPrime x primes]
where
isPrime x (p:ps) =
(p*p > x) || (x `mod` p /= 0 && isPrime x ps)
-- alebo
primes = isPrime [2..]
where
isPrime (p:xs) = p : isPrime [x|x <- xs, x `mod` p > 0]
```
Haskell s dostupnými IO funkcemi. Napsat funkci `mkR`, která dostane jméno souboru. V řádcích souboru se nachází buď FIT login, nebo prázdný řádek, nebo nějaký jiný text. Funkce má vypsat nejdříve počet řádků s validními loginy, pak počet textových řádků, pak počet prázdných řádku a nakonec vypsat všechny tyto validní loginy v náhodném pořadí. Pro generování náhodných čísel je k dispozici funkce `randomRIO :: Random a => (a, a) -> IO a`.
```haskell
mkR :: String -> IO ()
mkR file = do
h <- openFile file ReadMode
c <- hGetContents h
let alllogs = lines c
let empty = length $ filter (=="") alllogs
let wempty = filter (/="") alllogs
let notLogs = length $ filter (not . isLogin) wempty
let correct = filter isLogin wempty
putStrLn $ show (length correct) ++ "/" ++ show notLogs ++ "/" ++ show empty
randLog <- genRand correct
putStrLn $ unlines randLog
hClose h
isLogin :: String -> Bool
isLogin x =
length x == 8 && head x == 'x' &&
(all (\x -> elem x ['a'..'z']) $ take 5 $ tail x) &&
(all (\x -> elem x (['0'..'9']++['a'..'z'])) $ drop 6 x)
genRand :: [a] -> IO [a]
genRand [] = return []
genRand l = do
ir <- randomRIO (0,length l - 1) :: IO Int
let (h,t) = splitAt ir l
let v = head t
let r = tail t
mkr <- genRand (h++r)
return (v:mkr)
```
## 2016/2017
### Řádný termín
Holý Haskell. Definovat datový typ pro asociativní pole. Dále napsat funkci test, která ověří, že klíče v asociativním poli jsou unikátní. (7b)
```haskell
data AL k d
= Val k d (AL k d)
| Nil
deriving (Show,Eq)
test Nil = True
test (Val k _ rest) = noKey k rest && test rest
noKey _ Nil = True
noKey k (Val k' _ rest) = k/=k' && noKey k rest
```
Haskell + prelude (kromě readFile) + nějaké IO funkce jako (hGetContents, hClose, openFile, hPutStr). Napsat funkci fdup, která načte soubor jehož nazev je v jejím parametru a potom tento soubor vypíše na výstup, ale s tím, že pokud jsou na začátku řádku dva znaky +, tak se tento řádek vypíše 2x, ale už bez těchto dvou plusových znaků. Nesmí se změnit pořadí řádků. (6b)
```haskell
import System.IO
fdup :: FilePath -> IO ()
fdup file = do
h <- openFile file ReadMode
c <- hGetContents h
putStr $ unlines $ dl $ lines c
hClose h
dl :: [String] -> [String]
dl (('+':'+':l):ls) = l:l:dl ls
dl (l:ls) = l : dl ls
dl [] = []
```
Bonus: Definujte strukturu pro termy v prologu a následně funkci unify s dvěma parametry, která vratí nejobecnější unifikátor dvou termu (8b)
```haskell
data Term
= Var String
| ValI Integer
| Term String [Term]
deriving (Show,Eq)
unify (ValI a) (ValI b) =
if a==b then Just [] else Nothing
unify (Term a as) (Term b bs) =
if a==b && length as==length bs then comb [] as bs
else Nothing
where
comb res [] [] = Just res
comb res (a:as) (b:bs) =
unify a b >>=
(\s -> comb (res++s) (map (lapp s) as) (map (lapp s) bs))
unify w@(Var a) t =
if w==t then Just [] else Just [(a,t)]
unify t w@(Var a) = unify w t
lapp ss t = foldl (flip app) t ss
app (v,t) w@(Var v') =
if v==v' then t else w
app s (Term t ts) = Term t (map (app s) ts)
app _ x = x
```
Sign in with Wallet
Connect another wallet