---
# System prepended metadata

title: NeprocProg Cure

---

# NeprocProg Cure

[TOC]

## Prolog

### Topologické uspořádání grafu

Zdroj: [MFF Forum: Zkoužka 4.9.2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12095)

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:

```prolog
?- topo([a-[],b-[a,c],c-[a],d-[a,c]],Usp).
Usp = [b,d,c,a]
```

 1) Definujte příslušný predikát topo/2 v jazyce Prolog.
 2) Odhadněte časovou složitost vašeho řešení. Odhad zdůvodněte.
 3) 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í:

```prolog
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

Zdroj: [MFF Forum: Zkoužka 4.9.2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12095)

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:

```prolog
?- 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]]
```

1. Definujte příslušný predikát ``diskr/2.``
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?
3. 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í:

```prolog
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ů

Zdroj: [MFF Forum: Zkouška 16. 7. 2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12089)

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:

```none
   1
 2   3
4

   1
 2   3
  4

   1
 2   3
    4

   1
 2   3
      4
```

 1. Popište zvolenou reprezentaci binárních stromů.
 2. Definujte predikát ``allTrees/2``.
 3. Stručně vysvětlete, proč je vaše definice korektní.
 4. 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í:

```prolog
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

Zdroj: [MFF Forum: Zkouška 16. 7. 2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12089)

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.

```prolog
?- 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
```

 1. Definujte predikát ``bip/3``.
 2. Napište o jednotlivých predikátech ve vašem řešení, zda jsou koncově rekurzivní.

Řešení:

```prolog
% 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

Zdroj: [MFF Forum: Zkouška 24. 6. 2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12078)

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

```prolog
?- rezy(5,[3,2,2,2,2,1,4], N, V).
N=4, V=[[3,2],[2,2,1],[2],[4]]
```

1. Definujte predikát ``rezy/4.`` Definice případných pomocných predikátů
   prosím opatřete vysvětlujícím komentářem.
2. Je některý z vašich predikátů koncově rekurzivní? Pokud ano, vysvětlete,
   který to je a jaký to má význam.
3. Pokud ne, dal by se některý takto upravit? Odpověď prosím zdůvodněte.

Řešení:

```prolog
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ů

Zdroj: [MFF Forum: Zkouška 24. 6. 2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12078)

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:

```prolog
?- reprezentanti([[1],[1,2,3],[1,3,4]], R).
R = [[1,2,3],[1,2,4],[1,3,4]]
```

1. Sestavte predikát ``reprezentanti(+Mss, -Rss)``.
2. Stručně vysvětlete, proč je vaše definice korektní.
3. 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.)?

```prolog
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=12066)

Profesor Hammerstein definoval predikat ``setrid/2`` takto:

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

1. 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í.
2. 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?
3. 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.
4. *VOLITELNE*: Lze u procedury ``setrid/2`` obrátit směr výpočtu?

```prolog
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í:

```prolog
% 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)](http://forum.matfyz.info/viewtopic.php?f=169&t=12066)

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.

1. V jazyce Prolog popište datovou strukturu pro reprezentaci jednoho záznamu
   kontaktu občana Mobilie popsaného výše.
2. 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ů.
3. Sestavte predikát ``inf/4``, který obdrží

    ```none
    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.

4. Odhadněte časovou složitost vašeho řešení.
5. 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í:

```prolog
% 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

Zdroj: [MFF Forum: 10. 9. 2019 - Dvořák](http://forum.matfyz.info/viewtopic.php?f=169&t=11977)

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:

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

```prolog
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

Zdroj: [MFF Forum: 10. 9. 2019 - Dvořák](http://forum.matfyz.info/viewtopic.php?f=169&t=11977)

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:

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

```prolog
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í

Zdroj: [MFF Forum: 24.6.2019 (Dvořák, Hric)](http://forum.matfyz.info/viewtopic.php?f=169&t=11969)

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:

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

```prolog
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

Zdroj: [MFF Forum: 24.6.2019 (Dvořák, Hric)](http://forum.matfyz.info/viewtopic.php?f=169&t=11969)

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:

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

```prolog
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=11954)

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:

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

```prolog
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=11954)

Čá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:

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

```prolog
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11747)

Nalezněte lexikograficky předchozí permutaci. Pokud neexistuje tak ``false``.

Řešení:

```prolog
?- prev([1,2,6,3,4,5,7],V).
V = [1,2,5,7,6,4,3]
```

```prolog
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11756)

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.

```prolog
?- frekv([a,b,a,b,c], P).
P = [f(a-b,2), f(b-a,1), f(b-c,1)]
```

Řešení:

```prolog
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11756)

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:

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

