Declaratieve Talen/oplossingenContradicties

% To Do een predicaat meetegen(P,A) schrijven dat teruggeeft of die
% antwoordletter in contradictie is met een andere antwordleter.
% In een graaf ziet een contradictie eruit indien er een lus is.
% Algemene Strategie : we gaan voor de gegeven antwoordletter het pad
% doorheen de graaf volgen en kijken of we een pad naar onszelf tegen
% komen

%Prolog feiten:
antwoord(jan,c,[a,b,d,e]).
antwoord(jan,i,[f,k,c,b]).
antwoord(jan,j,[i,f,h,e]).
antwoord(jan,k,[j,h,g,d]).

buren(X,Y):-antwoord(_,X,Lijst),
	    member(Y,Lijst).
% buren in de andere richting zou je hier ook makkelijk kunnen
% definieren, maar dit is in ons geval niet nodig.

meetegen(P,A):-antwoord(P,A,_),
	      doorloopGraaf(P,A,A,[A]),!.

doorloopGraaf(P,A,B,Pad):- buren(A,X),
	                   (
			   \+ member(X,Pad)->
			   append(Pad,[X],New),
			   doorloopGraaf(P,X,B,New)
			   ;
			   true
			   ).

%maak een predikaat tegen(P,Tegens)

tegen(P,Tegens):- findall(X,doorloopGraaf(P,X,X,[]),Tegens).

--Greet

Alternatief omdat ik denk dat bovenstaande over het algemeen niet werkt:

% Prolog-feiten
antwoord(jan,c,[a,b,d,e]).
antwoord(jan,i,[f,k,c,b]).
antwoord(jan,j,[i,f,h,e]).
antwoord(jan,k,[j,h,g,d]).

% Atoom voor een quick-and-dirty manier om de recursie
% van pad/6 te laten eindigen.
pad_gevonden.

% A is in contradictie met een andere letter
% als er een kring bestaat die begint in A
meetegen(P,A) :-
    pad(P,A,A,A,[],_).

% bouw eerst alle lijsten op van letters die in contradictie zijn met elkaar
% en verwijder dan alle dubbels die zijn ontstaan
tegen(P,Tegens) :-
    findall(Letter, antwoord(P,Letter,_), LetterLijst),
    findall(Pad, (member(X,LetterLijst), langste_pad(P,X,Pad)), Paden),
    sortlists(Paden,DeepLevelSorted),
    sort(DeepLevelSorted,Tegens). % verwijdert duplicates

% sorteer een lijst van lijsten
sortlists(In,Out) :- sortlists(In,[],Out).
sortlists([],Out,Out).
sortlists([In | Rest],Acc,Out) :-
    sort(In,Sorted),
    NewAcc = [ Sorted | Acc ],
    sortlists(Rest,NewAcc,Out).

% Voor Persoon is Y een buur van letter als Y voorkomt in de lijst voor die letter
% en als Y ook een onderdeel is van een antwoord/3 feit.
% Volgens deze logica is 'j' een buur van 'i', maar is 'e' geen buur van 'c'
buren(Persoon,Letter,Y) :-
    antwoord(Persoon,Letter,Lijst),
    member(Y,Lijst),
    antwoord(Persoon,Y,_).
    
% Er is een pad gevonden: output Pad
pad(_,_,_,_,pad_gevonden,Pad,Pad).
pad(Persoon,Bron,Doel,Vorige,Acc,Bezocht) :-
    buren(Persoon,Vorige,Y), % backtracking zorgt ervoor dat effectief alle buren worden overlopen
    \+ member(Y,Acc), % anders loopt Prolog vast in een kring
    (Doel == Y -> % pad gevonden: output deze
    reverse([ Y | Acc ],NewAcc),
    pad(Persoon,Bron,Doel,Y,pad_gevonden,NewAcc,Bezocht)
    ;
    NewAcc = [ Y | Acc ],
    pad(Persoon,Bron,Doel,Y,NewAcc,Bezocht)).
    
% vindt het langste pad voor de gegeven letter
langste_pad(P,Letter,Pad) :-
    findall(Pad, pad(P,Letter,Letter,Letter,[],Pad), Paden),
    langste_rec(Paden,0,Acc,Pad).
    
langste_rec([], _, Langste, Langste).
langste_rec([Pad | Paden],Length,Acc,Langste) :-
    length(Pad,CurrLength),
    (CurrLength > Length -> 
    NewAcc = Pad,
    langste_rec(Paden,CurrLength,NewAcc,Langste)
    ;
    langste_rec(Paden,Length,Acc,Langste)).

--Thomas Vochten

antwoord(jan,c,[a,b,d,e]).
antwoord(jan,i,[f,k,c,b]).
antwoord(jan,j,[i,f,h,e]).
antwoord(jan,k,[j,h,g,d]).

meetegen(P,A) :-
  meetegen(P,A,A,[],_).

% Persoon, huidig uitbreid punt, te zoeken antwoord, reeds bezochte
% punten, de lus
meetegen(_,_,A,Acc,Loop) :-
  member(A,Acc),    % Antwoord heeft zichzelf gevonden
  sort(Acc,Loop),!. % Mooi alfabetisch, helpt bij het tegen predikaat

meetegen(P,Aa,A,Acc,Loop) :-
  antwoord(P,Aa,Pref),  % Neem de voorkeuren van het huidig antwoord
  findall(M, (member(M,Pref), \+ member(M,Acc)), Ms), % Elk nog niet reeds bezocht punt
  member(Mx,Ms),                   % Minstens eentje is genoeg om een loop te vinden
  meetegen(P,Mx,A,[Mx|Acc],Loop).  % Zoek verder in elk van die punten

% Luie aanpak: zoek elke mogelijkheid, dus de lus [i,j,k] word op 3
% verschillende manieren gevonden. Daarna filteren we ze gewoon weg.
tegen(P,Tegens) :-
  findall(Loop,meetegen(P,A,A,[],Loop),TegensList),
  list_to_set(TegensList,Tegens).

--Brecht Derwael