Skip to content

Instantly share code, notes, and snippets.

@Pitel
Created May 8, 2012 12:53
Show Gist options
  • Save Pitel/2634678 to your computer and use it in GitHub Desktop.
Save Pitel/2634678 to your computer and use it in GitHub Desktop.
FLP
-- http://en.wikipedia.org/wiki/Binary_search_tree
data BTree a
= Node a (BTree a) (BTree a)
| Empty
deriving (Show)
-- Jednoprvkovy strom, strom bez potomku
singleton :: a -> BTree a
singleton x = Node x Empty Empty
-- Vlozeni prvku do stromu
treeInsert :: Ord a => a -> BTree a -> BTree a
treeInsert x Empty = singleton x
treeInsert x (Node a left right)
| x == a = Node x left right
| x < a = Node a (treeInsert x left) right
| x > a = Node a left (treeInsert x right)
-- Vytvoreni stromu ze seznamu
treeFromList :: Ord a => [a] -> BTree a
treeFromList l = foldl (\tree x -> treeInsert x tree) Empty l
-- Obsahuje strom dany prvek?
treeElem :: Ord a => a -> BTree a -> Bool
treeElem _ Empty = False
treeElem x (Node a left right)
| x == a = True
| x < a = treeElem x left
| x > a = treeElem x right
-- Je strom prazdny?
treeEmpty :: BTree a -> Bool
treeEmpty Empty = True
treeEmpty _ = False
-- Je strom neprazdny?
treeNotEmpty :: BTree a -> Bool
treeNotEmpty x = not(treeEmpty x)
-- Odebrani prvku ze stromu
treeRemoveElem :: (Ord a) => a -> BTree a -> BTree a
treeRemoveElem _ Empty = Empty
treeRemoveElem x (Node a left right)
| x < a = Node a (treeRemoveElem x left) right -- Prvek ktery chceme odstranit je mensi -> jdeme doleva
| x > a = Node a left (treeRemoveElem x right) -- Prvek ktery chceme odstranit je vetsi -> jdeme doprava
| x == a && treeEmpty left && treeEmpty right = Empty -- Nasli jsme prvek ktery chceme odstranit a nema zadne podstromy -> odstranime ho
| x == a && treeEmpty left && treeNotEmpty right = right -- Nasli jsme prvek ktery chceme odstranit a ma podstrom vpravo -> nahradime ho pravym podstromem
| x == a && treeNotEmpty left && treeEmpty right = left -- Nasli jsme prvek ktery chceme odstranit a ma podstrom vlevo -> nahradime ho levy podstromem
| otherwise = Node (mostLeft right) left (treeRemoveElem (mostLeft right) right) -- Nasli jsme prvek ktery chceme odstranit a ma oba podstromy -> nahradime ho nejlevejsim prvkem praveho podstromu, a ten z nej odstranime, levy podstrom ponechame (stejne by to slo s nejpravejsim prvkem leveho podstromu)
where mostLeft (Node b l r) = if treeEmpty l then b else mostLeft l -- Nejlevejsi prvek. Kdyz uz vlevo nic neni, nasli jsme ho, jinak se rekurzivne norime
-- Cesta stromem k danemu prvku
treePathToElem :: (Ord a) => a -> BTree a -> [a]
treePathToElem x tree
| not (treeElem x tree) = [] -- Strom neobsahuje dany prvek
| otherwise = path x tree [] -- Jinak hledame cestu
where path x (Node a left right) l
| x == a = l ++ [a] -- Nasli jsme ho -> jen ho pridame na konec seznamu
| x < a = path x left (l ++ [a]) -- Hledany je mensi -> pridame ho do cesty a jdeme doleva
| x > a = path x right (l ++ [a]) -- Hledany je vetsi -> pridame ho do cesty a jdeme doprava
-- Hloubka stromu
treeDepth :: BTree a -> Integer
treeDepth Empty = 0
treeDepth (Node x left right) = 1 + max (treeDepth left) (treeDepth right)
-- Pre order = koren, levy, pravy
treePreOrder :: BTree a -> [a]
treePreOrder Empty = []
treePreOrder (Node a left right) = [a] ++ (treePreOrder left) ++ (treePreOrder right)
-- Post order = levy, pravy, koren
treePostOrder :: BTree a -> [a]
treePostOrder Empty = []
treePostOrder (Node a left right) = (treePostOrder left) ++ (treePostOrder right) ++ [a]
-- In order = levy, koren, pravy
treeInOrder :: BTree a -> [a]
treeInOrder Empty = []
treeInOrder (Node a left right) = (treeInOrder left) ++ [a] ++ (treeInOrder right)
-- Inverzni pruchody obraceji poradi levych a pravych, koren zustava, takze to neni reverzace!
-- Uprava hodnoty ve stromu (Yao Ming apporved)
treeReplace :: Ord a => a -> a -> BTree a -> BTree a
treeReplace old new tree = treeFromList . listReplace old new $ treePostOrder tree where
listReplace _ _ [] = []
listReplace old new (x:xs) = (if x == old then new else x):(listReplace old new xs)
%
% Počet všech acyklických cest po šachovnici zadaných rozměrů (i obdelníkové) s maximálně 3 změnami směru
%
:- dynamic board/2.
:- dynamic visited/2.
change3(XS, YS, XE, YE, W, H, N) :-
retractall(board(_, _)), retractall(visited(_, _)), % Procisteni
XS > 0, XS =< W, YS > 0, YS =< H, XE > 0, XE =< W, YE > 0, YE =< H, % Kontroly
W > 0, H > 0, assert(board(W, H)), % Kontrola sachovnice
bagof(C, path3(XS, YS, XS, YS, XE, YE, 0, C), RES), % Nalezeni cest, musi byt bagof!
length(RES, N). % Spocitani cest
% OX, OY kde jsem byl
% X, Y kde jsem ted
% EX, EY cil
% C aktualni pocet zmen smeru
% R vysledny pocet zmen smeru
path3(_, _, X, Y, X, Y, C, C) :- C =< 3. % Dosli jsme do cile a provedli jsme max 3 zmeny smeru
path3(_, _, X, Y, X, Y, _, _) :- !, fail. % Dosli jsme do cile a provedli jsme vic nez 3 zmeny smeru
path3(OX, OY, X, Y, EX, EY, C, R) :-
assert(visited(X, Y)), % Oznaceni za navstivene
move(X, Y, NX, NY), % Pohyb
not(visited(NX, NY)), % Kontrola ze nejdu na navstivene pole
changes(OX, OY, X, Y, NX, NY, C, NC), NC =< 3, % Spocitani zmen smeru
path3(X, Y, NX, NY, EX, EY, NC, R). % Rekurze
path3(_, _, X, Y, _, _, _, _) :- visited(X, Y), retract(visited(X, Y)), !, fail. % Kdyz se dostanu do mista odkud nemuzu dal.
changes(OX, OY, X, Y, NX, NY, C, C) :- (OX = X, X = NX) ; (OY = Y, Y = NY). % Kdyz se porad pohybuju ve stejnem smeru
changes(OX, OY, X, Y, NX, NY, C, NC) :- not((OX = X, X = NX) ; (OY = Y, Y = NY)), NC is C + 1. % Kdyz provedu zmenu smeru
% Pohyb a kontroly
move(X, Y, NX, Y) :- NX is X + 1, board(W, _), NX > 0, NX =< W.
move(X, Y, NX, Y) :- NX is X - 1, board(W, _), NX > 0, NX =< W.
move(X, Y, X, NY) :- NY is Y + 1, board(_, H), NY > 0, NY =< H.
move(X, Y, X, NY) :- NY is Y - 1, board(_, H), NY > 0, NY =< H.
import System.IO
-- Spocte pocet radku v souboru.
countLines file = do
h <- openFile file ReadMode
c <- hGetContents h
putStrLn . show . length $ lines c
hClose h
-- Spocte pocet slov v prvnich n radcich v souboru.
countWordsN file n = do
h <- openFile file ReadMode
c <- hGetContents h
putStrLn . show . length . words . unlines . take n $ lines c
hClose h
-- Prokladane vypise obsah souboru na vystup.
prokladane file1 file2 = do
h1 <- openFile file1 ReadMode
h2 <- openFile file2 ReadMode
c1 <- hGetContents h1
c2 <- hGetContents h2
write (lines c1) (lines c2)
hClose h1
hClose h2
where
write [] _ = return ()
write _ [] = return ()
write (x:xs) (y:ys) = do
putStrLn x
putStrLn y
write xs ys
-- Vytiskne dva soubory za sebou
vystup2souboru file1 file2 = do
h1 <- openFile file1 ReadMode
h2 <- openFile file2 ReadMode
c1 <- hGetContents h1
c2 <- hGetContents h2
putStrLn c1
putStrLn c2
hClose h1
hClose h2
-- Vypise obsah souboru s cisly radky.
printWithLineNumber file = do
h <- openFile file ReadMode
c <- hGetContents h
write (lines c) 1
hClose h
where
write [] _ = return ()
write (x:xs) n = do
putStrLn $ (show n) ++ ". " ++ x
write xs (n + 1)
-- Vypise radky na vystup, ktere jsou v obou souborech, ve stejnem poradi.
copyOut file1 file2 = do
h1 <- openFile file1 ReadMode
h2 <- openFile file2 ReadMode
c1 <- hGetContents h1
c2 <- hGetContents h2
putStr . unlines $ [x | x <- lines c1, y <- lines c2, x == y]
hClose h1
hClose h2
MODULE Fibonacci.
IMPORT Integers.
PREDICATE Fib : Integer * Integer.
Fib(0,0).
Fib(1,1).
Fib(k,n) <-
k > 1 &
FibIt(k-2,1,1,n).
PREDICATE FibIt : Integer * Integer * Integer * Integer.
FibIt(0,_,g,g).
FibIt(k,f,g,n) <-
k > 0 &
g < n &
FibIt(k-1,g,f+g,n).
##########################################################
MODULE PRIME.
IMPORT Integers.
PREDICATE Prime : Integer.
Prime(prime) <- ~ SOME [x] (x > 1 & x < prime & prime Mod x = 0).
%
% Nejkratsi cesta orientovanym grafem
%
:- dynamic used/1. % Navstivene uzly
% Graf
edge(1,2).
edge(1,4).
edge(2,4).
edge(2,3).
edge(4,5).
edge(3,5).
edge(5,6).
edge(6,7).
edge(7,1).
hledej(S, E, Nej) :-
setof(P, hledejcestu(S, E, P), Res), % Mnozina vsech reseni
shortest(Res, Nej). % Nalezeni nejkratsiho
hledejcestu(S, S, [S]). % Cesta samm do sebe
hledejcestu(S, E, [S | Res]) :-
assert(used(S)), % Ulozeni navstiveneho uzlu
edge(S, N), % Posun po hrane
not(used(N)), % Kontrola ze jsme tu jeste nebyli
hledejcestu(N, E, Res). % Rekurze
hledejcestu(S, _, _):- used(S), retract(used(S)), !, fail. % ?????
% Nejkratsi cesta
shortest([H], H).
shortest([X,Y|T], Res) :- length(X, LX), length(Y, LY), LX < LY, shortest([X | T], Res).
shortest([X,Y|T], Res) :- length(X, LX), length(Y, LY), LX >= LY, shortest([Y | T], Res).
data Lambda a
= LVar a -- V
| LApp (Lambda a) (Lambda a) -- (E1 E2)
| LAbs a (Lambda a) -- (\V . E)
deriving (Show, Eq)
-- \xyz.xa == LAbs "x" (LAbs "y" (LAbs "z" (LApp(LVar "x") (LVar "a"))))
-- Vrátí seznam všech volných proměnných v lambda výrazu.
freeVars :: Eq a => Lambda a -> [a]
freeVars (LVar v) = [v] -- Samotna promenna je proste vzdy volna
freeVars (LApp e1 e2) = (freeVars e1) ++ (freeVars e2)
freeVars (LAbs v e) = filter (/= v) $ freeVars e
-- Vrátí seznam všech vázaných proměnných v lambda výrazu.
boundVars :: Eq a => Lambda a -> [a]
boundVars (LVar v) = [] --Promenna je volna!
boundVars (LApp e1 e2) = (boundVars e1) ++ (boundVars e2)
boundVars (LAbs v e) = (boundVars e) ++ filter (v ==) (freeVars e) -- Kdyz neni volna, tak je vazana
-- Proměnné které na sebe mohou vázat
boundingVars :: Lambda a -> [a]
boundingVars (LVar v) = [] --Promenna je volna!
boundingVars (LApp e1 e2) = (boundingVars e1) ++ (boundingVars e2)
boundingVars (LAbs v e) = v : boundingVars e
-- \xyz.xa == [xyz]
-- Alfa konverze
alpha :: Eq a => Lambda a -> Lambda a -> Lambda a -> Lambda a
alpha e (LVar v) (LVar v') = if check then doAlpha e else error "Bounding problem!" where
check = (elem v (boundVars e)) && (not (elem v' ((freeVars e) ++ (boundingVars e)))) -- Nahrazovana promenna musi byt vazana a nahrazujici promenna nesmi byt volna nebo vazajici
doAlpha (LVar var) = LVar $ if var == v then v' else var
doAlpha (LApp e1 e2) = LApp (doAlpha e1) (doAlpha e2)
doAlpha (LAbs var le) = LAbs (if var == v then v' else var) (doAlpha le)
-- Substituce
subst :: Eq a => Lambda a -> Lambda a -> Lambda a -> Lambda a
subst e (LVar v) e' = if check then doSubst e else error "Bounding problem!" where
check = (not (elem v (boundVars e))) && ((intersect (boundingVars e) ((freeVars e') ++ (boundVars e') ++ (boundingVars e'))) == []) -- Nahrazovana promenna musi byt volna a nahrazujici vyraz musi mit jinak pojmenovane promenne
doSubst (LVar v') = if v' == v then e' else LVar v'
doSubst (LApp e1 e2) = LApp (doSubst e1) (doSubst e2)
doSubst (LAbs v' le) = LAbs v' (doSubst le)
-- subst (LAbs "x" (LVar "y")) (LVar "y") (LApp (LVar "a") (LVar "b")) == LAbs "x" (LApp (LVar "a") (LVar "b"))
-- Beta redukce
beta :: Eq a => Lambda a -> Lambda a -> Lambda a
beta (LAbs v e) e' = if check then doBeta e else error "Bounding problem!" where
check = intersect (filter (/=v) ((freeVars e') ++ (boundingVars e'))) (boundingVars (LAbs v e)) == []
doBeta (LVar v') = if v' == v then e' else LVar v'
doBeta (LApp e1 e2) = LApp (doBeta e1) (doBeta e2)
doBeta (LAbs v' le) = LAbs v' (if v' == v then le else doBeta le)
-- Eta konverze
eta :: Eq a => Lambda a -> Lambda a
eta l@(LAbs v (LApp e (LVar v'))) = if (v == v') && (not $ elem v (freeVars e)) then e else l
intersect :: Eq t => [t] -> [t] -> [t]
intersect xs ys = [a | a <- xs, b <- ys, a == b]
lambda(v(_)). % Promenna
lambda(apl(lambda(_), lambda(_))). % Aplikace
lambda(abs(v(_), lambda(_))). % Abstrakce
% Seznam bez duplicit
remdups([], []). % Prazdny seznam je bez duplicit
remdups([H|T], R) :- member(H, T), remdups(T, R). % Pokud najdeme duplicitu (H je obsazeno v T), ignorujeme a rekurzime
remdups([H|T], [H|R]) :- not(member(H, T)), remdups(T, R). % Pokud najdeme unikatni prvek (H neni v T), pridame ho na zacatek vysledku a rekurzime
% vraci seznam volnych promenych
freeVars(E, F) :- fv(E, [], Fs), remdups(Fs, F). % Najdeme volne a vratime seznam bez duplicit
fv(v(V), B, []) :- member(V, B). % Promenna je mezi vazajicimi, takze je vazana
fv(v(V), B, [V]) :- not(member(V, B)). % Promenna neni mezi vazajicimi, takze je volna
fv(apl(E1, E2), B, F) :- fv(E1, B, F1), fv(E2, B, F2), append(F1, F2, F). % Pri lambda aplikaci ziskama volne promenne z podvyrazu
fv(abs(v(V), E), B, F) :- fv(E, [V|B], F). % Pri lambda abstrakci pridame vazajici promennou a rekurzime do vyrazu
% vraci seznam vazanych promenych
boundVars(E, B) :- bv(E, [], Bs), remdups(Bs, B). % Najdeme volne a vratime seznam bez duplicit
bv(v(V), B, [V]) :- member(V, B). % Promenna je mezi vazajicimi, takze je vazana
bv(v(V), B, []) :- not(member(V, B)). % Promenna neni mezi vazajicimi, takze je volna
bv(apl(E1, E2), B, Bs) :- bv(E1, B, B1), bv(E2, B, B2), append(B1, B2, Bs). % Pri lambda aplikaci ziskama vazane promenne z podvyrazu
bv(abs(v(V), E), B, [V|Bs]) :- bv(E, [V|B], Bs). % Pri lambda abstrakci pridame vazajici promennou a rekurzime do vyrazu
--Napište funkci v Haskellu, která otevře tři soubory (2 pro čtení, třetí výstupní). V prvním souboru bude seznam loginů podle zvykostí FITu, v druhém bude nějaký text. Program do třetího souboru zapíše text z druhého souboru tolikrát, kolik je v prvním souboru loginů, zaměňuje každý výskyt řetězce xzzzzz99 za právě zpracovávaný login. Loginy budou ve výstupním souboru ve stejném pořadí jako ve vstupním souboru s loginy.
import System.IO
filllogins :: FilePath -> FilePath -> FilePath -> IO ()
filllogins log txt res = do
logH <- openFile log ReadMode -- Handlery souboru
txtH <- openFile txt ReadMode -- pro cteni
resH <- openFile res WriteMode -- a pro zapis
logC <- hGetContents logH -- Nacteni obsahu souboru s loginy
txtC <- hGetContents txtH -- Nacteni obsahu sablony
hPutStr resH $ unlines $ map (subs txtC) (lines logC) -- Nahrazeni loginu, unline, zapis
hClose logH -- Close
hClose txtH -- all the
hClose resH -- files
where
subs [] _ = [] -- Kdyz neni co nahrazovat tak konec
subs line@(x:xs) login =
if take 8 line == "xzzzzz99" -- Kdyz retezec zacina "xzzzzz99"...
then login ++ subs (drop 8 line) login -- Tak ho nahradime za login a rekurzime zbytek retezce
else x:subs xs login -- Jinak preskocime jeden znak a rekurzime zbytek retezce
%
% Najdi cestu po sachovnici, jsou na ni bariery, smis se pohybovat jen o 2 policka horizontalne nebo verikalne
%
:- dynamic pozice/2.
:- dynamic size/2.
%Priprava barier
barier(1,4).
barier(2,4).
barier(4,4).
barier(3,2).
hledej(W, H, SX, SY, EX, EY, Nej) :-
retractall(pozice(_, _)), retractall(size(_, _)), % Procisteni
W > 0, H > 0, % Test velikosti sachovnice
assert(size(W, H)), % Ulozeni veliskosti sachovnice
setof(P, hledejcestu(SX, SY, EX, EY, P), Res), % Mnozina vsech reseni
shortest(Res, Nej). %Najdeme nejkratsi
hledejcestu(SX, SY, SX, SY, [(SX, SY)]). % Kdyz zustavame na miste, je to ok
hledejcestu(SX, SY, EX, EY, [(SX, SY) | Res]) :-
assert(pozice(SX, SY)), % Ulozeni navstivene pozice
pohyb(SX, SY, XX, YY), % Pohyb
not(pozice(XX, YY)), % Kontrola ze jsem tu jeste nebyli
hledejcestu(XX, YY, EX, EY, Res). % Rekurze (hledani dalsi cesty)
hledejcestu(SX, SY, _, _, _) :- pozice(SX,SY), retract(pozice(SX, SY)), !, fail. % ?????
% Pohyb po sachovnici, test na pruchod barierou
pohyb(SX, SY, EX, SY) :- EX is SX + 2, test(EX, SY), not(barier(EX, SY)), XX is SX + 1, not(barier(XX, SY)).
pohyb(SX, SY, EX, SY) :- EX is SX - 2, test(EX, SY), not(barier(EX, SY)), XX is SX - 1, not(barier(XX, SY)).
pohyb(SX, SY, SX, EY) :- EY is SY + 2, test(SX, EY), not(barier(SX, EY)), YY is SY + 1, not(barier(SX, YY)).
pohyb(SX, SY, SX, EY) :- EY is SY - 2, test(SX, EY), not(barier(SX, EY)), YY is SY - 1, not(barier(SX, YY)).
test(X,Y) :- size(W, H), X > 0, Y > 0, X =< W, Y =< H. % Test zda pohyb neskoncil mimo sachovnici
% Nalezeni nejkratsi cesty
shortest([X], X).
shortest([X, Y | T], Res) :- length(X, XL), length(Y,YL), XL < YL, shortest([X | T], Res).
shortest([X, Y | T], Res) :- length(X, XL), length(Y,YL), XL >= YL, shortest([Y | T], Res).
%
% Podmnozina
%
% subset(mnozina, podmnozina).
subset(_, []). % Prazdna mnozina je podmnozina cehokoliv
subset(S, [H|T]) :- member(H, S), subset(S, T). % member rozhoduje zda je prvek H v seznamu S
%
% Obsahuje mnozina mnozin 2 stejne mnoziny?
% Mnozinou se mysli (neusporadany) seznam neobsahujici stejne prvky
%
has2eq([S1, S2 | SS]) :- % Vezmeme si prvni 2 mnoziny
(subset(S1, S2), subset(S2, S1)); % Mnoziny jsou stejne, pokud jsou vzajemne svymi podmnozinami
has2eq([S1 | SS]); % Nebo zkusime porovnavat prvni se zbytkem
has2eq([S2 | SS]). % Nebo zkusime porovnavat druhou se zbytkem
%
% Podretezec
% sbstr(string, substring)
%
sbstr(_, []). % Prazdny retezec je podretezcem cehokoliv
sbstr([H | STR], [H | SUB]) :- prefix(STR, SUB). % Pokud najdeme stejny prefix, zkusime jestli plati i dal, jinak pokracujeme v hledani
sbstr([_ | STR], SUB) :- sbstr(STR, SUB). % Hledame dal
prefix(_, []). % Pokud dozpracujeme podretezc, tak jsme ho nasli v retezci
prefix([H | STR], [H | SUB]) :- prefix(STR, SUB). % Kontrolujeme dal
%
% \f l -> map f $ concat l
% Provede funkci f nad kazdym prvkem ze seznamu seznamu
%
mapconcat(_, [], []). % Kdyz dostaneme prazdny seznam, tak nas funkce nezajima a vysledek je prazdny seznam
mapconcat(F, [[]|LS], R) :- mapconcat(F, LS, R). % Kdyz dozpracujeme podseznam, tak pokracujeme zbytkem seznamu
mapconcat(F, [[X|XS]|LS], [Y|R]) :- % Normalni pouziti
C =.. [F, X, Y], call(C), % Zavolani funkce nad prvkem seznamu
mapconcat(F, [XS|LS], R). % Rekurze (XS uz je seznamem)
inc(X, I) :- I is X + 1. % Pro testovani mapconcat(inc, [[1, 2], [3, 4]], R)
%
% Seznam všech palindromů délky alespoň 3 vyskytujících se jako podřetězec v řetězci zadaném seznamem.
%
palyndromes3(L, P) :- setof(S, sbstr(L, S), SUBS), include(pal3, SUBS, P). % include je jako filter
pal3(X) :- length(X, L), L >= 3, reverse(X, X). % Palyndrom delky alespon 3
% Najdi seznam prumerne delky
stredni(S, Res) :-
max(S, Max), % Nejdelsi seznam
min(S, Min), % Nejkratsi seznam
Half is (Max + Min) / 2, % Prumer
middle(S, Half, Res). % Nalezeni seznamu prumerne delky
middle([X], _, X). % Jediny seznam je prumerny
middle([X, Y | T], Half, Res) :-
length(X, XL), RozdilX is XL - Half, abs(RozdilX, AbsRozdilX), %Rozdil delky prvniho seznamu od prumeru
length(Y, YL), RozdilY is YL - Half, abs(RozdilY, AbsRozdilY), %Rozdil delky druheho seznamu od prumeru
AbsRozdilX < AbsRozdilY, middle([X | T], Half, Res). % Rekurze s kratsim seznamem
middle([X, Y | T], Half, Res) :-
length(X, XL), RozdilX is XL - Half, abs(RozdilX, AbsRozdilX), %Rozdil delky prvniho seznamu od prumeru
length(Y, YL), RozdilY is YL - Half, abs(RozdilY, AbsRozdilY), %Rozdil delky druheho seznamu od prumeru
AbsRozdilX >= AbsRozdilY, middle([Y | T], Half, Res). % Rekurze s kratsim seznamem
% Nejedelsi seznam
max([X], L) :- length(X, L).
max([X, Y | T], Res) :- length(X, XL), length(Y, YL), XL > YL, max([X | T], Res).
max([X, Y | T], Res) :- length(X, XL), length(Y, YL), XL =< YL, max([Y | T], Res).
% Nejkratsi seznam
min([X], L) :- length(X, L).
min([X, Y | T], Res) :- length(X, XL), length(Y, YL), XL < YL, min([X | T], Res).
min([X, Y | T], Res) :- length(X, XL), length(Y, YL), XL >= YL, min([Y | T], Res).
import System.IO
data LinkedList
= Item Int String LinkedList
| Eol
deriving(Show)
nacti :: Int -> FilePath -> IO ()
nacti cislo soubor = do
f <- openFile soubor ReadMode
c <- hGetContents f
vypiscislo cislo $ to_linked_list $ lines c
hClose f
vypiscislo :: Int -> LinkedList -> IO ()
vypiscislo cislo Eol = putStr ""
vypiscislo cislo (Item num text list) = if cislo == num
then do
putStrLn text
vypiscislo cislo list
else do
vypiscislo cislo list
to_linked_list :: [String] -> LinkedList
to_linked_list [] = Eol
to_linked_list (line:lines) = Item (cisloradku line) (textradku line) (to_linked_list lines)
cisloradku :: String -> Int
cisloradku line = read (takeWhile (/=':') line) :: Int
textradku :: String -> String
textradku line = tail $ dropWhile (/=':') line
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment