{{Předmět|Neprocedurální programování|Rudolf Kryl|AIL076}}
== 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 [[Rudolf Kryl|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 [[Algoritmy a datové struktury | ADSka]] alebo z [[Automaty a gramatiky|automatov]].
Odporúča sa tiež zapísať si tento predmet v roku, keď je vyučovaný Hricom.
* [http://ksvi.mff.cuni.cz/~kryl/prolog.pdf Učebný text k Prologu] - hlavní učební text od přednášejícího
* [http://ktiml.mff.cuni.cz/~hric/vyuka.htm#Progr2 Neprocedurálne programovanie u Hrica] - učebné texty, slajdy, témy na zápočtové programy, príklady.
== Řešení zkouškouvých úloh z Prologu ==
=== Hladiny binárního stromu ===
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).
Řešení by Nóža: oproti předchozímu řešení neduplikuje výsledky a při inverzi generuje všechny výsledky
ot([],A,A).
ot([H|T],A,S):-ot(T,[H|A],S).
%vytvari novou hladinu pridanim k novemu uzlu 0-2 uzly z hladiny pod sebou
vrstva([],[],[]).
vrstva([X|XS],[L,R|T],[tree(L,X,R)|T0]):-vrstva(XS,T,T0).
vrstva([X|XS],[L|T],[tree(L,X,nil)|T0]):-vrstva(XS,T,T0).
vrstva([X|XS],[R|T],[tree(nil,X,R)|T0]):-vrstva(XS,T,T0).
vrstva([X|XS],S,[tree(nil,X,nil)|S0]):-vrstva(XS,S,S0).
%buduje strom od spodu
vrs([],T,T).
vrs([H|T],U,OUT):-vrstva(H,U,U0),vrs(T,U0,OUT).
hladiny(nil,[]).
hladiny(Tree,S):-var(Tree),!,ot(S,[],OS),vrs(OS,[],Tree). %pro generovani vsech stromu
hladiny(tree(L,H,R),[[H]|OUT]):-hladiny(L,LS),hladiny(R,RS),spoj(LS,RS,OUT).
spojS([],S,S).
spojS([H|T],S,[H|OUT]):-spojS(T,S,OUT).
spoj([],S,S):-!. %rez predchazejici zbytecne duplicite
spoj(S,[],S).
spoj([Y|YT],[X|XT],[H|OUT]):-spojS(Y,X,H),spoj(YT,XT,OUT).
=== Ekvivalence dvou seznamů s žolíky ===
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
Řešení by Ivan Kuckir, asi stejné jako to první, ale bez reverse, + 2 testy, co mají vyjít pravdivě :) // ?- eqtest1(X).
equiv([A|X], [B|Y]) :- eq(A, B), equiv(X, Y).
equiv([*|X], L) :- suffix(X, L).
equiv(L, [*|X]) :- suffix(X, L).
equiv([], []).
suffix(A, B) :- equiv(A, B).
suffix(L, [_|Y]) :- suffix(L, Y).
suffix([], _).
eq(X, X).
eq(?, _).
eq(_, ?).
eqtest1(true) :- equiv([1, 2, ?, 1, 4, *, 9], [?, 2, *, 3, 4, 5, 6, ?, 8, 9]).
eqtest2(true) :- equiv([1, 2, *], [*, 4, 3, 7]).
=== Převod permutace na cykly ===
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,5]])" , 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.
Řešení #4 by iwtu:
p2c(p(N,Obrazy),c(N,Cykly)) :- p2c(Obrazy,[],[],Cykly1),filter(Cykly1,[],Cykly), !.
%p2c(+Obrazy, +Pouzite, ?Akumulator, -Cykly)
p2c(O,Pou,C,C) :- length(O,LO), length(Pou,LO), !.
p2c(O,Pou,A,CC) :- volny(O,Pou,V), cyklus(V,O,[V],C), append(Pou,C,NPou), p2c(O,NPou,[C|A],CC).
%cyklus(+Start,+Obrazy,?Akumulator,-Cyklus)
cyklus(S,P,[H|T],[H|T]) :- obraz(S,P,H), !.
cyklus(S,P,A,C) :- obraz(S,P,O), append(A,[O],AO), cyklus(O,P,AO,C).
%obraz(+Index,+Perm,-Obraz)
obraz(1,[O|_],O) :- !.
obraz(N,[_|T],O) :- N1 is N-1, obraz(N1,T,O).
%volny(+Zoznam1, +Zoznam2, -Prvok) -- prvy prvok, ktory obsahuje Zoznam1 ale neobsahuje Zoznam2
volny([H|_],Z2,H) :- neobsahuje(H,Z2), !.
volny([_|T],Z2,P) :- volny(T,Z2,P).
%neobsahuje(+Prvok,+Zoznam)
neobsahuje(_,[]).
neobsahuje(P,[H|T]) :- P \== H, neobsahuje(P,T).
%filter(+Cykly,?Akumulator,-NetrivlaneCykly)
filter([],A,A).
filter([H|T],A,C) :- length(H,LH), LH > 1, filter(T,[H|A],C).
filter([H|T],A,C) :- length(H,LH), LH == 1, filter(T,A,C).
=== Složení permutací ve tvaru cyklů ===
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).
=== Násobení binárních čísel ===
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í by Ivan Kuckir
plus([], [], [P], P).
plus([], [X|R], [X|R], 0).
plus([], [H|R], NL , 1) :- plus([1], [H|R], NL, 0).
plus([H|R], [], Res, P) :- plus([], [H|R], Res, P).
plus([0|R1], [0|R2], [X|R3], P) :- ((P=1, X is 1); (P=0, X is 0)), plus(R1, R2, R3, 0).
plus([0|R1], [1|R2], [X|R3], P) :- ((P=1, X is 0); (P=0, X is 1)), plus(R1, R2, R3, P).
plus([1|R1], [0|R2], [X|R3], P) :- plus([0|R2], [1|R1], [X|R3], P).
plus([1|R1], [1|R2], [X|R3], P) :- X is P, plus(R1, R2, R3, 1).
times([H|R], [1], [H|R]).
times([_|_], [0], [0]).
times(X, [H|Rest], L) :- Rest\=[], times([0|X], Rest, V), ((H=1, plus(X, V, L, 0)); (H=0, L = V)).
add (A, B, C) :- reverse(A, RA), reverse(B, RB), plus(RA, RB, RC, 0), reverse(RC, C).
multiply(A, B, C) :- reverse(A, RA), reverse(B, RB), times(RA, RB, RC) , reverse(RC, C).
Ř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).
=== Seznam na třetiny ===
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).
Řešení by Roman:
tretiny_(Vz,A,B,C) :- append(Vz,Vz,Vz1), tretiny(Vz,Vz1,Vz,A,B,C).
%Funkce dostane jako parametr puvodni seznam, dvojnasobne dlouhy seznam, puvodni seznam a vystupni parametry. Postupne ubira tri prvky z prvnich dvou seznamu.
%Kdyz dojde prvni seznam znacne se ukladat do druheho vystupniho parametru, kdyz dojde druhy seznam zacne se ukladat do tretiho.
tretiny([],[],[],[],[],[]).
tretiny([],[],[A|Vzor3],X,Y,[A|Z]) :- tretiny([],[],Vzor3,X,Y,Z).
tretiny([],Vzor2,[A|Vzor3],X,[A|Y],Z) :- odeber_tri(Vzor2,Vzor2_), tretiny([],Vzor2_,Vzor3,X,Y,Z).
tretiny(Vzor1,Vzor2,[A|Vzor3],[A|X],Y,Z) :- odeber_tri(Vzor1,Vzor1_), odeber_tri(Vzor2,Vzor2_), tretiny(Vzor1_,Vzor2_,Vzor3,X,Y,Z).
%odebere tri prvky ze seznamu, pripadne mene pokud to nejde.
odeber_tri([_,_,_|X],X).
odeber_tri([_,_],[]).
odeber_tri([_],[]).
Řešení by Peter Zeman:
div3(List, First, Second, Third) :- div3(List, List, First, Second, Third).
div3([], List2, [], Second, Third) :- div2(List2, Second, Third).
div3([_], List2, [], Second, Third) :- div2(List2, Second, Third).
div3([_, _], List2, [], Second, Third) :- div2(List2, Second, Third).
div3([_, _, _ | List1], [D | List2], [D | First], Second, Third) :- div3(List1, List2, First, Second, Third).
div2(List, First, Second) :- div2(List, List, First, Second).
div2([], List2, [], List2).
div2([_], List2, [], List2).
div2([_, _ | List1], [C | List2], [C | First], Second) :- div2(List1, List2, First, Second).
=== Na třetiny dle počtu "modrých" ===
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 [http://forum.matfyz.info/memberlist.php?mode=viewprofile&u=3483 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.
Řešení by Peter Zeman:
% Predpoklada na vstupe zoznam, obsahujuci 'r' a 'b', 'b' su modre, 'r' su
% cervene. Uprava podla zadania je trivialna.
div3blue(List, First, Second, Third) :- div3blue(List, List, First, Second, Third).
% Pri div3blue/4 zalezi na poradi predikatov
div3blue(List1, List2, First, Second, Third) :-
take3blue(List1, _, List1Right), !,
take1blue(List2, List2Left, List2Right),
div3blue(List1Right, List2Right, First2, Second, Third),
append(List2Left, First2, First).
div3blue(List1, List2, [], Second, Third) :- take2blue(List1, _, _), !, div2blue(List2, Second, Third).
div3blue(List1, List2, [], Second, Third) :- take1blue(List1, _, _), !, div2blue(List2, Second, Third).
div3blue(_, List2, [], Second, Third) :- div2blue(List2, Second, Third).
div2blue(List, First, Second) :- div2blue(List, List, First, Second).
% Pri div2blue/4 zalezi na poradi predikatov.
div2blue(List1, List2, First, Second) :-
take2blue(List1, _, List1Right), !,
take1blue(List2, List2Left, List2Right),
div2blue(List1Right, List2Right, First2, Second),
append(List2Left, First2, First).
div2blue(List1, List2, [], List2) :- take1blue(List1, _, _), !.
div2blue(_, List2, [], List2).
take3blue([b | List1], [b | List1Left], List1Right) :- take2blue(List1, List1Left, List1Right).
take3blue([r | List1], [r | List1Left], List1Right) :- take3blue(List1, List1Left, List1Right).
take2blue([b | List1], [b | List1Left], List1Right) :- take1blue(List1, List1Left, List1Right).
take2blue([r | List1], [r | List1Left], List1Right) :- take2blue(List1, List1Left, List1Right).
take1blue([b | List1], [b], List1).
take1blue([r | List1], [r | List1Left], List1Right) :- take1blue(List1, List1Left, List1Right).
=== Kódování textu do matice s klíčem ===
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.
=== Algebrogramy ===
9) Číslo reprezentujeme jako seznam jeho cifer v desítkové soustavě. Sestavte program, který pro 3 seznamy cifer a písmen zjistí, zda existuje substituce písmen za cifry taková, že součet prvních dvou seznamů se rovná třetímu seznamu. Stejné písmeno se může vyskytovat vícekrát (nahradíme ho vždy stejnou cifrou).
Řešení by Ivan Kuckir + testy
'''Vstup''': 3 seznamy cifer / písmen
'''Výstup''': seznam dvojic písmeno-číslo (substituce)
'''Algoritmus''': procházím čísla od konce, na každé úrovni zkusím substituovat za 0 až 3 znaky,
provedu substituci na zbytku a pustím algoritmus na tento zbytek
algebr(A, B, C, Seq) :- reverse(A, RA), reverse(B, RB), reverse(C, RC),
fillZero(RA, RC, NA, NC), fillZero(RB, RC, NB, _), algRec(NA, NB, NC, 0, Seq).
algRec([A|At], [B|Bt], [C|Ct], Z, Seq) :- getSub(A, B, C, Z, NZ, S),
makeSub(S, At, NAt), makeSub(S, Bt, NBt), makeSub(S, Ct, NCt),
algRec(NAt, NBt, NCt, NZ, NS), concat(S, NS, Seq).
algRec([], [], [], 0, []).
% najde seznam 0 až 3 substitucí pro dané A, B, C a Zbytek z předchozího řádu
getSub(A, B, C, Z, NZ, [A-X|T]) :- atom(A), !, cif(X), oneSub(A-X, [B, C], [NB, NC]), getSub(X, NB, NC, Z, NZ, T).
getSub(A, B, C, Z, NZ, [B-X|T]) :- atom(B), !, cif(X), oneSub(B-X, [C], [NC]), getSub(A, X, NC, Z, NZ, T).
getSub(A, B, C, Z, NZ, [C-X|T]) :- atom(C), !, cif(X), getSub(A, B, X, Z, NZ, T).
getSub(A, B, C, Z, NZ, []) :- X is (A+B+Z) mod 10, X == C, NZ is (A+B+Z) div 10.
% provede seznam substitucí na seznamu
makeSub([S|St], A, Na) :- oneSub(S, A, X), makeSub(St, X, Na).
makeSub([], X, X).
% provede jednu substituci na seznamu
oneSub(C-N, [C|Ct], [N|NCt]) :- oneSub(C-N, Ct, NCt).
oneSub(C-N, [X|Xt], [X|NXt]) :- X \= C, oneSub(C-N, Xt, NXt).
oneSub(_, [], []).
% doplní kratší ze seznamu nulami, aby byly stejně dlouhé
fillZero([A|At], [B|Bt], [A|NAt], [B|NBt]) :- fillZero(At, Bt, NAt, NBt).
fillZero([], [B|Bt], [0|NAt], [B|NBt]) :- fillZero([], Bt, NAt, NBt).
fillZero([A|At], [], [A|NAt], [0|NBt]) :- fillZero(At, [], NAt, NBt).
fillZero([], [], [], []).
% vrací cifry 0 až 9
cif(X) :- rcif(X, 9).
rcif(0, 0) :- !. rcif(X, X).
rcif(C, N) :- NN is N-1, rcif(C, NN).
atest1(X) :- algebr([1,1,a], [2,b,a], [3,4,6], X). %%%% X = [a-8, b-2] ; X = [a-3, b-3] ;
atest2(X) :- algebr([1,c,a], [4,3,b,c], [4,4,4,6], X). %%%% X = [a-6, c-0, b-4] ; X = [a-5, c-1, b-3] ; ...
atest3(X) :- algebr([a], [a], [c], X). %%%% X = [a-4, c-8] ; X = [a-3, c-6] ; X = [a-2, c-4] ; ...
atest4(X) :- algebr([o,k,l,a,m,a,l], [v,a,p,e,n,i,k], [k,o,m,i,n,i,k,a], X),. %%%% X = [l-8,k-1,a-9,i-2,m-1,n-0,e-1,p-3,o-9,v-9], ...
=== Vyvážený binárny strom ===
10) Mame rastuci zoznam a chceme vyvazeny binarny strom o N prvkov a Zvysok. Predpokladame, ze zoznam je velky aspon N.
%postav(+Zoznam,+N,-Strom,-Zvysok)
postav([],_,nil,[]).
postav(R,0,nil,R).
postav(Z,N,t(LS,V,PS),Zv) :- N1 is N - 1, NL is N1 div 2, NP is N1 - NL,
postav(Z,NL,LS,[V|Zv1]), postav(Zv1,NP,PS,Zv).
== Ř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"
Řešení by Ivan Kuckir. Pokud nejde topologicky uspořádat, vrátí kružnici (podgraf).
data Node = Node NodeID String [NodeID] deriving (Show)
type NodeID = Int
type Graph = [Node]
getID :: Node -> NodeID
getID (Node x _ _) = x
getNs :: Node -> [NodeID] -- následníci
getNs (Node _ _ l) = l
getNodeByID :: Graph -> NodeID -> Node -- najde vrchol podle ID
getNodeByID (x:t) id
| (getID x)==id = x
| otherwise = getNodeByID t id
{-
Topologické uspořádání grafu
vstup: Souvislý orientovaný graf (seznam vrcholů)
výstup: seznam dvojic (Vrchol : číslo) topologické uspořádání
seznam dvojic (Vrchol : 0), na nichž je cyklus
Algoritmus: while Existuje vrchol bez následníků
odeberu ho
odeberu hrany vedoucí do něj
pokud neexistuje, půjdu někam po hranách, než najdu cyklus
-}
topo :: Graph -> [(NodeID, Int)]
topo g = topoRec g 1
topoRec :: Graph -> Int -> [(NodeID, Int)] -- "topo" rekurzivně
topoRec g@(h:t) n
| eid == -1 = getCircle g
| otherwise = (eid, n) : (topoRec (graphWithout g eid) (n + 1))
where eid = getEmpty g -- eid = empty ID
topoRec [] _ = []
graphWithout :: Graph -> NodeID -> Graph -- smaže z grafu vrchol i hrany vedoucí do něj
graphWithout ((Node x s l):t) id
| x == id = graphWithout t id
| otherwise = (Node x s (remove id l)) : (graphWithout t id)
graphWithout [] _ = []
remove :: NodeID -> [NodeID] -> [NodeID] -- smaže ze seznamu první výskyt prvku
remove id (h:t)
| id == h = t
| otherwise = h:(remove id t)
remove id [] = []
getEmpty :: Graph -> NodeID -- najde v grafu vrchol bez následníků (hran směrem ven)
getEmpty ((Node id s l):t)
| l == [] = id
| otherwise = getEmpty t
getEmpty [] = -1
getCircle :: Graph -> [(NodeID, Int)] -- najde v grafu kružnici
getCircle ((Node id s l):t) = (id, 0) : (getCircleRec (head l) id ((Node id s l):t))
getCircleRec :: NodeID -> NodeID -> Graph -> [(NodeID, Int)] -- "getCircle" rekurzivně
getCircleRec x start g
| x == start = []
| otherwise = (x, 0) : (getCircleRec nb start g)
where nb = head (getNs (getNodeByID g x)) -- nb = první neighbour
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
Násobení by Tomáš Slavíček (nešlo mi to sem vložit, rozpadal se layout): http://pastebin.com/331Ka7fX
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
* 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.
== Ú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.
[[Category:Informatika]]
