Prolog finding target number in a list by applying operations (+,-,/,*) - prolog

The task is to find if there exists at least one combination of numbers from given list and operators to obtain target number. No usemodule allowed
numbers([3,4,1,2], 7) → true. (cause 4 + 3 = 7)
numbers([1,7,7,3], 24) → true. (cause (7 - 3) * (7 - 1) = 24)
Tried member if target is already in the list. But lost further

Building upon https://professor-fish.blogspot.com/2009/11/countdown-with-prolog.html
solve_countdown(Ns, SumWanted, TsUniq) :-
findall(T, (
any_comb(Ns, Sub),
num_combs(Sub, T),
SumWanted is T
), Ts),
sort(Ts, TsUniq).
any_comb(_, []).
any_comb([H|T], [E|Comb]) :-
select(E, [H|T], Lst0),
any_comb(Lst0, Comb).
num_combs([N], N).
num_combs(As, T) :-
split_list_in_2(As, As1, As2),
num_combs(As1, T1),
num_combs(As2, T2),
% Break symmetry, since 5+2 is same as 2+5
( T1 #=< T2,
( T = T1 + T2
; T1 > 1, T = T1 * T2
)
; T = T1 - T2
; T = T1 / T2
),
R is T,
integer(R),
R #> 0.
split_list_in_2([H1, H2|T], [H1|Start], Remainder) :-
split_list_in_2_(T, H2, Start, Remainder).
split_list_in_2_(L, H2, [], [H2|L]).
split_list_in_2_([H|T], H2, [H2|Start], Remainder) :-
split_list_in_2_(T, H, Start, Remainder).
Result in swi-prolog:
?- time(solve_countdown([1,7,7,3], 24, Ts)).
% 10,996 inferences, 0.002 CPU in 0.002 seconds (99% CPU, 5236642 Lips)
Ts = [3*(1+7), (7-1)*(7-3)].
select/3 code is here.

Squeezing the lemon. I get a slightly faster version.
The logic replicates this paper:
https://www.cs.nott.ac.uk/~pszgmh/countdown.pdf
But adds forward checking:
% solve(+Integer, -Term, +Integer, +List, -List)
solve(1, N, N, P, Q) :- !, select(N, P, Q).
solve(K, G, N, P, Q) :-
J is K-1,
between(1, J, I),
L is K-I,
solve2(I, E, A, P, H),
forward(E, A, F, B, G, N),
solve(L, F, B, H, Q).
forward(E, A, F, B, E+F, N) :- N > A, B is N-A, A =< B.
forward(E, A, F, B, E-F, N) :- A > N, B is A-N.
forward(E, A, F, B, E*F, N) :- N mod A =:= 0, B is N div A, A =< B, A =\= 1.
forward(E, A, F, B, E/F, N) :- A mod N =:= 0, B is A div N, B =\= 1.
% solve2(+Integer, -Term, -Integer, +List, -List)
solve2(1, N, N, P, Q) :- !, select(N, P, Q).
solve2(K, G, N, P, Q) :-
J is K-1,
between(1, J, I),
L is K-I,
solve2(I, E, A, P, H),
solve2(L, F, B, H, Q),
combine(E, A, F, B, G, N).
combine(E, A, F, B, E+F, N) :- A =< B, N is A+B.
combine(E, A, F, B, E-F, N) :- A > B, N is A-B.
combine(E, A, F, B, E*F, N) :- A =< B, A =\= 1, N is A*B.
combine(E, A, F, B, E/F, N) :- B =\= 1, A mod B =:= 0, N is A div B.
Example run with SWI-Prolog 9.1.4:
% time((between(1,6,N), solve(N, E, 999, [1,3,5,10,25,50], _), fail; true)).
% % 2,618,953 inferences, 0.234 CPU in 0.242 seconds (97% CPU, 11174199 Lips)
% true.

Related

Predicate returns true and not some value

