How to get the value of many elements of a matrix (list of lists) - matrix

I have problems because I want to get the values of many grids of a matrix
Example:
I have this matrix (list of lists)
[[g,z,n,d,o,g,r,o,y,c],
[a,u,u,d,p,o,x,s,t,b],
[u,y,z,r,r,e,m,e,e,o],
[g,v,j,m,x,e,j,e,h,l],
[e,r,u,y,d,z,k,b,r,x],
[e,d,h,n,c,y,q,e,x,i],
[w,f,m,w,x,n,n,m,h,i],
[y,d,g,u,q,d,z,o,n,d],
[g,p,o,u,c,o,n,f,x,q],
[c,y,z,r,i,c,a,t,x,v]]
I want to get the word "dog" from this matrix, this word is in the coordinates (0 3) (0 4) (0 5).
Now the problem is how I can do this in prolog?
My code so far:
selectElementList(0,[H|_],H).
selectElementList(P,[H|T],E):-
length([H|T],Len),
( P < Len
-> P1 is P - 1,
selectElementList(P1,T,E),
!
; E = false,
!
).
With this predicate I get one value of the matrix.
selectGridMatrix(Matrix,X,Y,R):-
selectElementList(X,Matrix,Row), selectElementList(Y,Row,R).
Example:
?- selectGridMatrix([[0,1,2],[3,4,5]],0,0,R).
R = 0 ;

an example, using builtin nth0/3 and library(yall):
?- M= [[g,z,n,d,o,g,r,o,y,c],
[a,u,u,d,p,o,x,s,t,b],
[u,y,z,r,r,e,m,e,e,o],
[g,v,j,m,x,e,j,e,h,l],
[e,r,u,y,d,z,k,b,r,x],
[e,d,h,n,c,y,q,e,x,i],
[w,f,m,w,x,n,n,m,h,i],
[y,d,g,u,q,d,z,o,n,d],
[g,p,o,u,c,o,n,f,x,q],
[c,y,z,r,i,c,a,t,x,v]], maplist({M}/[(R,C),V]>>(nth0(R,M,Row),nth0(C,Row,V)),[(0,3),(0,4),(0,5)],Word).
M = [[g, z, n, d, o, g, r, o|...], [a, u, u, d, p, o, x|...], [u, y, z, r, r, e|...], [g, v, j, m, x|...], [e, r, u, y|...], [e, d, h|...], [w, f|...], [y|...], [...|...]|...],
Word = [d, o, g].
HTH

Related

A Prolog program for permutation parity

