FLP studentská sbírka úloh === Přehlednější sbírka oficiálních řešení + zadání z fitušky od studentů. Upravujte, přidávejte dle libosti. Držte pls nějakou strukturu, ať se v tom dá vyznat a nedopadne to jak sdílený dokument. Pro diskuzi se dají použít komentáře u odstavců/kódů. # Haskell ## 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 UG g if gok then hClose h >> (return $ Just g) else hCloseh >> 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 [] = [] ``` ### Řádný termín Dáno: ```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. ```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++" ." ------------- 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 substr ```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) = 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 insx [] = [x] insxl@(y:ys) = if x < y then x : l else y : ins x ys sort l = foldr ins [] ``` /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 | IT Integer String deriving (Show,Eq) pr :: [DLog] -> IO () 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 () pl fn = do h <- openFile fn ReadMode c <- hGetContents h pr $ proc $ lines c hClose h proc :: [String] -> [DLog] proc [] = [] proc (l:ls) = if null l then Empty : proc ls else (mk l) : proc ls mk :: String -> DLog 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) ``` 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 ``` # Prolog ## 2018/2019 ### Řádný termín 1. Napsat predikaty pro zjisteni, jestli je prvek v seznamu a pro odstraneni hodnoty ze seznamu. Dat si bacha na to, ze seznam muze obsahovat nenavazane promenne a prvek se s nima nesmi zunifikovat. 2. Transpozice matice. 3. Predikat, ktery bere sudoku reprezentovane matici 9x9 a vytvori seznam bloku 3x3. 4. Predikat, ktery pro danou pozici v sudoku zjisti seznam moznych hodnot, ktere se na to policko daji doplnit. Mame k dispozici predikat getIth(X,M,L), ktery z matice M vytahne radek X do seznamu L. A meli jsme napsane, jak se z pozice [X,Y] v matici urci cislo bloku. 5. Predikat solves, ktery s vyuzitim definovanych predikatu vyresi sudoku, ktere ma na vstupu zadane matici 9x9. Neobsazene policka jsou reprezentovana volnou promennou. Muzem pouzit getIth, getRC, ktery pro zadanou pozici a matici vrati prvek na tech souradnicich a setRC, ktery nastavi prvek v matici na nejakou hodnotu. ```prolog /* -- vv -- */ elemNV(X,[V|_]) :- nonvar(V), V=X, !. elemNV(X,[_|VS]) :- elemNV(X,VS). remVals([],_,[]). remVals([X|XS],L,R) :- elemNV(X,L), !, remVals(XS,L,R). remVals([X|XS],L,[X|R]) :- remVals(XS,L,R). /* -- vv -- */ trp([[]|_],[]) :- !. trp(XSS,[L|LS]) :- heads(XSS,L,YSS), trp(YSS,LS). heads([[H|TS]|XSS],[H|T],[TS|YSS]) :- heads(XSS,T,YSS). heads([],[],[]). /* -- vv -- */ blocks([[A,B,C|CS],[D,E,F|FS],[G,H,I|IS]|XSS],[[A,B,C,D,E,F,G,H,I]|LS]) :- blocks([CS,FS,IS|XSS],LS). blocks([[],[],[]|XSS],LS) :- blocks(XSS,LS). blocks([],[]). /* -- vv -- */ valsFor(X,Y,M,[V|VS]) :- getIth(X,M,L), remVals([1,2,3,4,5,6,7,8,9],L,[H|T]), trp(M,TM), getIth(Y,TM,R), remVals([H|T],R,[HH|TT]), blocks(M,BM), P is (3*((X-1)//3)) + (1+((Y-1)//3)), getIth(P,BM,B), remVals([HH|TT],B,[V|VS]). /* -- vv -- */ solves(M) :- search(1,1,M). search(R,C,M) :- getRC(R,C,M,V), nonvar(V), !, goNonvar(R,C,M). search(R,C,M) :- valsFor(R,C,M,VS), testVals(R,C,M,VS). goNonvar(9,9,_) :- !. goNonvar(R,C,M) :- newRC(R,C,RR,CC), search(RR,CC,M). testVals(9,9,M,[X]) :- getRC(9,9,M,X), !. testVals(R,C,M,[X|_]) :- getRC(R,C,M,X), newRC(R,C,RR,CC), search(RR,CC,M). testVals(R,C,M,[_|XS]) :- testVals(R,C,M,XS). /* co bylo k dispozici jako hotove, pro uplnost */ newRC(R,C,R,CC) :- C<9, !, CC is C+1. newRC(R,9,RR,1) :- R<9, RR is R+1. getIth(1,[X|_],X) :- !. getIth(N,[_|XS],X) :- N1 is N-1, getIth(N1,XS,X). getRC(R,C,M,V) :- getIth(R,M,L), getIth(C,L,V). ``` ### 1. opravny termín Dámy ```prolog /* -------------------------------------------------------------------- */ genAll(0,_,[]). genAll(Size,Col,[pos(Col,Size)|Res]) :- Size > 0, SS is Size - 1, genAll(SS,Col,Res). /* -------------------------------------------------------------------- */ inConf([pos(X,_)|_], pos(X,_)) :- !. inConf([pos(_,Y)|_], pos(_,Y)) :- !. inConf([pos(XX,YY)|_], pos(X,Y)) :- tst(XX,X,YY,Y), !. inConf([_|PS], P) :- inConf(PS,P). tst(XX,X,YY,Y) :- XX<X, !, tst(X,XX,YY,Y). tst(XX,X,YY,Y) :- YY<Y, !, tst(XX,X,Y,YY). tst(XX,X,YY,Y) :- XR is XX-X, YR is YY-Y, XR == YR. /* -------------------------------------------------------------------- */ filterNot(_,[],[]). filterNot(FL,[X|XS],YS) :- append(FL,[X],C), Pred =.. C, call(Pred), !, filterNot(FL,XS,YS). filterNot(FL,[X|XS],[X|YS]) :- filterNot(FL,XS,YS). /* -------------------------------------------------------------------- */ tryNext(PS,Size,Possible) :- length(PS,LPS), NewCol is LPS+1, genAll(Size,NewCol,NewPs), filterNot([inConf,PS],NewPs,Possible). /* -------------------------------------------------------------------- */ findQ(Size,PS,PS) :- length(PS,Size), !. findQ(Size,PS,[]) :- tryNext(PS,Size,[]), !, fail. findQ(Size,PS,Res) :- tryNext(PS,Size,NewPS), tryAll(Size,PS,NewPS,Res). tryAll(_,_,[],_) :- !, fail. tryAll(Size,PS,[N|_],Res) :- findQ(Size,[N|PS],Res). tryAll(Size,PS,[_|NS],Res) :- tryAll(Size,PS,NS,Res). /* -------------------------------------------------------------------- */ queens(Size,Ress) :- setof(P,findQ(Size,[],P),Ress). /* -------------------------------------------------------------------- */ ``` ### 2. opravný termín **Obchodní cestující:** 1. Definovat predikát `search (From, To, L)`, který vyhledá nejkratší cestu z `From` do `To` a vrátí její délku v `L`. Přičemž využívá `get_distance(From,To,L)`, což je predikát pro navrácení délky cesty mezi dvěma místy. 2. Definovat predikát `fsf (+From, Where, Distances)`, který vhodně navrací nejkratší vzdálenosti od `From` do všech míst z množiny `Where` v argumentu `Distances`. 3. Definovat predikát `gc (+Distances, Closest, L)`, který vybere a vrátí nejbližší bod od `From` z předchozího bodu v argumentu `Closest` a vzdálenost k němu v `L`. 4. Definovat predikát `ts (+From, +Where, -Path, -L)`, jež dostává výchozí bod a množnu dalších, které je nutné navštívit. Musí pak vybrat nejkratší cestu a vrátit ji i její délku. ## 2017/2018 ### Řádný termín 1) /6b/ Flatten seznamu - vytvorit predikat e, ktery bere 2 argumenty. Prvni je seznam libovolne zanorenych seznamu (i prazdnych), napr. [[], [1, 2], [[[[]]],[atom, atom]]]. Druhy argument je vysledny seznam bez zanoreni. 2) /7b/ Funkce XOR, ktera vraci symterickou diferenci dvou mnozin (sjednoceni mnozin bez jejich pruseciku). Bere prvni a druhy parametr mnozinu reprezentovanou seznamem, treti parametr je vysledna mnozina reprezentovana seznamem. 3) /9b/ Napisat predikat search(PocatecniPozice, SeznamCest), ktory najde vsechny cesty z dane pozice zpet do teto pozice, delky 20 az 22 kroku (netrapit se tim, jestli vracet prvni/posledni prvek ci ne). Kazdy prvok je mozne nastivit len jeden krat vyjma prveho (== posledneho). Definicia pozicie je neznama, napiste funkci nextStep(Pos, NewPos) nad neznamym a NEKONECNYM stavovym priestorom. Mozno pouzit retract*, assert*, bagof, setof, length. 4) /8b/ Napisat predikat lookup. Prvy arguement vhodne reprezentovana tabulka symbolov, 2-hy argument kluc, 3-ty argument hodnota. A posledny a vysledny argument je modifikovana, pripadne vstupna tabulka symbolov. Predikat pracuje v dvoch rezimoch. Ak je zadana hodnota, tak sa modifikuje pripadne modifikuje zaznam (klic -> hodnota?) v tabulke symbolov. Ak nie je zadana hodnota, tak vyhladavame v tabulku hodnotu so zadanym klucom. Ak sa nemylim, tak bolo mozne pouzit vsetko zo zakladnej kniznice Prologu. Ja som pouzil var(), nonvar() na zistenie, ci (nie) je zadana hodnota a nemyslim si, ze by to bolo v zadani spomenute. -- priklad byl mozna lehce modifikovany? ```prolog :- dynamic pos/1. /* ---------------------------------- */ e([],[]). e([[]|R],Res) :- !, e(R,Res). e([[X|XS]|YS],Res) :- !, e([X,XS|YS],Res). e([V|XS],[V|Res]) :- e(XS,Res). /* ---------------------------------- */ xor([],L,L) :- !. xor(L,[],L) :- !. xor(L,R,Res) :- sub(L,R,L1),sub(R,L,R1),app(L1,R1,Res). sub([],_,[]). sub([X|XS],YS,RS) :- elem(X,YS),!,sub(XS,YS,RS). sub([X|XS],YS,[X|RS]) :- sub(XS,YS,RS). elem(X,[X|_]) :- !. elem(X,[_|XS]) :- elem(X,XS). app([],L,L). app([X|XS],L,[X|RS]) :- app(XS,L,RS). /* ---------------------------------- */ search(P,Res) :- setof(Path,s(P,P,0,Path),Res). s(P,P,N,[P]) :- N =< 22, N >= 20, !. s(_,_,N,_) :- N > 22, !, fail. s(P,P,N,_) :- N \= 0, !, fail. s(A,P,N,[A|R]) :- assertz(pos(A)), NN is N+1, nextStep(A,AA), ( not(pos(AA)) ; AA=P ) , s(AA,P,NN,R). s(A,_,_,_) :- pos(A), retract(pos(A)), !,fail. nextStep(p(X,Y),p(XX,Y)) :- XX is X+1. nextStep(p(X,Y),p(XX,Y)) :- XX is X-1. nextStep(p(X,Y),p(X,YY)) :- YY is Y+1. nextStep(p(X,Y),p(X,YY)) :- YY is Y-1. /* ---------------------------------- */ emptyT([]). lookup(T,_,_,_) :- var(T), !, fail. lookup(T,Var,Val,NT) :- nonvar(Var),nonvar(Val), !, iT(T,Var,Val,NT). lookup(T,Var,Val,T) :- nonvar(Var), lT(T,Var,Val). iT([], R, L, [p(R,L)]). iT([p(R,_)|PS], R, L, [p(R,L)|PS]) :- !. iT([p(RR,LL)|PS], R, L, [p(RR,LL)|PPS]) :- iT(PS,R,L,PPS). lT([p(R,L)|_],R,L) :- !. lT([_|PS],R,L) :- lT(PS,R,L). /* EOF */ ``` ### 1. opravny termín 1. Holý Prolog. Napsat predikát `mkTrans(ListOfLists,ListOfLists)`, která dostane v 1. argumentu matici, kterou transponovanou unifikuje do 2. argumentu. 2. Holý Prolog. Napsat predikát `subseq`, který v 1. argumentu dostane seznam a do 2. argumentu unifikuje seznam všech jeho podseznamů, tedy jde tam o prefix a suffix matching. 3. Prolog s `bagof, setof, assert, retract` atp. Prohledávání stavového prostoru. Napsat predikát `search(Start,Cíl, Nejkratší_cesta)`, který dostane nějakou startovní a koncovou pozici a unifikuje do 3. argumentu nejkratší cestu mezi nimi. Napsat také predikát `nextStep`, který bude vracet další novou pozici. úkolem není napsat optimální řešení, ale využít elegantnosti Prologu. 4. Prolog s celočíselným dělením, dělením a is. Napsat Prologovou reprezentaci racionálních čísel a operaci násobení a sčítání nad nimi. ```prolog :- dynamic pos/1. /* ---------------------------------- */ mkTrans([],[]). mkTrans([[]|_],[]). mkTrans(LS,[HS|HHS]) :- trans(LS,HS,TS), mkTrans(TS,HHS). trans([],[],[]). trans([[H|T]|LS],[H|HS],[T|TS]) :- trans(LS,HS,TS). /* ---------------------------------- */ suff([],[[]]). suff([H|T],[[H|T]|R]) :- suff(T,R). subseq(S,[[]|SS]) :- suff(S,SUFS), proc(SUFS,SS). proc([],[]). proc([S|SS],RES) :- pref(S,[_|PS]), proc(SS,PSS), append(PS,PSS,RES). pref([H|T],[[]|R]) :- pref(T,PS), prepAll(H,PS,R). pref([],[[]]). prepAll(_,[],[]). prepAll(X,[L|LS],[[X|L]|XS]) :- prepAll(X,LS,XS). /* ---------------------------------- */ search(S,E,Res) :- retractall(pos(_)), steptry(S,E,0,Res). steptry(S,E,N,Res) :- s(S,E,N,Res), !. steptry(S,E,N,Res) :- NN is N+1, steptry(S,E,NN,Res). s(E,E,0,[E]) :- !. s(_,_,N,_) :- N < 0, !, fail. s(A,E,N,[A|R]) :- assertz(pos(A)), NN is N-1, nextStep(A,AA), not(pos(AA)) , s(AA,E,NN,R). s(A,_,_,_) :- pos(A), retract(pos(A)), !,fail. nextStep(p(X,Y),p(XX,Y)) :- XX is X+1. nextStep(p(X,Y),p(XX,Y)) :- XX is X-1. nextStep(p(X,Y),p(X,YY)) :- YY is Y+1. nextStep(p(X,Y),p(X,YY)) :- YY is Y-1. /* ---------------------------------- */ /* rac(numerartor,denominator) */ /* op('+',L,R). * op('*',L,R). * rac(N,D). */ gcd(N,N,N) :- !. gcd(N,M,M) :- N > M, NN is mod(N,M), NN==0, !. gcd(N,M,D) :- N > M, !, NN is mod(N,M), gcd(M,NN,D). gcd(N,M,N) :- M > N, MM is mod(M,N), MM is 0, !. gcd(N,M,D) :- MM is mod(M,N), gcd(N,MM,D). ev(op('+',L,R),rac(NN,DD)) :- ev(L,rac(LN,LD)), ev(R,rac(RN,RD)), N1 is LN*RD + RN*LD, D1 is LD*RD, norm(N1,D1,NN,DD). ev(op('*',L,R),rac(NN,DD)) :- ev(L,rac(LN,LD)), ev(R,rac(RN,RD)), N1 is LN*RN, D1 is LD*RD, norm(N1,D1,NN,DD). ev(rac(X,Y),rac(X,Y)). norm(N,D,NN,DD) :- gcd(N,D,G), G>1,!, NN is div(N,G), DD is div(D,G). norm(N,D,N,D). /* EOF */ ``` ## 2016/2017 ### Riadny termín 1. Prohledávání stavového prostoru. Napsat predikát getPath, který má jako první parametr startovní bod a jako druhý cílový bod a do třetího unifikuje nejkratší (s nejmenší cenou) cestu mezi těmito body. Předpokládejte, že stavový prostor je konečný. Máte k dispozici predikát nextStep(X, XX, P), který jako první parametr dostane nějaký stav stavového prostoru a v druhém vrátí další stav a ve třetím bude výsledná cena tohoto kroku. (14b) 2. Holý prolog (unifikace, základní práce se seznamy, + řez tuším). Navrhnout strukturu pro ukládání boolovských výrazů (pro and, or, not) nad proměnnými a literály true/false. Dále strukturu pro ukládání hodnot proměnných. Dále napsat predikát eval(Table, Expr, Res), která vyhodnotí daný bool výraz. V table je tabulka hodnot proměnných. Expr je vyhodnocovaný výraz. Do Res se unifikuje výsledek. (6b) 3. Holý prolog (unifikace, základní práce se seznamy). Implementujte predikát msort, který provádí merge sort řazení seznamu hodnot. Musí to být merge sort s jeho klasickou složitostí (ne kvadratickou...). (7b) 4. Cely prolog, ale nesmi se pouzit vestaveny append a jeste 2 veci co si nepamatuju. Mame predikat, kde prvni parametr je predikat (dvouparametrovy - tedy jeden vstup a výsledek) a druhy je seznam seznamu. Z druheho parametru se postupně berou seznamy a ma se provest aplikace predikatu na vsechny hodnoty v seznamu a dat dohromady vysledky do jednoducheho seznamu (tedy ne seznam seznamu). (6b) ```prolog /* ------------------------------------------------------------ */ /* ------------------------------------------------------------ */ :- dynamic pom/1, price/1, ppos/1. /* ------------------------------------------------------------ */ /* ------------------------------------------------------------ */ getPath(S,E,Path) :- retractall(pom(_)), retractall(price(_)), retractall(ppos(_)), assert(price(none)), mks(S,E,Path). mks(S,E,_) :- search(S,E,0,[]). mks(S,_,[S|Path]) :- ppos(Path). checkP(NP,Path) :- price(none), retract(price(none)), assert(price(NP)), assert(ppos(Path)), !,fail. checkP(NP,Path) :- price(P), NP<P, retract(price(P)), retract(ppos(_)), assert(price(NP)), assert(ppos(Path)), !,fail. search(E,E,Price,Path) :- !, checkP(Price,Path). search(S,E,P,TP) :- assertz(pom(S)), nextStep(S,Nxt,SP), not(pom(Nxt)), NP is P+SP, append(TP,[Nxt],NTP), search(Nxt,E,NP,NTP). search(S,_,_,_) :- pom(S), retract(pom(S)), !, fail. /*or(L,R) and(L,R) not(E) true false var(V)*/ /*[w(Var,Value)]*/ eval(_,true,true). eval(_,false,false). eval(T,var(V),R) :- getVal(T,V,R),!. eval(T,not(E),R) :- eval(T,E,EE), (EE=true,R=false ; R=true ),!. eval(T,and(E1,E2),R) :- eval(T,E1,EE1), (EE1=false,R=false ; eval(T,E2,R) ),!. eval(T,or(E1,E2),R) :- eval(T,E1,EE1), (EE1=true,R=true ; eval(T,E2,R) ),!. getVal([w(V,Value)|_],V,Value) :- !. getVal([_|WS],V,Value) :- getVal(WS,V,Value). /* ------------------------------------------------------------ */ /* ------------------------------------------------------------ */ merge([],L,L). merge(L,[],L). merge([H1|T1],[H2|T2],[H1|TT]) :- H1 =< H2, merge(T1,[H2|T2],TT). merge([H1|T1],[H2|T2],[H2|TT]) :- H2 < H1, merge([H1|T1],T2,TT). msort([],[]). msort([V],[V]). msort([A,B|T],R) :- divide(T,L1,L2), msort([A|L1],S1), msort([B|L2],S2), merge(S1,S2,R). divide([],[],[]). divide([V],[V],[]). divide([A,B|T],[A|TA],[B|TB]) :- divide(T,TA,TB). /* ------------------------------------------------------------ */ /* ------------------------------------------------------------ */ mapC(_,[],[]) :- !. mapC(F,[HL|TL],RES) :- mapC(F,TL,RT), mapA(F,HL,RT,RES). mapA(_,[],R,R) :- !. mapA(F,[H|T],R,[X|RES]) :- C =.. [F,H,X], call(C), mapA(F,T,R,RES). ``` # Lambda kalkul ## 2019/2020 ### předtermín Bylo definovaný `True` jako `\xy.xy`. Muselo se definovat `False` libovolným způsobem. Dál bylo potřeba definovat ternární operátor `? :`. A v poslední řadě definovat funkci `eq`, která porovnává dvě celá čísla. U toho bylo možné využít funkce `iszero` a `pred`. Tohle bylo potřeba implementovat pomocí operátoru pevného bodu. ``` máme: celá čísla, iszero, prev LET True = \ x y . x y LET False = \ x y . y LET (?:) = \ c t f . c (\ z. t) f LET eq = Y (\ f x y . iszero x ? (iszero y ? True : False) : (iszero y ? False : f (prev x) (prev y)) ) ``` ## 2018/2019 ``` E k = k Y E = k Y E = E (Y E) LET True = \ x y. x LET False = \ x y. y LET LT = Y(\f x y. iszero y False (iszero x True (f (prev x) (prev y)))) ``` ## 2017/2018 /6b/ Op. pevneho bodu - MINUS x y. Nadefinovat True + False. K dispozici isZero, prev. Pripadne si dodefinovat dalsi funkce. ``` LET True = \ x y . x LET False = \ x y . y LET (?:) = \ c t f . c t f Y E = k E k = k Y E = E k = E (Y E) LET minus = Y (\ f x y . iszero x ? 0 : (iszero y ? x : f (prev x) (prev y) )) ``` ## 2016/2017 Ukázat vlastnost operátoru pevného bodu. V lamda kalkulu definovat násobení (MUL) s dvěma parametry pomocí prev, add, iszero a ternárního operátoru (6b) ``` k - pevny bod E - vyraz Y - operator pevneho bodu Y E = k E k = k E (Y E) = Y E LET mul = \ a b . (iszero a ? 0 : (iszero b ? 0 : mf a b 0)) LET mf = Y (\ f a b r . iszero a ? r : f (pred a) b (add r b)) ``` ## 2015/2016 Popsat operátor pevného bodu, jeho vlastnost. Pomocí něj a předdefinovaných funkcí isZero, add a ternárního operátoru vytvořit výraz SUM (funkce fungují tak jak čekáme, ale mají nám neznámou implementaci, taky čísla mají neznámou implementaci). Výraz SUM vezme dvě čísla, x a y, a pokud je y=0, vrátí x, jinak vrátí SUM (x+y) (tedy částečně aplikovaného sama sebe). Ukázat vyhodnocení SUM 2 3 0. ``` Pro vyraz E je pevny bod k: E k = k Operator pevneho bodu Y: Y E = k = E (Y E) LET G = \ f x y. iszero y ? x : f (add x y) LET SUM = Y G SUM 2 3 0 = = (Y G) 2 3 0 = (G (Y G)) 2 3 0 = (G SUM) 2 3 0 = ((\ f x y. iszero y ? x : f (add x y )) SUM) 2 3 0 = (iszero 3 ? 2 : SUM (add 2 3)) 0 = (SUM 5) 0 = SUM 5 0 = (Y G) 5 0 = (G (Y G)) 5 0 = (G SUM) 5 0 = ((\ f x y. iszero y ? x : f (add x y )) SUM) 5 0 = iszero 0 ? 5 : SUM (add 5 0) = 5 ``` ### 1. opravný Mějme definováno True jako: ``True = \ x y . x y``. Definujte False standardního významu dle libosti. S jejích pomoci definujte IMP (implikace zleva doprava) standardního významu. Redukujte po krocích```IMP True False = False``` ``` LET True = \ x y . x y LET False = \ x y . y LET IMP = \ x y . x (\ z . y) True IMP True False = = (\ x y . x (\ z . y) True) True False = (\ y . True (\ z . y) True) False = True (\ z . False) True = (\ x y . x y) (\ z . False) True = (\ y . (\ z . False) y) True = (\ z . False) True = False ``` ## 2014/2015 ### Řádny Definicia vlastnosti operatoru pevneho bodu. Potom pomocou tohoto operatoru, iszero a prev nadefinovat minus, ktore berie 2 cisla a odcita ich a - b, pricom vysledok je nezaporny (tj. ==0 ak je b vacsie ako a). Mali sme zohladnit, ze iszero, prev a cisla maju neznamu definiciu, ale znamy vyznam. True a False je mozne si nadefinovat podla seba. ``` let T = \ x y . x let F = \ x y . y nechť Y je operátor pevného bodu, E je lambda-výraz a k je pevný bod pro E, potom: Y E = k = E k Y E = E (Y E) ~ k = E k LET minus = Y (\ f x y. iszero y x (f (prev x) (prev y))) ``` ### 1. opravný ``` LET True = \ x y. x y LET False = \ x y. y LET NOR = \ a b. a (\i.False) (b (\k.False) True) NOR True False = (\ a b. a (\i.False) (b (\k.False) True)) True False ->Beta (\ b. True (\i.False) (b (\k.False) True)) False ->Beta True (\i.False) (False (\k.False) True) = (\ x y. x y) (\i.False) (False (\k.False) True) ->Beta (\ y. (\i.False) y) (False (\k.False) True) ->Beta (\i.False) (False (\k.False) True) ->Beta False ``` ## 2013/2014 pevny bod, nadefinovat GE ``` Y E = E (Y E) LET gef = \ f x y . (iszero x ? iszero y : (iszero y ? True : f (prev x) (f prev y))) let GE = Y gef ``` # Důkazy Ne všechno je definované v zadání. Například foldr, foldl a podobné definice je potřeba znát z paměti. ## 2019/2020 ### předtermín Dokázat, že `concat xs = foldr (++) [] xs`, když: ``` concat [] = [] -- 1 concat (x:xs) = x ++ concat xs -- 2 ``` Definiční rovnice pro foldr bylo potřeba si nadefinovat. ``` foldr f z [] = z -- 3 foldr f z (x:xs) = f x (foldr f z xs) -- 4 ------- 1: xs = [] L = concat [] =|1 = [] P = foldr (++) [] [] =|2 = [] L=P ------- 2: I.P.: concat xs = foldr (++) [] xs xs = (a:as) L = concat (a:as) =|2 = a ++ concat as =|I.P. = a ++ foldr (++) [] as P = foldr (++) [] (a:as) =|4 = (++) a (foldr (++) [] as) =|prefix -> infix = a ++ (foldr (++) [] as) =|zavorky zbytecne, priorita = a ++ foldr (++) [] as L=P Q.E.D. ``` ## 2018/2019 Dokážte, že platí `any xs = foldr (||) False xs` když: ``` any [] = False -- 1 any (x:xs) = x || any xs -- 2 ``` ``` foldr :: (a -> b -> b) -> b -> [a] -> b foldr f z [] = z -- 3 foldr f z (x:xs) = f x (foldr f z xs) -- 4 any xs = foldr (||) False xs 1) xs = [] L = any [] =|1 = False P = foldr (||) False [] =|3 = False L = P I.H.: any xs = foldr (||) False xs 2) xs = (a:as) L = any (a:as) =|2 = a || any as P = foldr (||) False (a:as) =| 4 = (||) a (foldr (||) False as) =|I.H. = (||) a (any as) =|prefix->infi = a || (any as) =|priorita = a || any as L=P Q.E.D. ``` ## 2017/2018 ### Radny ``` all' [] = True -- 1 all' (x:xs) = x && all' xs -- 2 foldr' f a [] = a -- 3 foldr' f a (x:xs) = f x (foldr' f a xs) -- 4 Ukazat: foldr (&&) True xs = all xs 1) xs = [] L = foldr (&&) True [] =|3 = True P = all [] =|1 = True L = P 2) I.H.: foldr (&&) True as = all as xs = (a:as) L = foldr (&&) True (a:as) =|4 = (&&) a (foldr (&&) True as) =|IH = (&&) a (all as) =|prefix->infix = a && (all as) =|priorita = a && all as P = all (a:as) =|2 = a && all as L = P Q.E.D. ``` ### Opravny ``` length' a [] = a -- 1 length' a (_:xs) = length' (a+1) xs -- 2 foldl' f a [] = a -- 3 foldl' f a (x:xs) = foldl' f (f a x) xs -- 4 length 0 xs = foldl (\ a _ -> a+1) 0 xs 1) xs = [] L = length 0 [] =|1 = 0 P = foldl (\ a -> a+1) 0 [] =|3 = 0 L = P 2) I.P. forall k in N: length k as = foldl (\ a _ -> a+1) k as xs = (a:as) L = length 0 (a:as) =|2 = length (0+1) as =|soucet = length (1) as =|prebytecne zavorky = length 1 as =|I.P. = foldl (\ a _ -> a+1) 1 as P = foldl (\ a _ -> a+1) 0 (a:as) =|4 = foldl (\ a _ -> a+1) ((\ a _ -> a+1) 0 a) as =|beta_redukce = foldl (\ a _ -> a+1) ((\ _ -> 0+1) a) as =|beta_redukce = foldl (\ a _ -> a+1) (0+1) as =|soucet = foldl (\ a _ -> a+1) (1) as =|prebytecne zavorky = foldl (\ a _ -> a+1) 1 as L = P Q.E.D. ``` ## 2016/2017 ``` -- apostrofy pouze pro akceptaci v ghci sum' [] = 0 -- 1 sum' (x:xs) = x + sum' xs -- 2 foldr' f a [] = a -- 3 foldr' f a (x:xs) = f x (foldr' f a xs) -- 4 sum xs = foldr (+) 0 xs (1) xs = [] L = sum [] =|1 = 0 P = foldr (+) 0 [] =|3 = 0 L=P 2) xs = (a:as) I.H. sum as = foldr (+) 0 as L = sum (a:as) =|2 = a + sum as P = foldr (+) 0 (a:as) =|4 = (+) a (foldr (+) 0 as) =|I.H. = (+) a (sum as) =|prefix->infix = a + (sum as) =|priorita aplikace nejvyssi -> eliminace zavorek = a + sum as L = P Q.E.D. ```