```prolog
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10961)

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.

```prolog
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í:

```prolog
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10961)

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

```prolog
?- combine([[2-5, 2-3], [3-4]], G)
G = [2-5, 1-4, 1-3]
```

Řešení:

```prolog
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.](http://forum.matfyz.info/viewtopic.php?f=169&t=11412)

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:

```prolog
?- cycle([a-[b,c,d],b-[c],c-[a,b,d],d-[a,c],e-[]], C)
C = [a, c, b]
```

Řešení:

```prolog
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ů

Zdroj: [MFF Forum: Zkouska 20.9.2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11466)

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:

```prolog
?- dif([a,b,c],D).
D=[[a,b,c], [b,c], [a,c], [a,b], [a], [c]]
```

Řešení:

```prolog
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

Zdroj: [MFF Forum: Zkouska 20.9.2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11466)

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

1. Na příkladě popište, jakou reprezentaci grafu budete používat.
2. Definujte predikát
```pokryti(+Graf, +Vrchol, -VPokrytí)```
kde Graf je zadán v reprezentaci popsané v **1.)**.

Řešení:

```prolog
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11457)

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:

```prolog
?- rozdel([a,b,c],X).
X = [[a, b, c], [[a, b], [c]], [[a], [b, c]], [[a, c], [b]], [[a], [b], [c]]].
```

Řešení:

```prolog
is_subset([], [], []).
is_subset([ X | Xs ], [ X | Ys ], Zs) :-
    is_subset( Xs, Ys, Zs ).
is_subset([ X | Xs ], Ys, [ X | Zs ]) :-
    is_subset( Xs, Ys, Zs ).

rozdel_nedet([], []).
rozdel_nedet([ X | Xs ], Division) :-
    is_subset(Xs, S, Rest),
    rozdel_nedet(Rest, Ds),
    Division = [ [ X | S ] | Ds].

rozdel(List, Divisions) :-
    rozdel_(List, [], Divisions).

rozdel_(List, Acc, Divisions) :-
    rozdel_nedet(List, Division),
    \+ member(Division, Acc),
    rozdel_(List, [ Division | Acc ], Divisions),
    !.
rozdel_(_, Acc, Acc).
```

### Nezávislé množiny

Zdroj: [MFF Forum: Zkouška 13. 9. 2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11457)

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:

```prolog
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í:

```prolog
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11380)

Na vstupu máme graf reprezentovaný jako

```prolog
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í:

```prolog
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

Zdroj: [MFF Forum: Zkouška 29.5.2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11357)

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:

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

```prolog
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

Zdroj: [MFF Forum: Zkouška 29.5.2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11357)

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

```prolog
?- 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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10963)

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

```prolog
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10963)

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

```prolog
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](http://forum.matfyz.info/viewtopic.php?f=169&t=10993)

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:

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

```prolog
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10934)

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

```prolog
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](http://forum.matfyz.info/viewtopic.php?f=169&t=10536)

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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10479)

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

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

```prolog
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10462)

- 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

Řešení:

```prolog
rotace1([], []).
rotace1([X | Xs], Out) :-
    rotace1_(Xs, X, Out).

rotace1_([], X, [X]).
rotace1_([Y | Ys], X, [ Y | Out ]) :-
    rotace1_(Ys, X, Out).

append_dif(X-Xs, Y-X, Y-Xs).

rotace2(P-[ X | Xs ], Out) :-
    append_dif(P-Xs, NewP-[ X | NewP ], Out).
```

### Izomorfizmus bin. stromů s popisem

