Related
Given a CNF logic formula
[[a, b, c], [b, d], [not(d), a]] that is equal to ((a or b or c) and (b or d) and (not d or a)), how do I calculate its models (possible values for its atoms that makes the formula true), using prolog? This is what i've got so far:
A valuation to the formula is a list of terms in the form os val(X,B), where X is an atom, and B is its value (0 or 1).
The relation value(X, Vs, B) is given by
value(X, [val(X, B)|_], B) :− !.
value(X, [_|Ps], B) :− value(X, Ps, B).
and its true whenever B is the value for the atom X in the valuation Vs.
The relation sp(F, Ss), given by
sp([],[]).
sp([F|Fs], Ss) :- setof(A, member(A,F), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss).
and its true whenever Ss is the list of atoms in logic formula F.
The relation valuation(As, Vs), given by
valuation([],[]).
valuation([A|As], [V|Vs]) :- (V = val(A,0); V = val(A,1)), valuation(As,Vs).
that is true whenever Vs is a possible valuation for the list of atoms As.
What I need:
The relation ext(F, Vs, B) that is true whenever F is a formula, Vs is a possible valuation for that formula, and B is the value of the formula applying Vs valuation. For example, the consult
ext([[a], [not(b), c]] , [val(a, 1), val(b, 0), val(c , 1)], B).
should return the value B = 1.
The relation model(F,Vs) that is true whenever the valuation Vs is a model for the formula F.
The relation models(F, Ms) that is true whenever Ms is a list which elements are models for the formula F. I guess we need to use prolog’s setof here.
And, at last, I don't know whats the best implementation of val(X,B) to make it work. I dont know if I should specify val(_,1) and val(_,0) to be true or only val(_,1), what is better knowing the other relations to be implemented?
Not sure to understand exactly what you want but...
First of all, let me try to simplify your code.
1) I think your value/2 should be written as
value(X, [val(X, B) | _], B).
value(X, [_ | Ps], B) :-
value(X, Ps, B).
2) I don't understand the purpose of your sp/2 but seems to me that can be simplified as
sp([], []).
sp([[A] | Fs], [A | Ss]) :-
sp(Fs, Ss).
sp([[A | As] | Fs], [A | Ss]) :-
append(As, Fs, N),
sp(N, Ss).
3) I don't understand the purpose of your valutation/2 but seems to me that can be simplified as
isBool(0).
isBool(1).
valuation([], []).
valuation([A | As], [val(A, B) | Vs]) :-
isBool(B),
valuation(As,Vs).
Now I try to respond to your question
4)
I need [...] The relation ext(F, Vs, B) that is true whenever F
is a formula, Vs is a possible valuation for that formula, and B
is the value of the formula applying Vs valuation
I suppose the following should work [caution: not tested really much]
ext([], _, 1).
ext([[] |_], _, 0).
ext([[X | L1] | L2], Vs, B) :-
value(X, Vs, 0),
ext([L1 | L2], Vs, B).
ext([[not(X) | L1] | L2], Vs, B) :-
value(X, Vs, 1),
ext([L1 | L2], Vs, B).
ext([[X | _] | L], Vs, B) :-
value(X, Vs, 1),
ext(L, Vs, B).
ext([[not(X) | _] | L], Vs, B) :-
value(X, Vs, 0),
ext(L, Vs, B).
5)
I need [...] The relation model(F,Vs) that is true whenever the
valuation Vs is a model for the formula F
What about the following ?
model(F, Vs) :-
ext(F, Vs, _). % or ext(F, Vs, 1)?
6)
I need [...] The relation models(F, Ms) that is true whenever Ms is a
list which elements are models for the formula F
If I understand correctly what do you want, given model/2, models/2 could be written as
models(_, []).
models(F, [Vs | Vl]) :-
model(F, Vs),
models(F, Vl).
7)
I don't know whats the best implementation of val(X,B) to make it
work. I dont know if I should specify val(,1) and val(,0) to be true
or only val(_,1)
Not sure to understand your question.
val/2 can't be true for every value; so you can't impose true val(_,1) and/or val(_,0) because given an atom (a, by example) is true val(a,1) or val(a,0) but ins't true val(X,1) for every X.
Another approach here. Translate to executable Prolog, and reify a specific execution (i.e. a proof with specific symbol bindings):
ext(F, Vs, B) :-
or_list(F, [], C, Vs), !,
assign(Vs), ( call(C), B = true ; B = false ).
assign(Dict) :- maplist(domain, Dict).
domain(val(_, true)).
domain(val(_, false)).
or_list([A], D, T, Du) :-
!, and_list(A, D, T, Du).
or_list([A|As], D, ( T ; Ts ), Du) :-
and_list(A, D, T, Dut),
or_list(As, Dut, Ts, Du).
and_list([V], D, T, Du) :-
!, negation(V, D, T, Du).
and_list([V|Vs], D, ( T , Ts ), Du) :-
negation(V, D, T, Dut),
and_list(Vs, Dut, Ts, Du).
negation(not(V), D, \+T, Du) :-
!, sym_bind(V, D, T, Du).
negation(V, D, T, Du) :-
sym_bind(V, D, T, Du).
sym_bind(V, D, T, D) :-
memberchk(val(V, T), D), !.
sym_bind(V, D, T, [val(V, T)|D]).
note:
false/true instead of 0/1
list to structure translation: could be way shorter, using foldl or DCGs or passing down the operators (that is (;)/2 (,)/2 (+)/1), but this way the Prolog patterns should be clearer...
I could finally finish it while waiting for replies, and improved it using max66's answer.
I made it to accept propositional logic forms too, so models/2 accepts both styles (CNF and Propositional form, based on operators and, not, or, imp, iff that I set).
:- op(400, fy , not).
:- op(500, xfy, and).
:- op(600, xfy, or ).
:- op(700, xfy, imp).
:- op(800, xfy, iff ).
distr(_, [], []).
distr([], _, []).
distr([C|Cs], Ds, Es) :- distr_un(C, Ds, Ss), distr(Cs, Ds, Ts), append(Ss, Ts, Es).
distr_un(_, [], []).
distr_un(C, [D|Ds], [E|Es]) :- append(C, D, E), distr_un(C, Ds, Es).
cnf(F, [[F]]) :- atom(F), !.
cnf(not(F), [[not(F )]]) :- atom(F), !.
cnf(not not F, Rs) :- cnf(F, Rs).
cnf(not (F imp G), Rs) :- cnf(F and not G, Rs).
cnf(not (F iff G), Rs) :- cnf((F and not G) or (not F and G), Rs).
cnf(not(F and G), Rs) :- cnf((not F) or (not G), Rs).
cnf(not(F or G), Rs) :- cnf((not F) and (not G), Rs).
cnf(F and G, Rs) :- cnf(F, Cs), cnf(G, Ds), append(Cs, Ds, Rs).
cnf(F or G, Rs) :- cnf(F, Cs), cnf(G, Ds), distr(Cs, Ds, Rs).
cnf(F imp G, Rs) :- cnf((not F) or G, Rs).
cnf(F iff G, Rs) :- cnf((not F or G) and (not G or F), Rs).
val(X,0) :- atom(X).
val(X,1) :- atom(X).
value(X, [val(X, B)|_], B) :- !.
value(X, [_|Ps], B) :- value(X, Ps, B), !.
value(not X, [val(X, B)|_], V) :- V is 1-B, !.
value(not X, [_|Ps], B) :- value(not X, Ps, B), !.
sp([],[]).
sp([F|Fs], Ss) :- setof(A1, member(not A1, F), R1), setof(A, (member(A,F), atom(A)), R), sp(Fs, N), append(R,N,M1), append(M1, R1, M), setof(B,member(B,M),Ss), !.
sp([F|Fs], Ss) :- setof(A, (member(A,F), atom(A)), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss), !.
sp([F|Fs], Ss) :- setof(A, (member(not A,F), atom(A)), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss), !.
valuation([],[]).
valuation([A|As], [V|Vs]) :- (V = val(A,0); V = val(A,1)), valuation(As,Vs).
ext([F|Fs], Vs, B) :- sp([F|Fs], Ss), valuation(Ss, Vs), ext_([F|Fs], Vs, B).
ext_([], _, 1).
ext_([F|Fs], Vs, 1) :- cl(F, Vs, 1), ext_(Fs, Vs, 1).
ext_([F|Fs], Vs, 0) :- cl(F, Vs, 0); ext_(Fs, Vs, 0).
cl([A|As], Vs, 1) :- value(A,Vs,1); cl(As, Vs, 1).
cl([A|As], Vs, 0) :- value(A,Vs,0), cl(As,Vs,0).
cl([], _, 0).
model(F, Vs) :- ext(F, Vs, 1).
models(F, Vs) :- cnf(F, Fs), setof(V, model(Fs, V), Vs).
models(F, Vs) :- setof(V, model(F, V), Vs).
I tested it and it seems to be working as intended.
I am reading the book Thinking as Computation and wrote the code as chapter 9.4:
plan(L) :-
initial_state(I),
goal_state(G),
reachable(I, L, G).
initial_state([]).
legal_move(S, A, [A | S]) :-
poss(A, S).
goal_state(S) :-
has_bananas(S).
reachable(S, [], S).
reachable(S1, [M | L], S3) :-
legal_move(S1, M, S2),
reachable(S2, L, S3).
location(box, loc3, []).
location(box, L, [push(L) | _]).
location(box, L, [A | S]) :-
\+ A = push(L),
location(box, L, S).
location(bananas, loc1, _).
location(monkey, loc2, []).
location(monkey, L, [push(L) | _]).
location(monkey, L, [go(L) | _]).
location(monkey, L, [climb_off | S]) :-
location(monkey, L, S).
location(monkey, L, [A | S]) :-
\+ A = push(_), \+ A = go(_), location(monkey, L, S).
on_box([climb_on | _]).
on_box([A | S]) :- \+ A = climb_off, on_box(S).
has_bananas([grab | S]) .
has_bananas([_ | S]) :- has_bananas(S).
poss(climb_off, S) :- on_box(S).
poss(go(_), S) :- \+ on_box(S).
poss(grab, S) :-
on_box(S), location(box, L, S), location(bananas, L, S).
poss(push(_), S) :- poss(climb_on, S).
poss(climb_on, S) :-
\+ on_box(S), location(box, L, S), location(monkey, L, S).
But I found that the program never stops... After printing the stack info, I found that goal_state generates lists of infinite length. I tried to constrain the length of the lists in has_banana
has_bananas([grab | S], N) :- length(S, NS), NS is N - 1.
has_bananas([_ | S], N) :- \+ N = 0, has_bananas(S, N - 1).
which N refers to the length of L in plan(L) (e.g. N is 4 when query plan([M1, M2, M3, M4])) But it doesn't work.
Is there any solution?
Non-termination is a very tricky business in Prolog, in particular if you are used to different more command-oriented programming languages. It is very tempting to try to understand the issue step-by-step. But very often that leads to nowhere in Prolog.
Instead, consider to modify your program. Just a little bit. And in a manner that it is easy to predict what the effect of your modifications will be. For example, add false goals into your program. What will their effect be? Well, not much: These goals will reduce the number of inferences. And maybe, they will also reduce the set of solutions found. But for the moment, let's stick to the number of inferences. You have encountered a case, where your program does not terminate for:
?- length(L, 4), plan(L).
In fact, you find a plan, but then it all goes into a loop. In terms of numbers of inferences, you have infinitely many1.
To localize the responsible part, let's add some false goals into your program. Add them such that the numbers of inferences is still infinite.
This is what I came up with:
?- length(L, 4), plan(L).
plan(L) :-
initial_state(I),
goal_state(G), false,
reachable(I, L, G).
initial_state([]).
goal_state(S) :-
has_bananas(S), false.
has_bananas([grab | S]) :- false.
has_bananas([_ | S]) :-
has_bananas(S), false.
This fragment of your program (called a failure-slice) alone is responsible for non-termination. If you are unhappy with it, you will have to modify something in the remaining visible part. If not, there is no hope to remove the non-termination.
My suggestion is that you change the order of the two goals in plan to:
plan(L) :-
initial_state(I),
reachable(I, L, G),
goal_state(G).
1) That's an idealization for all will crumble to dust in no time compared to infinity.
I am working on a project involving graphs, and I have a list of attribute variables, each representing a node in the graph. Each node has several attributes, such as adjacent nodes, distance to start node, etc. I want to remove a single node from the list, but when I use delete, I get the following error:
ERROR: uhook/3: Undefined procedure: adjs:attr_unify_hook/2
For example, I get this error if I include delete(OldVertices, Node, NewVertices) in my program.
I also get the exact same error if I am storing my vertices in a binary heap, and try to delete a vertex from the heap using delete_from_heap.
I was able to successfully use delete and delete_from_heap on the node if I first delete all of its attributes, but this causes problems for my program because I want to use the attributes later on; I just don't want the node to be contained in the list or binary heap.
Is this a bug, or am I handling attribute variables incorrectly?
EDIT:
Thanks! That works for lists. Now I am trying to do something similar for deleting attribute variables from binary heaps. I have a rule
delheap(Heap, Key, NewHeap) :-
delete_from_heap(Heap, A1, A0, NewHeap),
get_attr(Key, dist, A1),
A0 == Key.
However when I am testing I get the following results:
?- TLO = [3-A, 4-B], put_attr(A, dist, 3), put_attr(B, dist, 4), list_to_heap(TLO, H), delheap(H, A, Hq).
Correct to: "dijkstra_av:delheap(H,A,Hq)"? yes
TLO = [3-A, 4-B], H = heap(t(A, 3, [t(B, 4, [])]), 2), Hq = heap(t(B, 4, []), 1), put_attr(A, dist, 3), put_attr(B, dist, 4).
Which works fine, but when I try with B :
?- TLO = [3-A, 4-B], put_attr(A, dist, 3), put_attr(B, dist, 4), list_to_heap(TLO, H), delheap(H, B, Hq).
Correct to: "dijkstra_av:delheap(H,A,Hq)"? yes
TLO = [3-A, 4-B], false.
EDIT 2:
I was able to get it working by calling delete_from_heap with the priority and not the key, however, this does cause problems if two items has the same priority and it picks the wrong one. In my application this problem does not often arise, but it does seem like generally there should be a better way of using attribute variables with existing rules.
You are accidentally unifying a variable that has attributes attached with another term. Unifications that involve attributed variables trigger attr_unify_hook/2 in the corresponding modules, and you do not define such hooks, since you only use attributes as a quick way to access data and probably have no interest in any unifications among these variables.
To remove a variable from a list, use for example (==)/2:
list0_var_list(Ls0, V, Ls) :-
select(V0, Ls0, Ls),
V0 == V.
Sample query:
?- list0_var_list([A,B,C,D], B, Ls).
Ls = [A, C, D] ;
false.
Note that this still leaves a choicepoint. You can use once/1 to commit to the first and only solution, since you already know that each node in the list is unique:
?- once(list0_var_list([A,B,C,D], B, Ls)).
Ls = [A, C, D].
Using such a predicate instead of delete/3 lets you safely detect equality of variables and remove a given one from a list, without triggering any unification hooks.
Notice also that delete/3 is deprecated (see the documentation), and consider the following case:
?- delete([A,B,C], A, Cs).
Cs = [].
This shows that you cannot safely use delete/3 when variables are involved.
my own test using attributed variables for graph representation. I remember I found difficult to adapt to the particular programming style required. HTH
/* File: dijkstra_av.pl
Author: Carlo,,,
Created: Aug 3 2012
Modified:Oct 28 2012
Purpose: learn graph programming with attribute variables
*/
:- module(dijkstra_av, [dijkstra_av/3,
dijkstra_edges/3]).
dijkstra_av(Graph, Start, Solution) :-
setof(X, Y^D^(member(d(X,Y,D), Graph) ; member(d(Y,X,D), Graph)), Xs),
length(Xs, L),
length(Vs, L),
aggregate_all(sum(D), member(d(_, _, D), Graph), Infinity),
catch((algo(Graph, Infinity, Xs, Vs, Start, Solution),
throw(sol(Solution))
), sol(Solution), true).
dijkstra_edges(Graph, Start, Edges) :-
dijkstra_av(Graph, Start, Solution),
maplist(nodes_to_edges(Graph), Solution, Edges).
nodes_to_edges(Graph, s(Node, Dist, Nodes), s(Node, Dist, Edges)) :-
join_nodes(Graph, Nodes, Edges).
join_nodes(_Graph, [_Last], []).
join_nodes(Graph, [N,M|Ns], [e(N,M,D)|Es]) :-
aggregate_all(min(X), member(d(N, M, X), Graph), D),
join_nodes(Graph, [M|Ns], Es).
algo(Graph, Infinity, Xs, Vs, Start, Solution) :-
pairs_keys_values(Ps, Xs, Vs),
maplist(init_adjs(Ps), Graph),
maplist(init_dist(Infinity), Ps),
%ord_memberchk(Start-Sv, Ps),
memberchk(Start-Sv, Ps),
put_attr(Sv, dist, 0),
time(main_loop(Vs)),
maplist(solution(Start), Vs, Solution).
solution(Start, V, s(N, D, [Start|P])) :-
get_attr(V, name, N),
get_attr(V, dist, D),
rpath(V, [], P).
rpath(V, X, P) :-
get_attr(V, name, N),
( get_attr(V, previous, Q)
-> rpath(Q, [N|X], P)
; P = X
).
init_dist(Infinity, N-V) :-
put_attr(V, name, N),
put_attr(V, dist, Infinity).
init_adjs(Ps, d(X, Y, D)) :-
%ord_memberchk(X-Xv, Ps),
%ord_memberchk(Y-Yv, Ps),
memberchk(X-Xv, Ps),
memberchk(Y-Yv, Ps),
adj_add(Xv, Yv, D),
adj_add(Yv, Xv, D).
adj_add(X, Y, D) :-
( get_attr(X, adjs, L)
-> put_attr(X, adjs, [Y-D|L])
; put_attr(X, adjs, [Y-D])
).
main_loop([]).
main_loop([Q|Qs]) :-
smallest_distance(Qs, Q, U, Qn),
put_attr(U, assigned, true),
get_attr(U, adjs, As),
update_neighbours(As, U),
main_loop(Qn).
smallest_distance([A|Qs], C, M, [T|Qn]) :-
get_attr(A, dist, Av),
get_attr(C, dist, Cv),
( Av < Cv
-> (N,T) = (A,C)
; (N,T) = (C,A)
),
!, smallest_distance(Qs, N, M, Qn).
smallest_distance([], U, U, []).
update_neighbours([V-Duv|Vs], U) :-
( get_attr(V, assigned, true)
-> true
; get_attr(U, dist, Du),
get_attr(V, dist, Dv),
Alt is Du + Duv,
( Alt < Dv
-> put_attr(V, dist, Alt),
put_attr(V, previous, U)
; true
)
),
update_neighbours(Vs, U).
update_neighbours([], _).
:- begin_tests(dijkstra_av).
small([d(a,b,2),d(a,b,1),d(b,c,1),d(c,d,1),d(a,d,3),d(a,d,2)]).
test(1) :-
nl,
small(S),
time(dijkstra_av(S, a, L)),
maplist(writeln, L).
test(2) :-
open(salesman, read, F),
readf(F, L),
close(F),
nl,
dijkstra_av(L, penzance, R),
maplist(writeln, R).
readf(F, [d(X,Y,D)|R]) :-
read(F, dist(X,Y,D)), !, readf(F, R).
readf(_, []).
test(3) :-
nl, small(S),
time(dijkstra_edges(S, a, Es)),
maplist(writeln, Es).
:- end_tests(dijkstra_av).
the presence of test unit allows for:
?- run_tests(dijkstra_av).
% PL-Unit: dijkstra_av
% 122 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 1015009 Lips)
% 475 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 283613 Lips)
s(a,0,[a])
s(b,1,[a,b])
s(c,2,[a,b,c])
s(d,2,[a,d])
.
ERROR: /home/carlo/prolog/dijkstra_av.pl:115:
test 2: received error: open/3: source_sink `salesman' does not exist (No such file or directory)
% 122 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 2027285 Lips)
% 619 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 899941 Lips)
s(a,0,[])
s(b,1,[e(a,b,1)])
s(c,2,[e(a,b,1),e(b,c,1)])
s(d,2,[e(a,d,2)])
Warning: /home/carlo/prolog/dijkstra_av.pl:127:
PL-Unit: Test 3: Test succeeded with choicepoint
done
% 1 test failed
% 2 tests passed
false.
with time passing, something has been lost... sorry
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've been trying for a while now to implement a Dijkstra shortest path algorithm in JIProlog. There are a few implementations available online, such as here and here, but they all return the path as a list of nodes. This is problematic for my implementation, because I'm technically using a multigraph, where vertices can be connected by multiple edges. Therefore, I need an algorithm that returns a list of edges rather than a list of nodes.
I've been trying to adjust the first implementation I mentioned to track edges, but I get lost in the dijkstra_l/3 rule. Could someone help me? Thanks!
I answered some time ago to a similar question, with an implementation.
Alas, that code doesn't work with the lastes SWI-Prlog, I've debugged and found that ord_memberchk (used for efficiency) has changed behaviour. I've replaced with memberchk and now is working...
I would suggest to use the output of the algorithm with a simple post processing pass that recovers the edges from nodes, selecting the smaller value. I've implemented as it dijkstra_edges/3
/* File: dijkstra_av.pl
Author: Carlo,,,
Created: Aug 3 2012
Modified:Oct 28 2012
Purpose: learn graph programming with attribute variables
*/
:- module(dijkstra_av, [dijkstra_av/3,
dijkstra_edges/3]).
dijkstra_av(Graph, Start, Solution) :-
setof(X, Y^D^(member(d(X,Y,D), Graph) ; member(d(Y,X,D), Graph)), Xs),
length(Xs, L),
length(Vs, L),
aggregate_all(sum(D), member(d(_, _, D), Graph), Infinity),
catch((algo(Graph, Infinity, Xs, Vs, Start, Solution),
throw(sol(Solution))
), sol(Solution), true).
dijkstra_edges(Graph, Start, Edges) :-
dijkstra_av(Graph, Start, Solution),
maplist(nodes_to_edges(Graph), Solution, Edges).
nodes_to_edges(Graph, s(Node, Dist, Nodes), s(Node, Dist, Edges)) :-
join_nodes(Graph, Nodes, Edges).
join_nodes(_Graph, [_Last], []).
join_nodes(Graph, [N,M|Ns], [e(N,M,D)|Es]) :-
aggregate_all(min(X), member(d(N, M, X), Graph), D),
join_nodes(Graph, [M|Ns], Es).
algo(Graph, Infinity, Xs, Vs, Start, Solution) :-
pairs_keys_values(Ps, Xs, Vs),
maplist(init_adjs(Ps), Graph),
maplist(init_dist(Infinity), Ps),
%ord_memberchk(Start-Sv, Ps),
memberchk(Start-Sv, Ps),
put_attr(Sv, dist, 0),
time(main_loop(Vs)),
maplist(solution(Start), Vs, Solution).
solution(Start, V, s(N, D, [Start|P])) :-
get_attr(V, name, N),
get_attr(V, dist, D),
rpath(V, [], P).
rpath(V, X, P) :-
get_attr(V, name, N),
( get_attr(V, previous, Q)
-> rpath(Q, [N|X], P)
; P = X
).
init_dist(Infinity, N-V) :-
put_attr(V, name, N),
put_attr(V, dist, Infinity).
init_adjs(Ps, d(X, Y, D)) :-
%ord_memberchk(X-Xv, Ps),
%ord_memberchk(Y-Yv, Ps),
memberchk(X-Xv, Ps),
memberchk(Y-Yv, Ps),
adj_add(Xv, Yv, D),
adj_add(Yv, Xv, D).
adj_add(X, Y, D) :-
( get_attr(X, adjs, L)
-> put_attr(X, adjs, [Y-D|L])
; put_attr(X, adjs, [Y-D])
).
main_loop([]).
main_loop([Q|Qs]) :-
smallest_distance(Qs, Q, U, Qn),
put_attr(U, assigned, true),
get_attr(U, adjs, As),
update_neighbours(As, U),
main_loop(Qn).
smallest_distance([A|Qs], C, M, [T|Qn]) :-
get_attr(A, dist, Av),
get_attr(C, dist, Cv),
( Av < Cv
-> (N,T) = (A,C)
; (N,T) = (C,A)
),
!, smallest_distance(Qs, N, M, Qn).
smallest_distance([], U, U, []).
update_neighbours([V-Duv|Vs], U) :-
( get_attr(V, assigned, true)
-> true
; get_attr(U, dist, Du),
get_attr(V, dist, Dv),
Alt is Du + Duv,
( Alt < Dv
-> put_attr(V, dist, Alt),
put_attr(V, previous, U)
; true
)
),
update_neighbours(Vs, U).
update_neighbours([], _).
:- begin_tests(dijkstra_av).
small([d(a,b,2),d(a,b,1),d(b,c,1),d(c,d,1),d(a,d,3),d(a,d,2)]).
test(1) :-
nl,
small(S),
time(dijkstra_av(S, a, L)),
maplist(writeln, L).
test(2) :-
open('salesman.pl', read, F),
readf(F, L),
close(F),
nl,
dijkstra_av(L, penzance, R),
maplist(writeln, R).
readf(F, [d(X,Y,D)|R]) :-
read(F, dist(X,Y,D)), !, readf(F, R).
readf(_, []).
test(3) :-
nl, small(S),
time(dijkstra_edges(S, a, Es)),
maplist(writeln, Es).
:- end_tests(dijkstra_av).
test(3) shows the implementation, I've added some edge with higher values to verify, the output shows that these are correctly discarded:
s(a,0,[])
s(b,1,[e(a,b,1)])
s(c,2,[e(a,b,1),e(b,c,1)])
s(d,2,[e(a,d,2)])