Neprocedurální programování

Z ωικι.matfyz.cz
Přejít na: navigace, hledání
Neprocedurální programování
Kód předmětu: NAIL076
Přednáší: Rudolf Kryl

O předmětu

Trochu iné programovanie. Základy programovania, ktoré nepozná priraďovací príkaz. Vyučujú sa jazyky Prolog a Haskell (spomenú sa základy jazyka Scheme). Okrem Kryla tento predmet vyučuje aj Ján Hric. Pred skúškou je nutné vytvoriť zápočtový program v Prologu s dobrou dokumentáciou. V prípade cvičení s Krylom je dokumentácia možno aj dôležitejšia ako samotný program. Odporúčam vybrať si tému na program takú, pri ktorej sa dá určiť, či je program hotový (aby sa nestalo, že bude nutné pridávať stále ďalšie vlastnosti). Vhodná oblasť tém sú rozličné algoritmy, či už z ADSka alebo z automatov. Odporúča sa tiež zapísať si tento predmet v roku, keď je vyučovaný Hricom.


Řešení zkouškouvých úloh z Prologu

1) 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í: [p. Kryl toto řešení 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).


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

  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

3) 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í #1:

  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.

 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.

4) Vytvořte predikát, který přijme 2 permutace v zápisu cyklu a vrátí jejich součin (tedy složení permutací)

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

5) Čí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).

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

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


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

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


Řešené úlohy z haskellu

1) 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])
   			  ++ [(v,pp,zn)]
   			  ++ (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]
                        ++ [(v,h)]
                        ++ 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"
 

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

3) 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í: [najde pouze další permutaci]


   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
  

4) Ří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      

5) Vytvořte funkci, která pro (nekonečný) seznam reálných čísel [xi] vstup a (krátký) konečný rostoucí seznam intervaly malých integeru [a1,a2,...,an] - představte si třeba [2,5,10,25] vytvoří nekonečný seznam, jehož k-tý prvek je "n-tice" klouzavých průměrů s intervaly [a1,a2,...,an] konče k-tým.

Jiná formulace zadání: Sestavte funkci, která ke vstupujicí (nekonečné) posloupnosti reálných čísel a přirozenému číslu N vydá posloupnosti "klouzavých průměrů s intevalem N". Klouzavý průměr s intervalem N je průměr posledních prvků.

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

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


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

9) Soucin a podil dlouhych cisel - dlouhe cislo je trojice Znamenko, [Int], Pozice desetinne carky od prvni cifry

10) Ú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í:

  -- nalezeno na s0cketce: http://s0cketka.blogspot.com/
  -- 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                  

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


12) 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):-X<Y,rozloz([Y|T],T1,A,Z).
 rozloz([X,Y|T],[X],Y,T):-X>Y.
 
 % 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

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.


Ú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 <operator>  -- 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.