Zdroj: [MFF Forum: Zkouška 12.7.2021](http://forum.matfyz.info/viewtopic.php?f=169&t=12193)

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.

1. 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ě.
2. Definujte predikát ``iso/3``.
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:

```none
  S= d                 T= d                Popis= t
   /---\                /---\                   /---\
  b     e              e     b                 f     t
 / \   / \            / \   / \               / \   / \
a   c f   g          g   f a   c             f   f f   f
```

```prolog
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í:

```prolog
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

```prolog
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:

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

```prolog
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:

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

```prolog
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

Zdroj: [MFF Forum: Zkoužka 4.9.2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12095)

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

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

    ```haskell
    > soucty [-1,1,2,3,-4]
     (1,3,6)
    ```

2. Jaký význam má část ``Num a =>`` v definici funkce soucty ? Proč tam musí
   být?
3. Uveďte dvě možné konkrétní hodnoty proměnné a z typu funkce soucty.
4. 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í:

```haskell
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

Zdroj: [MFF Forum: Zkoužka 4.9.2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12095)

Binární vyhledávací strom je zadán jako seznam hodnot vrcholů v pořadí
preorder. Definujte funkci

```haskell
readBt :: Ord a => [a] -> Bt a
```

která ze zadaného seznamu zrekonstruuje původní strom typu

```haskell
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:

```haskell
> readBt [5, 2, 4, 9]
Node (Node Void 2 (Node Void 4 Void)) 5 (Node Void 9 Void)
```

1. Definujte funkci ``readBt``.
2. 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?
3. 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í:

```haskell
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

Zdroj: [MFF Forum: Zkouška 16. 7. 2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12089)

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:

```haskell
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
```

1. Definujte typovou signaturu funkce ``ascending``.
2. Definujte vlastní funkci.
3. Jak byste zobecnili tuto funkci tak, aby ji bylo možné použít s libovolným
   porovnávacím operátorem?
4. 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í:

```haskell
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

Zdroj: [MFF Forum: Zkouška 16. 7. 2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12089)

 1. 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.
 2. 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.
 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``.
 4. 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í:

```haskell
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

Zdroj: [MFF Forum: Zkouška 24. 6. 2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12078)

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:

```haskell
klouzave [1.5, 2.5, 3.5, 4.5, 5.5] 3
[2.5,3.5,4.5]
```

1. Definujte typovou signaturu funkce ``klouzave``
2. Definujte vlastní funkci s explicitním využitím rekurze
3. 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.
4. 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.
5. 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.

```haskell
take 5 $ klouzave [1..] 10
[5.5,6.5,7.5,8.5,9.5]
```

Řešení:

```haskell
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

Zdroj: [MFF Forum: Zkouška 24. 6. 2020](http://forum.matfyz.info/viewtopic.php?f=169&t=12078)

Cílem toho problému je zobecnit funkce ``foldr`` / ``foldl`` na obecné kořenové stromy.

1. 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
2. Funkce ``foldl`` a ``foldr`` zobecněte na funkci ``foldT``, která bude -
   namísto seznamu - procházet stromem ve vaší reprezentaci popsané v **1.**.
3. 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.
4. 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í:

```haskell
-- 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)](http://forum.matfyz.info/viewtopic.php?f=169&t=12066)

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
![priklad vstupu](https://i.imgur.com/sNvonyI.png)

Snažte se o efektivitu, celé podstromy patřící do jednoho pruhu zpracujte najednou.

1. Definujte datový typ pro reprezentaci binárních vyhledávacích stromů. Snažte
   se o co nejobecnější definici.
2. Definujte typovou signaturu funkce ``pruhy``, včetně typových tříd.
3. Funkci ``pruhy`` definujte. Budete-li používat pomocné funkce, u každé
   popište její význam.
4. Pokuste se stručně zdůvodnit korektnost vaší defnice.

Řešení:

```haskell
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=12066)

Definujte funkce ``rle`` a ``rld``, které realizují run-length encoding a
decoding. Funkce

```haskell
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:

```haskell
> rle ”abbcccda”
[Left 'a', Right ('b',2), Right ('c',3), Left 'd', Left 'a']
```

1. 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).
2. Definujte funkci ``rle`` bez explicitního využití rekurze, ale za použití
   stručných seznamů či funkcí vyšších řádů.
3. Definujte typovou signaturu funkce ``rld``, která realizuje dekompresi, tj.
   převod ze seznamu úseků na původní seznam prvků.
4. Definujte funkci ``rld.`` Použijte přitom funkci ``map`` či ``concat``.
5. Bude některá z funkcí fungovat i na nekonečných seznamech? Proč ano nebo
   proč ne?

Řešení:

```haskell
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

Zdroj: [MFF Forum: 10. 9. 2019 - Dvořák](http://forum.matfyz.info/viewtopic.php?f=169&t=11977)

Definujte funkce:

```none
prevod1 cislo puvodni
```

pro převod čísla z číselné soustavy o základu ``puvodni`` do ``dekadické
číselné soustavy``, a

```none
prevod2 cislo nova
```

pro převod čísla z dekadické do číselné soustavy o základu ``nova``.
Příklad:

```haskell
> 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]
```

1. Doplňte typové signatury definovaných funkcí

    ```haskell
    prevod1 ::
    prevod2 ::
    ```

2. Definujte funkci ``prevod1`` s využitím rekurze.
3. 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.
4. Definujte funkci ``prevod2`` s využitím funkce ``unfold`` definované
   následovně:

    ```haskell
    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í:

