Prolog Expert System for the Farmer Goat Wolf Cabbage Puzzle

Question

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

Answer 1

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