I wrote this small program in Prolog.
odd_even_flip(odd, even).
odd_even_flip(even, odd).
% flip_one, for A = a, B = b, P = [a, .., b, ..], gives M = [b, .., a, ..]
flip_one(A, B, P, M) :-
append([A|As], [B|Bs], P),
append([B], As, L),
append([A], Bs, R),
append(L, R, M).
permutation_parity([X|L], [X|P], R) :- permutation_parity(L, P, R).
% abc
permutation_parity([X|L], [Y|P], R) :-
X \= Y,
flip_one(Y, X, [Y|P], M),
permutation_parity([X|L], M, Res),
odd_even_flip(Res, R).
permutation_parity([], [], even).
I expect it to find the parity of a permutation P of list L. The few queries that assert that a given permutation of a given list is indeed even or odd worked fine.
However, from my experience with Prolog, I would expect that permutation_parity([a, b, c], X, Y). would show me all permutations of [a, b, c] but that is not happening.
Rather, I get X = [a, b, c], Y = even. and that is all.
I tried to add member(Y, L) in the rule that follows %abc as I was thinking that will help Prolog to know how to instantiate X in permutation_parity([a, b, c], X, Y) but that helped to no avail.
If someone could help me see what I am missing it would be great. Thanks in advance.
You only need to use unification to correctly instantiate the variable X (assuming that permutation_parity/3 is called with a proper list as its first argument). So I suggest you modify your code as follows:
permutation_parity([], [], even).
permutation_parity([X|Xs], [X|Zs], P) :-
permutation_parity(Xs, Zs, P).
permutation_parity([X|Xs], Zs, P) :-
permutation_parity(Xs, Ys, Q),
flip_first([X|Ys], Zs),
odd_even_flip(Q, P).
flip_first(L0, L1) :-
append([X|Xs], [Y|Ys], L0),
append([Y|Xs], [X|Ys], L1).
odd_even_flip(odd, even).
odd_even_flip(even, odd).
Examples:
?- permutation_parity([a,b,c], Permutation, Parity).
Permutation = [c, a, b],
Parity = even ;
Permutation = [b, c, a],
Parity = even ;
Permutation = [b, a, c],
Parity = odd ;
Permutation = [c, b, a],
Parity = odd ;
Permutation = [a, c, b],
Parity = odd ;
Permutation = [a, b, c],
Parity = even.
?- permutation_parity([a,b,c], [a,c,b], Parity).
Parity = odd ;
false.
?- permutation_parity([a,b,c], Permutation, even).
Permutation = [c, a, b] ;
Permutation = [b, c, a] ;
Permutation = [a, b, c].
EDIT
perm_parity(L0, L1, P) :-
same_length(L0, L1),
permutation_parity(L0, L1, P).
The predicate same_length/2 is defined in SWI-Prolog as follows:
same_length([], []).
same_length([_|T1], [_|T2]) :-
same_length(T1, T2).
Example:
?- perm_parity(L, [a,b,c], P).
L = [b, c, a],
P = even ;
L = [c, a, b],
P = even ;
L = [b, a, c],
P = odd ;
L = [c, b, a],
P = odd ;
L = [a, c, b],
P = odd ;
L = [a, b, c],
P = even.

Incorrect output when trying to query in a depth first search implementation for prolog

I just can't seem to get the correct output - I am supposed to get -
?- dfs([a], X).
X = [a, f, i] ;
false.
But I get -
?- dfs([a], X).
X = [a|f] ;
% Representation of a tree
% choose initial state a
arc(a, b).
arc(a, f).
arc(b, c).
arc(b, d).
arc(b, e).
arc(f, g).
arc(f, i).
arc(i, j).
arc(i, k).
% the goal
goal(i).
dfs([Node|_], [Node|X]) :-
goal(X).
dfs([Node|_], [Node|X]) :-
expands([Node|_], NewNode),
append([Node|_], NewNode, appendedN),
dfs(appendedN, X).
% expands(+Path, ?NewNode).
% -- Path: is a list of nodes of the form Path=[Node|Nodes], where
% Node is the node we want to expand and Nodes is a list
% of remaining nodes already expanded and containing the root.
% -- NewNode: is a constant representing the node we want to go to,
% as there is an link to it from where we are currently.
%
expands([Node|_], NewNode):-
arc(Node, NewNode).
Your program matches the first clause, dfs([Node|_], [Node|X]), and nothing else, producing X = [a|i] .
Here's a working version.
% Representation of a tree
% choose initial state a
arc(a, b).
arc(a, f).
arc(b, c).
arc(b, d).
arc(b, e).
arc(f, g).
arc(f, i).
arc(i, j).
arc(i, k).
% the goal
goal(i).
% You can expand a starting symbol S to a list L if G is your goal, S expands
% to G in list L1, and you append the two lists.
dfs([S], L) :-
goal(G),
expands(S, G, L1),
append([S], L1, L).
% X expands to Y in list [Y] if there's a direct arc from X to Y (base case).
expands(X, Y, [Y]) :-
arc(X, Y).
% X expands to Z in list [Y|L] if there's a direct arc from X to Y and Y
% expands to Z in list L (recursive case).
expands(X, Z, [Y|L]) :-
arc(X, Y),
expands(Y, Z, L).
In this version, expands() produces all of the lists that start with a:
?- expands(a, X, L).
X = b,
L = [b] ;
X = f,
L = [f] ;
X = c,
L = [b, c] ;
X = d,
L = [b, d] ;
X = e,
L = [b, e] ;
X = g,
L = [f, g] ;
X = i,
L = [f, i] ;
X = j,
L = [f, i, j] ;
X = k,
L = [f, i, k] ;
false.
Then dfs() confirms that the goal i has been reached and adds the start symbol a to the head of the list:
?- dfs([a], X).
X = [a, f, i] ;
false.

