---
# System prepended metadata

title: FLP -- Haskell

---

# 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

<!-- ![](https://media.discordapp.net/attachments/621775580471492638/973595388504317982/unknown_973594542941024347_372131404412354571.jpg?width=854&height=484) -->

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
```