```haskell
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

Zdroj: [MFF Forum: 10. 9. 2019 - Dvořák](http://forum.matfyz.info/viewtopic.php?f=169&t=11977)

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

1. Definujte typovou signaturu funkce ``rady``.
2. Funkci ``rady`` definujte.

Příklad:

```haskell
> rady [["e","a","b"], ["a","b","e"], ["b","e","a"]]
[("e",1), ("a",3), ("b",3)]
```

Řešení:

```haskell
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

Zdroj: [MFF Forum: 24.6.2019 (Dvořák, Hric)](http://forum.matfyz.info/viewtopic.php?f=169&t=11969)

Je dána číselná matice ``A``. Definujte funkci

```haskell
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:

```haskell
> 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í:

```haskell
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

Zdroj: [MFF Forum: 24.6.2019 (Dvořák, Hric)](http://forum.matfyz.info/viewtopic.php?f=169&t=11969)

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}``

1. 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.)
2. Specifikujte typovou signaturu funkce

    ```haskell
    doplneni ::
    ```

3. Funkci definujte.

Řešení:

```haskell
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=11954)

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'``.

1. Definujte datovou strukturu pro reprezentaci oboru hodnot funkce stat
   (pomocí data nebo type).
2. Definujte typovou signaturu funkce stat s použití datové struktury z **1.**.
3. Funkci stat definujte.

Řešení:

```haskell
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11747)

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:

```haskell
data Tree a = Nil | Tree a [Tree a]
label :: Tree a -> Tree (a, Int)
```

Příklad

```haskell
> 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í:

```haskell
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11756)

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:

```haskell
> change3 "ab" "aabe"
["bbae", "bbba", "bbbb", "baaa", "baab", "abaa", "abab"]
```

1. Definujte typ funkce ``change3`` co nejobecněji (včetně případných typových tříd)
2. Definujte funkci ``change3``

Řešení:

```haskell
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10961)

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

```haskell
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)](http://forum.matfyz.info/viewtopic.php?f=169&t=10961)

1. Napiste fold pro binarni stromy

    ```haskell
    data Tree a = Leaf a | Tree (Tree a) (Tree a)
    fold :: (a -> b) -> (b -> b -> b) -> Tree a -> b
    ```

2. Napiste one-liner funkci, ktera vypise minimum a maximum z celeho stromu
   pomoci vami napsaneho foldu.
3. Napiste hlavicku funkce z **2.**

Řešení:

```haskell
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.](http://forum.matfyz.info/viewtopic.php?f=169&t=11412)

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

```haskell
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

Zdroj: [MFF Forum: Zkouska 20.9.2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11466)

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:

```haskell
> podminky [even,(>5),(==3)] [0..9]
[[0,2,4,6,8],[7,9],[3]]
```

1. Napište typovou signaturu funkce podmínky (co nejobecnější, včetně
   případných typových tříd).
2. Napište funkci ``podminky``.

Řešení:

```haskell
podminky :: [a -> Bool] -> [a] -> [[a]]
podminky []       _  = []
podminky (f : fs) xs = filter f xs : podminky fs rest
  where rest = filter (not . f) xs
```

### Stromový take

Zdroj: [MFF Forum: Zkouska 20.9.2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11466)

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

1. Definujte datový typ pro obecný kořenový strom, v jehož vrcholech jsou
   uloženy prvky typu ``a``.
2. 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``.
3. Definujte typovou signaturu funkce ``takeTree``.
4. Funkci ``takeTree`` definujte.

Řešení:

```haskell
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11457)