Prolog: Remove circle from graph-like problem

I have the following prolog program where I want to go from position a to position d. We can do that by following the path: a->b->c->d. Another path is: a->b->c->b->c->d etc. How do we remove that 'circling' path? I tried to remove it by using 'not(member(from_to(X,_),Z))' but it doesn't seem to work.
from_to(a, b).
from_to(b, c).
from_to(c, d).
from_to(d, c).
from_to(c, b).
move(X,Y,Z) :- from_to(X,Y), X \= Y,
Z = [from_to(X,Y)].
move(X,Y,Z) :- from_to(X,K), K \= Y, move(K,Y,Z1),
Z = [from_to(X,K)|Z1],
not(member(from_to(X,_),Z)).
(if you remove the line 'not(member(from_to(X,_),Z))' the program works fine but outputs the circling paths)
It is better to use an accumulator here: a variable that you update through recursive calls, and thus contains some sort of "memory". Here the accumulator can store a list of nodes that we have visited. In order to move to a new node, that node should not be in the list.
So we define a predicate move/4 instead of move/3, with:
move(X,Y,Z) :-
move(X, Y, Z, [X]).
Now we can define the predicate move(S, D, Path, Visited) by using two rules:
in case S and D are the same, we are done, regardless what Visited is, we unify Path with [D]; and
otherwise we "walk" to another node N through the from_to/2 predicate, ensure that it is not a member of Visited, then we make a recursive call where we prepend S to the N to the visited nodes. We prepend X to the result of the recursive Z.
Like for example:
move(S, S, [S], _).
move(S, D, [S|Z], Visited) :-
from_to(S, N),
\+ member(N, Visited),
move(N, D, Z, [N|Visited]).
For your sample graph:
it generates then:
?- move(a, d, Z).
Z = [a, b, c, d] ;
false.
?- move(a, D, Z).
D = a,
Z = [a] ;
D = b,
Z = [a, b] ;
D = c,
Z = [a, b, c] ;
D = d,
Z = [a, b, c, d] ;
false.
?- move(A, d, Z).
A = d,
Z = [d] ;
A = a,
Z = [a, b, c, d] ;
A = b,
Z = [b, c, d] ;
A = c,
Z = [c, d] ;
false.
?- move(A, D, Z).
A = D,
Z = [D] ;
A = a,
D = b,
Z = [a, b] ;
A = a,
D = c,
Z = [a, b, c] ;
A = a,
D = d,
Z = [a, b, c, d] ;
A = b,
D = c,
Z = [b, c] ;
A = b,
D = d,
Z = [b, c, d] ;
A = c,
D = d,
Z = [c, d] ;
A = d,
D = c,
Z = [d, c] ;
A = d,
D = b,
Z = [d, c, b] ;
A = c,
D = b,
Z = [c, b] ;
false.
In case a node is not "connected to itself" as in that we have not a path from a to a for example, we can implement move as:
move(S, D, [S|Z], V) :-
from_to(S, N),
\+ member(N, V),
move2(N, D, Z, [N|V]).
move2(S, S, [S], _).
move2(N, D, [S|Z], V) :-
move(N, D, Z, V).

Trying to solve the peg jump puzzle in Prolog