I am trying to make a predicate that takes two numbers K, Num (0 when you use the predicate, it changes after each recursion), a list containing numbers from 1 to K and an associative tree with all keys from 1 to K having values 0. When all numbers from 1 to K are found on the list (Num has the numbers found until then) it returns the rest of the list NL and an associative tree where the value of each key is the times each number is found. It should be used like this:
first(3, 0, [1,3,1,3,1,3,3,2,2,1], T, NL, NT)
where T is the tree described above.
Here is my code:
first(K, K, L, T, L, T):- !.
first(_, _, [], _, [], NT) :-
empty_assoc(NT), !.
first(K, Num, [H|L], T, NL, NT) :-
get_assoc(H, T, V),
Newv is V+1,
put_assoc(H, T, Newv, TT),
V=:=0 -> Newnum is Num+1; Newnum is Num,
first(K, Newnum, L, TT, NL, NT).
My problem is than it returns true instead of the values of NL and NT.
The main problem here is operator precedence. If we ask the interpreter to generate a listing., we get:
first(A, A, B, C, B, C) :- !.
first(_, _, [], _, [], A) :-
empty_assoc(A), !.
first(G, E, [A|H], B, I, J) :-
( get_assoc(A, B, C),
D is C+1,
put_assoc(A, B, D, _),
C=:=0
-> F is E+1
; F is E,
first(G, F, H, _, I, J)
).
This learns us that only in case C =:= 0 does not hold, we will make a recursive call to first/6. This is probably not your intention. Since we only make a recursive call in case the condition does not hold, the TT
If we use brackets, like:
first(K, K, L, T, L, T):- !.
first(_, _, [], _, [], NT) :-
empty_assoc(NT), !.
first(K, Num, [H|L], T, NL, NT) :-
get_assoc(H, T, V),
Newv is V+1,
put_assoc(H, T, Newv, TT),
(V=:=0 -> Newnum is Num+1; Newnum is Num),
first(K, Newnum, L, TT, NL, NT).
With that fixed, we obtain an error:
?- first(3, 0, [1,3,1,3,1,3,3,2,2,1], T, NL, NT)
| .
ERROR: Arguments are not sufficiently instantiated
ERROR: In:
ERROR: [13] throw(error(instantiation_error,_7048))
ERROR: [9] assoc:get_assoc(1,_7080,_7082) at /usr/lib/swi-prolog/library/assoc.pl:178
ERROR: [8] first(3,0,[1,3|...],_7112,_7114,_7116) at /tmptest.pl:5
ERROR: [7] <user>
This means that we aim to call get_assoc/3, but with a non-constructed associative array. Note that the empty_assoc/1 is not constructed, it is only constructed at the end when the lists are exhausted.
I think the core problem here is that you are doing too much at once. We can make small predicates that each do limited work.
For example, we can generate an associative array that maps all values between 1 and K to 0 with:
gen_assoc(K, A) :-
empty_assoc(E),
gen_assoc(K, E, A).
gen_assoc(0, A, A).
gen_assoc(K, A, C) :-
K > 0,
put_assoc(K, A, 0, B),
K1 is K-1,
gen_assoc(K1, B, C).
So here gen_assoc(3, A) will unify A with an associative array that maps all numbers from 1 to 3 (both inclusive) to 0.
I leave the rest as an exercise.

Prolog path backtracking runs forever depending on grid size