Máme typ:

```haskell
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:

```haskell
gen = [ Konst True, Konst Flase, Not True, Not False, And True True, ... ]
```

Řešení:

```haskell
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](http://forum.matfyz.info/viewtopic.php?f=169&t=11380)

Máme dva druhy stromů - obecný n-ární:

```haskell
data NTree a = NTree a [NTree a]
```

a n-ární, ve kterém je řečeno, které podstromy jsou vlevo a které vpravo:

```haskell
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í:

```haskell
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ů

Zdroj: [MFF Forum: Zkouška 29.5.2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11357)

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

```haskell
> 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í:

```haskell
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

Zdroj: [MFF Forum: Zkouška 29.5.2017](http://forum.matfyz.info/viewtopic.php?f=169&t=11357)

Je dán datový typ

```haskell
data Bag a = Item a | Items [Bag a]
```

1. Definujte funkci ``fold`` pro obecný průchod touto datovou strukturou (to
   ``(a->b)`` tam zastupuje počáteční hodnotu v normálním foldu)

    ```haskell
    fold :: (a -> b) -> ([b] -> b) -> Bag a -> b
    ```

2. Pomocí funkce fold definujte funkci ``listy`` která posbírá všechny hodnoty
   z položek ``Item`` ze všech úrovní zleva.

```haskell
listy :: Bag a -> [a]
```

Příklad:

```haskell
> listy (Items [Item 1,Items [Item 2, Item 3], Items [Items [Item 4]]])
[1,2,3,4]
```

Řešení:

```haskell
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
```

### Hledání skoku

Zdroj: [MFF Forum: Zkouška 13. 6. 2016 (Dvořák, Hric)](http://forum.matfyz.info/viewtopic.php?f=169&t=10963)

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

```haskell
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 ]
```

### Násobení/sčítání řídkých polynomů

Zdroj: [MFF Forum: Zkouška 28.6.2016 - Dvořák, Hric](http://forum.matfyz.info/viewtopic.php?f=169&t=10993)

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)

```haskell
data Ridky a = Ridky [(Int, a)]
```

Řešení:

```haskell
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'
```

### Maximo-lexikografické generování všech dvojic

Zdroj: [MFF Forum: Zkouška 30. 05. 2016 (Dvořák, Hric)](http://forum.matfyz.info/viewtopic.php?f=169&t=10934)

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

```haskell
[[0,0],[0,1],[1,0],[1,1],[0,2],[1,2],[2,0],[2,1],[2,2],[0,3] ...]
```

Řešení:

```haskell
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 ]

```

### Ořezání intervalu z BVS

Zdroj: [MFF Forum: Zkouška 30. 05. 2016 (Dvořák, Hric)](http://forum.matfyz.info/viewtopic.php?f=169&t=10934)

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

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

### Otočení v orientované sekvenci

Zdroj: [MFF Forum: Zkouška 12.7.2021](http://forum.matfyz.info/viewtopic.php?f=169&t=12193)

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.

1. Napište (obecný) typ funkce ``otoceni``
2. Napište funkci ``otoceni``
3. 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:

```haskell
> 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í:

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

### Převážení binárního stromu II

Je zadán binární strom s vnitřními vrcholy typu

```haskell
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:

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

1. Napište co nejobecnější typ funkce ``prevaz`` a použitých pomocných funkcí
2. Napište funkci ``prevaz.``
3. Využíváte někde volání lambda-funkce nebo funkce s neúplně zadanými argumenty?

Řešení:

```haskell
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
```

### Diskvalifikováni sousedi

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.

1. Definujte vhodný typ ``Graf`` a pro graf, který používáte v další definici,
   přičemž parametr ``a`` je označení vrcholů.
2. Definujte funkci ``centrumG :: Eq a => Graf a -> Int -> (Graf a, [a])`` pro
   požadovaný výpočet.

Řešení:

```haskell
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
```

