{{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 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 alebo z . Odporúča sa tiež zapísať si tento predmet v roku, keď je vyučovaný Hricom.

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