Monkey and banana in Thinking as Computation - prolog

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.

Related

How add finitely failed branches to a Prolog visualizer?

Assume we want to visualize this Prolog execution. No goals from the fidschi islands, or something else exotic assumed, only good old SLDNF
with the default selection rule:
p(a).
p(b).
?- \+ p(c).
Yes
But we have only a Prolog visualizer that can show derivations
without negation as failure, like here. How can we boost
the Prolog visualizer to also show negation as failure?
The good thing about negation as failure, writing a meta interpreter for negation as failure is much easier, than writing a meta interpreter for cut (!). So basically the vanilla interpreter for SLDNF can be derived from the vanilla interpreter for SLD by inserting one additional rule:
solve(true) :- !.
solve((A,B)) :- !, solve(A), solve(B).
solve((\+ A)) :- !, \+ solve(A). /* new */
solve(H) :- functor(H, F, A), sys_rule(F/A, H, B), solve(B).
We can now go on and extend solve/3 from here in the same vain. But we do something more, we also write out failure branches in the search tree, similar like Prolog visualizer does by strikethrough of a clause. So the amended solve/3 is as follows:
% solve(+Goal, +Assoc, +Integer, -Assoc)
solve(true, L, _, L) :- !.
solve((A, B), L, P, R) :- !, solve(A, L, P, H), solve(B, H, P, R).
solve((\+ A), L, P, L) :- !, \+ solve(A, L, P, _). /* new */
solve(H, L, P, R) :- functor(H, F, A), sys_rule(F/A, J, B),
callable_property(J, sys_variable_names(N)),
number_codes(P, U), atom_codes(V, [0'_|U]), shift(N, V, W),
append(L, W, M),
(H = J -> true; offset(P), write(fail), nl, fail), /* new */
reverse(M, Z), triage(M, Z, I, K),
offset(P), write_term(I, [variable_names(Z)]), nl,
O is P+1, solve(B, K, O, R).
Here is an example run:
?- ?- \+ p(c).
fail
fail
Yes
See also:
AI Algorithms, Data Structures and Idioms
CH6: Three Meta-Interpreters
Georg F. Luger - Addison-Wesley 2009
https://www.cs.unm.edu/~luger/

Calculation logic formula models with prolog

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.

Prolog Shift n times a list function either way

I have to define a predicate nshift/3 that shift a list N times either way.
Examples:
?- nshift(3,[a,b,c,d,e,f,g,h],Shifted).
Shifted = [d,e,f,g,h,a,b,c]
?-­nshift(1,[1,2,3,4,5],Shifted).
Shifted = [2,3,4,5,1]
?-­nshift(-2,[a,b,c,d,e,f,g,h],Shifted).
Shifted = [g,h,a,b,c,d,e,f]
I created a code that would take care of the first two examples but I'm having problem with the last example where the N time is -2. Can somebody help me.
My code:
my_shift([], []).
my_shift([H|T], L) :-
append(T, [H], L).
nshift(0, L, L) :- !.
nshift(N, L1, L2) :-
N1 is N-1,
my_shift(L1, L),
nshift(N1, L, L2).
I have this old code
rotate(right, L, [T|H]) :- append(H, [T], L).
rotate(left, [H|T], L) :- append(T, [H], L).
Then, I think you could adapt your nshift/3 testing if the first argument is < 0, something like
nshift(0, L, L) :- !.
nshift(N, L1, L2) :-
N < 0, rotate(right, L1, L), N1 is N+1, nshift(N1, L, L2).
nshift(N, L1, L2) :-
N > 0, rotate(left, L1, L), N1 is N-1, nshift(N1, L, L2).
As hinted in another answer, your type of shift is usually called rotate. Rotates with non-negative N can be written in a nicely declarative way as
naive_rotate(N, Xs, Ys) :-
length(Bs, N),
append(As, Bs, Xs),
append(Bs, As, Ys).
While this works, people will be quick to point out that its termination properties are poor: when you backtrack into rotate/3, i.e. ask for more solutions, it will not terminate. This can be addressed by adding redundant conditions on the list lengths, viz.
rotate(N, Xs, Ys) :-
same_length(Xs, Ys),
leq_length(Bs, Xs),
length(Bs, N),
append(As, Bs, Xs),
append(Bs, As, Ys).
same_length([], []).
same_length([_|Xs], [_|Ys]) :- same_length(Xs, Ys).
leq_length([], _).
leq_length([_|Xs], [_|Ys]) :- leq_length(Xs, Ys).
This now works nicely for various query patterns, e.g.
?- rotate(2, [a,b,c,d,e], Ys). % gives Ys = [d,e,a,b,c]
?- rotate(2, Xs, [a,b,c,d,e]). % gives Xs = [c,d,e,a,b]
?- rotate(N, [a,b,c,d,e], Ys). % 5 solutions
?- rotate(N, Xs, [a,b,c,d,e]). % 5 solutions
?- rotate(N, Xs, Ys). % many solutions
You can then write your original nshift/3 as
nshift(N, Xs, Ys) :-
( N>=0 -> rotate(N, Xs, Ys) ; M is -N, rotate(M, Ys, Xs) ).

How to calculate all the possible divisions in a list?

I found this predicate for the calculation of all possible sums.
subset_sum(0,[],[]).
subset_sum(N,[_|Xs],L) :-
subset_sum(N,Xs,L).
subset_sum(N,[X|Xs],[X|Rest]) :-
R is N-X,
subset_sum(R,Xs,Rest).
Knowing that the division does not have the commutative property, how do I get the same result for the division?
This predicate only works for the division between the two elements and in order.
subset_div(1,[],[]).
subset_div(N,[_|Xs],L) :-
subset_div(N,Xs,L).
subset_div(N,[X|Xs],[X|Rest]) :-
R is X/N,
subset_div(R,Xs,Rest).
how you can get this result?
?-subset_div(20,[10,100,90,3,5],L).
L=[100,5].
?-subset_div(5,[10,4,59,200,12],L).
L=[200,10,4].
5= (200/10)/4 or 5 = (200/4)/10 but 5 \= (4/200)/10 or 5\= (10/4)/200
Thanks.
You can do it in terms of a product if you only care about left-associative solutions. Solutions when you can do, say [20 / (10 / 2) / 5] are harder, and would require a more complicated output format.
subset_prod(1, [], []).
subset_prod(N, [_|Xs], L) :-
subset_prod(N, Xs, L).
subset_prod(N, [X|Xs], [X|Rest]) :-
R is N/X,
subset_prod(R, Xs, Rest).
subset_div1(N, [X|Xs], [X|L]) :-
X1 is X / N,
integer(X1),
subset_prod(X1, Xs, L).
subset_div1(N, [_|Xs], L) :-
subset_div(N, Xs, L).
subset_div(N, L, M) :-
sort(L, L1),
reverse(L1, L2),
subset_div1(N, L2, M).

Prolog - Latin Square solution

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

Resources