[TOC]
Zdroj: MFF Forum: Zkoužka 4.9.2020
Je dán orientovaný graf G pomocí seznamů sousedů. Zjistěte, jestli lze graf G topologicky uspořádat a pokud ano, vydejte seznam vrcholů v topologickém pořadí.
Příklad:
?- topo([a-[],b-[a,c],c-[a],d-[a,c]],Usp).
Usp = [b,d,c,a]
- Definujte příslušný predikát topo/2 v jazyce Prolog.
- Odhadněte časovou složitost vašeho řešení. Odhad zdůvodněte.
- Jsou některé z vašich predikátů koncově rekurzivní ? Pokud ano, vysvětlete, které to jsou, a jaký to má význam. Pokud ne, vysvětlete, zdali by se dal některý takto upravit.
Řešení:
remove_vertex([], _, []).
remove_vertex([ Vertex-_ | Graph ], Vertex, Out) :-
remove_vertex(Graph, Vertex, Out),
!.
remove_vertex([ V-Ns | Graph ], Vertex, [ V-NewNs | Ans ]) :-
remove_vertex(Graph, Vertex, Ans),
(
member(Vertex, Ns)
->
select(Vertex, Ns, NewNs)
;
NewNs = Ns
).
topo(Graph, Usp) :-
topo_(Graph, [], Usp).
topo_([], Acc, Acc).
topo_(Graph, Acc, Out) :-
member(Min-[], Graph),
remove_vertex(Graph, Min, NewGrap),
topo_(NewGrap, [Min | Acc], Out).
Zdroj: MFF Forum: Zkoužka 4.9.2020
Napište predikát diskr/2
, který dostane binární strom (s konstruktory
t/3
a nil/0
) a vrátí seznam seznamů vrcholů stromu, kde v jednom
vnitřním seznamu jsou všechny vrcholy, ke kterým se při průchodu od kořene
dostaneme se stejným počtem kroků doprava. Vnější seznam je od nejlevější
vrstvy, na pořadí ve vnitřních seznamech nezáleží.
Příklad:
?- diskr(t( t(t(nil,a,nil),b,t(nil,c,nil)),
d,
t(t(nil,e,t(nil,f,nil)),
g,
t(nil,h,t(nil,i,nil)) )), V).
V = [[a,b,d],[c,g,e],[f,h],[i]]
- Definujte příslušný predikát
diskr/2.
- Je ve vašem řešení použit řez (!) nebo negace? Pokud ano, změní se něco, když řez / negaci vypustíme? Pokud ne, dal by se řez / negace někde smysluplně využít?
- Lze u predikátu
diskr/2
obrátit směr výpočtu? Podrobněji: dle příkladu předpokládáme volání diskr(+,-). Bude fungovat i volání diskr(-, +), tj. zadáme seznam diskrepančních vrstev, a na výstupu obdržíme strom? Vysvětlete.
Řešení:
diskr(Tree, V) :-
diskr_(Tree, 0, NodeRightCount),
collect(NodeRightCount, 0, V).
diskr_(nil, _, []).
diskr_(t(Left, Node, Right), RightCount, NodeRightCount) :-
diskr_(Left, RightCount, LAns),
NewCount is RightCount + 1,
diskr_(Right, NewCount, RAns),
append(LAns, [Node-RightCount | RAns], NodeRightCount).
is_count(Count, _-Count).
get_value(Value-_, Value).
collect([], _, []).
collect(Pairs, Count, Ans) :-
include(is_count(Count), Pairs, RightCount),
(
RightCount \= []
->
maplist(get_value, RightCount, Vals),
NewCount is Count + 1,
collect(Pairs, NewCount, TmpAns),
Ans = [Vals | TmpAns]
;
Ans = []
).
% test data
test_tree(
t(
t(
t(nil, a, nil),
b,
t(nil, c, nil)
),
d,
t(
t(
nil,
e,
t(nil, f, nil)
),
g,
t(
nil,
h,
t(nil, i, nil)
)
)
)
).
Zdroj: MFF Forum: Zkouška 16. 7. 2020
Cílem úlohy je definovat predikát allTrees, který pro daný seznam hladin vygeneruje všechny možné binární stromy.
- Hladinou rozumíme seznam prvků, které se nacházejí ve stejné hloubce
- Můžete předpokládat, že každá hladina má nanejvýš dvojnásobek prvků předchozí hladiny (ale může jich mít méně).
- Hladiny vygenerovaného stromu musejí odpovídat hladinám specifikovaných ve vstupním seznamu.
Např. pro seznam [[1],[2,3],[4]]
dostaneme následující 4 stromy:
1
2 3
4
1
2 3
4
1
2 3
4
1
2 3
4
- Popište zvolenou reprezentaci binárních stromů.
- Definujte predikát
allTrees/2
. - Stručně vysvětlete, proč je vaše definice korektní.
- Lze vaší definici použít opačným směrem? Tj. nalezne váš predikát seznam hladin pokud specifikujete pouze výsledný strom? Vysvětlete.
Řešení:
level_to_forest([], [], []).
level_to_forest([X | Xs], [Left, Right | Rest], [t( Left, X, Right ) | Ans]) :-
level_to_forest( Xs, Rest, Ans ).
level_to_forest([X | Xs], [Left | Rest], [t( Left, X, nil ) | Ans]) :-
level_to_forest( Xs, Rest, Ans ).
level_to_forest([X | Xs], [Right | Rest], [t( nil, X, Right ) | Ans]) :-
level_to_forest( Xs, Rest, Ans ).
level_to_forest([X | Xs], Trees, [t( nil, X, nil ) | Ans]) :-
level_to_forest( Xs, Trees, Ans ).
all_trees(Levels, SingleTree) :-
reverse(Levels, ReversedLevels),
Forest = [],
all_trees(ReversedLevels, Forest, [SingleTree]).
all_trees([], Forest, Forest).
all_trees([Level | Levels], Forest, Ans) :-
level_to_forest(Level, Forest, NewForest),
all_trees(Levels, NewForest, Ans).
Zdroj: MFF Forum: Zkouška 16. 7. 2020
Je zadán neorientovaný graf G a množina vrcholů M. Zjistěte, zda M a doplněk M tvoří bipartitní rozklad grafu G (tj. každá hrana grafu má právě jeden koncový vrchol v množině M). Pokud ano, vydejte druhou množinu rozkladu.
?- bip([a-[c,d], b-[d], c-[a], d-[a,b]], [a,b], D).
D = [c,d]
?- bip([a-[c,d], b-[d], c-[a], d-[a,b]], [b,c], D).
false
- Definujte predikát
bip/3
. - Napište o jednotlivých predikátech ve vašem řešení, zda jsou koncově rekurzivní.
Řešení:
% collect_nodes(+Graph, -Nodes) is true when Nodes are all the nodes in Graph
% in sorted order.
collect_nodes(Graph, Nodes) :-
collect_nodes(Graph, [], NodesDup),
sort(NodesDup, Nodes),
!.
collect_nodes([], Acc, Acc).
collect_nodes([Node-Neighbours | Ns], Acc, Ans) :-
append([Node | Neighbours], Acc, NewAcc),
collect_nodes(Ns, NewAcc, Ans).
% difference(+List1, +List2, -List3) is true if List3 contains all nodes of List1
% except the elements in List2
difference(List, [], List).
difference(List, [X | Xs], Out) :-
exclude(=(X), List, Tmp),
difference(Tmp, Xs, Out),
!.
bip(Graph, V, U) :-
collect_nodes(Graph, Nodes),
difference(Nodes, V, U),
is_bipartite(Graph, V, U).
is_bipartite([], _, _).
is_bipartite([Node-Neighbours | NNs], V, U) :-
(
member(Node, V)
->
Partition = V
;
Partition = U
),
member(Node, Partition),
maplist(does_not_contain(Partition), Neighbours),
is_bipartite(NNs, V, U),
!.
does_not_contain(List, X) :- \+ member(X, List).
Zdroj: MFF Forum: Zkouška 24. 6. 2020
Truhlář má dostatek trámů délky D
a seznam Xs
délek trámů, které
potřebuje nařezat. V seznamu Xs
se délky mohou opakovat.
Cílem problému je sestavit predikát rezy(+D, +Xs, -N, -Vss)
, který
- rozdělí požadované délky do skupin, které se mají nařezat z jednoho trámu
- truhlář přitom používá hladový algoritmus, tj. pro každou délku použije první trám, z něhož lze ještě požadovanou délku odřezat
- vrátí celkový počet řezaných trámů N
- a seznam seznamů Vss (délky N), jehož každý prvek reprezentuje dělení jednoho trámu (případný zbytek se neuvádí).
?- rezy(5,[3,2,2,2,2,1,4], N, V).
N=4, V=[[3,2],[2,2,1],[2],[4]]
- Definujte predikát
rezy/4.
Definice případných pomocných predikátů prosím opatřete vysvětlujícím komentářem. - Je některý z vašich predikátů koncově rekurzivní? Pokud ano, vysvětlete, který to je a jaký to má význam.
- Pokud ne, dal by se některý takto upravit? Odpověď prosím zdůvodněte.
Řešení:
second(_-X, X).
rezy(Length, Xs, N, Vss) :-
rezy_(Length, Xs, [], TRVss),
maplist(second, TRVss, RVss),
maplist(reverse, RVss, Vss),
length(Vss, N),
!.
rezy_(_, [], Acc, Acc).
rezy_(Length, [ X | Xs ], Acc, Ans) :-
greedy_extend_cut(Length, Acc, X, NewAcc),
rezy_(Length, Xs, NewAcc, Ans).
greedy_extend_cut(_, [], NextCut, [ NextCut-[NextCut] ]).
greedy_extend_cut(MaxLength, [ Total-Cuts | Cs ], NextCut, Ans) :-
NextCut =< MaxLength,
Free is MaxLength - Total,
(
NextCut =< Free
->
NewTotal is Total + NextCut,
Ans = [ NewTotal-[NextCut | Cuts ] | Cs ]
;
greedy_extend_cut(MaxLength, Cs, NextCut, Ans_),
Ans = [ Total-Cuts | Ans_]
),
!.
Zdroj: MFF Forum: Zkouška 24. 6. 2020
Je zadán seznam množin Mss
. Chceme všemi možnými způsoby vybrat a vrátit v
seznamu reprezentanty daných množin v odpovídajícím pořadí s podmínkou, že
konkrétní reprezentanti v jednom výběru jsou různí.
Příklad:
?- reprezentanti([[1],[1,2,3],[1,3,4]], R).
R = [[1,2,3],[1,2,4],[1,3,4]]
- Sestavte predikát
reprezentanti(+Mss, -Rss)
. - Stručně vysvětlete, proč je vaše definice korektní.
- Je ve vašem programu použit řez
(!)
? Jde o řez červený (mění deklarativní význam programu) či zelený (nemění d.v.)? Pokud ne, je řez nezbytný pro definici některého vestavěného predikátu / operátoru, který jste ve vašem řešení použili? Jde o řez červený (mění deklarativní význam programu) či zelený (nemění d.v.)?
cons(X, Xs, [X | Xs]).
extend_one(X, Ys, Ans) :-
exclude(member(X), Ys, Tmp),
maplist(cons(X), Tmp, Ans).
extend_with([], _, Acc, Acc).
extend_with([X | Xs], Ys, Acc, Ans) :-
extend_one(X, Ys, Tmp),
append(Tmp, Acc, NewAcc),
extend_with(Xs, Ys, NewAcc, Ans).
reprezentanti(Xss, Ans) :-
reprezentanti(Xss, [[]], Ans).
reprezentanti([], Acc, Acc).
reprezentanti([Xs | Xss], Acc, Ans) :-
extend_with(Xs, Acc, [], NewAcc),
reprezentanti(Xss, NewAcc, Ans).
Zdroj: MFF Forum: Zkouška 12. 6. 2020 (Dvořák, Hric)
Profesor Hammerstein definoval predikat setrid/2
takto:
% setrid(+Xs,-Ys) :- Ys je seznam přirozených čísel ze seznamu Xs setříděný
% vzestupně
setrid(Xs,Ys) :-
append(A,[H1,H2|B],Xs),
H1 > H2,
!,
append(A,[H2,H1|B],Xs1),
setrid(Xs1,Ys).
zapomněl však na klauzuli, která definuje bázi rekurze.
- Doplňte jednu (opravdu jen jednu) chybějící klauzuli za uvedené pravidlo tak, aby výsledná procedura korektně setřídila vstupní seznam přirozených čísel. Na výstupu bychom měli obdržet jen jediné řešení.
- V definici pravidla je použit řez (!). Jde o zelený (nemění deklarativní význam) či červený řez (mění d.v.) ? Vysvětlete! Obsahuje některá z vašich klauzulí, (doplněná v(a) nebo (b)) zelený či červený řez?
- Jaký známý třídící algoritmus výše uvedený kód implementuje? Pokud neznáte
název, můžete alespoň slovně popsat, jak
setrid/2
funguje. - VOLITELNE: Lze u procedury
setrid/2
obrátit směr výpočtu?
setrid(-Xs,+Ys) :- Xs je seznam přirozených čísel ze seznamu Ys setříděný vzestupně
Pokud ne, šel by kód jednoduše upravit tak, aby se výsledný predikát
(pojmenovaný třeba setrid2/2
) dal korektně volat oběma způsoby?
Řešení:
% setrid(+Xs,-Ys) :- Ys je seznam přirozených čísel ze seznamu Xs setříděný
% vzestupně
% Bubble sort
setrid(Xs, Ys) :-
append(A, [H1,H2|B], Xs),
H1 > H2,
!, % cerveny
append(A, [H2,H1|B], Xs1),
setrid(Xs1, Ys).
setrid(Xs, Xs).
Zdroj: MFF Forum: Zkouška 12. 6. 2020 (Dvořák, Hric)
Do země Mobilia, v níž je každý občan vybaven chytrým telefonem, přicestoval
Cestovatel, nakažený virovým onemocněním. Všichni ostatní byli přitom ještě
zdraví. Můžeme předpokládat, že virus se přenese z jedné osoby na druhou, pokud
spolu strávili ve vzdálenosti menší než 2m alespoň čas K
, kde K
je
známá kritická hodnota. Díky chytrým telefonům máme pro každého občana Mobilie
seznam záznamů jeho kontaktů, kde každý takový záznam pro osobu A
obsahuje
identifikaci osoby B
, která se k němu přiblížila do vzdálenosti < 2m
čas setkání a délku setkání.
Cílem je sestavit program, který na základě takových záznamů vrátí seznam infikovaných osob.
-
V jazyce Prolog popište datovou strukturu pro reprezentaci jednoho záznamu kontaktu občana Mobilie popsaného výše.
-
V jazyce Prolog navrhněte reprezentaci položek VstupníhoSeznamu, přičemž každá položka bude obsahovat indentifikaci občana Mobilie a seznam záznamů jeho kontaktů.
-
Sestavte predikát
inf/4
, který obdržíVstupníSeznam identifikaci Cestovatele kritickou hodnotu K
a vrátí seznam infikovaných.
U každého pomocného predikátu prosím v poznámce popište jeho význam.
Volitelné: výstupní seznam můžete uspořádat dle délky kontaktu s infikovanými do nerostoucí posloupnosti.
-
Odhadněte časovou složitost vašeho řešení.
-
Je některý z vašich predikátů koncově rekurzivní ? Pokud ano, vysvětlete, jaký to má význam. Pokud ne , dal by se některý takto upravit?
Řešení:
% contact(ID, Time, Length)
% [ID1-[ contact(...), ... ], ID2-[ contact(...), ... ], ...]
lookup_contact([ID-Contacts | _], ID, Contacts) :- !.
lookup_contact([ _ | Cs ], ID, Contacts) :-
lookup_contact(Cs, ID, Contacts).
was_infected(TimeInfected, K, contact(_, Time, Length)) :-
Time >= TimeInfected,
Length >= K.
get_id_time_pair(contact(ID, Time), ID-Time).
get_infected(ContactsList, K, ID, TimeInfected, Infected) :-
lookup_contact(ContactsList, ID, Contacts),
include(was_infected(TimeInfected, K), Contacts, InfectedCs),
maplist(get_id_time_pair, InfectedCs, Infected).
contained_in(InfectedIDs, ID-_) :- member(ID, InfectedIDs).
first(X-_, X).
inf(ContactsList, TravellerID, K, Infected) :-
TimeInfected = 0,
ToProcess = [ TravellerID-TimeInfected ],
Acc = [ ],
inf(ContactsList, K, ToProcess, Acc, Infected).
inf(_, _, [], Acc, Acc).
inf(ContactsList, K, [ ID-TimeInfected | Ps ], Acc, Ans) :-
get_infected(ContactsList, K, ID, TimeInfected, Infected),
exclude(contained_in(Acc), Infected, NewInfected),
append(Ps, NewInfected, NewToProcess),
maplist(first, NewInfected, NewIDs),
append(NewIDs, Acc, NewAcc),
inf(ContactsList, K, NewToProcess, NewAcc, Ans).
Zdroj: MFF Forum: 10. 9. 2019 - Dvořák
Definujte binární predikát aspon2/2
, který
- obdrží seznam výrokových proměnných (reprezentovaných atomy), v němž je každá proměnná ohodnocena hodnotou true nebo false
- vrátí seznam všech takových ohodnocení týchž proměnných, v němž se každé ohodnocení bude od vstupního lišit v hodnotách alespoň 2 proměnných.
Příklad:
?- aspon2([x1-true, x2-false, y-true], V).
V = [ [x1-false, x2-true, y-true],
[x1-false, x2-false, y-false],
[x1-true, x2-true, y-false],
[x1-false, x2-true, y-false] ]
Řešení:
cons(X, Xs, [X | Xs]).
% diff(Modified, Original, N).
diff_ord([], [], 0).
diff_ord([_-V | T1], [_-not(V) | T2], AnsN) :-
diff_ord(T1, T2, N),
AnsN is N + 1.
diff_ord([_-V | T1], [_-V | T2], N) :-
diff_ord(T1, T2, N).
diff_less_then_2(Original, Modified) :-
diff_ord(Original, Modified, N),
N < 2.
aspon_2(Values, X) :-
subset_change(Values, All),
exclude(diff_less_then_2(Values), All, X).
subset_change([], [[]]).
subset_change([Var-Value | Values], Ans) :-
subset_change(Values, Tmp),
maplist(cons(Var-Value), Tmp, NotChanged),
maplist(cons(Var-not(Value)), Tmp, Changed),
append(NotChanged, Changed, Ans).
Zdroj: MFF Forum: 10. 9. 2019 - Dvořák
Graf je zadán jako seznam svých vrcholů se seznamy sousedů (viz příklad).
Definujte binární predikát troj(+Graf, -SeznamTrojuhelniku)
který k
takovému grafu vrátí seznam všech jeho trojúhelníků. Ve výsledném seznamu by se
každý trojúhelník měl vyskytovat právě jednou (t(a,b,c)
, t(b,c,a)
a
t(c,a,b)
jsou stejné trojúhelníky).
Příklad:
?- troj([a-[b,c,d],b-[a,c],c-[a,b,d],d-[a,c],e-[]], S).
S = [t(a,b,c), t(a,c,d)]
Řešení:
is_edge(Graph, From, To) :-
member(From-Neighbours, Graph),
member(To, Neighbours).
neighbours(Graph, Node, Neighbours) :-
member(Node-Neighbours, Graph).
first(X-_, X).
lift_list(X, [X]).
all_paths(_, 0, []).
all_paths(Graph, N, Paths) :-
maplist(first, Graph, Nodes),
maplist(lift_list, Nodes, Acc),
all_paths(Graph, N, 1, Acc, Paths).
all_paths(_, N, N, Acc, Acc) :- !.
all_paths(Graph, MaxLen, Len, Paths, Ans) :-
extend_paths(Graph, Paths, NewAcc),
NewLen is Len + 1,
all_paths(Graph, MaxLen, NewLen, NewAcc, Ans),
!.
extend_paths(Graph, Paths, Ans) :-
extend_paths(Graph, Paths, [], Ans).
push(Xs, X, [X | Xs]).
extend_paths(_, [], Acc, Acc).
extend_paths(Graph, [ Path | Ps ], Acc, Ans) :-
Path = [ N | _ ],
neighbours(Graph, N, Neighbours),
maplist(push(Path), Neighbours, Tmp),
append(Tmp, Acc, NewAcc),
extend_paths(Graph, Ps, NewAcc, Ans).
is_triangle([A, B, C, A]) :-
A \= B,
B \= C,
A \= C.
to_triangle([A, B, C, A], t(A, B, C)).
is_congruent(t(A, B, C), t(A, B, C)).
is_congruent(t(A, B, C), t(A, C, B)).
is_congruent(t(A, B, C), t(B, A, C)).
is_congruent(t(A, B, C), t(B, C, A)).
is_congruent(t(A, B, C), t(C, A, B)).
is_congruent(t(A, B, C), t(C, B, A)).
deduplicate(Triangles, Ans) :-
deduplicate(Triangles, [], Ans).
deduplicate([], Acc, Acc).
deduplicate([ Triangle | Ts ], Acc, Ans) :-
exclude(is_congruent(Triangle), Ts, Filtered),
deduplicate(Filtered, [Triangle | Acc], Ans).
troj(Graph, Triangles) :-
all_paths(Graph, 4, Paths),
include(is_triangle, Paths, Filtered),
maplist(to_triangle, Filtered, Tmp),
deduplicate(Tmp, Triangles).
Zdroj: MFF Forum: 24.6.2019 (Dvořák, Hric)
Formule výrokového počtu jsou sestavené z (výrokových) proměnných ve funktoru
var/1
a logických spojek negace, konjunkce a disjunkce (bez konstant). Dále
máte dány v argumentech predikátu gen/3
číslo k
pro velikost formule a
seznam jmen proměnných. Generujte backtrackingem všechny logické formule
(každou jednou), které obsahují proměnné ze seznamu a ve kterých je počet
spojek a výskytů proměnných dohromady právě k
.
Definujte predikát gen(+K, +Jmena, -Fle)
. Na pořadí generovaných formulí
nezáleží, ale měli byste vygenerovat každou právě jednou. K řešení není potřeba
predikát =../2
(univ).
Příklad:
?- gen(4,[p],F).
F = not(not(not(var(p))));
F = not(and(var(p),var(p)));
F = not(or(var(p),var(p)));
F = and(not(var(p)),var(p));
F = and(var(p),not(var(p)));
F = or(not(var(p)),var(p));
F = or(var(p),not(var(p)));
false.
Řešení:
gen(K, Vars, F) :-
length(Slots, K),
gen_(Slots, Vars, F).
gen_([_], Vars, var(V)) :-
member(V, Vars).
gen_([_ | Ss], Vars, not(F)) :-
gen_(Ss, Vars, F).
gen_([_ | Ss], Vars, Ans) :-
append(Left, Right, Ss),
gen_(Left, Vars, F1),
gen_(Right, Vars, F2),
(
Ans = and(F1, F2)
;
Ans = or(F1, F2)
).
Zdroj: MFF Forum: 24.6.2019 (Dvořák, Hric)
Jeden objekt je zadán uspořádaným seznamem dvojic klíč-hodnota. Na vstupu máte
seznam objektů. Napište proceduru koncept/2
, která vyrobí nejmenší koncept
zahrnující všechny vstupní objekty. Koncept je seznam dvojic
klíč-seznam_hodnot
. Koncept zahrnuje objekt, pokud koncept má všechny klíče
objektu a v seznamu hodnot příslušného klíče u konceptu je obsažena hodnota
klíče u objektu. Pokud objekt nějaký klíč konceptu nemá, bude v seznamu hodnot
konceptu hodnota nedef
.
Příklad:
?- koncept([ [barva-modra, motor-diesel, pocet_kol-6],
[barva-bila, motor-plyn, pocet_mist-40],
[motor-elektro, pocet_mist-5] ],
Koncept).
Koncept = [ barva-[modra,bila,nedef],
motor-[diesel,plyn,elektro],
pocet_kol-[6,nedef],
pocet_mist-[40,5,nedef] ]
Řešení:
collect_attributes(Objects, Attributes) :-
collect_attributes(Objects, [], Attributes).
collect_attributes([], Acc, Ans) :-
sort(Acc, Ans).
collect_attributes([ Object | Os ], Acc, Ans) :-
collect_attributes_one(Object, Attrs),
append(Attrs, Acc, NewAcc),
collect_attributes(Os, NewAcc, Ans).
collect_attributes_one(Object, Attributes) :-
collect_attributes_one(Object, [], Attributes).
collect_attributes_one([], Acc, Acc).
collect_attributes_one([Key-_ | Ps], Acc, Ans) :-
collect_attributes_one(Ps, [ Key | Acc ], Ans).
koncept(Objects, Concepts) :-
collect_attributes(Objects, Attrs),
koncept(Objects, Attrs, [], Concepts).
koncept([], _, Concepts, Concepts).
koncept([ Object | Os ], Attrs, Concepts, Ans ) :-
extend_concepts(Attrs, Object, Concepts, NewConcepts),
koncept( Os, Attrs, NewConcepts, Ans ).
extend_concepts([], _, Concepts, Concepts).
extend_concepts([ Attr | Attrs ], Objects, Concepts, Ans) :-
(
select(Attr-Value_, Objects, RestObjects)
->
Value = Value_,
NewObjects = RestObjects
;
Value = nedef,
NewObjects = Objects
),
extend_concept(Attr-Value, Concepts, NewConcepts),
extend_concepts(Attrs, NewObjects, NewConcepts, Ans).
extend_concept(Attr-Value, Concepts, NewConcepts) :-
(
select(Attr-Values, Concepts, RestConcepts)
->
set_add(Values, Value, NewValues),
NewConcept = Attr-NewValues,
NewConcepts = [ NewConcept | RestConcepts ]
;
NewValues = [ Value ],
NewConcept = Attr-NewValues,
NewConcepts = [ NewConcept | Concepts ]
).
set_add(List, Element, Out) :-
(
member(Element, List)
->
Out = List
;
Out = [ Element | List ]
).
Zdroj: MFF Forum: Zkouška 10.6.2019 (Dvořák + Hric)
Máte dány dva řetězce, u kterých nevíte jejich vzájemnou orientaci. Najděte a vydejte v seznamu všechna jejich vzájemná neprázdná překrytí.
Příklad:
?- prekryti([a,t,c,t,c],[c,t,c,c], V).
V = [a,t,c,t,c,t,c,c],[a,t,c,t,c,c],[a,t,c,t,c,c,t,c]]
Řešení:
id_or_reverse(X, X).
id_or_reverse(X, Y) :-
reverse(X, Y),
X \= Y.
prekryti(Xs, Ys, Out) :-
prekryti_(Xs, Ys, [], Out).
prekryti_(Xs, Ys, Acc, Out) :-
is_prekryti(Xs, Ys, P),
\+ member(P, Acc),
prekryti_(Xs, Ys, [P | Acc], Out),
!.
prekryti_(_, _, Acc, Acc) :- !.
is_prekryti(Xs, Ys, Out) :-
id_or_reverse(Xs, X),
id_or_reverse(Ys, Y),
append(_, BodyTailX, X),
append(HeadBodyY, TailY, Y),
BodyTailX = HeadBodyY,
BodyTailX \= [],
append(X, TailY, Out).
Zdroj: MFF Forum: Zkouška 10.6.2019 (Dvořák + Hric)
Částečně uspořádaná množina je popsána seznamem termů tvaru x -> y
s
významem x pokrývá y (tj. x > y
a současně x ≥ z ≥ y
implikuje x = z
nebo y = z
).
Definujte predikát nepor/2
, který k takto zadané množině vrátí seznam všech
dvojic vzájemně neporovnatelných prvků (tj. dvojic x
,y
takových, že
neplatí x ≥ y
ani x ≤ y
).
Příklad:
?- nepor([a->b, a->c, b->d, e->f], N).
N = [a-e,a-f,b-c,b-e,b-f,c-d,c-e,c-f,d-e,d-f]
Řešení:
ge(_, X, X).
ge(R, X, Y) :- member(X -> Y, R).
ge(R, X, Y) :- member(X -> Z, R), ge(R, Z, Y).
collect_variables(Rel, Vars) :-
collect_variables_(Rel, [], Vars).
collect_variables_( [], Acc, Ans) :-
sort(Acc, Ans).
collect_variables_( [X -> Y | Rs], Acc, Ans) :-
collect_variables_(Rs, [X, Y | Acc], Ans).
pair(X, Y, X-Y).
pairs(Vars, Pairs) :-
select(Var, Vars, RestVars),
!,
maplist(pair(Var), RestVars, Tmp),
pairs(RestVars, Ans),
append(Tmp, Ans, Pairs).
pairs([], []).
is_nepor(R, X-Y) :-
\+ ge(R, X, Y),
\+ ge(R, Y, X).
nepor(Rel, Out) :-
collect_variables(Rel, Vars),
pairs(Vars, Pairs),
include(is_nepor(Rel), Pairs, Out).
Zdroj: MFF Forum: Zkouška 21.6.2018
Nalezněte lexikograficky předchozí permutaci. Pokud neexistuje tak false
.
Řešení:
?- prev([1,2,6,3,4,5,7],V).
V = [1,2,5,7,6,4,3]
find_longest_ascending([], [], []).
find_longest_ascending([X], [X], []).
find_longest_ascending([X1, X2 | Xs], [X1], [X2 | Xs]) :-
X1 > X2,
!.
find_longest_ascending([X1, X2 | Xs], [ X1 | Ans ], Rest) :-
X1 < X2,
find_longest_ascending([X2 | Xs], Ans, Rest).
replace([], _, _, []).
replace([X | Xs], X, Y, [Y | Xs]) :- !.
replace([R | Xs], X, Y, [R | Ans]) :-
replace(Xs, X, Y, Ans).
prev(Perm, Prev) :-
find_longest_ascending(Perm, Asc, Rest),
reverse(Asc, Rev),
member(X, Rev),
Y is X - 1,
member(Y, Rest),
!,
replace(Asc, X, Y, NewAsc),
replace(Rest, Y, X, NewRest),
reverse(NewRest, FinalRest),
append(NewAsc, FinalRest, Prev).
Zdroj: MFF Forum: Zkouška 26.6.2018
Definujte predikát frekv/2
, který obdrží seznam konstant
a vrátí frekvence dvojic za sebou jdoucích konstant.
Výstupní reprezentaci si zvolte a popište pro vzorový vstup.
?- frekv([a,b,a,b,c], P).
P = [f(a-b,2), f(b-a,1), f(b-c,1)]
Řešení:
frekv(List, Freq) :-
frekv_(List, [], Freq),
!.
frekv_([], Acc, Acc).
frekv_([_], Acc, Acc).
frekv_([ X1, X2 | Xs ], Freq, Ans) :-
increase_frequency(X1-X2, Freq, NewFreq),
frekv_([ X2 | Xs ], NewFreq, Ans).
increase_frequency(X-Y, Freq, [f(X-Y, NewN) | Rest]) :-
select(f(X-Y, N), Freq, Rest),
NewN is N + 1,
!.
increase_frequency(X-Y, Freq, [f(X-Y, 1) | Freq]).
Zdroj: MFF Forum: Zkouška 26.6.2018
Je dán orientovaný acyklický graf (DAG) o n
vrcholech pomocí seznamu
sousedů. Procedura dfs/2
projde graf do hloubky a přidá k vrcholům časy
otevření a uzavření v rozsahu od 1
do 2n
. Na pořadí vrcholů na výstupu
nezáleží:
Definujte predikát dfs/2
a napište konkrétní výstup vašeho programu na
vzorovém grafu z příkladu níže.
Příklad:
?- dfs([c-[d], a-[b,c], b-[d,e], d-[], e-[]], V).
V = [v(a,1,10,[b,c]), v(c,2,5,[d]), v(d,3,4,[]), v(b,6,9,[e]), v(e,7,8,[])]
Řešení:
dfs(Graph, Out) :-
member(Start-_, Graph),
Stack = [ Start ],
Opened = [],
Closed = [],
Time = 1,
dfs_(Graph, Stack, Time, Opened, Closed, Out).
dfs_(_, [ ], _, _, Out, Out).
dfs_(Graph, [ Vertex | Vs ], Time, Opened, Closed, Out) :-
member(t(Vertex, _, _), Closed),
dfs_(Graph, Vs, Time, Opened, Closed, Out),
!.
dfs_(Graph, [ Vertex | Vs ], Time, Opened, Closed, Out) :-
NewTime is Time + 1,
(
select(Vertex-InTime, Opened, NewOpened)
->
dfs_(
Graph,
Vs,
NewTime,
NewOpened,
[t(Vertex, InTime, Time) | Closed],
Out
)
;
member(Vertex-Neigbours, Graph),
append(Neigbours, [Vertex | Vs], NewStack),
dfs_(
Graph,
NewStack,
NewTime,
[ Vertex-Time | Opened ],
Closed,
Out
)
).
Zdroj: MFF Forum: Zkouška 6. 6. 2016 (Dvořák, Hric)
Naprogramujte predikát splay(+Hodnota, +BinarniVyhledavaciStrom, -Vysledek)
, který provede funkci splay
(přesune daný vrchol až do kořene
pomoci rotací) na Hodnotu
. Pokud Hodnota
ve stromě není, pak se splay
provede na bezprostredního předchůdce/následníka.
TestTree = tree(
tree(
tree(
tree(null, 1, null),
2,
tree(null, 3, null)
),
4,
tree(null, 5, null)
),
6,
tree(
tree(null, 7, null),
8,
tree(null, 9, null)
)
).
Řešení:
splay(X, T, T) :-
T = tree(_, X, _),
!.
splay(X, T, Out) :-
T = tree(Left, Y, Right),
(
X < Y
->
splay(X, Left, Ans),
Ans = tree(LeftAns, Z, RightAns),
Out = tree(LeftAns, Z, tree(RightAns, Y, Right))
;
splay(X, Right, Ans),
Ans = tree(LeftAns, Z, RightAns),
Out = tree(tree(Left, Y, LeftAns), Z, RightAns)
),
!.
splay(_, T, T) :- T = tree(null, _, null).
Zdroj: MFF Forum: Zkouška 6. 6. 2016 (Dvořák, Hric)
Na vstupu máme seznam po částech konstantních funkcí Fs
, kde každá funkce
je ve tvaru DelkaUseku-Hodnota
. Všechny funkce začinají v 0
a po konci
posledního useku pokračují hodnotou 0
. Máme vytvořit nejmenší novou funkci
takovu, že v každém bodě je větší rovna všem zadaným funkcím.
Příklad:
Dvě funkce: první má na intervalu [0, 2)
hodnotu 5, na intervalu [2, 4)
hodnotu 3 a na intervalu [4, inf)
hodnotu 0. Druhá má na intervalu [0, 3)
hodnotu 4 a na intervalu [3, inf)
hodnotu 0.
Vysledkem je funkce [2-5, 1-4, 1-3]
.
?- combine([[2-5, 2-3], [3-4]], G)
G = [2-5, 1-4, 1-3]
Řešení:
combine([], []).
combine([ Base | Fs ], G) :-
combine_(Fs, Base, G).
combine_([], Base, Base).
combine_([F | Fs], Base, Out) :-
extend_base(Base, F, NewBase),
combine_(Fs, NewBase, Out),
!.
extend_base(Base, [], Out) :-
merge_adjecent(Base, Out).
extend_base([], F, F).
extend_base([ Length-BaseVal | BLVs ], [ Length-FVal | FLVs], Out) :-
extend_base(BLVs, FLVs, Ans),
(
BaseVal > FVal
->
Out = [Length-BaseVal | Ans]
;
Out = [Length-FVal | Ans]
).
extend_base([ BaseLength-BaseVal | BLVs ], [ FLength-FVal | FLVs], Out) :-
(
BaseLength < FLength
->
Remainder is FLength - BaseLength,
extend_base(
[ BaseLength-BaseVal | BLVs ],
[ BaseLength-FVal, Remainder-FVal | FLVs],
Out
)
;
Remainder is BaseLength - FLength,
extend_base(
[ FLength-BaseVal, Remainder-BaseVal | BLVs ],
[ FLength-FVal | FLVs],
Out
)
).
merge_adjecent([], []).
merge_adjecent([P], [P]).
merge_adjecent([Length1-Val, Length2-Val | LVs], Out) :-
NewLength is Length1 + Length2,
merge_adjecent([NewLength-Val | LVs], Out),
!.
merge_adjecent([X, Y | LVs], [X | Out]) :-
merge_adjecent([Y | LVs], Out).
Zdroj: MFF Forum: Zkouška 22.6.
Máme daný orientovaný graf reprezentovaný jako [vrchol-[seznam sousedů]|...]
, zjistěte, zda v něm je orientovaná kružnice, a pokud ano,
vraťte vrcholy nějaké takové kružnice v tom pořadí, jak jsou na kružnici. Chce
se polynomiální řešení.
Příklad:
?- cycle([a-[b,c,d],b-[c],c-[a,b,d],d-[a,c],e-[]], C)
C = [a, c, b]
Řešení:
cycle(Graph, Cycle) :-
member(Start-_, Graph),
Stack = [Start],
Path = [],
cycle_(Graph, Stack, Path, Cycle),
!.
cycle_(Graph, [ Vertex | Vs ], Path, Out) :-
(
member(Vertex, Path)
->
append(Cs, [Vertex | _], Path),
Out = [Vertex | Cs]
;
member(Vertex-Neighbours, Graph),
append(Neighbours, Vs, NewStack),
cycle_(Graph, NewStack, [Vertex | Path], Out)
).
Zdroj: MFF Forum: Zkouska 20.9.2017
Definujte predikát dif/2
, který obdrží seznam S
, a vrátí seznam všech
seznamů, které obdržíte z S
vypuštěním nejvýše 2 prvků. Pořadí prvků ve
výstupních seznamech se nemění.
Příklad:
?- dif([a,b,c],D).
D=[[a,b,c], [b,c], [a,c], [a,b], [a], [c]]
Řešení:
smaller_than(N, Xs) :- length(Xs, K), K < N.
dif(List, Out) :-
length(List, N),
MinSize is N - 2,
dif_(List, Ans),
exclude(smaller_than(MinSize), Ans, Out).
cons(X, Xs, [X | Xs]).
dif_([], [[]]).
dif_([X | Xs], Out) :-
dif_(Xs, Tmp),
maplist(cons(X), Tmp, Appended),
append(Appended, Tmp, Out).
Zdroj: MFF Forum: Zkouska 20.9.2017
Je zadán neorientovaný graf G
a jeden jeho vrchol v
. Definujte predikát
pokryti/3,
který postupně vrátí všechna vrcholová pokrytí grafu G
,
která obsahují vrchol v
a jsou minimální vzhledem k inkluzi.
Množina vrcholů V
grafu je vrcholovým pokrytím, pokud každá hrana má
alespoň jeden vrchol v množině V
.
- Na příkladě popište, jakou reprezentaci grafu budete používat.
- Definujte predikát
pokryti(+Graf, +Vrchol, -VPokrytí)
kde Graf je zadán v reprezentaci popsané v 1.).
Řešení:
collect_nodes(Graph, Nodes) :-
collect_nodes(Graph, [], NodesDup),
sort(NodesDup, Nodes),
!.
collect_nodes([], Acc, Acc).
collect_nodes([Node-Neighbours | Ns], Acc, Ans) :-
append([Node | Neighbours], Acc, NewAcc),
collect_nodes(Ns, NewAcc, Ans).
covers(Cover, U, V) :-
member(U, Cover);
member(V, Cover).
is_cover([], _).
is_cover([ Vertex-Neighbours | Rest ], Cover) :-
maplist(covers(Cover, Vertex), Neighbours),
is_cover(Rest, Cover).
pokryti(Graph, Vertex, Cover) :-
collect_nodes(Graph, Nodes),
select(Vertex, Nodes, Rest),
!,
pokryti_(Graph, Vertex, Rest, Cover).
pokryti_(Graph, Vertex, [], [Vertex]) :-
is_cover(Graph, [Vertex]).
pokryti_(Graph, Vertex, Nodes, Cover) :-
(
select(_, Nodes, Rest),
is_cover(Graph, [Vertex | Rest])
->
pokryti_(Graph, Vertex, Rest, Cover)
;
Cover = [Vertex | Nodes]
).
Zdroj: MFF Forum: Zkouška 13. 9. 2017
Napište predikát rozdel(+Mnozina,-Rozdeleni)
, který rozdělí množinu na
neprázdné podmnožiny. Všechny možnosti rozdělení pak vrátí spojené v jednom
seznamu.
Příklad:
?- rozdel([a,b,c],X).
X = [[a, b, c], [[a, b], [c]], [[a], [b, c]], [[a, c], [b]], [[a], [b], [c]]].
???
Zdroj: MFF Forum: Zkouška 13. 9. 2017
Napište predikát nez(+Graf,+Vrchol.-NezMn)
, který vezme graf a jeden jeho
zadaný vrchol a postupně vydává všechny jeho největší nezávislé množiny
obsahující daný vrchol.
Příklad:
nez(g([a,b,c,d,e],[a-b,b-c,b-d,c-d]),a,X).
X=[a,c,e];
X=[a,d,e].
Řešení:
is_edge(g(_, Edges), U, V) :-
member(U-V, Edges), !;
member(V-U, Edges), !.
is_not_edge(Graph, U, V) :- \+ is_edge(Graph, U, V).
is_independent(_, []) :- !.
is_independent(Graph, [ V | Vs ]) :-
maplist(is_not_edge(Graph, V), Vs),
is_independent(Graph, Vs).
is_subset([], []).
is_subset([ X | Xs ], [ X | Ys ]) :-
is_subset(Xs, Ys).
is_subset([_ | Xs], Ys) :-
is_subset(Xs, Ys).
nez(Graph, Vertex, MaxIndSet) :-
g(Vertices, _) = Graph,
length(Vertices, N),
nez_(Graph, N, MaxIndSet),
!,
member(Vertex, MaxIndSet).
nez_(Graph, N, IndSet) :-
N > 0,
Graph = g(Vertices, _),
length(IndSet, N),
is_subset(Vertices, IndSet),
is_independent(Graph, IndSet).
nez_(Graph, N, IndSet) :-
NewN is N - 1,
NewN > 0,
nez_(Graph, NewN, IndSet).
Zdroj: MFF Forum: Zkouška 6. 6. 2017
Na vstupu máme graf reprezentovaný jako
graf(SeznamVrcholu, SeznamHran)
(bylo ale dovoleno si reprezentaci grafu změnit) a číslo N
. Máme určit,
jestli v grafu existuje cyklus délky alespoň N
. Pokud ano, program alespoň
jeden takový cyklus vypíše, pokud ne, vrátí fail.
Pozn.: Problém je NP-úplný, tzn. očekává se řešení typu hrubá síla.
Řešení:
subsets([], []).
subsets([ H | T ], [ H | Out ]) :-
subsets(T, Out).
subsets([ _ | T], Out) :-
subsets(T, Out).
is_edge(graph(_, Edges), U, V) :-
member(U-V, Edges), !;
member(V-U, Edges), !.
is_path(Graph, [], Start, End) :-
is_edge(Graph, Start, End).
is_path(Graph, Vertices, Start, End) :-
select(Vertex, Vertices, Rest),
is_edge(Graph, Start, Vertex),
is_path(Graph, Rest, Vertex, End).
is_cycle(Graph, Vertices) :-
select(Start, Vertices, Rest),
is_path(Graph, Rest, Start, Start),
!.
cycle_n(Graph, N, Cycle) :-
graph(Vertices, _) = Graph,
length(Vertices, K),
K >= N,
!,
between(N, K, N_),
length(Cycle, N_),
subsets(Vertices, Cycle),
is_cycle(Graph, Cycle),
!.
Zdroj: MFF Forum: Zkouška 29.5.2017
Sestavte predikát termy/1
, který postupně vrací termy složené z funktorů
bin/2
, un/1
a const/0
. Výstupem bude tedy korektně sestavený term.
Predikát by měl postupně vrátit všechna řešení, sice v libovolném pořadí, ovšem
každé právě jednou.
Příklad:
?- termy(V).
V=const;
V=un(const);
V=bin(const,const);
V=un(un(const));
V=un(bin(const,const));
V=bin(un(const),un(const));
Řešení:
termy(V) :-
length(Slots, _),
termy_(Slots, V).
termy_([_], const).
termy_([_ | Slots], un(T)) :-
termy_(Slots, T).
termy_([_ | Slots], bin(T1, T2)) :-
append(S1, S2, Slots),
termy_(S1, T1),
termy_(S2, T2).
Zdroj: MFF Forum: Zkouška 29.5.2017
Multimnožinu lze specifikovat seznamem termů Prvek-Pocet
. Sestavte predikát
mensi/2
, který porovná multimnožiny A
a B
následovně:
mensi(A,B)
jetrue
právě tehdy, pokud vB
existuje nějaký prvek, co není vA
takový, že je větší než všechny prvky zA
, které nejsou vB
.
?- mensi([c-3,b-2,a-1],[d-1,b-3])
true
?- mensi([c-3,b-2,a-1],[c-1,b-3])
fail
Řešení: ???
Zdroj: MFF Forum: Zkouška 13. 6. 2016 (Dvořák, Hric)
Napište predikát, který naplánuje pokud možno optimální (nutné použít nějakou
jednoduchou heuristiku) rozvrh výroby na strojích. Na vstupu je seznam délek
operací (např. [3,3,2,6,4]
) a maximální čas běhu (např. 10
). Operace je
možné plánovat na paralelně běžící stroje, chceme, aby celkový počet potřebných
strojů byl co nejmenší. Výstupem má být nějaké optimální rozložení operací pro
jednotlivé stroje (např. [[3,3,2],[6,4]]
, což znamená, že použijeme dva
stroje, první z nich vykoná operace trvající 3
, 3
a 2
úseky, druhý
operace trvající 6
a 4
časové úseky, obojí se vejde do limitu 10
časových úseků / stroj).
Řešení:
sum(List, Sum) :-
sum_(List, 0, Sum).
sum_([], Acc, Acc).
sum_([X | Xs], Acc, Out) :-
NewAcc is Acc + X,
sum_(Xs, NewAcc, Out).
plan(Times, MaxTime, Plan) :-
msort(Times, TimesSorted),
plan_(TimesSorted, MaxTime, [], Plan).
plan_([], _, Plan, Plan).
plan_([T | Ts], MaxTime, Plan, Out) :-
extend_plan(Plan, MaxTime, T, NewPlan),
plan_(Ts, MaxTime, NewPlan, Out).
extend_plan([], MaxTime, T, [[T]]) :-
MaxTime >= T.
extend_plan([ P | Ps ], MaxTime, T, Out) :-
sum(P, PlanTime),
Free is MaxTime - PlanTime,
(
Free >= T
->
Out = [ [ T | P ] | Ps ]
;
extend_plan(Ps, MaxTime, T, Ans),
Out = [ P | Ans ]
).
Zdroj: MFF Forum: Zkouška 13. 6. 2016 (Dvořák, Hric)
Máte zadaný binární strom (klasická tree(vlevo, hodnota, vpravo)
notace).
Roztřiďte vrcholy podle toho, kolikrát musíme jít doprava, než je objevíme.
Řešení:
group_by_right_turns(null, []).
group_by_right_turns(tree(Left, Val, Right), Out) :-
group_by_right_turns(Left, LeftAns),
group_by_right_turns(Right, RightAns),
merge_(LeftAns, [ [Val] | RightAns], Out).
merge_(Xs, [], Xs).
merge_([], Ys, Ys).
merge_([X | Xs], [ Y | Ys], [ Z | Ans ]) :-
append(X, Y, Z),
merge_(Xs, Ys, Ans).
Zdroj: MFF Forum: Zkouška 28.6.2016 - Dvořák, Hric
Napište predikát parovani(+G, +H, -P)
, který bere neorientovaný graf G
bez smyček (tj. reflexivních hran) zadaný jako seznam následníků, hranu H
v
podobě (v1-v2)
a vydá co do inkluze maximální párování obsahující zadanou
hranu H
(pozor: nikoli největší párování, ale pouze maximální co do
inkluze).
Například:
?- parovani([a-[b,c,d],b-[a,c],c-[a,b,d],d-[a,c],e-[]],a-d,P)
P = [a-d,b-c].
Řešení:
parovani(Graph, Edge, MaxMatching) :-
Edge = U-V,
select(U-_, Graph, Tmp),
select(V-_, Tmp, RestOfGraph),
parovani_(RestOfGraph, [U, V], Ans),
MaxMatching = [ Edge | Ans ].
parovani_([], _, []).
parovani_(Graph, Taken, [ U-V | Ans ]) :-
select(U-Neighbours, Graph, RestOfGraph),
member(V, Neighbours),
\+ member(V, Taken),
parovani_(RestOfGraph, [U, V | Taken], Ans),
!.
parovani_(_, _, []).
Zdroj: MFF Forum: Zkouška 30. 05. 2016 (Dvořák, Hric)
Na vstupu dostaneme posloupnost čísel a číslo V
. Máme vrátit všechny možné
matematické výrazy, které lze z dané posloupnosti postavit pomocí operátorů
+
, -
, *
, //
a závorek
, a jejichž hodnota je V
. Výraz
musí využít všechna zadaná čísla, a jejich pořadí nesmí měnit. Dále si máme
dávat pozor, abychom ve výrazu nedělili nulou.
Řešení:
gen_expr(List, V, Expr) :-
gen_expr_(List, Expr),
V is Expr.
gen_expr_([Expr], Expr).
gen_expr_(Xs, Expr) :-
select(X, Xs, Ys),
select(Y, Ys, Zs),
!,
(
E = X + Y
;
E = X - Y
;
E = X * Y
;
Denom is Y, Denom \= 0, E = X // Y
),
gen_expr_([E | Zs], Expr).
Zdroj: MFF Forum: Zkouška 19.06.2015 - Dvořák, Hric
Napište predikát zlepsirez(+Graf, +Vrcholy1, +Vrcholy2, -OutV)
, který pro
zadaný ohodnocený neorientovaný graf Graf
a řez (definovaný pomocí dvou
disjunktních množin vrcholů Vrcholy1
a Vrcholy2
) najde vrchol, který
když přesuneme do opačné skupiny vrcholů řezu, tak dostaneme řez s lepší cenou.
Zdroj: MFF Forum: Zkouška 2. 6. 2015 (Dvořák, Hric)
Definujte predikát transverse(+Strom,-OhodnocenýStrom)
, který zkopíruje
strukturu stromu Strom
do OhodnocenýStrom
s tím, že ke každému vrcholu
přidá číslo N
, které znamená pořadí v preOrder průchodu a číslo M
,
které znamená pořadí v postOrder průchodu. Ideálně jedním průchodem stromem.
Příklad
?- transverse(t(t(nil,l,nil),v,t(nil,p,nil)),X).
X = t(t(nil,l-2-1,nil),v-1-3,t(nil,p-3-2,nil))
Řešení:
transverse(Tree, Out) :-
transverse(Tree, 0, 0, _, _, Out),
!.
transverse(nil, PreOrder, PostOrder, PreOrder, PostOrder, nil).
transverse(Tree, PreOrderIn, PostOrderIn, PreOrderOut, PostOrderOut, Out) :-
Tree = t(Left, Val, Right),
NewPreOrder is PreOrderIn + 1,
transverse(
Left,
NewPreOrder,
PostOrderIn,
PreOrderOutLeft,
PostOrderOutLeft,
LeftAns
),
transverse(
Right,
PreOrderOutLeft,
PostOrderOutLeft,
PreOrderOutRight,
PostOrderOutRight,
RightAns
),
PreOrderOut = PreOrderOutRight,
PostOrderOut is PostOrderOutRight + 1,
Out = t(LeftAns, Val-NewPreOrder-PostOrderOut, RightAns).
Zdroj: MFF Forum: Zkouška 25. 5. 2014 (Dvořák, Hric)
- napište predikát
rotace/2
na rotování seznamu. Nesmíte použít žádné pomocné predikáty. (V lineárním čase) (pouze 3 verze) - v konstantním čase, jakou potřebujete strukturu? Ukažte na
[1,2,3]
- napište
rotace/2
(pouze 2 verze) v konstantním čase
Zdroj: MFF Forum: Zkouška 12.7.2021
Jsou zadány dva binární (zakořeněné) stromy S
a T
s ohodnocenými
vrcholy, přičemž ohodnocení vrcholů se může opakovat. Definujte predikát
iso/3
, který zjistí, zdali jsou tyto stromy isomorfní a vydá popis
transformace. Volání je iso(+S,+T, -Popis)
, kde ve třetím argumentu bude
popis. Popis je strom stejného tvaru jako S
a ve vrcholech má boolovské
hodnoty true
a false
. Hodnota true
ve vrcholu znamená, že se děti
vrcholu v S
mají přehodit, abychom dostali T
.
Dva binární stromy jsou isomofní, pokud lze jeden získat z druhého permutací dětí libovolných vrcholů stromu, tj. vyměněním nebo nevyměněním podstromů vrcholu.
- Navrhněte reprezentaci binárního (zakořeněného) stromu s ohodnocenými vrcholy v jazyce Prolog. Vaši reprezentaci ukažte na příkladě.
- Definujte predikát
iso/3
. - Je některý z predikátů, které ve vašem řešení používáte (ať už vámi
definovaných či knihovních), nedeterministický? Je predikát
iso/3
nedeterministický? Lze ho zdeterminičtit (a jak?), pokud nám stačí nejvýš jedno řešení?
Příklad:
S= d T= d Popis= t
/---\ /---\ /---\
b e e b f t
/ \ / \ / \ / \ / \ / \
a c f g g f a c f f f f
S = t(
t(
t(nil, a, nil),
b,
t(nil, c, nil)
),
d,
t(
t(nil, f, nil),
e,
t(nil, g, nil)
)
).
T = t(
t(
t(nil, g, nil),
e,
t(nil, f, nil)
),
d,
t(
t(nil, a, nil),
b,
t(nil, c, nil)
)
).
Řešení:
iso(TreeA, TreeB, Transform) :-
transform(TreeA, Transform, TreeB),
!.
transform(nil, nil, nil).
transform(t(Left, Val, Right), t(TransLeft, Bool, TransRight), TreeOut) :-
transform(Left, TransLeft, LeftOut),
transform(Right, TransRight, RightOut),
(
Bool = false, TreeOut = t(LeftOut, Val, RightOut)
;
Bool = true, TreeOut = t(RightOut, Val, LeftOut)
).
Dostanete informaci o obsazené paměti jako seznam dvojic zacatek-konec
o
jednotlivých obsazených úsecích. Úseky jsou v seznamu uspořádány vzestupné a
nenavazují bezprostředně na sebe (tj. navazující úseky se spojí) a tyto
invarianty chcete udržovat.
Dále dostanete seznam délek úseků, které máte naalokovat.
Napište predikát
firstFit(+Aalokovat, +Obsazeno, -Umisteni, -ObsszenoO)
, který naalokuje postupně všechny požadavky z Alokovat
metodou firstFit,
tj. alokuje na první místo, kde se úsek vejde a tím ho obsadí. Vydejte nový
popis obsazených úseků, ve tvaru splňujicím invariant, a popis umístění jako
seznam dvojic delkaUseku-umisteni
ve stejném pořadíjako v Alokova
.
Příklad:
?- firstFit([100,117,501, 10-50, 1P0-150, 250-1001, U, O).
U = [100-150,10-50,50-100],
O = [0-60, 100-150]
Řešení:
first_fit([], Obsazeno, [], Obsazeno).
first_fit([H | T], Obsazeno, [ H-U | UmistnenoAns], ObsazenoOut) :-
first_fit_one(H, Obsazeno, 0-0, U, ObsazenoTmp),
first_fit(T, ObsazenoTmp, UmistnenoAns, ObsazenoOut),
!.
first_fit_one(Size, [], LastFrom-LastTo, LastTo, [LastFrom-NewTo]) :-
NewTo is LastTo + Size.
first_fit_one(Size, [From-To | Rest], LastFrom-LastTo, LastTo, ObsazenoOut) :-
Free is From - LastTo,
Free >= Size,
ObsazenoOut = ObsazenoOut_,
(
Free is Size
->
ObsazenoOut_ = [ LastFrom-To | Rest]
;
NewTo is LastTo + Size,
ObsazenoOut_ = [ LastFrom-NewTo, From-To | Rest]
).
first_fit_one(Size, [From-To | Rest], LastFrom-LastTo, OutPos, ObsazenoOut) :-
Free is From - LastTo,
Free < Size,
first_fit_one(Size, Rest, From-To, OutPos, ObsazenoAns),
ObsazenoOut = ObsazenoOut_,
(
0 is LastTo
->
ObsazenoOut_ = ObsazenoAns
;
ObsazenoOut_ = [LastFrom-LastTo | ObsazenoAns]
).
Na vstupu je daný seznam S
nějakých položek, například RNA bází. Chcete
vydat seznam seznamú položek Vs
jako seznam výsledků, který vznikne
otočením nějaké souvislé části S
délky aspoň 2
všemi možnými zpüsoby.
Napište predikát otoceni(+S, -Vs)
.
Přiklad:
?- otoceni([ a, c, g, t], Vs).
Vs = [[c, a, g, t], [g, c, a, t], [t, g, c, a], [a, t, g, c], [a, c, t, g]]
Řešení:
je_otoceni(List, Out) :-
append(Front, MidBack, List),
append(Mid, Back, MidBack),
length(Mid, N),
N >= 2,
reverse(Mid, MidRev),
append(MidRev, Back, Tmp),
append(Front, Tmp, Out).
otoceni(List, Out) :-
otoceni_(List, [], Out).
otoceni_(Xs, Acc, Out) :-
je_otoceni(Xs, P),
\+ member(P, Acc),
otoceni_(Xs, [P | Acc], Out),
!.
otoceni_(_, Acc, Acc) :- !.
Zdroj: MFF Forum: Zkoužka 4.9.2020
-
Pro zadanou posloupnost čísel najděte spojitý úsek, jehož součet je největší. Vydejte souřadnice začátku a konce úseku a dosažený součet.
soucty :: Num a => [a] → (Int, Int, a)
Pokuste se o nějakou optimalizaci, tj. nepočítejte součty hrubou silou (zcela samostatně).
Příklad: (indexováno od 0)
> soucty [-1,1,2,3,-4] (1,3,6)
-
Jaký význam má část
Num a =>
v definici funkce soucty ? Proč tam musí být? -
Uveďte dvě možné konkrétní hodnoty proměnné a z typu funkce soucty.
-
Lze definovat
Num a
taky pro uživatelské typy nebo musíme použít pouze předdefinované/vestavěné? Lze naši funkci soucty použít pro nějaký uživatelský typ na místěa
? (Proč ano/ne?)
Řešení:
scan :: (b -> a -> b) -> b -> [a] -> [b]
scan _ acc [] = [acc]
scan f acc (x : xs) = acc : scan f (f acc x) xs
soucty :: (Num a, Ord a) => [a] -> (Int, Int, a)
soucty [] = (0, 0, 0)
soucty xs = foldr
partSum
(0, 0, 0)
[ (from, to - 1, cumsum !! to - cumsum !! from)
| from <- [0 .. length xs]
, to <- [from + 1 .. length xs]
]
where
cumsum = scan (+) 0 xs
partSum :: Ord b => (a, a, b) -> (a, a, b) -> (a, a, b)
partSum a@(_, _, x) b@(_, _, y) | x > y = a
| otherwise = b
Zdroj: MFF Forum: Zkoužka 4.9.2020
Binární vyhledávací strom je zadán jako seznam hodnot vrcholů v pořadí preorder. Definujte funkci
readBt :: Ord a => [a] -> Bt a
která ze zadaného seznamu zrekonstruuje původní strom typu
data Bt a = Void
| Node (Bt a) a (Bt a)
Připomeňme, že v binárním vyhledávacím stromu platí pro každý vrchol v
, že
všechny hodnoty v levém, resp. pravém podstromu v jsou menší, resp. větší nežli
hodnota v
. Odtud plyne, že původní strom je zadaným seznamem určen
jednoznačně.
Příklad:
> readBt [5, 2, 4, 9]
Node (Node Void 2 (Node Void 4 Void)) 5 (Node Void 9 Void)
- Definujte funkci
readBt
. - Je ve vašem řešení použita nějaká funkce vyššího řádu (funkce s funkcionálními argumenty)? Pokud ne, dala by se zde nějaká smysluplně použít?
- Je ve vašem řešení použita notace stručných seznamů (list comprehension),
tj.
[... | ...]
? Pokud ne, dala by se zde smysluplně použít?
Řešení:
data Bt a = Void
| Node (Bt a) a (Bt a)
deriving (Eq, Show)
readBt :: Ord a => [a] -> Bt a
readBt [] = Void
readBt (x : xs) = Node leftAns x rightAns
where
left = takeWhile (<= x) xs
right = dropWhile (<= x) xs
leftAns = readBt left
rightAns = readBt right
Zdroj: MFF Forum: Zkouška 16. 7. 2020
Cílem je definovat funkci ascending,
která na vstupu obdrží seznam hodnot
(libovolného typu) a vrátí zpět seznam posloupností, který splňuje:
- každá posloupnost je striktně rostoucí a nelze ji zleva ani zprava prodloužit
- sloučením všech posloupností dostaneme vstupní seznam
Příklad:
ghci> ascending [1,2,3,4,3,2,1,2]
[[1,2,3,4],[3],[2],[1,2]]
ghci> let x = [1,2,3,1,2,3] in concat (ascending x) == x
True
- Definujte typovou signaturu funkce
ascending
. - Definujte vlastní funkci.
- Jak byste zobecnili tuto funkci tak, aby ji bylo možné použít s libovolným porovnávacím operátorem?
- Bude vaše definice fungovat i na nekonečných seznamech? Pokud ano, vysvětlete proč. Pokud ne, dala by se vaše definice takto upravit? Zdůvodněte proč.
Řešení:
ascending :: Ord a => [a] -> [[a]]
ascending [] = []
ascending xs = ys : ascending zs where (ys, zs) = takeAscending (<) xs
takeAscending :: Ord a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeAscending cmp [] = ([], [])
takeAscending cmp [x] = ([x], [])
takeAscending cmp (x1 : x2 : xs) | cmp x1 x2 = (x1 : asc, rest)
| otherwise = ([x1], x2 : xs)
where (asc, rest) = takeAscending cmp (x2 : xs)
Zdroj: MFF Forum: Zkouška 16. 7. 2020
- Definujte datový typ pro binární stromy.
- Hodnoty jsou uloženy ve vnitřních uzlech.
- Pokuste se o co nejobecnější definici.
- Nezapomeňte na reprezentaci prázdného stromu.
- Definujte funkci
replicateT
. VýsledkemreplicateT n a
je binární strom, který obsahujen
kopií hodnotya
.- Výsledný strom by měl mít minimální možnou hloubku. Např. strom
replicateT 7 a
by měl mít hloubku 3.
- Výsledný strom by měl mít minimální možnou hloubku. Např. strom
- Definujte funkci
zipWithT
jako zobecnění funkcezipWith
.zipWithT f t1 t2
sloučí prvky stromůt1
at2
na stejných pozicích pomocí funkce f.- Pokud nemá nějaký prvek z jednoho stromu odpovídající prvek na stejné
pozici v druhém stromě, tak jej do výsledného stromu nepřidávejte. Např.
pro prázdný strom empty by mělo platit
zipWithT f t empty == empty
azipWithT f empty t == empty
.
- Pokud nemá nějaký prvek z jednoho stromu odpovídající prvek na stejné
pozici v druhém stromě, tak jej do výsledného stromu nepřidávejte. Např.
pro prázdný strom empty by mělo platit
- Pomocí
replicateT
azipWithT
definujte funkcicut
. Funkcecut n t
odstraní ze stromut
všechny vrcholy, jejichž hloubka je ostře větší nežn
.
Řešení:
data Tree a = Null
| Tree (Tree a) a (Tree a)
deriving (Eq, Show)
replicateT :: Int -> a -> Tree a
replicateT 0 _ = Null
replicateT n val = Tree leftAns val rightAns
where
leftN = (n - 1) `div` 2
rightN = n - 1 - leftN
leftAns = replicateT leftN val
rightAns = replicateT rightN val
zipWithT :: (a -> b -> c) -> Tree a -> Tree b -> Tree c
zipWithT _ Null _ = Null
zipWithT _ _ Null = Null
zipWithT f (Tree leftA a rightA) (Tree leftB b rightB) = Tree leftAns
(f a b)
rightAns
where
leftAns = zipWithT f leftA leftB
rightAns = zipWithT f rightA rightB
cut :: Int -> Tree a -> Tree a
cut n tree = zipWithT const tree (replicateT ((2 ^ n) - 1) undefined)
Zdroj: MFF Forum: Zkouška 24. 6. 2020
Cílem je definovat binární funkci klouzave, která
- obdrží na vstupu posloupnost čísel a přirozené číslo
n
- a vrátí posloupnost klouzavých průměrů řádu
n
, tj. aritmetických průměrůn
sousedních prvků.
Příklad:
klouzave [1.5, 2.5, 3.5, 4.5, 5.5] 3
[2.5,3.5,4.5]
- Definujte typovou signaturu funkce
klouzave
- Definujte vlastní funkci s explicitním využitím rekurze
- Sestavte alternativní definici, tentokráte bez explicitního použití rekurze, přitom můžete využívat libovolné knihovní funkce z přiloženého seznamu.
- Vyhýbá se alespoň jedna z vašich definic opakovaným výpočtům? Pokud ne, dala by se takto upravit? Zdůvodněte.
- Bude některá z vašich definic fungovat i na nekonečných seznamech? Pokud ano, vysvětlete proč. Pokud ne, dala by se některá z vašich definic takto upravit? Zdůvodněte.
take 5 $ klouzave [1..] 10
[5.5,6.5,7.5,8.5,9.5]
Řešení:
klouzave :: [Double] -> Int -> [Double]
klouzave _ 0 = []
klouzave [] _ = []
klouzave xs@(first : _) n | length window < n = []
| otherwise = klouzave' window mean n rest
where
window = take n xs
mean = sum window / fromIntegral n
rest = drop n xs
klouzave' :: [Double] -> Double -> Int -> [Double] -> [Double]
klouzave' _ mean _ [] = [mean]
klouzave' (w : ws) mean n (x : xs) = mean : klouzave' (ws ++ [x]) newMean n xs
where newMean = (mean * fromIntegral n - w + x) / fromIntegral n
klouzave2 :: [Double] -> Int -> [Double]
klouzave2 xs n =
[ sum window / fromIntegral n
| d <- [0 .. length xs - n]
, let tail = drop d xs
, let window = take n tail
, length window >= n
]
Zdroj: MFF Forum: Zkouška 24. 6. 2020
Cílem toho problému je zobecnit funkce foldr
/ foldl
na obecné kořenové stromy.
- Definujte datový typ pro reprezentaci obecných kořenových stromů s
ohodnocenými vrcholy:
- snažte se o co nejobecnější definici
- nezapomeňte na reprezentaci prázdného stromu
- Funkce
foldl
afoldr
zobecněte na funkcifoldT
, která bude - namísto seznamu - procházet stromem ve vaší reprezentaci popsané v 1.. - Pomocí funkce fold definujte funkci
arita,
která vrátíaritu
(tj. maximální počet dětí přes všechny vrcholy) zadaného kořenového stromu. - Pomocí funkce
foldT
definujte funkcipdc
, která vrátí průměrnou délku cesty z kořene do listu (tj. součet délek všech cest z kořene do listu / počet listů).
Řešení:
-- NOTE: Tree a [] is invalid
data Tree a = Null
| Tree a [Tree a]
deriving (Eq, Show)
foldT :: (a -> [b] -> b) -> b -> Tree a -> b
foldT _ acc Null = acc
foldT f acc (Tree val ts) = f val bs where bs = map (foldT f acc) ts
arita :: Tree a -> Int
arita = foldT (\_ bs -> max (length bs) (maximum bs)) 0
pdc :: Tree a -> Double
pdc tree = sumOfLengths / leafsN
where
(sumOfLengths, leafsN) = foldT step (0, 1) tree
step _ bs = (sum $ map ((+ 1) . fst) bs, sum $ map snd bs)
testTree = Tree
1
[ Tree 1 [Null]
, Null
, Tree 2 [Tree 4 [Tree 5 [Null], Tree 6 [Null]]]
, Tree 3 [Null, Null, Null, Null]
]
Zdroj: MFF Forum: Zkouška 12. 6. 2020 (Dvořák, Hric)
Rozdělte zadaný binární vyhledávací strom T
na n+1
binárních
vyhledávacích stromů T_0, .. , T_n
podle zadaných vstupních hodnot k_i
,
1 <= i <= n
tak, že ve stromě T_i
jsou hodnoty x
, k_i <= x < k_i+1
, pokud jsou nerovnosti aplikovatelné.
Snažte se o efektivitu, celé podstromy patřící do jednoho pruhu zpracujte najednou.
- Definujte datový typ pro reprezentaci binárních vyhledávacích stromů. Snažte se o co nejobecnější definici.
- Definujte typovou signaturu funkce
pruhy
, včetně typových tříd. - Funkci
pruhy
definujte. Budete-li používat pomocné funkce, u každé popište její význam. - Pokuste se stručně zdůvodnit korektnost vaší defnice.
Řešení:
data BTree a = Nil
| BTree (BTree a) a (BTree a)
deriving (Eq, Show)
cutUpTo :: Ord a => a -> BTree a -> (BTree a, BTree a)
cutUpTo _ Nil = (Nil, Nil)
cutUpTo max (BTree left val right)
| val >= max
= let (ans, restAns) = cutUpTo max left in (ans, BTree restAns val right)
| otherwise
= let (ans, restAns) = cutUpTo max right in (BTree left val ans, restAns)
pruhy :: Ord a => [a] -> BTree a -> [BTree a]
pruhy [] tree = [tree]
pruhy (x : xs) tree =
let (part, rest) = cutUpTo x tree in part : pruhy xs rest
testTree =
BTree (BTree (BTree Nil 1 Nil) 2 (BTree Nil 4 Nil)) 5 (BTree Nil 6 Nil)
Zdroj: MFF Forum: Zkouška 12. 6. 2020 (Dvořák, Hric)
Definujte funkce rle
a rld
, které realizují run-length encoding a
decoding. Funkce
rle :: Eq a => [a] -> [Either a (a,Int)]
zakóduje co nejdelší úseky stejných prvků ve vstupním seznamu do dvojice
(prvek, počet)
typu Either
s datovým konstruktorem Right
.
Pokud je prvek v úseku sám, kóduje se pouze prvek vnořený do typu Either
s
datovým konstruktorem Left
.
Příklad:
> rle ”abbcccda”
[Left 'a', Right ('b',2), Right ('c',3), Left 'd', Left 'a']
- Definujte funkci
rle
s využitím rekurze, ale bez použití stručných seznamů či funkcí vyšších řádů (funkce s funkcionálními parametry). - Definujte funkci
rle
bez explicitního využití rekurze, ale za použití stručných seznamů či funkcí vyšších řádů. - Definujte typovou signaturu funkce
rld
, která realizuje dekompresi, tj. převod ze seznamu úseků na původní seznam prvků. - Definujte funkci
rld.
Použijte přitom funkcimap
čiconcat
. - Bude některá z funkcí fungovat i na nekonečných seznamech? Proč ano nebo proč ne?
Řešení:
rle :: Eq a => [a] -> [Either a (a, Int)]
rle [] = []
rle (x : xs) = encoded : rle rest
where
((_, count), rest) = munch x xs
encoded = if count == 1 then Left x else Right (x, count)
munch x [] = ((x, 1), [])
munch x (y : ys)
| x /= y = ((x, 1), y : ys)
| otherwise = let ((_, count), rest) = munch y ys in ((x, count + 1), rest)
groups :: Eq a => [a] -> [[a]]
groups [] = []
groups xs@(x : xs') = takeWhile (== x) xs : groups (dropWhile (== x) xs')
rle2 :: Eq a => [a] -> [Either a (a, Int)]
rle2 xs =
[ if l == 1 then Left (head group) else Right (head group, l)
| group <- groups xs
, let l = length group
]
Zdroj: MFF Forum: 10. 9. 2019 - Dvořák
Definujte funkce:
prevod1 cislo puvodni
pro převod čísla z číselné soustavy o základu puvodni
do dekadické číselné soustavy
, a
prevod2 cislo nova
pro převod čísla z dekadické do číselné soustavy o základu nova
.
Příklad:
> prevod1 [1,1,1,0] 2 -- převede binární 1110 do desítkové soustavy
14
> prevod2 33 16 -- převede dekadické číslo 33 do hexadecimální soustavy
[2,1]
-
Doplňte typové signatury definovaných funkcí
prevod1 :: prevod2 ::
-
Definujte funkci
prevod1
s využitím rekurze. -
Sestavte alternativní definici funkce prevod1 s využitím alespoň jedné z funkcí
map
,filter
,foldr
čifoldl
, ale bez (explicitního) použití rekurze. -
Definujte funkci
prevod2
s využitím funkceunfold
definované následovně:unfold :: (t -> Bool) -> (t -> (a, t)) -> t -> [a] unfold done step x = if done x then [] else let (y,ys) = step x in y: unfold done step ys
Řešení:
prevod1 :: [Int] -> Int -> Int
prevod1 ds base = go ds 0
where
go [] acc = acc
go (d : ds) acc = go ds (base * acc + d)
prevod1' :: [Int] -> Int -> Int
prevod1' ds base = foldl (\acc d -> base * acc + d) 0 ds
unfold :: (t -> Bool) -> (t -> (a, t)) -> t -> [a]
unfold done step x =
if done x then [] else let (y, ys) = step x in y : unfold done step ys
moddiv a b = (a `mod` b, a `div` b)
prevod2 :: Int -> Int -> [Int]
prevod2 n base = reverse $ unfold (== 0) (`moddiv` base) n
Zdroj: MFF Forum: 10. 9. 2019 - Dvořák
Definujte unární funkci rady, která obdrží multiplikativní tabulku grupy jako
matici prvků. První řádek matice obsahuje násobení grupovou jednotkou e
a
pořadí prvků odpovídající řádkům a sloupcům je stejné. Vydá seznam všech prvků
spolu s jejich řády.
Řád prvku p
je nejmenší přirozené číslo n
takové, že n
-tá mocnina
p
je rovna e
.
- Definujte typovou signaturu funkce
rady
. - Funkci
rady
definujte.
Příklad:
> rady [["e","a","b"], ["a","b","e"], ["b","e","a"]]
[("e",1), ("a",3), ("b",3)]
Řešení:
rady :: Eq a => [[a]] -> [(a, Int)]
rady [] = []
rady table@(firstRow@(e : _) : _) = zip firstRow (map rad firstRow)
where
transitions =
[ ((a, b), c)
| (a, (b, c)) <- concat
$ zipWith (zip . repeat) firstRow (map (zip firstRow) table)
]
lookup :: Eq a => [(a, b)] -> a -> b
lookup [] _ = error "Lookup error"
lookup ((key, value) : ps) k | key == k = value
| otherwise = lookup ps k
mult a b = lookup transitions (a, b)
rad x = length (takeWhile (/= e) $ iterate (mult x) x) + 1
Zdroj: MFF Forum: 24.6.2019 (Dvořák, Hric)
Je dána číselná matice A
. Definujte funkci
kumulace :: Num a => [[a]] -> [[a]]
která z matice A
vyrobí matici B
stejných rozměrů (viz příklad níže).
Každý prvek na souřadnicích (i,j)
bude roven součtu všech hodnot v
submatici s levým horním rohem (0,0)
a pravým dolním rohem (i,j)
.
Poznámka: Snažte se vyhnout opakování stejných výpočtů.
Příklad:
> kumulace[[1,1,1],[1,2,1],[0,1,0],[1,1,-4]]
[[1,2,3],[2,5,7],[2,6,8],[3,8,6]]
Řešení:
kumulace :: Num a => [[a]] -> [[a]]
kumulace [] = []
kumulace [[]] = [[]]
kumulace table = memo
where
indices =
[ [ (i, j) | (j, _) <- zip [0 ..] row ] | (i, row) <- zip [0 ..] table ]
memo = map (map go) indices
go (0, 0) = table !! 0 !! 0
go (i, 0) = memo !! (i - 1) !! 0 + table !! i !! 0
go (0, j) = memo !! 0 !! (j - 1) + table !! 0 !! j
go (i, j) =
(memo !! (i - 1) !! j)
+ (memo !! i !! (j - 1))
- (memo !! (i - 1) !! (j - 1))
+ (table !! i !! j)
Zdroj: MFF Forum: 24.6.2019 (Dvořák, Hric)
Hypergraf je zadán množinou vrcholů a množinou hyperhran, což jsou alespoň
dvouprvkové podmnožiny množiny vrcholů. Naší cílem je definovat funkci
doplnění, která doplní do hypergrafu H
všechny dvouprvkové (hyper)hrany pro
ty dvojice vrcholů, které nejsou společně obsaženy v žádné hyperhraně vstupního
hypergrafu H
. Funkce tedy např. z hypergrafu s vrcholy {1,2,3,4,5}
a
hyperhranani {1,3,5}
a {2,3,4}
vytvoří hypergraf se stejnými vrcholy a
hyperhranami {1,3,5},{2,3,4},{1,2},{1,4},{5,2}
a {5,4}
-
Definujte datový typ pro reprezentaci hypergrafu. Pokuste se o co nejobecnější definici (vrcholy mohou být reprezentovány nejen čísly, ale i znaky, řetězci apod.)
-
Specifikujte typovou signaturu funkce
doplneni ::
-
Funkci definujte.
Řešení:
data HGraph a = HGraph [a] [[a]]
deriving (Eq, Show)
fromMaybe :: a -> Maybe a -> a
fromMaybe def Nothing = def
fromMaybe _ (Just a) = a
lookup' :: Eq a => [(a, b)] -> a -> Maybe b
lookup' [] _ = Nothing
lookup' ((key, value) : ps) k | key == k = Just value
| otherwise = lookup' ps k
doplneni :: Eq a => HGraph a -> HGraph a
doplneni (HGraph vs es) = HGraph vs (es ++ newEdges)
where
trans_table = zip [0 ..] vs
newEdges =
[ [ fromMaybe undefined (lookup' trans_table i)
, fromMaybe undefined (lookup' trans_table j)
]
| i <- [0 .. length vs - 1]
, j <- [0 .. i - 1]
, not $ isEdge i j
]
isEdge i j = or
[ elem (fromMaybe undefined (lookup' trans_table i)) edge
&& elem (fromMaybe undefined (lookup' trans_table j)) edge
| edge <- es
]
Zdroj: Zkouška 10.6.2019 (Dvořák + Hric)
Na vstupu je zadán text jako hodnota typu String
. Naším cílem je definovat
binární funkci stat text n
, která
- obdrží takový text a přirozené číslo
n
- vrátí všechna slova z tohoto textu o délce alespoň
n
, setříděná lexikograficky - každé slovo s čísly řádků, kde se slovo vyskytuje
Řádky jsou ukončeny znakem '\n'
. Slovo je každý maximální podřetězec textu
neobsahující mezeru ' '
, tabulátor '\t'
či konec řádku '\n'
.
- Definujte datovou strukturu pro reprezentaci oboru hodnot funkce stat (pomocí data nebo type).
- Definujte typovou signaturu funkce stat s použití datové struktury z 1..
- Funkci stat definujte.
Řešení:
newtype Stat = Stat [(Int, String)]
deriving (Eq, Show)
lines' :: String -> [String]
lines' "" = []
lines' ss = line : lines' rest
where
line = takeWhile (/= '\n') ss
rest = dropWhile (/= '\n') ss
words' :: String -> [String]
words' "" = []
words' ss = case takeWhile (not . isSpace) ss of
[] -> []
word -> word : words' rest
where
isSpace = flip elem [' ', '\t', '\n']
tmp = dropWhile (not . flip elem [' ', '\t', '\n']) ss
rest = dropWhile isSpace tmp
sortBy :: Ord b => (a -> b) -> [a] -> [a]
sortBy _ [] = []
sortBy f (pivot : xs) = left ++ [pivot] ++ right
where
left = filter (\y -> f y <= f pivot) xs
right = filter (\y -> f y > f pivot) xs
stat :: String -> Int -> Stat
stat text n = Stat sortedWords
where
numberedLines = zip [1 ..] $ lines' text
linesToWords = concatMap
(\(line_no, line) -> zip (repeat line_no) (words' line))
numberedLines
filteredWords = filter (\(_, word) -> length word >= n) linesToWords
sortedWords = sortBy snd filteredWords
Zdroj: MFF Forum: Zkouška 21.6.2018
Ohodnotit vrcholy obecného n-arní stromu v pořadí v jakém jsou vrcholy uzavírány, takže post-fixově. Měla se napsat datová struktura pro strom, typová hlavička fce a pak tu funkci implementovat:
data Tree a = Nil | Tree a [Tree a]
label :: Tree a -> Tree (a, Int)
Příklad
> label $ Tree 1 [Tree 1 [Nil],Nil,Tree 2 [Tree 4 [Tree 5 [Nil],Tree 6 [Nil]]],Tree 3 [Nil,Nil,Nil,Nil]]
Tree (1,7) [Tree (1,1) [Nil],Nil,Tree (2,5) [Tree (4,4) [Tree (5,2) [Nil],Tree (6,3) [Nil]]],Tree (3,6) [Nil,Nil,Nil,Nil]]
Řešení:
data Tree a = Nil | Tree a [Tree a]
deriving (Eq, Show)
label :: Tree a -> Tree (a, Int)
label = snd . label' 0
label' :: Int -> Tree a -> (Int, Tree (a, Int))
label' n Nil = (n, Nil)
label' n (Tree val ts) = (newN, Tree (val, newN) ansTs)
where
(ansN, ansTs) = sequentialLabel n ts
newN = ansN + 1
sequentialLabel :: Int -> [Tree a] -> (Int, [Tree (a, Int)])
sequentialLabel n [] = (n, [])
sequentialLabel n (Nil : ts) =
let (ansN, ansTs) = sequentialLabel n ts in (ansN, Nil : ansTs)
sequentialLabel n (tree : ts) =
let (ansN1, ansT ) = label' n tree
(ansN2, ansTs) = sequentialLabel ansN1 ts
in (ansN2, ansT : ansTs)
Zdroj: MFF Forum: Zkouška 26.6.2018
Definujte funkci change
, která:
- obdrží seznam, který reprezentuje abecedu povolených prvků, které lze využít k modifikaci
- obdrží seznam
xs
pro modifikaci - vrátí seznam všech modifikací vstupního seznamu
xs
, které se od něho liší v právě 3 prvcích.
Příklad:
> change3 "ab" "aabe"
["bbae", "bbba", "bbbb", "baaa", "baab", "abaa", "abab"]
- Definujte typ funkce
change3
co nejobecněji (včetně případných typových tříd) - Definujte funkci
change3
Řešení:
change3 :: Eq a => [a] -> [a] -> [[a]]
change3 cs xs = map snd $ filter (\(count, _) -> count == 3) $ change' cs xs
change' :: Eq a => [a] -> [a] -> [(Int, [a])]
change' _ [] = [(0, [])]
change' cs (x : xs) = changed ++ notChanged
where
ans = change' cs xs
other = filter (/= x) cs
notChanged = map (\(count, ys) -> (count, x : ys)) ans
changed =
map (\(c, (countChanged, ys)) -> (countChanged + 1, c : ys))
$ [ (c, p) | c <- other, p <- ans ]
Zdroj: MFF Forum: Zkouška 6. 6. 2016 (Dvořák, Hric)
Máme zadanou matici (jako seznam seznamů). Naším cílem je vypsat seznam všech
dvojic (x, y)
takových, že podmatice (1, 1):(x, y)
bude obsahovat pouze
kladné hodnoty. Dvojice (x, y)
musí být vždy nejvyšší možné (t. j. nelze
ani v jedne souradnici zvětšit)
Řešení:
scan :: (b -> a -> b) -> b -> [a] -> [b]
scan _ acc [] = [acc]
scan f acc (x : xs) = acc : scan f (f acc x) xs
maxPositive :: (Num a, Ord a) => [[a]] -> [(Int, Int)]
maxPositive [] = []
maxPositive [[]] = []
maxPositive matrix =
[ (row, count)
| (row, count, jump) <- zip3 [1 ..] maxCounts jumpDown
, count > 0
, jump
]
where
posCounts = map (length . takeWhile (> 0)) matrix
maxCounts = drop 1 $ scan min (maxBound :: Int) posCounts
jumpDown =
[True]
++ [ curr > next
| (curr, next) <- zip (drop 1 posCounts) (drop 2 posCounts)
]
++ [True]
Zdroj: MFF Forum: Zkouška 6. 6. 2016 (Dvořák, Hric)
-
Napiste fold pro binarni stromy
data Tree a = Leaf a | Tree (Tree a) (Tree a) fold :: (a -> b) -> (b -> b -> b) -> Tree a -> b
-
Napiste one-liner funkci, ktera vypise minimum a maximum z celeho stromu pomoci vami napsaneho foldu.
-
Napiste hlavicku funkce z 2.
Řešení:
data Tree a = Leaf a | Tree (Tree a) (Tree a)
deriving (Eq, Show)
fold :: (a -> b) -> (b -> b -> b) -> Tree a -> b
fold f _ (Leaf a ) = f a
fold f comb (Tree left right) = comb leftAns rightAns
where
leftAns = fold f comb left
rightAns = fold f comb right
minmaxT :: Ord a => Tree a -> (a, a)
minmaxT = fold
(\a -> (a, a))
(\(minLeft, maxLeft) (minRight, maxRight) ->
(min minLeft minRight, max maxLeft maxRight)
)
Zdroj: MFF Forum: Zkouška 22.6.
Máme obdélníkovou tabulku uloženou po řádcích jako seznam seznamů Intů. Vymažte z ní všechny sloupce, které neobsahují žádnou nulu.
Řešení:
transpose :: [[a]] -> [[a]]
transpose [] = []
transpose matrix = case concatMap (take 1) matrix of
[] -> []
col -> col : transpose (map (drop 1) matrix)
tetris :: (Eq a, Num a) => [[a]] -> [[a]]
tetris = transpose . removeFull . transpose
where removeFull rows = [ row | row <- rows, 0 `elem` row ]
Zdroj: MFF Forum: Zkouska 20.9.2017
Funkce podminky
dostává seznam podmínek jedné proměnné a seznam hodnot.
Vydává seznam seznamů hodnot, kde i
-tý seznam na výstupu obsahuje hodnoty,
pro které byla splněna i
-tá podmínka a nebyly splněny předchozí podmínky.
Hodnoty, pro které nebyla splněna žádná podmínka, se zahodí.
Příklad:
> podminky [even,(>5),(==3)] [0..9]
[[0,2,4,6,8],[7,9],[3]]
- Napište typovou signaturu funkce podmínky (co nejobecnější, včetně případných typových tříd).
- Napište funkci
podminky
.
Řešení:
podminky :: [a -> Bool] -> [a] -> [[a]]
podminky [] _ = []
podminky (f : fs) xs = filter f xs : podminky fs rest
where rest = filter (not . f) xs
Zdroj: MFF Forum: Zkouska 20.9.2017
Cílem tohoto problému je zobecnit standardní funkci take
na funkci
takeTree
, která
- obdrží obecný kořenový strom a dvě přirozená čísla
n
am
- odstraní ve stromě všechny vrcholy ve hloubce větší než
m
(hloubka vrcholuv
je počet hran na cestě z kořene dov
) - pro každý vrchol, který má více než
n
dětí, odstraní všechny děti (s příslušnými podstromy) kroměn
nejlevějších - výsledný (nejvýše
n
-ární) strom (hloubky nejvýšem
) vrátí.
- Definujte datový typ pro obecný kořenový strom, v jehož vrcholech jsou
uloženy prvky typu
a
. - Využijte váš datový typ k definici nekonečného stromu, tj. takového stromu,
že pro každé přirozené číslo
i
buďto existuje vrchol s alespoňi
dětmi, nebo existuje vrchol ve hloubce alespoňi
. - Definujte typovou signaturu funkce
takeTree
. - Funkci
takeTree
definujte.
Řešení:
data Tree a = Nil | Tree a [Tree a]
deriving (Eq, Show)
infiniteTree :: Tree Int
infiniteTree = go 0 where go n = Tree n (take (n + 1) $ repeat (go (n + 1)))
takeTree :: Int -> Int -> Tree a -> Tree a
takeTree n m = go 0
where
go _ Nil = Nil
go h (Tree val ts)
| h == m = Tree val []
| otherwise = let tsAns = take n $ map (go (h + 1)) ts in Tree val tsAns
Zdroj: MFF Forum: Zkouška 13. 9. 2017
Máme typ:
data Formule = Konst Bool | Not Formule | And Formule Formule | Or Formule Formule
a chceme napsat funci gen
, která vygeneruje nekonečný seznam složený z formulí:
Příklad:
gen = [ Konst True, Konst Flase, Not True, Not False, And True True, ... ]
Řešení:
data Formule = Konst Bool
| Not Formule
| And Formule Formule
| Or Formule Formule
deriving(Eq, Show)
gen :: [Formule]
gen = concat memo
memo = map genN [0 ..]
genN :: Int -> [Formule]
genN 0 = []
genN 1 = [Konst True, Konst False]
genN n = ands ++ ors
where
last = memo !! (n - 1)
nots = [ Not f | f <- last ]
ands = [ And f s | f <- last, s <- last ]
ors = [ Or f s | f <- last, s <- last ]
Zdroj: MFF Forum: Zkouška 6. 6. 2017
Máme dva druhy stromů - obecný n-ární:
data NTree a = NTree a [NTree a]
a n-ární, ve kterém je řečeno, které podstromy jsou vlevo a které vpravo:
data UspTree a = UspTree [UspTree a] a [UspTree a]
Máme napsat funkci, která obecný n-ární strom převede na uspořádaný strom. V každém uzlu obecného n-árního stromu na vstupu je kromě hodnoty uložený taky počet synů, kteří jsou vlevo.
Řešení:
data NTree a = NTree a [NTree a]
deriving (Eq, Show)
data UspTree a = UspTree [UspTree a] a [UspTree a]
deriving (Eq, Show)
prevodT :: NTree (Int, a) -> UspTree a
prevodT (NTree (n, val) ts) = UspTree (take n ts') val (drop n ts')
where ts' = map prevodT ts
Zdroj: MFF Forum: Zkouška 29.5.2017
- Navrhněte datový typ
Graf
a pro reprezentaci konečného neorientovaného grafu s vrcholy typua
. - Definujte funkci
troj :: Graf a -> Int
, která k takovému grafu vrátí počet všech jeho trojúhelníků.
Priklad:
> let
testGraph = Graph [0..8]
[(0, 1), (0, 3), (1, 0), (1, 2), (1, 3), (2, 1), (2, 4),
(3, 0), (3, 1), (3, 5), (4, 2), (4, 5), (5, 3), (5, 4),
(5, 6), (6, 5), (6, 7), (6, 8), (7, 6), (7, 8), (8, 6),
(8, 7)]
> troj testGraph
[(0,1,3),(6,7,8)]
Řešení:
type Edge a = (a, a)
data Graph a = Graph [a] [Edge a]
deriving (Eq, Show)
troj :: Eq a => Graph a -> [(a, a, a)]
troj (Graph xs edges) = troj' edges xs
troj' :: Eq a => [Edge a] -> [a] -> [(a, a, a)]
troj' _ [] = []
troj' edges (a : vertices) =
[ (a, b, c)
| n <- [1 .. length vertices - 1]
, b <- drop (n - 1) $ take n vertices
, (a, b) `elem` edges
, c <- drop n vertices
, (b, c) `elem` edges
, (c, a) `elem` edges
]
++ troj' edges vertices
Zdroj: MFF Forum: Zkouška 29.5.2017
Je dán datový typ
data Bag a = Item a | Items [Bag a]
-
Definujte funkci
fold
pro obecný průchod touto datovou strukturou (to(a->b)
tam zastupuje počáteční hodnotu v normálním foldu)fold :: (a -> b) -> ([b] -> b) -> Bag a -> b
-
Pomocí funkce fold definujte funkci
listy
která posbírá všechny hodnoty z položekItem
ze všech úrovní zleva.
listy :: Bag a -> [a]
Příklad:
> listy (Items [Item 1,Items [Item 2, Item 3], Items [Items [Item 4]]])
[1,2,3,4]
Řešení:
data Bag a = Item a | Items [Bag a]
deriving (Eq, Show)
fold :: (a -> b) -> ([b] -> b) -> Bag a -> b
fold f _ (Item a ) = f a
fold f comb (Items bs) = comb ans where ans = map (fold f comb) bs
listy :: Bag a -> [a]
listy = fold (: []) concat
Zdroj: MFF Forum: Zkouška 13. 6. 2016 (Dvořák, Hric)
Máte nějakou funkci, která nabývá jen dvou různých funkčních hodnot. Funkce
přechází někde (nevíme kde) skokově z jedné funkční hodnoty na druhou. Na
vstupu dostanete c
a d
určující ony dvě funkční hodnoty. Dále dostanete
seznam (x, y)
bodů, ve kterých jste funkci změřili s nějakou chybou.
Napište funkci, která na výstupu tyto body rozdělí na levé a pravé (seznam dvou
seznamů) podle toho, které body patří ještě k hodnotě c
, a které už k
hodnotě d
.
Pozor, je potřeba minimalizovat celkovou odchylku spočtenou jako součet
(f(x_i) - y_i)^2
přes všechny body, kde f(x)
je změřená hodnota (ze
seznamu) a y
skutečná hodnota z našeho odhadu.
Řešení:
sortBy :: Ord b => (a -> b) -> [a] -> [a]
sortBy _ [] = []
sortBy f (x : xs) = left ++ [x] ++ right
where
left = sortBy f $ filter (\elem -> f elem < f x) xs
right = sortBy f $ filter (\elem -> f elem >= f x) xs
minimumBy :: Ord b => (a -> b) -> [a] -> a
minimumBy f = (!! 1) . sortBy f
skok :: (Ord a, Num a) => a -> a -> [(a, a)] -> ([(a, a)], [(a, a)])
skok _ _ [] = undefined
skok c d ps = snd $ minimumBy fst cuts
where
sorted = sortBy fst ps
cuts =
[ (cost left right, (left, right))
| n <- [0 .. length sorted]
, let left = take n sorted
, let right = drop n sorted
]
cost xs ys =
sum $ [ (fx - c) ^ 2 | (_, fx) <- xs ] ++ [ (fx - d) ^ 2 | (_, fx) <- ys ]
Zdroj: MFF Forum: Zkouška 28.6.2016 - Dvořák, Hric
Mějme řídké polynomy reprezentované pomocí [(nenulový koeficient,exponent)]
. Definujte pro ně datový typ (nezapomeňte na nulový
polynom) a napište funkci mult
(i její datovou signaturu), která bude řídké
polynomy násobit.
- řídký polynom: u spousty exponentů je nulový koeficient (exponenty prostě nejdou po 1, ale skáčou)
data Ridky a = Ridky [(Int, a)]
Řešení:
type Order = Int
type Coeff = Int
newtype Poly = Poly [(Coeff, Order)]
deriving (Eq, Show)
sortBy :: Ord b => (a -> b) -> [a] -> [a]
sortBy _ [] = []
sortBy f (x : xs) = left ++ [x] ++ right
where
left = sortBy f $ filter (\elem -> f elem < f x) xs
right = sortBy f $ filter (\elem -> f elem >= f x) xs
groupBy f [] = []
groupBy f xs@(x : xs') = group : groupBy f rest
where
group = takeWhile ((== f x) . f) xs
rest = dropWhile ((== f x) . f) xs
normalize :: Poly -> Poly
normalize (Poly ps) = Poly p
where
groups = groupBy snd $ sortBy snd ps
p = [ (sum $ map fst group, snd $ head group) | group <- groups ]
mult :: Poly -> Poly -> Poly
mult (Poly p) (Poly q) = normalize $ Poly ans
where ans = [ (c1 * c2, o1 + o2) | (c1, o1) <- p, (c2, o2) <- q ]
summ :: Poly -> Poly -> Poly
summ p q = summ' (normalize p) (normalize q)
summ' :: Poly -> Poly -> Poly
summ' (Poly xs) (Poly ys) = Poly $ go xs ys
where
go xs [] = xs
go [] ys = ys
go xs@(x@(xCoeff, xOrd) : xs') ys@(y@(yCoeff, yOrd) : ys')
| xOrd == yOrd = (xCoeff + yCoeff, xOrd) : go xs' ys'
| xOrd > yOrd = x : go xs' ys
| otherwise = y : go xs ys'
Zdroj: MFF Forum: Zkouška 30. 05. 2016 (Dvořák, Hric)
Pro zadané K
máme generovat nekonečný uspořádáný seznam K
-tic:
uspořádání je definováno tak, že nejprve se třídí podle maximálního prvku v
daném seznamu. (jakákoliv k
-tice, jejíž maximum je menší nebo rovno 2
bude před k
-ticí obsahující číslo 3). Když mají dvě k-tice stejné maximum,
řadí se lexikograficky.
Příklad pro K=2
:
[[0,0],[0,1],[1,0],[1,1],[0,2],[1,2],[2,0],[2,1],[2,2],[0,3] ...]
Řešení:
sort :: Ord a => [a] -> [a]
sort [] = []
sort (x : xs) = left ++ [x] ++ right
where
left = sort $ filter (< x) xs
right = sort $ filter (>= x) xs
sequencesUpTo :: Int -> Int -> [[Int]]
sequencesUpTo 0 _ = []
sequencesUpTo len max = go len [[]]
where
go 0 acc = acc
go k acc = go (k - 1) [ n : seq | n <- [0 .. max], seq <- acc ]
maxLex :: Int -> [[Int]]
maxLex k = concatMap (sort . withMax) [0 ..]
where withMax max = [ seq | seq <- sequencesUpTo k max, max `elem` seq ]
Zdroj: MFF Forum: Zkouška 30. 05. 2016 (Dvořák, Hric)
Máme zadaný binární vyhledávací strom (reprezentaci si máme zvolit), a dvě
čísla D
, H
. Máme vrátit BVS, který vznikl ořezáním vstupního stromu
tak, aby v něm byly pouze hodnoty X
takové, že D<=X<=H
.
Řešení:
data Tree a = Nil | Tree (Tree a) a (Tree a)
deriving (Eq, Show)
cut :: (Ord a, Num a) => a -> a -> Tree a -> Tree a
cut _ _ Nil = Nil
cut min max (Tree left val right)
| val < min = cut min max right
| val > max = cut min max left
| otherwise = Tree (cut min max left) val (cut min max right)
testTree = Tree
(Tree (Tree Nil 1 Nil) 3 (Tree (Tree Nil 4 Nil) 6 (Tree Nil 7 Nil)))
8
(Tree Nil 10 (Tree (Tree Nil 13 Nil) 14 Nil))
Zdroj: MFF Forum: Zkouška 12.7.2021
Na vstupu je daný seznam S
obsahující dvojice (položka, orientace)
, kde
položky jsou obecné informace nějakého typu (například geny v chromozomu), a
orientace je typu Bool
(pro sousměrně a protisměrně). Volání funkce
otoceni S
má vydat seznam všech výsledků [Vs]
jako seznam seznamů
dvojic stejného typu, kde jeden výsledek vznikne otočením nějaké souvislé části
S
, přičemž v otočené části změníte informaci o směru. Délka otočené části
je od 1
do délky S
, tj. otáčenou spojitou část vybíráte všemi možnými
způsoby.
- Napište (obecný) typ funkce
otoceni
- Napište funkci
otoceni
- Pracovala by Vaše implementace funkce otoceni na nekonečném vstupním seznamu? Šla by napsat správná implementace pro nekonečný seznam? (Stačí myšlenka: proč ano nebo proč ne.)
Příklad:
> otoceni [('a',True),('b',True),('c',False)]
[[('a',False),('b',True),('c',False)],[('a',True),('b',False),('c',False)],[('b',False),('a',False),('c',False)],[('a',True),('b',True),('c',True)],[('a',True),('c',True),('b',False)],[('c',True),('b',False),('a',False)]]
Řešení:
split3 :: [a] -> [([a], [a], [a])]
split3 as =
[ (xs, ys, zs)
| (n, _) <- zip [0 ..] (as ++ [undefined])
, let prefix = take n as
, let zs = drop n as
, (k, _) <- zip [0 ..] (prefix ++ [undefined])
, let xs = take k prefix
, let ys = drop k prefix
, not $ null ys
]
otoceni :: [(a, Bool)] -> [[(a, Bool)]]
otoceni ps = [ xs ++ map flipPair ys ++ zs | (xs, ys, zs) <- split3 ps ]
where flipPair (x, bool) = (x, not bool)
Je zadán binární strom s vnitřními vrcholy typu
data Bt a = Void | Node (Bt a) a (Bt a)
Definujte funkci prevaz
která projde strom a pro každý vnitřní vrchol
prohodí levý a pravý podstrom, pokud je ve vstupním stromě vlevo víc vrcholů
než vpravo.
Příklad:
> prevaz (Node (Node (Node Void 'a' Void) 'b' Void) 'c' (Node Void 'ď Void))
Node (Node Void 'ď Void) 'c' (Node Void 'b' (Node Void 'a' Void))
- Napište co nejobecnější typ funkce
prevaz
a použitých pomocných funkcí - Napište funkci
prevaz.
- Využíváte někde volání lambda-funkce nebo funkce s neúplně zadanými argumenty?
Řešení:
data Bt a = Void | Node (Bt a) a (Bt a)
deriving (Eq, Show)
prevaz :: Bt a -> Bt a
prevaz = snd . prevaz'
prevaz' :: Bt a -> (Int, Bt a)
prevaz' Void = (0, Void)
prevaz' (Node left val right)
| leftN > rightN = (count, Node rightAns val leftAns)
| otherwise = (count, Node leftAns val rightAns)
where
(leftN , leftAns ) = prevaz' left
(rightN, rightAns) = prevaz' right
count = leftN + rightN + 1
Dostanete vstupní graf G
, neorientovaný a bez ohodnocení. Vypusťte z něho
opakovaně všechny vrcholy, které mají méně sousedů než dané k
. Vydejte
zbylý graf a seznam vrcholů v poradí, jak jste je vypouštěli.
- Definujte vhodný typ
Graf
a pro graf, který používáte v další definici, přičemž parametra
je označení vrcholů. - Definujte funkci
centrumG :: Eq a => Graf a -> Int -> (Graf a, [a])
pro požadovaný výpočet.
Řešení:
data Graph a = Graph [(a, [a])]
deriving (Eq, Show)
unfold :: (a -> Bool) -> (a -> (a, b)) -> a -> (a, [b])
unfold done step x
| done x
= (x, [])
| otherwise
= let (newX, newY ) = step x
(ansX, ansYs) = unfold done step newX
in (ansX, newY : ansYs)
centrumG :: Eq a => Graph a -> Int -> (Graph a, [a])
centrumG (Graph ps) k = (Graph ansPs, bs)
where
findSmallDegree = filter (\p -> length (snd p) < k)
degreeAtLeast ps = null (findSmallDegree ps)
removeSmallDegree ps =
let toRemove = fst $ head $ findSmallDegree ps
in ( [ (v, filter (/= toRemove) ns) | (v, ns) <- ps, v /= toRemove ]
, toRemove
)
(ansPs, bs) = unfold degreeAtLeast removeSmallDegree ps