FLP

btree.hs

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

change3.pro

%
% 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.

files.hs

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

goedel

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).

graf.pro

%
% 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).

lambda.hs

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.pro

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

logins.hs

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

sachovnice.pro

%
% 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).

shorts.pro

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

stredniseznam.pro

% 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).

vypiscislo.hs

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