I've written some code to do backtracking in Prolog that generates all the possible paths to reach the Gold cell from the initial one (Agent). The input of getAllPaths is the map size NxN. When I run it with a 6x6 map it works perfectly and prints all the possible paths, but when I input any map size >= 7 it prints the first path and gets stuck there when I require the next possible solution with ;. Here is my code:
gold(3, 3).
agent(1, 1).
getAllPaths(MS) :-
agent(X, Y),
assertz(worldSize(MS)),
getAllPathsRec(X, Y, [], []).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, V, L) :-
\+member((X, Y), V), append(V, [(X, Y)], VP),
((gold(X, Y), print(L)) ; move(X, Y, VP, L)).
% Left
move(X, Y, V, L) :-
XP is X - 1, XP > 0,
append(L, [l], LP),
getAllPathsRec(XP, Y, V, LP).
% Right
move(X, Y, V, L) :-
XP is X + 1, worldSize(MS), XP =< MS,
append(L, [r], LP),
getAllPathsRec(XP, Y, V, LP).
% Up
move(X, Y, V, L) :-
YP is Y + 1, worldSize(MS), YP =< MS,
append(L, [u], LP),
getAllPathsRec(X, YP, V, LP).
% Down
move(X, Y, V, L) :-
YP is Y - 1, YP > 0,
append(L, [d], LP),
getAllPathsRec(X, YP, V, LP).
The output:
?- getAllPaths(6).
[r,r,r,r,r,u,l,l,l,l,l,u,r,r]
true ;
[r,r,r,r,r,u,l,l,l,l,l,u,r,u,l,u,r,r,r,r,r,d,l,l,l,d]
true ;
[r,r,r,r,r,u,l,l,l,l,l,u,r,u,l,u,r,r,r,r,r,d,l,l,d,l]
true ;
[...]
?- getAllPaths(7).
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r]
true ;
% It gets stuck here forever...
First I thought it would be for some depth recursion limits, but it's so strange because the map size is only incremented from 36 to 49, and I would probably get some warning or error, but it displays nothing. Any clue?
Here is my variation.
getAllPaths_01(MS, R) :-
agent(X, Y),
getAllPathsRec_01(MS, X, Y, [], R).
getAllPathsRec_01(_MS, X, Y, _V, []) :-
gold(X,Y), !.
% Positions, Visited list, and Path list
getAllPathsRec_01(MS, X, Y, V, R) :-
\+ memberchk((X, Y), V),
move_01(MS, X, Y, [(X, Y)|V], R).
% Left
move_01(MS, X, Y, V, [l|R]) :-
XP is X - 1, XP > 0,
getAllPathsRec_01(MS, XP, Y, V, R).
% Right
move_01(MS, X, Y, V, [r|R]) :-
XP is X + 1, XP =< MS,
getAllPathsRec_01(MS, XP, Y, V, R).
% Up
move_01(MS, X, Y, V, [u|R]) :-
YP is Y + 1, YP =< MS,
getAllPathsRec_01(MS, X, YP, V, R).
% Down
move_01(MS, X, Y, V, [d|R]) :-
YP is Y - 1, YP > 0,
getAllPathsRec_01(MS, X, YP, V, R).
count(S,N) :-
bagof(L,getAllPaths_01(S,L),Ls),
length(Ls,N).
This removes the use assertz/1 so that rerunning the query does not add multiple facts, changes member/2 to memerchk/2 for efficiency, builds the path upon backtracking to avoid append/3, and added a cut to remove the duplicate answers.
Since the result is returned to the top level, added count/2 to show the counts instead of the list.
?- count(3,N).
N = 12.
?- count(4,N).
N = 132.
?- count(5,N).
N = 6762.
?- count(6,N).
N = 910480
This code improve the performance.
I think it's a bad design to mix the search and the printing of the result.
gold(3, 3).
agent(1, 1).
getAllPaths(MS, L) :-
agent(X, Y),
retractall(worldSize(_)),
assertz(worldSize(MS)),
getAllPathsRec(X, Y, [], [], L).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, _V, L, NL) :-
gold(X, Y),
reverse(L, NL).
% Positions, Visited list, and Path list
getAllPathsRec(X, Y, V, CL, L) :-
\+member((X, Y), V),
% useless
% append(V, [(X, Y)], VP),
move(X, Y, CL, NX, NY, NL),
% No need to use append to build the list of visited nodes
getAllPathsRec(NX, NY, [(X,Y) | V], NL, L).
% Left
move(X, Y, L, NX, Y, [l|L]) :-
X > 1 ,NX is X - 1.
% Right
move(X, Y, L, NX, Y, [r|L]) :-
worldSize(MS), X < MS,NX is X + 1.
% Up
move(X, Y, L, X, NY, [u|L]) :-
worldSize(MS), Y < MS, NY is Y + 1.
% Down
move(X, Y, L, X, NY, [d|L]) :-
Y > 1, NY is Y - 1.
I get :
?- getAllPaths(7, V), writeln(V).
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,l]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,l,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,l,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,l,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,r,u,l,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,u,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] ;
[r,r,r,r,r,r,u,l,l,l,l,l,l,u,r,r,r,r,r,r,u,l,l,l,u,l,l,u,r,r,r,r,d,r,u,u,l,l,l,l,l,l,d,d,d,r,r,d]
V = [r, r, r, r, r, r, u, l, l|...] .

Prolog how to find sum of elements matrix

