Prolog ======= * Sestavte predikáty hladiny(+Strom, -Seznam_Hladin) kde výstupní parametr je seznam seznamu prvku na jednotlivých hladinách vstupního binárního stromu Strom a k nemu inverzní strom(-Strom, +Seznam_Hladin). Nejedná se o binární vyhledávací strom, ale prvky na dané hladine jsou serazené (na jejich poradí záleží). Takže pokud mám hladinu 3 (max. 4 prvky) [a,b,c], tak tu hladinu mohu rekonstruovat jako [nil a b c], [a nil b c], [a b nil c] nebo [a b c nil], nikoli jako [b a nil c]. Pochopitelne to muže být jeden oboustranný predikát, bude-li efektivní (to inverzní musí vracet postupne všechny možnosti stromu) Řešení: [Kryl toto reseni uznal] %hladiny(+- Strom, +- Hladiny) hladiny(nil, []). hladiny(tree(Levy, Hodnota, Pravy), [[Hodnota] | T]) :- hladiny(Levy, TL), hladiny(Pravy, TP), bmerge(TL, TP, T). bmerge([], X, X). bmerge(X, [], X). bmerge([X1|T1], [X2|T2],[X|T]) :- merge(X1, X2, X), bmerge(T1, T2, T). merge([], X, X). merge([X|T1], T2, [X|T]) :- merge(T1, T2, T). * Definujte predikát odpov(r1,r2) dvou proměnných, který pro každé dva seznamy (přirozených čísel a znaků * a ?) r1 a r2 uspěje pokud existuje "substituce jedno císla za žolík '?' a substituce posloupnosti čísel za znak '*'" takové, že dostanete stejné seznamy. Mužete předpokládat, že v každém ze seznamů, které jsou parametry, muže být nanejvýše jedna hvězdička. Řešení #1: [OK] match(?,_). match(_,?). match(A,A). % :- number(A). pokud je libo :) odpov([*|A], B) :- reverse(A, RA), reverse(B, RB), odpovt(RA, RB). odpov(A, [*|B]) :- reverse(A, RA), reverse(B, RB), odpovt(RB, RA). odpov([A1|A], [B1|B]) :- match(A1, B1), odpov(A, B). odpov([], []). odpovt([], _). odpovt(_, [*|_]). odpovt([A1|A], [B1|B]) :- match(A1, B1), odpovt(A, B). Řešení #2 by Martin Všeticka: odpov(R1,R2) :- cutStart(R1,R2,R1c,R2c), % kontroluji zda se shoduji zacatky obou seznamu, dokud nenarazim na hvezdicku, % vratim zbytky obou seznamu (hvezdicku ponechavam v seznamu) reverse(R1c,R1cr), % otocim seznam reverse(R2c,R2cr), % otocim seznam cutStart(R1cr,R2cr,_,_). % orezavam, tentokrat konce % cutStart bud failuje a pak seznamy nemohou byt stejne nebo nezfailuje a vratil by seznamy: % 1. pripad: % =========== % L1=[*,neco, neco,...] % L2=[neco, neco,...,*] % coz je pripad, kdy bychom meli vratit "true" ( % hvezdicka v L1 se predstavuje zacatek L2 az po hvezdicku; pro hvezdicku v L2 obdobne) % % 2. pripad: % =========== % L1=[cislo/*] % L2=[*/cislo] % meli bychom vratit "true" % match match(X,Y):-integer(X),integer(Y),X=:=Y. match(X,Y):-(X == '?';Y=='?'),(integer(X);integer(Y)). % cutStart(+Sezn1,+Sezn2,-OrezanySezn1,-OrezanySezn2) /* pokud procedura zjisti, ze se seznamy lisi ve dvou prvcich, tak nenavratne failuje */ cutStart([],[],[],[]):-!. % oba dva seznamy jsou stejne (s prihlednuti k vyznamu '?') a neobsahuji hvezdicku cutStart([],L2,[],L2):-!,fail. % jeden seznam je kratsi nez druhy; fail cutStart(L1,[],L1,[]):-!,fail. % dtto cutStart([H1|T1],[H2|T2],T3,T4):-match(H1,H2),!,cutStart(T1,T2,T3,T4). % dve stejna cisla cutStart([H1|_],[H2|_],_,_):-integer(H1),integer(H2),H1=\=H2,!,fail. % dve ruzna cisla; konec cutStart([H1|T1],[H2|T2],[H1|T1],[H2|T2]):-(H1=='*';H2=='*'),!. % konec na hvezdicce * Prevest permutaci zadanou ve tvaru "v(7,[4,3,5,6,2,7,1])" (tedy prvni cifra udava rozsah hodnot v permutaci, zde od 1 do 7, pak nasleduje seznam, kde prvek na pozici i se zobrazi na cislo na te pozici) do zapisu ve tvaru cyklu "c(7,[[1,4,6,7],[2,3,4]])" , tedy nepsat jednoprvkove cykly. Řešení: [?] preved(v(L, P), c(L, CP)) :- ohodnot(1, P, O), spoj(O, CP), !. ohodnot(X, [X|T], Z) :- L1 is X + 1, ohodnot(L1, T, Z). ohodnot(L, [H|T], [[L,H]|Z]) :- L1 is L + 1, ohodnot(L1, T, Z). ohodnot(_, [], []). spoj([H|Z], O) :- last(H, Last), member([Last|X], Z), append(H,X,V), delete(Z, [Last|X], Z1), spoj([V|Z1], O). spoj([H|Z], [X|O]) :- append(X, [_], H), % odstrani posledni prvek spoj(Z, O). spoj([], []). Řešení #2 by Mus: Popis: Vezmu prvni prvek permutace, hledam pro nej cyklus, vratim permutaci, kde prvky, na kterych jsem byl, jsou 0. cyklus hledam naivne - cili vezmu dany prvek x, pridam do seznamu, k nemu xty, ap. dokud nezjistim, ze tam ten prvek uz v cyklu je Kód: perm_cykly(v(0,_), c(0,[])). perm_cykly(v(N,P), c(N,C)) :- perm(P, P, C). %perm(+[Permutace], +[Permutace], -[[Cyklus]]) perm(_, [], []). %hledame postupne cykly pres vsechny prvky permutace perm(P, [HP|TP], [C|CS]) :- najdi_cyklus(HP, P, [], C, P2), !, perm(P2, TP, CS). %vratil se prazdny seznam, ten v cyklech nechceme perm(P, [_|TP], CS) :- perm(P, TP, CS). %najdi_cyklus(+Prvek, +[Permutace], +[SetridenySeznam], -[Cyklus], -[0Permtuce]) najdi_cyklus(X, P, C1, C, P3) :- nty(X,P,NT,P2), vloz(NT, C1, C2), !, najdi_cyklus(NT, P2, C2, C, P3). najdi_cyklus(_, P, [], [], P) :- !, fail. % vkladali jsme 0 -> prvek uz je v min. cyklu najdi_cyklus(_, P, [_], [], P) :- !, fail. % identita -> prazdny seznam najdi_cyklus(_, P, C, C, P). % prvek uz je v cyklu, konec %vloz(+Prvek, +SetridenySeznam, -SetridenySeznam), vklada prvek > 0 do usp. sezn. vloz(0, _, _) :- !, fail. vloz(X, [H|T], [H|T1]) :- X > H, !, vloz(X, T, T1). vloz(X, T, [X|T]). %nty(+N, +Seznam, -Nty, -Seznam), vrati Nty a vrati seznam, kde na Ntem prvku je 0 nty(1, [H|T], H, [0|T]). nty(N, [H|T], X, [H|T1]) :- N1 is N - 1, nty(N1, T, X, T1). Řešení #3 by Martin Všeticka: % +N ... pocet permutovanych prvku % +Perm ... permutace, seznam, pr. [4,3,2,1] pro N = 4 % -Cycles ... vrati: [[1, 4], [2, 3]] perm2cycles(N,Perm,Cycles):- addPos(N,Perm,PermPairs), place(PermPairs,CyclesPairs), findCycles(CyclesPairs,Cycles). % addPos(+N, +Perm, -Result) % Prevede permutaci [4,3,2,1] na [[1,4],[2,3],[3,2],[4,1]], tj. % mame tedy vzdy dvojici [x,f(x)] addPos(N,Perm,Result):-addPos(1,N,Perm,Result). addPos(N,N,[P],[[N,P]]). addPos(I,N,[H|PermTail],[[I,H]|Result]):-I1 is I+1, addPos(I1,N,PermTail,Result). % place(+PermPairs,-CyclesPairs) % Seradi za sebou dvojice [x,f(x)] timto zpusobem: % CyclesPairs = [ [x,f(x)], [f(x),y],[y,x], [h,i],[i,j], ...] % tj. vytvarime co nejdelsi posloupnosti place(PermPairs,CyclesPairs):-place(PermPairs,[],CyclesPairs). place([],L,L). place([[First,Second]|T],Tmp,Result):-placeWork([First,Second],Tmp,Tmp2), place(T,Tmp2,Result). placeWork([F1,S1],[],[[F1,S1]]). placeWork([F1,S1],[[F2,S2]|T],[[F1,S1],[F2,S2]|T]):-S1=:=F2. placeWork([F1,S1],[[F2,S2]|T],[[F2,S2],[F1,S1]|T]):-F1=:=S2. placeWork([F1,S1],[[F2,S2]|T],[[F2,S2]|R]):-placeWork([F1,S1],T,R). % findCycles(+CyclesPairs,-Cycles) % pr. CyclesPairs = [ [x,f(x)], [f(x),y],[y,x], [h,i],[i,j], ...] % predikat nalezne cykly. Prvni z prikladu je [x,f(x)], [f(x),y],[y,x]. findCycles([],[]). findCycles([[Start,Start]|RestCyclesPairs],R):-findCycles(RestCyclesPairs,R). % odstraneni jednoprvkovych cyklu findCycles([[Start,Last]|TCyclesPairs],[Cyclus|R]):-Start=\=Last, findCycle(Start,Last,TCyclesPairs,Cyclus,RestCyclesPairs), findCycles(RestCyclesPairs,R). % findCycle(+Start,+Last,+CyclesPairs,-Cyclus,-RestOfCyclesPairs) % Start ... hodnota prvku, kterym jsme zacinali a ktery kdyz nalezneme % znovu, tak mame cyklus % Last ... hodnota prvku, na ktery chceme napojovat % CyclesPairs ... seznam dvojic [x,f(x)] findCycle(Start,Last,[[F1,S1]|RestCyclesPairs],[Last|R],Return):-Last=:=F1, S1=\=Start, findCycle(Start,S1,RestCyclesPairs,R,Return). findCycle(Start,Last,[[F1,S1]|RestCyclesPairs],[Last,Start],RestCyclesPairs):- % uspesny konec cyklu Last=:=F1, S1=:=Start. * Vytvorit predikat, ktery % a) prijme 2 permutace v zapisu cyklu a vrati jejich soucin (tedy slozeni permutaci) Řešení by Martin Všetička: soucin(c(N,C1), c(N,C2), c(N,C3)):- % soucin dvou permutaci sezn(N,1,Res1), sloz(N,C1,C2,Res1,P_tmp), perm_cykly(v(N,P_tmp),c(N,C3)). sloz(_,[],_,Res1,Res1). % zpracuje v kazdem kroku jeden cyklus prvni permutace do vysledne permutace sloz(N,[[H|T]|Z],C2,Rs1,Rs):- zarad(H,[H|T],C2,Rs1,Rs2), sloz(N,Z,C2,Rs2,Rs). % v prvni permutaci se H1 zobrazi na Start zarad(Start,[H],C2,Rs1,Rs2):- fnd(Start, C2, X), umisti(1,H, X, Rs1, Rs2). % v prvni permutaci se H1 zobrazi na H2 zarad(Start,[H1,H2|L],C2,Rs1,Rs2):- fnd(H2,C2,X), umisti(1,H1, X, Rs1, Rs3), zarad(Start,[H2|L],C2,Rs3,Rs2). umisti(N,N,X,[_|T],[X|T]). umisti(I,N,X,[H|T],[H|Rs]):-I1 is I+1,umisti(I1,N,X,T,Rs). fnd(E,[[H|T1]|_],X):-fnd0(E,H,[H|T1],X). % na co se zobrazi prvek E v druhe permutaci fnd(E,[_|T],X):-fnd(E,T,X). fnd0(E,X,[E],X). fnd0(E,_,[H1,H2|_],H2):-E==H1. fnd0(E,H,[H1,H2|T1],X):-E\=H1,fnd0(E,H,[H2|T1],X). %sezn(+N, 1, -[1..N]). ... vrati seznam N nul sezn(N, N, [N]). sezn(N, X, [0|T]) :- X < N, X1 is X + 1, sezn(N, X1, T). Řešení by Mus: %POSTUP: brute-force cykly->permut->soucin->permut->cykly %soucinc(+Cykly, +Cykly, -SoucinCyklu) soucinc(c(N,C1), c(N,C2), c(N,C3)) :- cykly_perm(v(N,P1),c(N,C1)), % vrati permutaci jakozto seznam pres prvni parametr cykly_perm(v(N,P2),c(N,C2)), soucinp(P1, P2, P3), perm_cykly(v(N,P3), c(N,C3)). %soucinp (+Permutace1, +Permutace2, -Slozena) ... slozeni dvou permutaci ulozenych v seznamech soucinp([], _, []). soucinp([P1|T1], P2, [S|TS]) :- nty(P1,P2,S), soucinp(T1, P2, TS). %nty(+N, +Seznam, -Nty, -Seznam), vrati Nty a vrati seznam, kde na Ntem prvku je 0 nty(1, [H|_], H). nty(N, [_|T], X) :- N1 is N - 1, nty(N1, T, X). %cykly_perm(-Permutace, +Cykly) cykly_perm(v(0,_), c(0,[])). cykly_perm(v(N,P), c(N,C)) :- sezn(N, 1, P1), cykly_init(C, P1, P). %cykly_init(+Cykly, +TempPermutace, -Permutace) cykly_init([], P, P). cykly_init([C|TC], P1, P) :- cykl(C,C,1,P1,P2), cykly_init(TC, P2, P). %cykl(+Cyklus, +Cyklus, 1, +TempPermutace, -PermutaceDleCyklu) cykl([HC|_], [C|TC], N, [H|TP], [H|T2]) :- N < C, !, N1 is N + 1, cykl([HC], [C|TC], N1, TP, T2). cykl([HC|_], [_], _, [_|TP], [HC|TP]). cykl([HC|_], [_,C2|TC], N, [_|TP], [C2|T2]) :- N1 is N + 1, cykl([HC], [C2|TC], N1, TP, T2). %sezn(+N, 1, -[1..N]). ... vrati seznam cisel od 1 do N sezn(N, N, [N]). sezn(N, X, [X|T]) :- X < N, X1 is X + 1, sezn(N, X1, T). * Čísla reprezentujeme jako seznamy čísel jejich dvojkových zápisů. Sestavte predikát, který realizuje násobení čísel. Řešení by Martin Všetička: binAdd(B1,B2,R):-binAdd(B1,B2,0,R1),reverse(R1,R). binAdd([],[],0,[]). binAdd([],[],1,[1]). binAdd([],[H2|T2],Rem,R):-binAdd([H2|T2],[],Rem,R). binAdd([H1|T1],[],0,[H1|T1]). binAdd([H1|T1],[],1,[H3|R]):- count(H1+1,H3,Rem2), binAdd(T1,[],Rem2,R). binAdd([H1|B1],[H2|B2],Rem,[H3|R]):- count(H1+H2+Rem,H3,Rem2), binAdd(B1,B2,Rem2,R). count(Sum,Show,Remainder):-Remainder is Sum//2, Show is Sum mod 2. % cisla se zadavaji odzadu, vysledek je jiz popredu binMult(B1,B2,R):-binMult(B1,B2,[],R1),reverse(R1,R). binMult(_,[],R,R). binMult(B1,[0|B2],M,R):-binMult([0|B1],B2,M,R). binMult(B1,[1|B2],M,R):-binAdd(M,B1,0,M1), binMult([0|B1],B2,M1,R). Zdroje: http://www.binarymath.info/multiplication-division.php Řešení z http://prgs.xf.cz/: %binarni cisla reprezentujeme jako seznam jednicek a nul %mult(+A, +B, -AxB) %v predikatu mult jsou v seznamu cisla serazene od nejvyssi vahy po nejmensi %cislo 12 = 1100 v programu [1,1,0,0] mult(A,B, Res):- reverse(A,RA), reverse(B,RB), nasob(RA, RB, RRes), reverse(RRes, Res). %reverse(+L, -ReversedL). reverse(L, RL):-reverse(L, [], RL). reverse([H|T], Acc, Res):-reverse(T, [H|Acc], Res). reverse([], Acc, Acc). %nasob(+A, +B, -AxB) %v seznamu jsou cisla serazene od nejmensi vahy po nejvetsi %cislo 12 = 1100 v programu [0,0,1,1] nasob(A, B, Res):- nasob(A, B, 0, [], Res). %nasob(+A, +B, +PosunitieBdolava, +DocasnySucet, -Res) nasob(_, [], _, Acc, Acc). nasob(A, [0|B], N, Acc, Res):- N2 is N+1, nasob(A, B, N2, Acc, Res). nasob(A, [1|B], N, Acc, Res):- posun(A, N, A2), scitaj(A2, Acc, 0, Tmp), N2 is N+1, nasob(A, B, N2, Tmp, Res). %posun(+A, +PocetMist, -Aposunute_o_pocet_mist_doleva) posun(A, 0, A):-!. posun(A, N, [0|X]):- N2 is N-1, posun(A, N2, X). %scitaj(+A, +B, +Prechod, -Res):- scitaj([X|A],[Y|B], P, [Z|R]):- bs(X, Y, V, 0), bs(V, P, Z, P2), scitaj(A, B, P2, R). scitaj([1|A], [1|B], P, [P|R]):- scitaj(A, B, 1, R). scitaj([], B, 0, B). scitaj(A, [], 0, A). scitaj([], B, 1, R):- !, scitaj([1], B, 0, R). scitaj(A, [], 1, R):- scitaj(A, [1], 0, R). %bs(+C1, +C2, -Vysl, -Prechod) %binarni scitani dvou binarnich cisel bs(0,0,0,0). bs(0,1,1,0). bs(1,0,1,0). bs(1,1,0,1). * Sestavte predikát natretiny(+Seznam,-Prvni,-Druhy,-Treti), který rozdělí vstupní seznam na tři seznamy přibližně stejné délky (Zřetězení seznamů Prvni, Druhy a Treti je seznam Seznam, délky seznamů Prvni, Druhy a Treti se mohou lišit nejvýše o 1). Při jeho konstrukci nesmíte použít žádnou aritmetiku (ani predikát length). Řešení by Martin Všetička: %na3(+Seznam,-Prvni,-Druhy,-Treti) na3(X,R1,R2,R3):-fst3(X,X,R1,R),hlfs(R,R,R2,R3). %hlfs(+Seznam,+Seznam,-Prvni,-Druhy) hlfs([],T2,[],T2). hlfs([_],[H|T2],[H],T2). hlfs([_,_|T1],[H|T2],[H|Hlf],R):-hlfs(T1,T2,Hlf,R). %fst3(+Seznam,+Seznam,-Tretina,-Zbytek) fst3([],T2,[],T2). fst3([_],[H|T2],[H],T2). fst3([_,_],[H|T2],[H],T2). fst3([_,_,_|T1],[H|T2],[H|Thrd],R):-fst3(T1,T2,Thrd,R). Řešení z http://prgs.xf.cz: %rozdeleni seznamu na tretiny natretiny(L, L1, L2, L3):- tretiny(L, L1, L23), na2(L23, L2, L3). %na2(+L, -L1, -L2). %rozdeleni seznamu na dve poloviny na2(L, L1, L2):- na2(L,L,L1,L2). na2(L, [], [], L). na2(L, [_], [], L). na2([H|L],[_,_|T],[H|X],Y):- na2(L,T,X,Y). %prvnitretina(+L123, -L1, -L23). %rozdeleni seznamu na prvni tretinu a zbytek tretiny(L, L1, L23):- tretiny(L, L, L1, L23). tretiny(L, [], [], L). tretiny(L, [_], [], L). tretiny(L, [_,_], [], L). tretiny([H|L],[_,_,_|T],[H|X],Y):- tretiny(L, T, X, Y). * Máte k dispozici predikát modry/1, který uspěje, pokud argument je modrý. Sestavte predikát natretiny(+Seznam, -Prvni, -Druhy, -Treti), který rozdělí efektivním způsobem vstupní seznam na tři seznamy obsahující přibližně stejně modrých prvků (Zřetězení seznamu Prvni, Druhy a Treti je seznam Seznam, počty modrých prvků v seznamech Prvni, Druhy a Treti se mohou lišit nejvýše o 1). Při jeho konstrukci nesmíte použít žádnou aritmetiku (ani predikát length). Řešení od univ z fora (http://forum.matfyz.info/memberlist.php?mode=viewprofile&u=3483): % natretiny(+,-,-,-) natretiny(Seznam,Prvni,Druhy,Treti):- % hlavni predikat prvni_tretina(Seznam,Prvni,Zbytek), napoloviny(Zbytek,Druhy,Treti). % prvni_tretina(+,-,-) prvni_tretina(Seznam,Prvni,Zbytek):-tretina2(Seznam,Seznam,Prvni,Zbytek). % tretina2(+,+,-,-) tretina2(L1,L2,P,Zb):- odeber3modre(L1,L1Zb),!, % pokusim se odebrat tri modre prvky, pokud neuspeje, cela klauzule tretina2 zfailuje odeber1modry(L2,PZb,P,L2Zb), % na tri nalezene modre mi pripada jeden, ktery umistim do prvni tretiny tretina2(L1Zb,L2Zb,PZb,Zb). tretina2(_,L2,[],L2). % odeber1modry(+,+,-,-) odeber1modry([H|L],PZb,[H|L2],Zb):- modry(H),!,L2=PZb,Zb=L; % odeberu modry prvek odeber1modry(L,PZb,L2,Zb). % .. nebo pokracuju ve zbytku seznamu % odeber2modre(+,-) odeber2modre([H|L],Zb):- modry(H),!,odeber1modry(L,_,_,Zb); % odeberu dva modre prvky odeber2modre(L,Zb). % .. nebo pokracuju ve zbytku seznamu % odeber3modre(+,-) odeber3modre([H|L],Zb):- modry(H),!,odeber2modre(L,Zb); % odeberu tri modre prvky odeber3modre(L,Zb). % .. nebo pokracuju ve zbytku seznamu % napoloviny(+,-,-) napoloviny(L,L1,L2):- polovina2(L,L,L1,L2). % polovina2(+,+,-,-) polovina2(L1,L2,P,Zb):- odeber2modre(L1,L1Zb),!, % stejny princip, najdu dva modre, pak jeden hned muzu zaradit do prvni poloviny odeber1modry(L2,PZb,P,L2Zb), polovina2(L1Zb,L2Zb,PZb,Zb). polovina2(_,L2,[],L2). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % TEST :-op(100,xfy,->). modry(m). s([m,m,a,m,m,b,m,m]). s([a,m,b,m,c,m,d,m,e,m,f]). s([a,b,c,m,m,d,e,f,m,g,h,i,m,j,k,l]). test:-s(X),natretiny(X,L1,L2,L3),write(X->L1+L2+L3),nl,fail. * Sestavte proceduru-y, pro kódování a dekódování (dlouhého) seznamu pomocí šifry "Monte Christo". Text se zakóduje do čtvercové matice 4x4. Kódovacím klíčem je čtvercová mřížka stejných rozměrů s vhodně vyřezanými otvory. Text se vypisuje do otvorů ve mřížce postupně po řádcích, vždy do každého otvoru jedno písmeno. Pak se mřížka otočí o 90° doprava a další text se opět vypisuje do otvorů. Toto se opakuje celkem čtyřikrát. Po zaplnění celé matice se mřížka odstraní a obsah matice se vypíše po řádcích na výstup. Je-li šifrovaná zpráva delší než jeden čtverec (tj. delší než 4x4 písmen), rozdělí se na více úseků, každý o délce jednoho čtverce. Napište kódovací a dekódovací proceduru, musíte otestovat, zda je mřížka přípustná. Řešení by dobre_rano: % oboustranny predikat zasifruj(Text, Klic1, Sifra):- len(Text, Len), Len=16, take4(Text,T1, Zb1), works(T1,Klic1, Sifra), otoc(Klic1, Klic2), take4(Zb1,T2, Zb2), works(T2, Klic2, Sifra), otoc(Klic2, Klic3), take4(Zb2,T3, Zb3), works(T3, Klic3, Sifra), otoc(Klic3, Klic4), works(Zb3, Klic4, Sifra). % works(T, Klic, Sifra) ... provadi samotne (de)sifrovani works([],_,_). works([HP|TP], [HK|TK], [HS|TS]):- HK=1,!,HP=HS,works(TP, TK, TS); % pokud se objevi policko, do ktereho mame psat works([HP|TP], TK, TS). % pokud ne. % Natvrdo napsane otoceni mrizky 4x4. otoc([A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A16],[A13,A9,A5,A1,A14,A10,A6,A2,A15,A11,A7,A3,A16,A12,A8,A4]). % Pro vsechny rotace klicove mrizky plati, ze dohromady musi vyrezana policka vsech rotaci klicove mrizky pokryt celou mrizku, % tudiz pokud si seznamy rotaci klice napiseme nad sebe, tak ve sloupci musi byt vzdy prave jedna jednicka % reprezentujici zapisovane policko tabulky, jinak by dochazelo k prepisum pri kodovani a klic by nebyl pripustny. zkontroluj(Klic1):- otoc(Klic1, Klic2), otoc(Klic2, Klic3), otoc(Klic3, Klic4), zkontroluj(Klic1, Klic2, Klic3, Klic4). zkontroluj([],[],[],[]). zkontroluj([H1|T1], [H2|T2], [H3|T3], [H4|T4]):- (H1=:=1,H2=:=0,H3=:=0,H4=:=0; H1=:=0,H2=:=1,H3=:=0,H4=:=0; H1=:=0,H2=:=0,H3=:=1,H4=:=0; H1=:=0,H2=:=0,H3=:=0,H4=:=1), zkontroluj(T1,T2,T3,T4). % Vezmi ctyri prvky ze seznamu take4(Text,Ctyri,Zbytek):- takeN(4, Text, Ctyri, Zbytek). take4(0, L, [], L). take4(_, [], [],[]). take4(N, [H|L], [H|Zb], Rest):- N > 0, N1 is N -1, takeN(N1, L, Zb, Rest). len([],0). len([H|T], N):- len(T,N1), N is N1+1. Haskell ========= * Definujte si vhodným způsobem datovou strukturu pro reprezentaci orientovaného grafu. Vytvořte funkci (definovanou na všech grafech), která vrátí topologické uspořádání grafu nebo sdělí, že topologicky uspořádat nejde. Řešení by Martin Všetička: {- Popis algoritmu: Topologické uspořádání grafu: Máme orientovaný graf G s N vrcholy a chceme očíslovat vrcholy čísly 1 až N tak, aby všechny hrany vedly z vrcholu s větším číslem do vrcholu s menším číslem, tedy aby pro každou hranu e = (vi, vj) bylo i > j. Představme si to jako srovnání vrcholů grafu na přímku tak, aby "šipky" vedly pouze zprava doleva. Cyklus je to jediné, co muže existenci topologického uspořádání zabránit. Libovolný acyklický graf lze uspořádat následujícím algoritmem: 1. Na začátku máme orientovaný graf G a proměnnou p = 1. 2. Najdeme takový vrchol v, ze kterého nevede žádná hrana (budeme mu říkat stok). Pokud v grafu žádný stok není, výpočet končí, protože jsme našli cyklus. 3. Odebereme z grafu vrchol v a všechny hrany, které do něj vedou. 4. Přiřadíme vrcholu v číslo p. 5. Proměnnou p zvýšíme o 1. 6. Opakujeme kroky 2 až 5, dokud graf obsahuje alespoň jeden vrchol. zdroj: http://ksp.mff.cuni.cz/tasks/18/cook2.html -} data Vertex a = Vertex a [a] deriving Show data (Eq a) => Graph a = Vertices [Vertex a] topSrch :: (Eq a) => (Graph a) -> [a] topSrch g = reverse $ topSrch1 g topSrch1 :: (Eq a) => (Graph a) -> [a] topSrch1 (Vertices []) = [] topSrch1 g@(Vertices lst) = (lastOne):(topSrch1 (Vertices lst3)) where lastOne = fndLast lst lst2 = rmVertex lst lst3 = remEdges lst2 lastOne fndLast :: [Vertex a] -> a fndLast [] = error "fndLast: No last vertex. It's not possible to topologically sort the graph" fndLast ((Vertex a []):xs) = a fndLast (x:xs) = fndLast xs rmVertex :: [Vertex a] -> [Vertex a] rmVertex [] = [] rmVertex ((Vertex a []):xs) = xs rmVertex (x:xs) = x:(rmVertex xs) remEdges :: (Eq a) => [Vertex a] -> a -> [Vertex a] remEdges [] _ = [] remEdges ((Vertex nm1 edg1):xs) v = ((Vertex nm1 (filter (/= v) edg1)):(remEdges xs v)) {- Testy: topSrch (Vertices [(Vertex 'a' ['b']),(Vertex 'b' ['c']),(Vertex 'c' ['d']), (Vertex 'd' ['a'])]) -- obsahuje cyklus topSrch (Vertices [(Vertex 'a' ['b']),(Vertex 'b' ['c']),(Vertex 'c' ['d']), (Vertex 'd' [])]) -- neobsahuje cyklus -} Řešení z http://prgs.xf.cz/pis080107/topolog_tried.hs: type Graf a = [(a,Int,[a])] --(vrchol,pocet predchodcov, zoznam nasledovnikov) sort::Graf a->Graf a --zotriedenie grafu podla poctu predchodcov sort [] = [] sort ((v,pp,zn):xs) = (sort [s|s@(a,b,c)<-xs, b=pp]) usp::(Eq a)=>Graf a->(Bool, [a]) --usp graf z => graf topologicky usporiada do zoznamu a tento pripoji k zoznamu z --predpokladame, ze g je zotriedeny funkciou sort usp [] = (True, []) usp (h@(v,pp,zn):xs) = if pp>0 then (False, []) else let (res,t) = usp (sort (zniz zn xs)) in (res,v:t) zniz::(Eq a)=>[a]->Graf a->Graf a --zniz nasledovnikom v grafe pocet predchodcov o jedna zniz znasl g = [(v,pp-1,zn)|(v,pp,zn)<-g, znasl `obsahuje` v] ++[s|s@(v,pp,zn)<-g, not (znasl `obsahuje` v)] where obsahuje::(Eq a)=>[a]->a->Bool (x:xs) `obsahuje` v = if x==v then True else xs `obsahuje` v [] `obsahuje` v = False topol::(Eq a)=>Graf a->[a] --vrati topologicke usporiadanie grafu, ak graf obsahuje kruzniu, vrati prazdny zoznam topol g = let (res,t) = usp (sort g) in if res==True then t else [] sort [] = [] sort ((v,h):xs) = sort [(a,b)|(a,b)<-xs, b=h] nodes::Tree a->[a] --vrati seznam vrcholu stromu setridenych podle vzdalenosti od nejblisiho listu, ktery je pod nim nodes t = [v|(v,h)<-sort (ohodnot t)] --nodes strom vrati "aeghbdfc" * Definujte typ vhodný k reprezentaci multimnožiny desítkových cifer (každá z cifer se v ní může vyskytovat vícekrát). Uvažme čísla, která lze sestavit z cifer takové multimnožiny (nemusíme použít všechny). Naprogramujte dvě funkce: a) první, která nalezne k číslu N a multimnožině M N-té takové číslo b) druhou "inverzní", která k takovému číslu X spočítá jeho pořadové číslo Řešení: a) TODO b) -- TEST: {- multPor [1,1,2,5,0] 5 -} -- NENI TO TOTALNE FUNKCI A JE TO DOST NEEFEKTIVNI, JE POTREBA VYMYSLET JAK ZNOVUPOUZIT VYSLEDKY -- multPor (multimnozina + porad) -- #1 arg: prvky v multimnozine, libovolne usporadane -- #2 arg: cislo slozene z prvku z multimnoziny -- vrati: poradi cisla vzhledem k moznym cislum vytvorenym z multimnoziny multPor :: [Int] -> Int -> Int multPor [] x = 0 multPor m x = sum [pomocnyVypocet m2 l | l <- [1 .. (len-1)]] - sum [pomocnyVypocet m3 l | l <- [1 .. (len-1)], (num,_) <- m2, num == 0] + (spocitej m2 iList len 1) + 1 where iList = reverse (int2list x) len = length iList m2 = nasobnosti (quicksort m) 0 (-1) m3 = snizCetnost m2 0 -- (-1) je specialni hodnota, potrebuji jen nejak fci zavolat, aby to neovlivnilo vysledek -- spocitej -- #1 arg: pocet jednotlivych cifer -- #2 arg: zadane cislo (list) -- #3 arg: delka cisla, aby se nemusela porad pocitat znovu -- #4 arg: na kolikate cifre odpredu jsem -- popis: ozn. prvni cifru `c'. Uvazujeme, ze na prvni pozici mohou byt cisla <= c a na ostatnich muze byt cokoli -- co zbyva v multimnozine -- vraci: pocet poradi zadaneho cisla v ramci dane multimnoziny (razeno od nejmensiho po nejvetsi) spocitej :: [(Int,Int)] -> [Int] -> Int -> Int -> Int spocitej [] _ _ _ = 0 spocitej _ [] _ _ = 0 spocitej m (x:xs) l c = sum [ pomocnyVypocet (snizCetnost m y) (l-1) | y <- moznostiPrvniCifra ] + (spocitej m2 xs (l-1) (c+1)) where m2 = snizCetnost m x moznostiPrvniCifra = filter (pred1 c x) [frst | (frst,sec) <- m, sec > 0] -- pomocnyVypocet -- #1 arg: pocet jednotlivych cifer; pr. (1,2) - jednicku mam 2x -- #2 arg: odendana cifra -- #3 arg: na kolika prvcich -- vraci: pocet cisel delky `l' z dane multimnoziny -- pozn: pocitaji se i pripady, kdy na zacatku je nula, jelikoz fce se pouziva jen funkci `spocitej' v pripade, -- ze mame pripad cisla [1-9]xxxx, kde na xxxx se pouziva tato funkce pomocnyVypocet :: [(Int,Int)] -> Int -> Int pomocnyVypocet m 0 = 1 pomocnyVypocet m l = (countDiff m 0) * (pomocnyVypocet ([(prvek-1,cet) | (prvek,cet) <-m ]) (l-1)) -- countDiff -- #1 arg: seznam dvojic prvek cetnost -- #2 arg: inkrementovana promenna, vstupni hodnota je nula -- vraci: pocet ruznych prvku s cetnosti vetsi nez nula countDiff :: [(Int,Int)] -> Int -> Int countDiff [] n = n countDiff ((prvek,cet):xs) n | cet > 0 = countDiff xs (n+1) | otherwise = countDiff xs n -- snizi cetnost v seznamu u daneho prvku snizCetnost :: [(Int,Int)] -> Int -> [(Int,Int)] snizCetnost [] _ = [] snizCetnost ((prvek',cet):xs) prvek | prvek == prvek' = if cet - 1 == 0 then xs else (prvek',cet-1):xs | otherwise = (prvek',cet):(snizCetnost xs prvek) -- U prvni cifry nepovolujeme nulu pred1 :: Int -> Int -> Int -> Bool pred1 c m n | n > 0 && n < m && c == 1 = True | n < m && c > 1 = True | otherwise = False -- KATEGORIE PREDIKATU, KTERE UZ BUDOU NEKDE PRAVDEPODOBNE NAPROGRAMOVANE factorial :: Int -> Int factorial x | x == 1 = 1 | x == 0 = 1 factorial n = n*(factorial (n-1)) int2list :: Int -> [Int] int2list n | ndiv10 > 0 = nmod10:(int2list ndiv10) | otherwise = [nmod10] where nmod10 = n `mod` 10 ndiv10 = n `div` 10 nasobnosti :: [Int] -> Int -> Int -> [(Int, Int)] nasobnosti [] n lastVal = [(lastVal,n)] nasobnosti (x:xs) n lastVal | lastVal == (-1) = nasobnosti xs 1 x | lastVal /= x = (lastVal,n):(nasobnosti xs 1 x) | lastVal == x = nasobnosti xs (n+1) x quicksort :: (Ord a)=> [a] -> [a] quicksort [] = [] quicksort [] = [] quicksort (x:xs) = quicksort [k | k <- xs, k <= x] ++ [x] ++ quicksort [k | k <- xs, k > x] * Všechna k-ciferná čísla, v jejichž dekadickém zápisu jsou všechny cifry různé, jsme "myšlenkově" seřadili podle velikosti. Napište procedury či funkce, které k zadanému číslu přímo spočtou jeho pořadí a naopak na základě pořadí naleznou příslušné číslo. Řešení: [zatím pouze další permutace] quicksort :: (Ord a) => [a] -> [a] quicksort [] = [] quicksort (x:xs) = let smallerSorted = quicksort [a | a <- xs, a <= x] biggerSorted = quicksort [a | a <- xs, a > x] in smallerSorted ++ [x] ++ biggerSorted -- 1. param je posledni hodnota, 2. je soucasne minimum z prochazenych prvku fnd :: (Ord a) => Int -> a -> [a] -> Int fnd n z (x:xs) | z < x && xs /= [] = fnd (n+1) x xs | z > x = n | otherwise = error "zadna dalsi permutace" -- error state -- Myslenka je takova, ze otocime seznam s permutaci, hledame prvni cislo X takove, ze je vetsi nez predchozi cislo, -- najdeme minimum v casti pred X a prohodime toto cislo s X v seznamu a setridim cast pred X. nepe :: (Ord a,Show a) => Int -> [a] -> [a] nepe k lst = (take (n-2) lst) ++ [min'] ++ (quicksort (filter (/= min') (take (j+1) revLst))) where (y:ys) = reverse lst revLst = (y:ys) j = fnd 1 y ys n = k - j + 1 min' = (minimum (filter (> (revLst !! j)) (take j revLst))) Řešení #2 pomocí algoritmu z přednášky: naslPerm :: (Ord a) => [a] -> [a] naslPerm lst = reverse zbytek ++ (z:lst3) where lst2 = reverse lst (rZac, y, zbytek) = rostZac lst2 (lst3, z) = zarad rZac y rostZac :: (Ord a) => [a] -> ([a],a,[a]) rostZac [] = error "Prazdny seznam neni povolen" rostZac (x:y:xs) | x > y = ([x],y,xs) | x < y = ((x:sezn),z,zbytek) where (sezn,z,zbytek) = rostZac (y:xs) zarad :: (Ord a) => [a] -> a -> ([a],a) zarad (x:xs) y | y < x = (y:xs, x) -- x je nejmensi vetsi nez y | y > x = (x:sezn, z) where (sezn, z) = zarad xs y * Řídká matice je reprezentována jako trojice (m,n,s), kde m a n jsou rozměry matice a s je seznam trojic (i,j,aij) - i,j souřadnice, a_{ij} nenulové číslo na těch souřadnicích - uspořádany vzestupně podle i a uvnitř řádek podle j. Naprogramujte: a) transpozici b) násobení 2 matic Řešení by Mus: type Matice = (Int, Int, [Souradnice]) -- synonymum type Souradnice = (Int, Int, Int) {- a) transpozici -} {- =================== -} transpozice :: Matice -> Matice transpozice (m, n, []) = (n, m, []) transpozice (m, n, s) = (n, m, quicksort [(j, i, aij) | (i, j, aij) <- s]) -- transpozice (m, n, s) = (n, m, sort [(j, i, aij) | (i, j, aij) <- s]) sort [] = [] sort (x:xs) = sort [a | a <- xs, a <= x] ++ [x] ++ sort [a | a <- xs, a > x] quicksort :: (Ord a) => [a] -> [a] quicksort [] = [] quicksort (x:xs) = let smallerSorted = quicksort [a | a <- xs, a <= x] biggerSorted = quicksort [a | a <- xs, a > x] in smallerSorted ++ [x] ++ biggerSorted -- Test: transpozice (4,4,[(1,3,3),(2,2,4),(3,4,5)]) -- Vysledek: (4,4,[(2,2,4),(3,1,3),(4,3,5)]) {- b) násobení 2 matic -} {- =================== -} -- Cij = Suma k=1..n : Aik * Bkj vynasob :: Matice -> Matice -> Matice vynasob (m, n, a) (o, p, b) | n /= o = error "matice nelze nasobit" | otherwise = (m, p, secti (srovnej [(i, j, aik*bkj) | (i, k1, aik) <- a, (k2, j, bkj) <- b, k1 == k2 ])) -- seradi seznam trojic (a,b,c) tak, ze za sebou jsou trojice se stejnymi a a b srovnej :: [Souradnice] -> [Souradnice] srovnej [] = [] srovnej [a] = [a] srovnej ((i1, j1, aij1):s) = [(i1, j1, aij1)] ++ [ (i, j, aij) | (i, j, aij) <- s, i == i1, j == j1 ] ++ srovnej [ (i, j, aij) | (i, j, aij) <- s, (i /= i1 || j /= j1) ] secti :: [Souradnice] -> [Souradnice] secti [] = [] secti [a] = [a] secti ((i1, j1, aij1):(i2, j2, aij2):s) | i1 == i2 && j1 == j2 = if aij1 + aij2 /= 0 then secti ((i1, j1, aij1 + aij2):s) else secti s | otherwise = [(i1, j1, aij1)] ++ secti ((i2, j2, aij2):s) -- WIKI: http://en.wikipedia.org/wiki/Sparse_matrix * Vytvorte funkci, která pro (nekonecný) seznam reálných císel [xi] vstup a (krátký) konecný rostoucí seznam intervaly malých integeru [a1,a2,...,an] - predstavte si treba [2,5,10,25] vytvorí nekonecný seznam, jehož k-tý prvek je "n-tice" klouzavých prumeru s intervaly [a1,a2,...,an] konce k-tým. * Jina formulace zadani: Sestavte funkci, ktera ke vstupujici (nekonecne) posloupnosti realnych cisel a prirozenemu cislu N vyda posloupnosti "klouzavych prumeru s intevalem N". Klouzavy prumer s intervalem N je prumer poslednich prvku. Řešení: Klouzave prumery - urcite pomocnou fci (nebo lambda), ktera dostane dvakrat seznam (puvodni a puvodni bez prvnich n clenu), soucasnou sumu a dane N a bude nove soucty pocitat pomoci tech predchozich. Co jsem slysel, nelibi se mu, kdyz to clovek pokazde pocita znovu. * Mocninna rada je reprezentovana (nekonecnou posloupnosti) posloupnosti jejich koeficientu. Vytvorte funkce, ktere spocitaji a) Soucet dvou mocninnych rad b) Soucin dvou mocninnych rad c) K-tou derivaci mocninne rady Řešení by Martin Všetička: a) soucet s t = [a+b | (a,b) <- zip s t] -- verze 1 soucet2 (a:s) (b:t) = ((a+b):soucet2 s t) -- verze 2 -- pokud nescitame radu, ale polynomy: add :: (Num a)=>[a]->[a]->[a] add [] [] = [] -- neni potreba pokud jde o mocninou radu add (x:xs) [] = x:xs -- dtto add [] (y:ys) = y:ys -- dtto add (x:xs) (y:ys) = (x+y):(add xs ys) b) zipWith' :: (a -> a -> a) -> [a] -> [a] -> [a] zipWith' f [] _ = [] zipWith' f _ [] = [] zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys product :: (Num a)=>[a]->[a]->[a] product series1 series2 = [sum (zipWith' (*) xs ys ) | n <- [1,2..], let xs = take n series1, let ys = reverse (take n series2)] Jiny zpusob: let (+++) = zipWith (+); (f:fs) *** (g:gs) = f*g : (map (*f) gs +++ map (*g) fs +++ (0: fs***gs)) in [1..] *** [1..] (source: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.38.9450 - chapter 2.2) Jiny zpusob: nasob a b = nas a b [] nas (an:as) b rev = [ sum( [ x*y | (x,y) <- zip b (an:rev)] ) ] ++ (nas as b (an:rev) ) c) -- 1. zpusob derivative :: (Num a,Enum a)=>Integer->[a]->[a] derivative n lst = if n > 0 then derivative (n-1) (zipWith (*) [1,2..] (drop 1 lst)) else lst -- 2. zpusob der (a:s) k = (k*a):der s (k+1) derivace (a:s) = der s 1 -- jednoducha derivace (odeberu konstantu ze zacatku a nasobim v der) derivace_k s 0 = s -- 0-ta derivace derivace_k s k = derivace_k (derivace s) (k-1) -- k-ta derivace * Reprezentovat BVS a pak funkci na vypousteni vsech vrcholu s hodnotou mezi Min a Max: Řešení: data (Ord a, Eq a, Num a) => BVS a = Null | Node (BVS a) a (BVS a) deriving Show inorder :: (Ord a, Eq a, Num a) => BVS a -> [a] inorder Null = [] inorder (Node left a right) = inorder left ++ [a] ++ inorder right min' :: (Ord a, Eq a, Num a) => BVS a -> a min' = head . inorder max' :: (Ord a, Eq a, Num a) => BVS a -> a max' = head . inorder {- Pro jeden prvek -} deleteX :: (Ord a, Eq a, Num a) => a -> (BVS a) -> (BVS a) deleteX e Null = Null deleteX e (Node Null a Null) | e == a = Null | otherwise = Node Null a Null deleteX e (Node left a Null) | a == e = left | otherwise = (Node (deleteX e left) a Null) deleteX e (Node Null a right) | a == e = right | otherwise = (Node Null a (deleteX e right)) deleteX e (Node left a right) | a == e = Node (deleteX (max' left) left) (max' left) right | a < e = Node left a (deleteX e right) | a > e = Node (deleteX e left) a right {- Test: deleteX 3 (Node (Node Null 1 Null) 2 (Node (Node Null 3 Null) 3 Null)) -} {- viceprvkova verze: -} -- vypusti ze stromu vsechny uzly od m do n remBVS :: (Ord a) => BVS a -> a -> a -> BVS a remBVS Null _ _ = Null remBVS (BVS (Null,val,Null)) m n | m <= val && val <= n = Null | otherwise = BVS (Null,val,Null) remBVS (BVS (left,val,right)) m n = if m>n then Null else if n < val then BVS (remLeft,val,right) else if val < m then BVS (left,val,remRight) else if not (remLeft==Null) then BVS (remLeftMax, maxremLeft, remRight) else if not (remRight==Null) then BVS (remLeft, minremRight, remRightMin) else Null where remLeft = remBVS left m n remRight = remBVS right m n maxremLeft = findMax remLeft minremRight = findMin remRight remLeftMax = remBVS remLeft maxremLeft maxremLeft remRightMin = remBVS remRight minremRight minremRight Zdroj: http://s0cketka.blogspot.com/2006/01/haskell-male-ulozky.html Zdroj: http://blog.geeksynapse.net/29/en/ * Soucin a podil dlouhych cisel - dlouhe cislo je trojice Znamenko, [Int], Pozice desetinne carky od prvni cifry * Úloha BATOH: Je dán seznam A číslo N. Napište funkci, která zjistí, zda je možné posčítat (některé) prvky seznamu, aby součet vyšel N. Řešení: -- implementujeme funkci, ktera tento seznam vrati, dana uloha pak by byla -- pokud seznam neexistuje, vraci se [] batoh :: [Int] -> Int -> [Int] batoh _ 0 = [] batoh [] _ = [] batoh (x:xs) n | sum newBatoh1 == n = newBatoh1 | sum newBatoh2 == n = newBatoh2 | otherwise = [] where newBatoh1 = x:(batoh xs (n-x)) newBatoh2 = batoh xs n * Definujte prirozenou reprezentaci binárních stromu, v jehož uzlech je uložena informace nejakého typu (podtrídy Ord). Sestavte funkci, která na základe rostoucího (!) seznamu S a císla N vytvorí z prvních N prvku tohoto seznamu dokonale vyvážený binární vyhledávací strom T (pro každý uzel platí, že velikost L a P podstromu se liší nejvíc o 1) a spolu s tímto stromem vrátí i seznam, který zbyl ze seznamu S po postavení stromu T, tj. S bez prvních N clenu. Řešení od HonzyK: data (Ord a) => BST a = Null | Node (BST a) a (BST a) middle_element :: (Ord a) => [a] -> a -- returns middle element from the list middle_element x = last y where y = take (((length x) `div` 2) + 1) x build_tree :: (Ord a) => [a] -> BST a -- builds perfectly balanced BST build_tree [] = Null build_tree (h:[]) = Node Null h Null build_tree x = Node leftOne h rightOne where h = middle_element x leftOne = build_tree [ y | y <- x, y < h] rightOne = build_tree [ y | y <- x, y > h] build :: (Ord a) => [a] -> Int -> (BST a, [a]) build x 0 = (Null, x) build [] _ = error "Nothing in list" build s n | (length s) < n = error "List S contains less than N elements" | otherwise = ( build_tree (take n s), drop n s ) Řešení by Mus: -- Binarni Strom data (Ord a) => BTree a = Null | Node (BTree a) a (BTree a) deriving Show createBTree :: (Ord a) => [a] -> Int -> ((BTree a), [a]) createBTree [] _ = (Null, []) createBTree s 0 = (Null, s) createBTree [s] n = ((Node Null s Null), []) createBTree s n = ((Node l v r), rest) where n1 = n - 1 nr = n1 `div` 2 nl = n1 - nr (l, (v:rs)) = createBTree s nl (r, rest) = createBTree rs nr -- casova slozitost: O(N) * Definujte přirozenou reprezentaci binárního stromu, v jehož uzlech je uložena informace nějakého typu (podtřídy Ord). Naprogramujte funkci, která ze zadaného binárního vyhledávacího stromu vypustí všechny uzly, které obsahují hodnotu klíče, na kterém zadaná funkce `krit' vrátí hodnotu True. Řešení od univ z fóra: data Tree a = Nil | ND (Tree a) a (Tree a) deriving Show instance Eq (Tree a) where -- na porovnavani stromu s Nilem Nil == Nil = True _ == _ = False vypust::(a->Bool)->Tree a->Tree a vypust _ Nil = Nil vypust krit (ND l v p) | not (krit v) = (ND lt v pt) | lt == Nil = pt | pt == Nil = lt | otherwise = (ND ltBEZmax maxlt pt) where lt = vypust krit l pt = vypust krit p (ltBEZmax,maxlt) = bezMAX lt bezMAX:: Tree a->(Tree a,a) bezMAX (ND l v p) | p == Nil = (l,v) -- pro toto porovnani jsme definovali vyse "instance ..." | otherwise = ((ND (l) (v) (pt)), maxpt) where (pt,maxpt) = bezMAX p Užitečné algoritmy ===================== * následující permutace: % vyda nasledujici permutaci v lexikografickem poradi naslperm(Perm, NPerm) :- reverse(Perm, OtPerm), rozloz(OtPerm, RostZac, X, Zbytek), zarad(RostZac, X, Y, NRostZac), concrev(Zbytek,[Y|NRostZac], NPerm). % rozloz(+Perm,-RostZac,-KlesPrvek,-Zbytek) rozloz([X,Y|T],[X|T1],A,Z):-XY. % zarad(+Rost,+Vloz,-NejmenšíVětšíNežX,-RostPoVýměně) zarad([A|Rost],X,Y,[A|NRost]):- A < X, zarad(Rost,X,Y,NRost). zarad([A|Rost],X,A,[X|Rost]) :- A > X. % ============================================================== % concrev(+L,+T,-S) S je zřetězení obráceného seznamu L % se seznamem T % tedy predikát ot(+L,-S):- concrev(L,[],S) otáčí seznam % ?-concrev([a,b,c],[1,2],S). S=[c,b,a,1,2] % ============================================================== concrev([],L,L). concrev([X|T],L,P):- concrev(T,[X|L],P). % pozn. algoritmus selze, pokud dalsi permutace v lex. poradi neexistuje * Rozdílový seznam: [ 1,2,3 | T1]-T1, [4,5,6|T2]-T2 Spojení rozdílových seznamů: conc(A-B, B-C, A-C). V konstantnim case. Užitečné Haskellovské funkce ============================ * zip, forldl, foldr, sum * http://prgs.xf.cz/ - nějaké řešené úložky * http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems - rešené problémy Užitečné progr. techniky z learnyouhaskell.com ============================================== * case lze pouzit prakticky kdekoli describeList :: [a] -> String describeList xs = "The list is " ++ case xs of [] -> "empty." [x] -> "a singleton list." xs -> "a longer list." * If you want to get an element out of a list by index, use !!. The indices start at 0. ghci> "Steve Buscemi" !! 6 'B' ghci> [9.4,33.2,96.2,11.2,23.25] !! 1 * Haskell umí porovnávat n-tice: (1,2,3) <= (3,4,5) vrátí TRUE. FAQ === * Rozdil mezi "where" a "let" konstrukci je v tom, ze "where" je pouze syntactic sugar, nicmene "let" lze pouzit kdekoli. Ústní ===== PROLOG Tvar programu v Prologu a jeho interpretace Deklarativní a operační sémantika programu v Prologu Operátor řezu Negace Práce se seznamy Reprezentace datových struktur (např. grafy, stromy, rozdílové seznamy) Edinbugrský model vstupu a výstupu. Definování a použití operátorů Predikáty pro řízení databáze (assert,...) Predikáty grupování termů (bagof, setof) a jejich užití Neúplně definované datové struktury, rozdílové seznamy Efektivita programů v Prologu HASKELL Typy v Haskellu, typová specifikace funkce Základní způsoby definování výrazů, Sémantika "mečování" parametrů, as patterns ( @s ), žolíky ( _ ), lazy-parametry ( ˜x ), Lazy vyhodnocování, "nekonečné" termy. Lambda abstrakce (tj. lambda funkce) Vyhneme se definovaní nových funkcí, pokud danou funkci jinak nepotřebujeme. pr. inc x = x+1 => lambda funkce => \x -> x+1 Používání jmen funkcí jako operátorů a naopak, specializace operátorů { (např. (x+) }. Definování priority a asociativity infixových operátorů. pr. infixr 5 ++ -- prava asociativita, 0 nejmensi 9 nejvetsi; pr. infixl 2 -- leva asociativita pr. infix -- zadna asociativita main = print (1 +++ 2 *** 3) main2 = print (1 ++++ 2 ++++ 3) infixr 6 +++ infixl 5 ***,/// infixl 6 ++++ (+++) :: Int -> Int -> Int a +++ b = a + 2*b (++++) :: Int -> Int -> Int a ++++ b = a - b (***) :: Int -> Int -> Int a *** b = a - 4*b (///) :: Int -> Int -> Int a /// b = 2*a - 3*b Třídy, podtřídy, instance. Pole v Haskellu.