I have been tasked with creating a General Expert System in Prolog which you can plug in different knowledge bases to, so it has to be general. The knowledge base that I have to provide with the Expert System is the Farmer Goat Wolf and Cabbage Puzzle. I am having a really tough time designing the knowledge base and the general inference engine.
After a couple days of searching, I have found a bunch of examples of Expert Systems for the bird hierarchy and some other odds and ends, but they don't seem to help me wrap my head around how to put this project together.
I was just wondering if anyone has some good examples or material of how to design Expert Systems in Prolog or where good places to look are?
Thanks for your help as it is much appreciated.
PS. I would prefer not to purchase material as this is my last month of school and it will be highly unlikely that I will be doing much Prolog programming after this course is finished.
Thanks and Regards,
D
EDIT
Here is my knowledge base.
% Order is Farmer, Goat, Wolf, Cabbage
start_state :: state(west_side, west_side, west_side, west_side).
fact :: current(X, X, X, X) :-
end_state :: state(X, X, X, X),
X = east_side.
move_goat ::
if
state(X, X, W, C) and
opp(X, Y) and
(unsafe(state(Y, Y, W, C)))
then
current(Y, Y, W, C).
move_wolf ::
if
state(X, G, X, C) and
opp(X, Y) and
(unsafe(state(Y, G, Y, C)))
then
current(Y, G, Y, C).
move_cabbage ::
if
state(X, G, W, X) and
opp(X, Y) and
(unsafe(state(Y, G, W, Y)))
then
current(Y, G, W, Y).
% Move the object to the other side of the river
opp(west_side, east_side).
opp(east_side, west_side).
% Is the new state unsafe
fact :: unsafe(state(X,Y,Y,C)) :- opp(X,Y).
fact :: unsafe(state(X,Y,W,Y)) :- opp(X,Y).
Here is the Expert System I am trying to retrofit my knowledge base to.
:-op(900, xfx, ::).
:-op(800, xfx, was).
:-op(880, xfx, then).
:-op(870, fx, if).
:-op(600, xfx, from).
:-op(600, xfx, by).
:-op(550, xfy, or).
:-op(540, xfy, and).
:-op(300, fx, 'derived by').
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
main :-
consult('FarmerKB.pl'),
assertz(lastindex(0)),
assertz(wastold(dummy, false, 0)),
assertz(end_answers(dummy)),
expert.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
expert :-
getquestion(Question),
( answeryes(Question)
;
answerno(Question)
).
answeryes(Question) :-
markstatus(negative),
explore(Question, [], Answer),
positive(Answer),
markstatus(positive),
present(Answer), nl,
write('More Solutions?'),
getreply(Reply),
Reply = no.
answerno(Question) :-
retract(no_positive_answer_yet), !,
explore(Question, [], Answer),
negative(Answer),
present(Answer), nl,
write('More Negative Solutions?'),
getreply(Reply),
Reply = no.
markstatus(negative) :-
assertz(no_positive_answer_yet).
markstatus(positive) :-
retract(no_positive_answer_yet), !
;
true.
getquestion(Question) :-
nl, write('Question Please'), nl,
read(Question).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
explore(Goal, Trace, Goal is true was 'found as a fact') :-
fact :: Goal.
explore(Goal, Trace, Goal is TruthValue was 'derived by' Rule from Answer) :-
Rule :: if Condition then Goal,
explore(Condition, [Goal by Rule | Trace], Answer),
truth(Answer, TruthValue).
explore(Goal1 and Goal2, Trace, Answer) :- !,
explore(Goal1, Trace, Answer1),
continue(Answer1, Goal1 and Goal2, Trace, Answer).
explore(Goal1 or Goal2, Trace, Answer) :-
exploreyes(Goal1, Trace, Answer)
;
exploreyes(Goal2, Trace, Answer).
explore(Goal1 or Goal2, Trace, Answer1 and Answer2) :- !,
not(exploreyes(Goal1, Trace, _)),
not(exploreyes(Goal2, Trace, _)),
explore(Goal1, Trace, Answer1),
explore(Goal2, Trace, Answer2).
explore(Goal, Trace, Goal is Answer was told) :-
useranswer(Goal, Trace, Answer).
exploreyes(Goal, Trace, Answer) :-
explore(Goal, Trace, Answer),
positive(Answer).
continue(Answer1, Goal1 and Goal2, Trace, Answer) :-
positive(Answer1),
explore(Goal2, Trace, Answer2),
( positive(Answer2),
Answer = Answer1 and Answer2
;
negative(Answer2),
Answer = Answer2
).
continue(Answer1, Goal1 and Goal2, _, Answer1) :-
negative(Answer1).
truth(Question is TruthValue was found, TruthValue) :- !.
truth(Answer1 and Answer2, TruthValue) :-
truth(Answer1, true),
truth(Answer2, true), !,
TruthValue = true
;
TruthValue = false.
positive(Answer) :-
truth(Answer, true).
negative(Answer) :-
truth(Answer, false).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
getreply(Reply) :-
read(Answer),
means(Answer, Reply), !
;
nl, write('Answer unknown, try again please'), nl,
getreply(Reply).
means(yes, yes).
means(y, yes).
means(no, no).
means(n, no).
means(why, why).
means(w, why).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
useranswer(Goal, Trace, Answer) :-
askable(Goal, _),
freshcopy(Goal, Copy),
useranswer(Goal, Copy, Trace, Answer, 1).
useranswer(Goal, _, _, _, N) :-
N > 1,
instantiated(Goal), !,
fail.
useranswer(Goal, Copy, _, Answer, _) :-
wastold(Copy, Answer, _),
instance_of(Copy, Goal), !.
useranswer(Goal, _, _, true, N) :-
wastold(Goal, true, M),
M >= N.
useranswer(Goal, Copy, _, Answer, _) :-
end_answers(Copy),
instance_of(Copy, Goal), !,
fail.
useranswer(Goal, _, Trace, Answer, N) :-
askuser(Goal, Trace, Answer, N).
askuser(Goal, Trace, Answer, N) :-
askable(Goal, ExternFormat),
format(Goal, ExternFormat, Question, [], Variables),
ask(Goal, Question, Variables, Trace, Answer, N).
ask(Goal, Question, Variables, Trace, Answer, N) :-
nl,
( Variables = [], !,
write('Is it true:')
;
write('Any (more) solution to:')
),
write(Question), write('?'),
getreply(Reply), !,
process(Reply, Goal, Question, Variables, Trace, Answer, N).
process(why, Goal, Question, Variables, Trace, Answer, N) :-
showtrace(Trace),
ask(Goal, Question, Variables, Trace, Answer, N).
process(yes, Goal, _, Variables, Trace, true, N) :-
nextindex(Next),
Next1 is Next + 1,
( askvars(Variables),
assertz(wastold(Goal, true, Next))
;
freshcopy(Goal, Copy),
useranswer(Goal, Copy, Trace, Answer, Next1)
).
process(no, Goal, _, _, _, false, N) :-
freshcopy(Goal, Copy),
wastold(Copy, true, _), !,
assertz(end_answers(Goal)),
fail
;
nextindex(Next),
assertz(wastold(Goal, false, Next)).
format(Var, Name, Name, Vars, [Var/Name | Vars]) :-
var(Var), !.
format(Atom, Name, Atom, Vars, Vars) :-
atomic(Atom), !,
atomic(Name).
format(Goal, Form, Question, Vars0, Vars) :-
Goal =..[Functor | Args1],
Form =..[Functor | Forms],
formatall(Args1, Forms, Args2, Vars0, Vars),
Question =..[Functor | Args2].
formatall([], [], [], Vars, Vars).
formatall([X | XL], [F | FL], [Q | QL], Vars0, Vars) :-
formatall(XL, FL, QL, Vars0, Vars1),
format(X, F, Q, Vars1, Vars).
askvars([]).
askvars([Variable/Name | Variables]) :-
nl, write(Name), write(' = '),
read(Variable),
askvars(Variables).
showtrace([]) :-
nl, write('This was you question'), nl.
showtrace([Goal by Rule | Trace]) :-
nl, write('To investigate, by'),
write(Rule), write(','),
write(Goal),
showtrace(Trace).
instantiated(Term) :-
numbervars(Term, 0, 0).
instance_of(Term, Term1) :-
freshcopy(Term1, Term2),
numbervars(Term2, 0, _), !,
Term = Term2.
freshcopy(Term, FreshTerm) :-
asserta(copy(Term)),
retract(copy(FreshTerm)), !.
nextindex(Next) :-
retract(lastindex(Last)), !,
Next is Last + 1,
assertz(lastindex(Next)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
present(Answer) :-
nl, showconclusion(Answer),
nl, write('Would you like to see how?'),
getreply(Reply),
( Reply = yes, !,
show(Answer)
;
true
).
showconclusion(Answer1 and Answer2) :- !,
showconclusion(Answer1), write('and '),
showconclusion(Answer2).
showconclusion(Conclusion was Found) :-
write(Conclusion).
show(Solution) :-
nl, show(Solution0), !.
show(Answer1 and Answer2, H) :- !,
show(Answer1, H),
tab(H), write(and), nl,
show(Answer2, H).
show(Answer was Found, H) :-
tab(H), writeans(Answer),
nl, tab(H),
write('was '),
show1(Found, H).
show1(Derived from Answer, H) :- !,
write(Derived), write('from'),
nl, H1 is H + 4,
show(Answer, H1).
show1(Found, _) :-
write(Found), nl.
writeans(Goal is true) :- !,
write(Goal).
writeans(Answer) :-
write(Answer).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Negate the current statement
not(P) :-
P, !, fail
;
true.
Thanks,
D
For people that are struggling with similar issues, I was able to work with the tutorial from amzi.com and George Luger's examples to come up with a working knowledge base / Expert System for the Farmer and Goat problem.
http://www.amzi.com/ExpertSystemsInProlog/xsiptop.php
http://www.cs.unm.edu/~luger/
http://www.cs.unm.edu/~luger/ai-final/code/
As this was the toughest part I am only posting the knowledge base.
rule((move(St1, Cu1) :-
(start(state(St1, St2, St3, St4)),
switch(state(St1, St2, St3, St4), state(Cu1, Cu2, Cu3, Cu4), [state(St1, St2, St3, St4)]))), 100).
start(state(east_side, east_side, east_side, east_side)).
end(state(west_side, west_side, west_side, west_side)).
switch(state(F1, G1, W1, C1), state(F2, G2, W2, C2), History) :-
is_end(state(F1, G1, W1, C1))
;
move_state(state(F1, G1, W1, C1), state(F2, G2, W2, C2)),
not(is_history(state(F2, G2, W2, C2), History)),
switch(state(F2, G2, W2, C2), state(F3, G3, W3, C3), [state(F2, G2, W2, C2)|History]).
move_state(state(X,X,W,C), state(Y,Y,W,C)) :-
opp(X,Y), not(unsafe(state(Y,Y,W,C))).
move_state(state(X,G,X,C), state(Y,G,Y,C)) :-
opp(X,Y), not(unsafe(state(Y,G,Y,C))).
move_state(state(X,G,W,X), state(Y,G,W,Y)) :-
opp(X,Y), not(unsafe(state(Y,G,W,Y))).
move_state(state(X,G,W,C), state(Y,G,W,C)) :-
opp(X,Y), not(unsafe(state(Y,G,W,C))).
opp(east_side, west_side).
opp(west_side, east_side).
unsafe(state(X, Y, Y, C)) :- opp(X, Y).
unsafe(state(X, Y, W, Y)) :- opp(X, Y).
is_end(state(F1, G1, W1, C1)) :-
end(state(Side1, Side2, Side3, Side4)),
Side1 == F1, Side2 == G1,
Side3 == W1, Side4 == C1.
is_history(state(F1, G1, W1, C1), []) :-
fail.
is_history(state(F1, G1, W1, C1), [HisHead|HisTail]) :-
state(F1, G1, W1, C1) == HisHead
;
is_history(state(F1, G1, W1, C1), HisTail).
% This has to be added if there are no ask-able questions otherwise the program will fail
askable(test).
I'm attempting to write a Prolog meta-interpreter to choose the order of goal execution, for example executing first all goals with the minimum number of parameters.
I started from the vanilla meta-interpreter:
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- solve2(A), solve2(B).
solve2(A) :- clause(A,B), solve2(B).
Then i went to something like
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- count(A,Args), count(B,Args2), Args<Args2, solve2(A), solve2(B).
solve2((A,B)) :- count(A,Args), count(B,Args2), Args>Args2, solve2(B), solve2(A).
solve2(A) :- clause(A,B), solve2(B).
But if the 4th line is executed then the whole block B is executed before A which is wrong.
Ex. A=a(x,y), B=(b(x,y,z), c(x)) I'd like to execute c, then a, then b. - while in this method i'd get c, b and then a.
I'm thinking about transforming the goals in a list but i'm not too sure.
Any ideas?
Here is an (untested) vanilla meta interpreter, with conjunction order changed. I would be glad if you could try with your data.
solve2(true).
solve2(A) :- builtin(A), !, A.
solve2((A,B)) :- ordering(A,B, C,D), ! /* needed */, solve2(C), solve2(D).
solve2(A) :- clause(A,B), solve2(B).
ordering(A,B, C,D) :-
minargs(A, NA),
minargs(B, NB),
( NA =< NB -> C/D=A/B ; C/D=B/A ).
minargs((A,B), N) :-
minargs(A, NA),
minargs(B, NB),
!, ( NA =< NB -> N=NA ; N=NB ).
minargs(T, N) :-
functor(T, _, N).
edit I tested with this setting:
builtin(writeln(_)).
a(1):-writeln(1).
b(1,2):-writeln(2).
c(1,2,3):-writeln(3).
test :-
solve2((c(A,B,_),a(A),b(A,B))).
and got the expected output:
?- test.
1
2
3
true .
edit I had to resort to a list representation, but then it make sense to preprocess the clauses and get the right order before, then stick to plain vanilla interpreter:
test :-
sortjoin((b(A,B),a(A),c(A,B,_)), X),
solve2(X).
sortjoin(J, R) :-
findall(C-P, (pred(J, P), functor(P,_,C)), L),
sort(L, T),
pairs_values(T, V),
join(V, R).
join([C], C).
join([H|T], (H,R)) :- join(T, R).
pred((A, _), C) :-
pred(A, C).
pred((_, B), C) :-
!, pred(B, C).
pred(C, C).
where solve2((A,B)) :- ... it's the original solve2(A),solve2(B)
I am trying to write a program in Prolog to find a Latin Square of size N.
I have this right now:
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R) :-
permutation(T, X),
delete(H, R, X).
latinSqaure([_]).
latinSquare([A,B|T], N) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
using SWI-Prolog library:
:- module(latin_square, [latin_square/2]).
:- use_module(library(clpfd), [transpose/2]).
latin_square(N, S) :-
numlist(1, N, Row),
length(Rows, N),
maplist(copy_term(Row), Rows),
maplist(permutation, Rows, S),
transpose(S, T),
maplist(valid, T).
valid([X|T]) :-
memberchk(X, T), !, fail.
valid([_|T]) :- valid(T).
valid([_]).
test:
?- aggregate(count,S^latin_square(4,S),C).
C = 576.
edit your code, once corrected removing typos, it's a verifier, not a generator, but (as noted by ssBarBee in a deleted comment), it's flawed by missing test on not adjacent rows.
Here the corrected code
delete(X, [X|T], T).
delete(X, [H|T], [H|S]) :-
delete(X, T, S).
permutation([], []).
permutation([H|T], R):-
permutation(T, X),
delete(H, R, X).
latinSquare([_]).
latinSquare([A,B|T]) :-
permutation(A,B),
isSafe(A,B),
latinSquare([B|T]).
isSafe([], []).
isSafe([H1|T1], [H2|T2]) :-
H1 =\= H2,
isSafe(T1, T2).
and some test
?- latinSquare([[1,2,3],[2,3,1],[3,2,1]]).
false.
?- latinSquare([[1,2,3],[2,3,1],[3,1,2]]).
true .
?- latinSquare([[1,2,3],[2,3,1],[1,2,3]]).
true .
note the last test it's wrong, should give false instead.
Like #CapelliC, I recommend using CLP(FD) constraints for this, which are available in all serious Prolog systems.
In fact, consider using constraints more pervasively, to benefit from constraint propagation.
For example:
:- use_module(library(clpfd)).
latin_square(N, Rows, Vs) :-
length(Rows, N),
maplist(same_length(Rows), Rows),
maplist(all_distinct, Rows),
transpose(Rows, Cols),
maplist(all_distinct, Cols),
append(Rows, Vs),
Vs ins 1..N.
Example, counting all solutions for N = 4:
?- findall(., (latin_square(4,_,Vs),labeling([ff],Vs)), Ls), length(Ls, L).
L = 576,
Ls = [...].
The CLP(FD) version is much faster than the other version.
Notice that it is good practice to separate the core relation from the actual search with labeling/2. This lets you quickly see that the core relation terminates also for larger N:
?- latin_square(20, _, _), false.
false.
Thus, we directly see that this terminates, hence this plus any subsequent search with labeling/2 is guaranteed to find all solutions.
I have better solution, #CapelliC code takes very long time for squares with N length higher than 5.
:- use_module(library(clpfd)).
make_square(0,_,[]) :- !.
make_square(I,N,[Row|Rest]) :-
length(Row,N),
I1 is I - 1,
make_square(I1,N,Rest).
all_different_in_row([]) :- !.
all_different_in_row([Row|Rest]) :-
all_different(Row),
all_different_in_row(Rest).
all_different_in_column(Square) :-
transpose(Square,TSquare),
all_different_in_row(TSquare).
all_different_in_column1([[]|_]) :- !.
all_different_in_column1(Square) :-
maplist(column,Square,Column,Rest),
all_different(Column),
all_different_in_column1(Rest).
latin_square(N,Square) :-
make_square(N,N,Square),
append(Square,AllVars),
AllVars ins 1..N,
all_different_in_row(Square),
all_different_in_column(Square),
labeling([ff],AllVars).
What I want to do is to delete part of a list specified in another list i.e. e.g.
?- deleteSome([1,4,3,3,2,2],[1,2,4],Z).
Z = [3,3,2].
I first defined the following. No problem there.
deleteOne(X, [X|Z], Z).
deleteOne(X, [V|Z], [V|Y]) :-
X \== V,
deleteOne(X,Z,Y).
Then, the following does not work as expected.
deleteSome([], [], _).
deleteSome([X|Xs], Y, Zs) :-
deleteSome(Xs, Y, [X|Zs]).
deleteSome([X|Xs], Y, Zs) :-
member(X,Y),
deleteOne(X,Y,Y),
deleteSome(Xs, Y, Zs).
I would use the powerful select/3 builtin
deleteSome(L, D, R) :-
select(E, L, L1),
select(E, D, D1),
!, deleteSome(L1, D1, R).
deleteSome(L, _, L).
test:
?- deleteSome([1,4,3,3,2,2],[1,2,4],Z).
Z = [3, 3, 2].
I must admit, I don't understand your deleteSome code at all. Here's what I'd do (no Prolog here, so might contain errors):
deleteSome(X, [], X).
deleteSome(X, [Y|Ys], Z) :-
deleteOne(Y, X, T),
deleteSome(T, Ys, Z).
I.e. If there's nothing to delete, no change. Otherwise, the result is when we delete the first of the to-deletes, and then delete the rest of them.
There is some confusion in that it seems your deleteOne has (Original, ToDelete, Result) parameters, but deleteSome has (ToDelete, Original, Result). For consistency, I'd rather rewrite it so the signatures are compatible:
deleteSome([], Y, Y).
deleteSome([X|Xs], Y, Z) :-
deleteOne(X, Y, T),
deleteSome(Xs, T, Z).