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|...] .
Related
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.
I need to write the predicate Frequest(InList, OutList) to find the list
OutList of all elements that occur most frequently in the given InList.
Here is my code, help me write more professional and understandable for everyone please.
`counter([], _, 0).
counter([X|T], X, C) :- counter(T, X, C1), C is C1 + 1.
counter([X|T], Y, C) :- X == Y, counter(T, Y, C).
max_count([], , 0).
max_count([E|L], L1, C):-
counter(L1, E, C1),
maxcount(L, L1, C2),
C is max(C1, C2), !.
max_count_el([], , _, []) :- !.
max_count_el([X|L], L1, M, LR) :-
ffff(L, L1, M, LR2),
( counter(L1, X, C),
C == M,
+ member(X, LR2),
append(LR2, [X], LR);
LR = LR2
).
frequentest(L1, L2):-
max_count(L1, L1, R),
max_count_el(L1, L1, R, L2), !.`
I currently have to make some sort of Wumpus World implementation in SWI Prolog and give all possible paths over a board of size NxN, I have done several prolog tutorials but I can't figure how to solve this particular task in Prolog. I'm trying to get all possible paths for my agent to the gold and nothing else. It has to start from the initial position (X0, Y0).
I attach the code that I've managed to write so far. I have tried to do a simple DFS which sort of works but I struggle with the variable "parsing" to complete the code.
:- dynamic getAllPathsRec/2, agent/2, visited/2, visited/2.
gold(5,5).
worldSize(10).
agent(1,1).
getAllPaths :-
getAllPathsRec(1,1).
getAllPathsRec(X,Y) :-
format(X), format(Y), format('~n'),
gold(X1,Y1),
\+visited(X,Y),
assert(visited(X,Y)),
(X = X1, Y = Y1) -> print('Found GOLD');
move(_,X,Y).
move(right, X, Y) :-
X1 is X + 1,
X1 > 0 , X1 < 11,
getAllPathsRec(X1,Y).
move(left, X, Y) :-
X1 is X - 1,
X1 > 0 , X1 < 11,
getAllPathsRec(X1,Y).
move(up, X, Y) :-
Y1 is Y + 1,
Y1 > 0 , Y1 < 11,
getAllPathsRec(X,Y1).
move(down, X, Y) :-
Y1 is Y - 1,
Y1 > 0 , Y1 < 11,
getAllPathsRec(X,Y1).
I expect to find the gold in any possible way, ideally printing each path the algorithm has taken. Thank you in advance.
EDIT:
I've noticed that this solution has some efficiency problems for boards of enough size. It's being discussed here. I'll update the answer when we come up with a result.
Take care with assert/1 predicate, as it adds the fact to the knowledge base permanently and it's not undone while trying other combinations, so you won't be able to visit the same cell twice.
Instead of that, I approached it with an extra parameter V (that stands for visited), in which you can append the element treated in each exploration step. Also I stored the chosen directions in every step into a list L to print it when the target is found.
The or operator ; allows to not keep exploring the same path once the target is found and goes back to keep trying other combinations.
Notes:
If you face any use case where you can use assert/1, take care, because it's deprecated.
The _ variable it's not necessary in the move function as you can simply add 4 different "implementations" and just append the four directions.
As an advice use the facts or knowledge (a.k.a. World Size, Target position and Player position) as variables and don't hard code it. It'll be easier to debug and try different parameters.
Here you have the working code and some output example:
:- dynamic
getAllPathsRec/2,
agent/2,
visited/2.
gold(3, 3).
worldSize(5).
agent(1, 1).
getAllPaths :-
agent(X, Y),
getAllPathsRec(X, Y, [], []).
getAllPathsRec(X, Y, V, L) :-
hashPos(X, Y, H), \+member(H, V), append(V, [H], VP),
((gold(X, Y), print(L)) ; move(X, Y, VP, L)).
% Hash H from h(X, Y)
hashPos(X, Y, H) :- H is (X*100 + Y).
% 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).
?- getAllPaths.
[r,r,r,r,u,l,l,l,l,u,r,r]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,l,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,l,d,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,d,l,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,r,d,d,l,u,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,l,d]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,r,d,l,l]
true ;
[r,r,r,r,u,l,l,l,l,u,r,u,l,u,r,r,r,d,d,l]
...
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).
I have a predicate variablize/3 that takes a list and replaces each item, in turn, with a variable, example:
% ?- variablize([a,b,c], X, L).
% L = [[X, b, c], [a, X, c], [a, b, X]]
Now I am trying to extend this predicate to accept a list of variables, example:
% ?- variablize([a,b,c], [X,Y], L).
% L = [[X, Y, c], [X, b, Y], [a, X, Y]]
My code so far is:
replace_at([_|Tail], X, 1, [X|Tail]).
replace_at([Head|Tail], X, N, [Head|R]) :- M is N - 1, replace_at(Tail, X, M, R).
replace_each([], _, _, [], _).
replace_each([_|Next], Orig, X, [Res|L], N) :-
replace_at(Orig, X, N, Res),
M is N + 1,
replace_each(Next, Orig, X, L, M).
variablize(I, X, L) :- replace_each(I, I, X, L, 1).
Any pointers? Do I extend replace_at/4 to have a list of indexes that should be skipped?
A simplified, builtin based way of implementing variablize/3
variablize(I, X, L) :-
bagof(R, U^select(U, I, X, R), L).
put in evidence that instead of select/4 we could have a distribute/3 that applies replacements of elements of X, when X becomes a list. select/4 can be implemented in this way
myselect(B, I, X, R) :-
append(A, [B|C], I), append(A, [X|C], R).
and this form is convenient because we have the part to the right of input list I, where I suppose you need to distribute remaining variables. Then a recursion on X elements should do:
distribute(I, [X|Xs], L) :-
append(A, [_|C], I),
distribute(C, Xs, R),
append(A, [X|R], L).
distribute(I, [], I).
distribute/3 behaves this way:
?- distribute([a,b,c,d],[1,2],X).
X = [1, 2, c, d] ;
X = [1, b, 2, d] ;
X = [1, b, c, 2] ;
X = [a, 1, 2, d] ;
X = [a, 1, c, 2] ;
X = [a, b, 1, 2] ;
false.
thus
variablize_l(I, X, L) :-
bagof(R, distribute(I, X, R), L).
give us:
?- variablize_l([a,b,c],[X,Y],L).
L = [[X, Y, c], [X, b, Y], [a, X, Y]].
edit
I initially wrote this way, for here the evidence of separating the distribution phase from list construction:
replace_v([_|T], X, [X|T]).
replace_v([L|T], X, [L|R]) :-
replace_v(T, X, R).
variablize(I, X, L) :-
bagof(E, replace_v(I, X, E), L).
variablize(L1,L2,L) :-
append(L1,L2,L3),
length(L1,Len1),
length(L2,Len2),
findall(L4,(combination(L3,Len1,L4),var_count(L4,Len2)),L).
combination(X,1,[A]) :-
member(A,X).
combination([A|Y],N,[A|X]) :-
N > 1,
M is N - 1,
combination(Y,M,X).
combination([_|Y],N,A) :-
N > 1,
combination(Y,N,A).
var_count([],0).
var_count([V|R],N) :-
var(V),
var_count(R,N1),
N is N1 + 1,
!.
var_count([A|R],N) :-
var_count(R,N).