NeprocProg Cure

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

Diskrepanční vrstvy

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

Generování binárních stromů

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:

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

Bipartitní rozklad grafu

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

Problém truhláře

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_]
    ),
    !.

Systém různých reprezentantů

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

Hammerstein

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

Cestovatel

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

Generování hodnot výrokových proměnných

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

Trojúhelníky v grafu

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

Generování výrokových formulí

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

Koncepty

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

Překrytí segmentů

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

Neporovnatelné prvky částečně uspořádané množiny

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

Lexikograficky předchozí permutace

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

Frekvence

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

Časové ohodnocení DFS

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

Splay

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

Skládání konstantních úseků

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

Kružnice v grafu

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

Vypustění nejvýše dvou prvků

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

Vrcholové pokrytí minimální k inkluzi

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

!! Rozděl

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

???

Nezávislé množiny

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

Cykly délky alespoň N

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),
    !.

Termy

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

!! Porovnání multimnožin

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) je true právě tehdy, pokud v B existuje nějaký prvek, co není v A takový, že je větší než všechny prvky z A, které nejsou v B.

?- 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í: ???

Plánování výroby

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

Listy stromu podle počtu kroků vpravo

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

Maximální párování dle inkluze

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_(_, _, []).

Generování všech možných výrazů

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

!! Zlepšení řezu

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.

Ohodnocení stromu post- a pre-order

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

!! Rotace seznamu

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

Izomorfizmus bin. stromů s popisem

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

FirstFit

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

Otočení v sekvenci

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

Haskell

Největší součet souvislé podposloupnosti

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

Rekonstrukce binárního stromu

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

Rostoucí posloupnosti

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)

Stromové operace

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ýsledkem replicateT n a je binární strom, který obsahuje n kopií hodnoty a.
- 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.
Definujte funkci zipWithT jako zobecnění funkce zipWith. zipWithT f t1 t2 sloučí prvky stromů t1 a t2 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 a zipWithT f empty t == empty.
Pomocí replicateT a zipWithT definujte funkci cut. Funkce cut n t odstraní ze stromu t 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)

Klouzavé průměry

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
  ]

Stromovy fold

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 a foldr zobecněte na funkci foldT, 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 funkci pdc, 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]
  ]

Deleni stromu

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

Obrázek

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)

Run-length encoding/decoding

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 funkci map či concat.
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
  ]

Převody mezi číselnými soustavami

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 či foldl, ale bez (explicitního) použití rekurze.

Definujte funkci prevod2 s využitím funkce unfold 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

Řády prvků grupy

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

Kumulativní součty

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)

Doplnění hypergrafu

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
    ]

Analýza textu

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

Označkování stromu

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)

Změna některých prvků

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 ]

Největší kladná podmatice

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]

Stromový fold

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

Tetris

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 ]

Splnění všech podmínek

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

Stromový take

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 a m
odstraní ve stromě všechny vrcholy ve hloubce větší než m (hloubka vrcholu v je počet hran na cestě z kořene do v)
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ýše m) 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

Formule

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 ]

Převody stromů

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

Počet trojúhelníků

Navrhněte datový typ Graf a pro reprezentaci konečného neorientovaného grafu s vrcholy typu a.
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

Bag fold