Declaratieve Talen/Oplossing celautomaat

Een oplossing

Deze oplossing werkte voor zover ik getest heb... Bij predicaat regels wordt ook overal de 'javelregel' toegevoegd.

volgendegen(Seq,Regels,Volgende):-
	volgendegen2([o,o|Seq],Regels,Volgende).

volgendegen2([S1,S2],Regels,[V1,V2]):-
	member([S1,S2,o,V1],Regels),
	member([S2,o,o,V2],Regels).
volgendegen2([S1,S2,S3|Seq],Regels,[V1|Volgende]):-
	member([S1,S2,S3,V1],Regels),
	volgendegen2([S2,S3|Seq],Regels,Volgende).

regels([S1,S2],Regels):-
	 regelsseq(S1,Regels,S2).
regels([S1,S2|Sequenties],Regels):-
	 regels([S2|Sequenties],R1),
	 regelsseq(S1,R2,S2),
	 merge(R1,R2,R3),
	 remove_doubles(R3,Regels),
	 geldig(Regels).

% regels genereren voor 1 overgang van een sequentie naar zijn opvolger 
% bij eerste in sequentie 2 o's toevoegen voor het genereren begint
regelsseq(S1,Regels,S2):-
	 regelsseq2([o,o|S1],Regels,S2).

% op het einde van de sequentie 2 extra o's veronderstellen 
regelsseq2([o,o],[ [o,o,o,V] ],[V,V]).
regelsseq2([o,x],[[o,x,o,V1],[x,o,o,V2]],[V1,V2]).
regelsseq2([x,o],[[x,o,o,V1],[o,o,o,V2]],[V1,V2]).
regelsseq2([x,x],[[x,x,o,V1],[x,o,o,V2]],[V1,V2]).
regelsseq2([S1,S2,S3|Seq],Regels,[V1|Volgende]):-
	 regelsseq2([S2,S3|Seq],Regels,Volgende),
	 member([S1,S2,S3,V1],Regels).
regelsseq2([S1,S2,S3|Seq],[[S1,S2,S3,V1]|Regels],[V1|Volgende]):-
	 regelsseq2([S2,S3|Seq],Regels,Volgende),
	 \+member([S1,S2,S3,_],Regels).

% dubbels verwijderen uit een lijst van regels
remove_doubles([L],[L]).
remove_doubles([L|List],L2):-
	 remove_doubles(List,L2),
	 member(L,L2).
remove_doubles([L|List],[L|L2]):-
	 remove_doubles(List,L2),
	 \+member(L,L2).

% testen of een lijst van regels geen tegenstrijdige regels bevat
geldig([_]).
geldig([[X,Y,Z,_]|List]):-
	 geldig(List),
	 \+member([X,Y,Z,_],List).

Een andere oplossing

% Vraag 1:
volgendegen(Seq, Regels, Volgende) :-
	append([o,o|Seq],[o,o],Seq2),
	findall(Nieuw,
		(append(_,Skipped,Seq2),append([A,B,C],_,Skipped),
			member([A,B,C,Nieuw],Regels)
		),
		Volgende).

% Vraag 2:
regels(Sequenties, Regels) :-
	findall(Seq2,
		(member(Seq,Sequenties),
			append([o,o|Seq],[o,o],Seq2)
		),
		Padded),
	regels(Padded, [], Regels).
regels([_], Regels, Regels).
regels([[L,X,R|T1], [_,A,N|T2] | Rest], RegelAcc, Regels) :-
	!,
	(member([L,X,R,_], RegelAcc) ->
		forall(member([L,X,R,OudeRegel], RegelAcc),
			N = OudeRegel),	% Is de regel wel consistent?
		regels([[X,R|T1],[A,N|T2]|Rest], RegelAcc, Regels)
	;
		regels([[X,R|T1],[A,N|T2]|Rest], [[L,X,R,N]|RegelAcc], Regels)
	).
regels([_|Seqs], RegelAcc, Regels) :-
	regels(Seqs, RegelAcc, Regels).

Roald 12 jan 2010 22:38 (UTC)

Nog een oplossing

--Nick.dewaele (overleg) 30 dec 2017 19:01 (CET)

Deze is gebaseerd op het gedeeltelijk instantieren van de kop van een lijst (wordt wel duidelijk als je de debugger volgt)

exampleRules(R) :- R = [[o,o,o,o],[o,o,x,x], [o,x,o,o], [x,o,o,x], [x,o,x,x]].

% past een regel toe, gegeven een lijst regels. Res unificeert met het nieuwe symbool,
% en AppliedRule is de regel die toegepast werd
applyAppropRule(A,B,C,[[A,B,C,D]|_], D, [A,B,C,D]).
applyAppropRule(A,B,C,[[X,Y,Z,_]|Tail], Res, AppliedRule) :-
        A-B-C \= X-Y-Z,
        applyAppropRule(A,B,C,Tail, Res, AppliedRule).

% zoals gevraagd in de opgave
volgendegen(Seq, Rules, Res) :-
        nextLevel(Seq, Rules, Res, _).

% hulppredicaat voor 'volgendegen'. Deze zal zowel het resultaat teruggeven als de lijst van toegepaste regels (belangrijk voor het tweede deel)
nextLevel(Seq, Rules, Res, AppliedRules) :-
        append([o,o|Seq], [o,o], Seq2),
        length(Seq, L),
        LenRes is L + 2,
        length(Res, LenRes),
        subs(Seq2, Rules, [], Res, [], AppliedRules).

% voer 1 substitutie uit, waarbij je het resultaat Res 1 stapje verder instantieert. 
% Dit geeft ook een lijst van toegepaste regels.
subs([A,B,C|T], Rules, Acc, Res, AccRules, AppliedRules) :-
        applyAppropRule(A,B,C,Rules, NewSymbol, AppliedRule),
        append(Acc,[NewSymbol], NewAcc),
        append(NewAcc, _, Res),
        subs([B,C|T], Rules, NewAcc, Res, [AppliedRule | AccRules], AppliedRules).

subs(L, _, _, _, AccRules, AccRules) :-
        L \= [_,_,_|_].        

% zoals gevraagd in de opgave
regels(L, Rules) :-
        search(L, [[o,o,o,o]], UsedRules),
        sort(UsedRules, Rules).

% hulppredicaat voor 'regels'. AccRules geeft de regels die tot nu toe gebruikt zijn.
search([Seq,Seq2|Seqs], AccRules, FinalRules) :-
        append(AccRules, _, Rules),
        nextLevel(Seq, Rules, Seq2, ApplRules),
        append(AccRules, ApplRules, NewRules),
        search([Seq2|Seqs], NewRules, FinalRules).
        
search([_], AccRules, AccRules).