Declaratieve Talen/Oplossing Graaf-isomorfie

Oplossing

Dit is een mogelijke oplossing:

verbonden(A,B) :- boog(A,B).
verbonden(A,B) :- boog(B,A).

verplaatsKeien(Van, Naar, Aantal, Knopen, Waarden, NieuweWaarden) :-
        member(Van, Knopen),
        member(Naar, Knopen),
        verbonden(Van, Naar),
        index(Knopen, Van, VanPos),
        index(Knopen, Naar, NaarPos),
        index(Waarden, VanAantal, VanPos),
        index(Waarden, NaarAantal, NaarPos),
        numlist(1,VanAantal, Poss),
        member(Aantal, Poss),
        VanAantal2 is VanAantal - Aantal,
        NaarAantal2 is NaarAantal + Aantal - 1,
        setElementAt(Waarden,VanPos,VanAantal2, NieuweWaardenTmp),
        setElementAt(NieuweWaardenTmp,NaarPos,NaarAantal2, NieuweWaarden).

kei_bereikbaar(Knoop) :-
        findall(K, knoop(K, _), Knopen),
        findall(W, knoop(_, W), Waarden),
        kei_bereikbaar2(Knoop, Knopen, Waarden, []).

kei_bereikbaar2(Knoop, Knopen, Waarden, _) :-
        index(Knopen, Knoop, Pos),
        index(Waarden, Aantal, Pos),
        Aantal > 0.
kei_bereikbaar2(Knoop, Knopen, Waarden, Gedaan) :-
        knoop(Van, _),
        index(Knopen, Van, Pos),
        index(Waarden, VanAantal, Pos),
        VanAantal > 1,
        knoop(Naar, _),
        % A -> B => nutteloos om B -> A te doen:
        not(member((Naar, Van), Gedaan)),
        NieuwGedaan = [(Van, Naar) | Gedaan],
        verplaatsKeien(Van,Naar,_,Knopen,Waarden,NieuweWaarden),
        kei_bereikbaar2(Knoop, Knopen, NieuweWaarden, NieuwGedaan).

kei_goed :-
        forall(knoop(Knoop, _), kei_bereikbaar(Knoop)).

kei_nijg :-
        findall(K, knoop(K, _), Knopen),
        findall(W, knoop(_, W), Waarden),
        kei_nijg2(Knopen, Waarden, []).

kei_nijg2(_, Waarden, _) :-
        forall(member(X, Waarden), X > 0).
kei_nijg2(Knopen, Waarden, Gedaan) :-
        knoop(Van, _),
        index(Knopen, Van, Pos),
        index(Waarden, VanAantal, Pos),
        VanAantal > 1,
        knoop(Naar, _),
        % A -> B => nutteloos om B -> A te doen:
        not(member((Naar, Van), Gedaan)),
        NieuwGedaan = [(Van, Naar) | Gedaan],
        verplaatsKeien(Van,Naar,_,Knopen,Waarden,NieuweWaarden),
        kei_nijg2(Knopen, NieuweWaarden, NieuwGedaan).

index([], _, _) :- 0 = 1.
index([RijHoofd|_], Element, Index) :-
        RijHoofd = Element,
        Index = 0.
index([RijHoofd|Rest], Element, Index) :-
        nonvar(Element),
        RijHoofd \= Element,
        index(Rest, Element, SubIndex),
        Index is 1 + SubIndex.
index([_|Rest], Element, Index) :-
        nonvar(Index),
        SubIndex is Index - 1,
        index(Rest, Element, SubIndex).

setElementAt([], _, _) :- 0 = 1.
setElementAt([_|Rest], 0, X, NieuweRij) :-
        NieuweRij = [X|Rest].
setElementAt([RijHoofd|Rest], A, X, NieuweRij) :-
        A > 0,
        A2 is A - 1,
        setElementAt(Rest,A2,X,Rest2),
        NieuweRij = [RijHoofd|Rest2].