There are 8 pegs in nine holes. At beginning, the four red pegs on the left and the four blue pegs are on the right, and one empty hole between them. The puzzle is to move all the red to the right, and blue pegs to the left(in other opposite). These are the legal moves to do so:
Pegs may only move forward (red may move right and blue left).
A peg may move forward one step into an open position.
A peg may skip over exactly one peg of the opposite color, if the position beyond it is open.
This is what I wrote, but it doesn't work
% Form of board, b for blue, r for red, o for empty.
% [ [r,r,r,r], [o], [b,b,b,b] ]
% jumps
linjmp([x, x, o | T], [o, o, x | T]).
linjmp([o, x, x | T], [x, o, o | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).
% Series of legal boards.
series(From, To, [From, To]) :- jump(From, To).
series(From, To, [From, By | Rest])
:- jump(From, By),
series(By, To, [By | Rest]).
% Print a series of boards. This puts one board per line and looks a lot
% nicer than the jumble that appears when the system simply beltches out
% a list of boards. The write_ln predicate is a built-in which always
% succeeds (is always satisfied), but prints as a side-effect. Therefore
% print_series(Z) will succeed with any list, and the members of the list
% will be printed, one per line, as a side-effect of that success.
print_series_r([]) :-
write_ln('*******************************************************').
print_series_r([X|Y]) :- write_ln(X), print_series_r(Y).
print_series(Z) :-
write_ln('\n*******************************************************'),
print_series_r(Z).
% A solution.
solution(L) :- series([[r,r,r,r], [o], [b,b,b,b]],
[[b,b,b,b], [o], [r,r,r,r]], L).
% Find a print the first solution.
solve :- solution(X), print_series(X).
% Find all the solutions.
solveall :- solve, fail.
% This finds each solution with stepping.
solvestep(Z) :- Z = next, solution(X), print_series(X).
It should be like so when it works:
?- consult(linejump).
% linejump compiled 0.00 sec, 3,612 bytes
true.
?- solve.
*******************************************************
[r, r, r, r, o, b, b, b, b]
[r, r, r, o, r, b, b, b, b]
[r, r, r, b, r, o, b, b, b]
[r, r, r, b, r, b, o, b, b]
[r, r, r, b, o, b, r, b, b]
[r, r, o, b, r, b, r, b, b]
[r, o, r, b, r, b, r, b, b]
[r, b, r, o, r, b, r, b, b]
[r, b, r, b, r, o, r, b, b]
[r, b, r, b, r, b, r, o, b]
[r, b, r, b, r, b, r, b, o]
[r, b, r, b, r, b, o, b, r]
[r, b, r, b, o, b, r, b, r]
[r, b, o, b, r, b, r, b, r]
[o, b, r, b, r, b, r, b, r]
[b, o, r, b, r, b, r, b, r]
[b, b, r, o, r, b, r, b, r]
[b, b, r, b, r, o, r, b, r]
[b, b, r, b, r, b, r, o, r]
[b, b, r, b, r, b, o, r, r]
[b, b, r, b, o, b, r, r, r]
[b, b, o, b, r, b, r, r, r]
[b, b, b, o, r, b, r, r, r]
[b, b, b, b, r, o, r, r, r]
[b, b, b, b, o, r, r, r, r]
*******************************************************
true ;
*******************************************************
[r, r, r, r, o, b, b, b, b]
[r, r, r, r, b, o, b, b, b]
[r, r, r, o, b, r, b, b, b]
[r, r, o, r, b, r, b, b, b]
[r, r, b, r, o, r, b, b, b]
[r, r, b, r, b, r, o, b, b]
[r, r, b, r, b, r, b, o, b]
[r, r, b, r, b, o, b, r, b]
[r, r, b, o, b, r, b, r, b]
[r, o, b, r, b, r, b, r, b]
[o, r, b, r, b, r, b, r, b]
[b, r, o, r, b, r, b, r, b]
[b, r, b, r, o, r, b, r, b]
[b, r, b, r, b, r, o, r, b]
[b, r, b, r, b, r, b, r, o]
[b, r, b, r, b, r, b, o, r]
[b, r, b, r, b, o, b, r, r]
[b, r, b, o, b, r, b, r, r]
[b, o, b, r, b, r, b, r, r]
[b, b, o, r, b, r, b, r, r]
[b, b, b, r, o, r, b, r, r]
[b, b, b, r, b, r, o, r, r]
[b, b, b, r, b, o, r, r, r]
[b, b, b, o, b, r, r, r, r]
[b, b, b, b, o, r, r, r, r]
*******************************************************
true .
?-
A straightforward Prolog code which tries to be the simplest and clearest, and doesn't care about efficiency at all:
start([r,r,r,r,e,b,b,b,b]). % starting position
% can move from a position P1 to position P2
move(P1,P2):- append(A,[r,e|B],P1), append(A,[e,r|B],P2).
move(P1,P2):- append(A,[e,b|B],P1), append(A,[b,e|B],P2).
move(P1,P2):- append(A,[e,r,b|B],P1), append(A,[b,r,e|B],P2).
move(P1,P2):- append(A,[r,b,e|B],P1), append(A,[e,b,r|B],P2).
solved([b,b,b,b,e,r,r,r,r]). % the target position to be reached
pegs :- start(P), solve(P, [], R),
maplist(writeln, R), nl, nl, fail ; true.
% solve( ?InitialPosition, +PreviousPositionsList, ?ResultingPath)
solve(P, Prev, R):-
solved(P) -> reverse([P|Prev], R) ;
move(P, Q), \+memberchk(Q, Prev), solve(Q, [P|Prev], R).
Nothing special about it. Takes whole of 0.08 seconds on Ideone to find two solutions, both of 24 moves.
For an N-pegs problem, we only need to modify the start and solved predicates accordingly.
Kudos go to Cary Swoveland from whose answer I took the notation (that's half the solution). A more efficient code, following mat's answer, building the result list in Prolog's characteristic top-down manner (similar to difference-lists technique, cf. tailrecursion-modulo-cons ):
swap([r,e|B],[e,r|B]).
swap([e,b|B],[b,e|B]).
swap([e,r,b|B],[b,r,e|B]).
swap([r,b,e|B],[e,b,r|B]).
move(A,B):- swap(A,B).
move([A|B],[A|C]):- move(B,C).
moves(S,[S]):- solved(S).
moves(S,[S|B]):- move(S,Q), moves(Q,B).
pegs(PS) :- start(P), moves(P, PS), maplist( writeln, PS), nl.
In general, any board game with positions and moves between them can be seen as a search problem in a search space of positions, defined by the valid moves, that is to take us from the start to the end (final) position. Various search strategies can be used, depth first, breadth first, iterative deepening, best-first heuristics ... This views the search space as a graph where nodes are positions (board configurations), and edges are moves; otherwise we can say this is a transitive closure of a move relation.
Sometimes the move relation is defined such that it produces a new legal configuration (like here); sometimes it is easier to define a general move relation and check the produced position for legality (like in N-queens problem). It is also common to maintain the visited nodes list while searching, and check any newly discovered node for being one of those already visited - discarding that path, to avoid getting into a loop.
Breadth first search will explicitly maintain the frontier of the nodes being discovered, and maintain it as a queue while extending it by one move at a time; depth first as a stack. Best first search will reorder this frontier according to some heuristics. Here, moves/2 is depth-first implicitly, because it relies on Prolog search which is itself depth-first.
Sometimes the search space is guaranteed to not have these cycles (i.e. to be a DAG - directed acyclic graph) so the check for uniqueness is not necessary. As for the final node, sometimes it is defined by value (like here), sometimes we're interested in some condition to hold (like e.g. in chess). See this answer for how to enforce this uniqueness with a lazy all_dif/1 predicate upfront. With the predicates defined in it, this problem becomes simply
pegs(Ps):-
path( move, Ps, [r,r,r,r,e,b,b,b,b], [b,b,b,b,e,r,r,r,r]).
It is always nice to use a dcg when describing lists.
For example:
initial_state([r,r,r,r,o,b,b,b,b]).
final_state([b,b,b,b,o,r,r,r,r]).
move([E|Es]) --> [E], move(Es).
move([r,o|Ls]) --> [o,r], list(Ls).
move([o,b|Ls]) --> [b,o], list(Ls).
move([o,r,b|Ls]) --> [b,r,o], list(Ls).
move([r,b,o|Ls]) --> [o,b,r], list(Ls).
list([]) --> [].
list([L|Ls]) --> [L], list(Ls).
moves(S) --> [S], { final_state(S) }.
moves(S0) --> [S0], { phrase(move(S0), S) }, moves(S).
We can use iterative deepening to find a shortest solution:
?- length(Ms, _),
initial_state(S0),
phrase(moves(S0), Ms),
maplist(writeln, Ms).
[r,r,r,r,o,b,b,b,b]
[r,r,r,r,b,o,b,b,b]
[r,r,r,o,b,r,b,b,b]
[r,r,o,r,b,r,b,b,b]
[r,r,b,r,o,r,b,b,b]
[r,r,b,r,b,r,o,b,b]
[r,r,b,r,b,r,b,o,b]
[r,r,b,r,b,o,b,r,b]
[r,r,b,o,b,r,b,r,b]
[r,o,b,r,b,r,b,r,b]
[o,r,b,r,b,r,b,r,b]
[b,r,o,r,b,r,b,r,b]
[b,r,b,r,o,r,b,r,b]
[b,r,b,r,b,r,o,r,b]
[b,r,b,r,b,r,b,r,o]
[b,r,b,r,b,r,b,o,r]
[b,r,b,r,b,o,b,r,r]
[b,r,b,o,b,r,b,r,r]
[b,o,b,r,b,r,b,r,r]
[b,b,o,r,b,r,b,r,r]
[b,b,b,r,o,r,b,r,r]
[b,b,b,r,b,r,o,r,r]
[b,b,b,r,b,o,r,r,r]
[b,b,b,o,b,r,r,r,r]
[b,b,b,b,o,r,r,r,r]
with additional bindings for the lists of moves Ms and the initial state S0.
a purely syntactic variation of Will Ness's answer:
swap(X,P,Q) :- append([L,X,R],P), reverse(X,Y), append([L,Y,R],Q).
solve(P,Prev,R) :-
solved(P)
-> reverse([P|Prev], R)
; % move(P, Q)
phrase( (swap([r,e])|swap([e,b])|swap([e,r,b])|swap([r,b,e])), P, Q),
\+memberchk(Q, Prev),
solve(Q, [P|Prev], R).
I don't know prolog, but here's a recursive solution using Ruby. Even if you don't know Ruby, you should be able to figure out how the recursion works.
A Ruby primer:
a[space_pos-1], a[space_pos] = a[space_pos], a[space_pos-1] uses parallel assignment to swap the values at array indices space_pos-1 and space_pos without the need for a temporary variable.
FINAL, since it begins with a capital letter, is a constant.
a = arr.dup returns a "shallow" copy of the array arr, so swapping elements of a does not effect arr.
If a method contains no return statement, the value computed in the last line is returned by the method (e.g., the array a in red_slide).
soln=[] in def solve(arr, soln = []) assigns soln to an empty array if solve is called solve(arr).
soln + [:red_slide], where soln is an array and [:red_slide] is an array containing a single symbol (indicated by the colon) is a new array comprised of the elements of soln and the element :red_slide.
you can think of && as "and".
nil is returned by solve if the state of the moves given by solve's argument arr does not lead to a solution.
FINAL = [:b, :b, :b, :b, :e, :r, :r, :r, :r]
SIZE = FINAL.size
def red_slide(arr, space_pos)
a = arr.dup
a[space_pos-1], a[space_pos] = a[space_pos], a[space_pos-1]
a
end
def blue_slide(arr, space_pos)
a = arr.dup
a[space_pos], a[space_pos+1] = a[space_pos+1], a[space_pos]
a
end
def red_jump(arr, space_pos)
a = arr.dup
a[space_pos-2], a[space_pos] = a[space_pos], a[space_pos-2]
a
end
def blue_jump(arr, space_pos)
a = arr.dup
a[space_pos+2], a[space_pos] = a[space_pos], a[space_pos+2]
a
end
def solve(arr, soln = [])
return soln if arr == FINAL
space_pos = arr.index(:e)
# See if can slide red
if space_pos > 0 && arr[space_pos-1] == :r
ret = solve(red_slide(arr, space_pos), soln + [:red_slide])
return ret if ret
end
# See if can slide blue
if space_pos < SIZE-1 && arr[space_pos+1] == :b
ret = solve(blue_slide(arr, space_pos), soln + [:blue_slide])
return ret if ret
end
# See if can jump red over blue
if space_pos > 1 && arr[space_pos-2] == :r && arr[space_pos-1] == :b
ret = solve(red_jump(arr, space_pos), soln + [:red_jump])
return ret if ret
end
# See if can jump blue over red
if space_pos < SIZE-2 && arr[space_pos+2] == :b && arr[space_pos+1] == :r
ret = solve(blue_jump(arr, space_pos), soln + [:blue_jump])
return ret if ret
end
nil
end
solve [:r, :r, :r, :r, :e, :b, :b, :b, :b]
#=> [:red_slide, :blue_jump, :blue_slide, :red_jump, :red_jump, :red_slide,
# :blue_jump, :blue_jump, :blue_jump, :blue_slide, :red_jump, :red_jump,
# :red_jump, :red_jump, :blue_slide, :blue_jump, :blue_jump, :blue_jump,
# :red_slide, :red_jump, :red_jump, :blue_slide, :blue_jump, :red_slide]
I was surprised that it took just a fraction of a second to compute a solution. I guess the number of combinations of moves is not as great as I had imagined.
Note that this solution is for the "N peg problem", not just the "8 peg problem". For example,
FINAL = [:b, :b, :b, :e, :r, :r, :r]
SIZE = FINAL.size
solve [:r, :r, :r, :e, :b, :b, :b]
#=> [:red_slide, :blue_jump, :blue_slide, :red_jump, :red_jump, :red_slide,
# :blue_jump, :blue_jump, :blue_jump, :red_slide, :red_jump, :red_jump,
# :blue_slide, :blue_jump, :red_slide]
Board representation is important, here.
% Form of board, b for blue, r for red, o for empty.
% [r, r, r, r, o, b, b, b, b]
% Legal jumps.
linjmp([r, o | T], [o, r | T]).
linjmp([o, b | T], [b, o | T]).
linjmp([o, r, b | T], [b, r, o | T]).
linjmp([r, b, o | T], [o, b, r | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).
% Series of legal boards.
series(From, To, [From, To]) :- linjmp(From, To).
series(From, To, [From, By | Rest])
:- linjmp(From, By),
series(By, To, [By | Rest]).
% Print a series of boards. This puts one board per line and looks a lot
% nicer than the jumble that appears when the system simply beltches out
% a list of boards. The write_ln predicate is a built-in which always
% succeeds (is always satisfied), but prints as a side-effect. Therefore
% print_series(Z) will succeed with any list, and the members of the list
% will be printed, one per line, as a side-effect of that success.
print_series_r([]) :-
write_ln('*******************************************************').
print_series_r([X|Y]) :- write_ln(X), print_series_r(Y).
print_series(Z) :-
write_ln('\n*******************************************************'),
print_series_r(Z).
% A solution.
solution(L) :- series([r, r, r, r, o, b, b, b, b],
[b, b, b, b, o, r, r, r, r], L).
% Find a print the first solution.
solve :- solution(X), print_series(X).
% Find all the solutions.
solveall :- solve, fail.
% This finds each solution with stepping.
solvestep(Z) :- Z = next, solution(X), print_series(X).

Counting within a list. Help me understand this code

I found a 3 year old question that helps me count the number of occurrences of variables within a list. The question had the answer below. The code works. But I can't understand how, can someone help me make sense of this?
Here is the answer with the code I found, writing in quotation marks is part of the answer:
count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([X1|T],X,Z):- X1\=X,count(T,X,Z).
'However note that the second argument X is supposed to be instantiated. So e.g. count([2,23,3,45,23,44,-20],23,C) will unify C with 2. If you want the count for every element use'
:- use_module(library(lists)).
count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([X1|T],X,Z):- X1\=X,count(T,X,Z)
countall(List,X,C) :-
sort(List,List1),
member(X,List1),
count(List,X,C).
'Then you get'
?- countall([2,23,3,45,23,44,-20],X,Y).
X = -20,
Y = 1 ;
X = 2,
Y = 1 ;
X = 3,
Y = 1 ;
X = 23,
Y = 2 ;
X = 44,
Y = 1 ;
X = 45,
Y = 1 ;
no
I am very new to Prolog, I only understand one part of this code, and it is this
sort(List,List1),
member(X,List1),
I would appreciate an explanation of this the whole thing, especially how Y is being printed.
About counting, first try to think about the meaning of the code.
list_member_occ([], _, 0). % list is empty, 0 occurrences
list_member_occ([X|Xs], X, N) :- % list has the element at the head
list_member_occ(Xs, X, N0), % count number of elements in the tail
succ(N0, N). % the number of occurrences is the
% next natural number
list_member_occ([Y|Xs], X, N) :-
dif(X, Y), % head and the element are different
list_member_occ(Xs, X, N). % occurrences in the tail of the list
% is the total number
In this code, succ(N0, N) is (arguably) a better way to say "N is the natural number after N0" than N is N0 + 1. One reason is that succ/2 was meant to be used in every direction:
?- succ(2, 3).
true.
?- succ(X, 4).
X = 3.
?- succ(1, X).
X = 2.
... while is/2 should be used with unbound left operand. Take this query
?- list_member_occ([1,1,2,1], X, 3).
... for an example of N being a number instead of a free variable.
Using the predicate:
?- list_member_occ([1,2,1], X, N).
X = 1,
N = 2 ;
X = 2,
N = 1 ;
N = 0,
dif(X, 1),
dif(X, 2),
dif(X, 1).
One interesting property of dif/2, as opposed to \=/2, is that it imposes a constraint on the variable X in the last solution: X cannot, from now on, take any of the values 1, or 2.
For the reason why you get all answers using dif/2, consider:
?- X = Y. % unify X and Y and succeed
X = Y.
?- X \= Y. % succeed if you cannot unify X and Y
false.
?- dif(X, Y). % succeed if X and Y are and will be different
dif(X, Y).
When you use X \= Y, Prolog tries to unify its arguments and fails if the unification succeeds. This means that you only get the solution in which all free variables have been unified to each other, but you miss solutions where free variables are different from each other.
About the Y = ..., when you make a query at the top level, it reports to you all new variable bindings that were made during successful proofs of this query. As the most simple example:
Which numbers are between 3 and 5, both including?
?- between(3, 5, X).
X = 3 ;
X = 4 ;
X = 5.
You don't need, of course, to print out the values of X by hand; just type a semicolon to get the next answer. After the last answer you get a full stop and return to the ?- prompt.
About the sorting: it sorts the whole list, but only shows you the first 9 elements of the sorted list. See this FAQ page from SWI-Prolog. In a nutshell, the easiest is to type ; true after your query, to make sure that there is at least one choice point, and use w and p to switch between showing the whole term and only some of it.
?- string_chars("the quick brown fox jumps over the lazy dog", Cs), sort(Cs, S) ; true.
Cs = [t, h, e, ' ', q, u, i, c, k|...],
S = [' ', a, b, c, d, e, f, g, h|...] [write]
Cs = [t, h, e, ' ', q, u, i, c, k, ' ', b, r, o, w, n, ' ', f, o, x, ' ', j, u, m, p, s, ' ', o, v, e, r, ' ', t, h, e, ' ', l, a, z, y, ' ', d, o, g],
S = [' ', a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z] .
?- string_chars("the quick brown fox jumps over the lazy dog", Cs), sort(Cs, S) ; true.
Cs = [t, h, e, ' ', q, u, i, c, k, ' ', b, r, o, w, n, ' ', f, o, x, ' ', j, u, m, p, s, ' ', o, v, e, r, ' ', t, h, e, ' ', l, a, z, y, ' ', d, o, g],
S = [' ', a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z] [print]
Cs = [t, h, e, ' ', q, u, i, c, k|...],
S = [' ', a, b, c, d, e, f, g, h|...] .
Hope this helps.

Resources