I have matrix size [n,n].
I need to find sum
For example
1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 16
sum = 3+4+7+8
I need to find sum of elements of first quadrant matrix
Using library(clpfd), which provides the useful sum/3 and transpose/2:
:- use_module(library(clpfd)).
sum_first_quadrant(M, S) :-
first_quadrant(M, Q),
maplist(sum_, Q, Ss),
sum_(Ss, S).
sum_(L, S) :-
sum(L, #=, S).
first_quadrant(M, Q) :-
transpose(M, T),
reverse(T, RT),
dichotomize(RT, RD),
reverse(RD, D),
transpose(D, TD),
dichotomize(TD, Q).
dichotomize(M, D) :-
length(M, L),
X #= L//2,
dichotomize_(M, X, D).
dichotomize_(_, 0, []).
dichotomize_([H|T], X, [H|T2]) :-
X #> 0,
Y #= X - 1,
dichotomize_(T, Y, T2).
Example:
?- sum_first_quadrant([[1,2,3,4],[5,6,7,8],[9,10,11,12],[13,14,15,16]], Z).
Z = 22 ;
false.
Note
You can get rid of the extraneous choice point in dichotomize_ using if_/3 and (=)/3 from library reif:
dichotomize_(L, X, D) :-
X #>= 0,
if_(X = 0,
D = [],
( Y #= X - 1,
L = [H|T],
D = [H|T2],
dichotomize_(T, Y, T2)
)
).
%-matrix
data([[1,2,18,23],
[5,6,10,10],
[9,10,11,12],
[13,14,15,16]]).
%-Sum
main(S):-
data(Ms),
length(Ms,N),
Mdl is N//2,
sum_matr(Ms,1,N,Mdl,0,S).
%+Matrix,+RowCounter,+Length,+Midle,+Acc,-S
sum_matr([R|Rs],I,K,Mdl,Acc,S):-
I=<Mdl, I1 is I+1,
findEnd(R,Mdl,ResList),
sum_row(ResList,Mdl,I,K,0,Srow),
Acc1 is Acc + Srow,
sum_matr(Rs,I1,K,Mdl,Acc1,S).
sum_matr(_,I,_,Mdl,S,S):-
I>Mdl.
%+Row,+Counter,+I,+K,+Acc,-Sum
sum_row([X|Xs],C,I,K,Acc,S):-
C<K,
Acc1 is Acc+X,
C1 is C+1,
sum_row(Xs,C1,I,K,Acc1,S).
sum_row(_,C,_,K,S,S):-
C>=K.
%+List, +Position, -End
findEnd(E, 0, E).
findEnd([_|T], N, E):-
N>0,
N1 is N-1,
findEnd(T, N1, E).

Factors of a number

So I am relatively new to Prolog, and while this problem is easy in many other languages I am having a lot of trouble with it. I want to generate a List of factors for a number N. I have already built a predicate that tells me if a number is a factor:
% A divides B
% A is a factor of B
divides(A,B) :- A =\= 0, (B mod A) =:= 0.
% special case where 1 // 2 would be 0
factors(1,[1]) :- !.
% general case
factors(N,L):- N > 0, factor_list(1, N, L).
factor_list(S,E,L) :- S =< E // 2, f_list(S,E,L).
f_list(S,E,[]) :- S > E // 2, !.
f_list(S,E,[S|T]) :- divides(S,E), !, S1 is S+1, f_list(S1, E, T).
f_list(S,E,L) :- S1 is S+1, f_list(S1,E,L).
Any help would be appreciated.
EDIT
I pretty much changed my entire solution, but for some reason predicates like factors(9, [1]) return true, when I only want factors(9, [1,3]) to return true. Any thoughts?
Here's why factors(9,[1]) is true: the timing of attempted instantiations (that is to say, unifications) is off:
f_list(S,E,[]) :- S > E // 2, !.
f_list(S,E,[S|T]) :- divides(S,E), !, S1 is S+1, f_list(S1, E, T).
f_list(S,E,L) :- S1 is S+1, f_list(S1,E,L).
%% flist(1,9,[1]) -> (2nd clause) divides(1,9), S1 is 2, f_list(2,9,[]).
%% flist(2,9,[]) -> (3rd clause) S1 is 3, f_list(3,9,[]).
%% ...
%% flist(5,9,[]) -> (1st clause) 5 > 9 // 2, !.
because you pre-specify [1], when it reaches 3 the tail is [] and the match with the 2nd clause is prevented by this, though it would succeed due to divides/2.
The solution is to move the unifications out of clauses' head into the body, and make them only at the appropriate time, not sooner:
f_list(S,E,L) :- S > E // 2, !, L=[].
f_list(S,E,L) :- divides(S,E), !, L=[S|T], S1 is S+1, f_list(S1, E, T).
f_list(S,E,L) :- S1 is S+1, f_list(S1,E,L).
The above usually is written with the if-else construct:
f_list(S,E,L) :-
( S > E // 2 -> L=[]
; divides(S,E) -> L=[S|T], S1 is S+1, f_list(S1, E, T)
; S1 is S+1, f_list(S1, E, L)
).
Also you can simplify the main predicate as
%% is not defined for N =< 0
factors(N,L):-
( N =:= 1 -> L=[1]
; N >= 2 -> f_list(1,N,L)
).
Personally, I use a somewhat simpler looking solution:
factors(1,[1]):- true, !.
factors(X,[Factor1|T]):- X > 0,
between(2,X,Factor1),
NewX is X // Factor1, (X mod Factor1) =:= 0,
factors(NewX,T), !.
This one only accepts an ordered list of the factors.
Here is a simple enumeration based procedure.
factors(M, [1 | L]):- factors(M, 2, L).
factors(M, X, L):-
residue(M, X, M1),
((M==M1, L=L1); (M1 < M, L=[X|L1])),
((M1=1, L1=[]); (M1 > X, X1 is X+1, factors(M1, X1, L1))).
residue(M, X, M1):-
((M < X, M1=M);
(M >=X, MX is M mod X,
(MX=0, MM is M/X, residue(MM, X, M1);
MX > 0, M1=M))).

How to make my relation work

I have the following relation: index(X,N,List).
for example:
index(X,2,[a,b,c]).
X=b
index(b,N,[a,b,c]).
N=2
I don't know how to make my relation to work with the second example. It says that N is not defined well
Here is my code (it works well for the first example).
index(X,1,[X|_]).
index(X,N,[_|Tail]) :- N > 1, N1 is N - 1 , index(X,N1,Tail).
There is a SWI-Prolog built-in nth1/3 that does what you want:
?- nth1(N, [a, b, c], b).
N = 2 ;
false.
Look at its source code:
?- listing(nth1).
lists:nth1(A, C, D) :-
integer(A), !,
B is A+ -1,
nth0_det(B, C, D).
lists:nth1(A, B, C) :-
var(A), !,
nth_gen(B, C, 1, A).
true.
?- listing(nth0_det).
lists:nth0_det(0, [A|_], A) :- !.
lists:nth0_det(1, [_, A|_], A) :- !.
lists:nth0_det(2, [_, _, A|_], A) :- !.
lists:nth0_det(3, [_, _, _, A|_], A) :- !.
lists:nth0_det(4, [_, _, _, _, A|_], A) :- !.
lists:nth0_det(5, [_, _, _, _, _, A|_], A) :- !.
lists:nth0_det(A, [_, _, _, _, _, _|C], D) :-
B is A+ -6,
B>=0,
nth0_det(B, C, D).
true.
?- listing(nth_gen).
lists:nth_gen([A|_], A, B, B).
lists:nth_gen([_|B], C, A, E) :-
succ(A, D),
nth_gen(B, C, D, E).
true.
The variable N has not been instantiated to a numeric type when Prolog attempts to evaluate the goals N > 1 and N1 is N - 1 in the recursive clause defining index/3. This causes the instantiation error you are reporting.
I don't know how to solve your problem directly, but I have two suggestions. The first is to use an accumulator, so that the arithmetic operations in the recursive clause can be evaluated:
get(M,Xs,X) :- get(1,M,Xs,X).
get(N,N,[X|_],X).
get(N,M,[_|Xs],X) :-
L is N + 1,
get(L,M,Xs,X).
For instance:
?- index(N,[a,b],X).
N = 1,
X = a ;
N = 2,
X = b ;
false.
The other is to use a natural number type, so that the index can be constructed via unification:
nat(0).
nat(s(N)) :- nat(N).
get(s(0),[X|_],X).
get(s(N),[_|Y],X) :- get(N,Y,X).
For instance,
?- get(N,[a,b],X).
N = s(0),
X = a ;
N = s(s(0)),
X = b ;
false.
Hopefully this was helpful. Perhaps someone more knowledgeable will come along and give a better solution.

Resources