Related
Without using arithmetics (=< , =>, etc.)!
I have a few separate piles of blocks, for example two piles.
I need a way to figure out if block A sits Higher on any pile than block B.
For example:
is_on_top(Block1,Pile,Block2). %relations of blocks in a particular pile
for example:
is_bellow(a,1,b). % a is bellow b in pile number 1
is_bellow(r,2,e).
is_bellow(f,2,null). % is at top.
....
and so on.
I'm trying to figure out how to write the predicate:
is_higher(Block1,Block2):- %block1 is higher than block2 in Any line.
% to check for the same line if a block is higher than another I'm this
% is Block1 higher than Block2 in THE SAME pile.
taller(Block1, Block2) :-
is_bellow(Block2,_,Block1).
taller(Block1, Block2) :-
is_bellow(Y, I,Block1),
taller(Y, Block2).
is it possible to do it without using arithmetics?
I think I have the terminating condition.
is_higher(Block1,Block2):-
is_bellow(Block1,_,null), is_bellow(Block2,_,X).
X \= null.
is_higher(Block1,Block2):- % don't know how to continue.
From the comments:
I thought something along the lines of digging deeper on both blocks till block one is paired with null, but I cant quite get my head around it.
You are thinking along the correct lines, but your representation of the world seems to confuse you a bit. It becomes easier if we define a cleaner language for talking about blocks and their relationships.
It would have been good if you had posted a complete example. Here is the one I will be using:
is_below(a, 1, b).
is_below(b, 1, null). % topmost on pile
is_below(c, 2, d).
is_below(d, 2, e).
is_below(e, 2, f).
is_below(f, 2, null). % topmost on pile
I understand this to model the following world:
f
e
b d
a c
-----------------
pile 1 pile 2
Now let's talk about concepts related to this world. First... what even is a block? The representation is implicit, but it appears that a block is something that is on a pile. Being "on a pile" is somewhat implicit too, but it means being below something -- another block, or the special non-block atom null.
So this is a block:
% block(X): X is a block
block(X) :-
is_below(X, _Pile, _BlockOrNull).
Prolog can now enumerate blocks:
?- block(X).
X = a ;
X = b ;
X = c ;
X = d ;
X = e ;
X = f.
Note that null is not included, which is good since it is not a block.
Now, is_below complicates things because it talks about non-blocks (namely, null) and also about the numbers of piles, which we don't always need. Let's define a simpler notion of a block being directly on top of another block:
% block_on(X, Y): X is a block directly on top of block Y
block_on(X, Y) :-
is_below(Y, _Pile, X),
block(X).
Note that we use block(X) to make sure we only talk about blocks. Let's test:
?- block_on(X, Y).
X = b,
Y = a ;
X = d,
Y = c ;
X = e,
Y = d ;
X = f,
Y = e ;
false.
Good. Now, let's define notions for being the topmost and the bottommost block on a pile:
% top(X): X is a block that is topmost on its pile
top(X) :-
block(X),
\+ block_on(_OtherBlock, X). % no other block is on X
% bottom(X): X is a block that is bottommost on its pile
bottom(X) :-
block(X),
\+ block_on(X, _OtherBlock). % X is not on any other block
This behaves like this:
?- top(X).
X = b ;
X = f.
?- bottom(X).
X = a ;
X = c ;
false.
And now we can return to your comment:
I thought something along the lines of digging deeper on both blocks till block one is paired with null, but I cant quite get my head around it.
You were talking about digging (upwards?) until you arrive at a topmost block, but in fact what you should be doing is to dig downwards until you arrive at a bottommost block! Hopefully you can see that it's easier to talk about these concepts now that we have given them clearer names, rather than descriptions like being "paired with null".
Let's start with a non-recursive rule for expressing "higher than". Any non-bottom block is definitely "higher than" any bottom block:
% higher_than(X, Y): X is a block higher on any pile than Y
higher_than(X, Y) :-
bottom(Y),
block(X),
\+ bottom(X).
This already captures a lot of relationships:
?- higher_than(X, Y).
X = b,
Y = a ;
X = d,
Y = a ;
X = e,
Y = a ;
X = f,
Y = a ;
X = b,
Y = c ;
X = d,
Y = c ;
X = e,
Y = c ;
X = f,
Y = c ;
false.
Any non-bottom block (b, d, e, f) is higher than any bottom block (a, c).
Now let's do the "digging" part to express that, for example, f is higher than b. Your idea is correct: If we're at some blocks X and Y, and X is directly on top of some block V and Y is directly on top of some block W, and we can somehow establish that V is higher than W, then X is higher than Y! Here's the same idea expressed in Prolog code:
higher_than(X, Y) :-
block_on(X, V),
block_on(Y, W),
higher_than(V, W).
So is f higher than b?
?- higher_than(f, b).
true ;
false.
Nice. And enumerating all "higher than" pairs:
?- higher_than(X, Y).
X = b,
Y = a ;
X = d,
Y = a ;
X = e,
Y = a ;
X = f,
Y = a ;
X = b,
Y = c ;
X = d,
Y = c ;
X = e,
Y = c ;
X = f,
Y = c ;
X = e,
Y = b ;
X = e,
Y = d ;
X = f,
Y = b ;
X = f,
Y = d ;
X = f,
Y = e ;
false.
Most of these are as before, but we got some new pairs as well: e is higher than b and d, f is higher than b, d, and e. And that is all!
Final remark: I'm not an expert on blocks worlds, but my impression was that it is more usual to model the table top as a special "location" rather than having a special marker for "there is nothing above this".
So I would have represented the same world more like this:
pile_on(1, a, table).
pile_on(1, b, a).
pile_on(2, c, table).
pile_on(2, d, c).
pile_on(2, e, d).
pile_on(2, f, e).
You could switch your code to this representation, maybe it would make your life easier. You could also keep the same higher_than definition -- if you adjust the definitions of block and block_on, all the rest can remain the same.
Assuming is_below( A, P, B) means block A is immediately below block B in some pile P, or is topmost in that pile, with B = null, we can code the is_higher( A, B) predicate exactly as you wanted:
we either have one more step to go down the piles and recurse, or we've reached the bottom of the B pile and judge the situation accordingly:
is_higher( A, B) :- % A is higher than B, if
is_below( A2, _, A), % A is atop one
is_below( B2, _, B), % which is _higher_ than that
A \== B, % which B is atop of
is_higher( A2, B2). % (determined _recursively_)
is_higher( A, B) :- % or,
is_below( _, _, A), % A is not bottommost
is_below( B, _, _), % while B is, because
\+ is_below( _, _, B). % there is nothing below B
%% the world: c
%% b e
%% a d
is_below(a,1,b).
is_below(b,1,c).
is_below(c,1,null).
is_below(d,2,e).
is_below(e,2,null).
Testing:
36 ?- findall( A-B, (is_higher(A,B), A\==null), X).
X = [c-b, c-e, b-a, b-d, c-a, c-d, e-a, e-d].
I'm trying to write a set of predicates that replace terms in nested predicates using recursion; i.e.
Given:
r(a, aa).
r(c, cc).
r(e, ee).
p(a, b, c).
p(a, b, p(d, e, f)).
p(a, p(p(b, c, d), e, f), g).
I want:
p(aa, b, cc)
p(aa, b, p(d, ee, f))
p(aa, p(p(b, cc, d), ee, f), g)
Here is a (probably wildly incorrect) attempt:
inf(p(A, B, C), p(AA, BB, CC)):-
p(A, B, C),
( r(A, AA);
r(B, BB);
r(C, CC)
).
inf(p(A, B, C), p(AA, BB, CC)):-
p(A, B, C),
( r(A, AA);
r(B, BB);
r(C, CC)
),
( inf(A, AA);
inf(B, BB);
inf(C, CC)
).
With a call to inf(X, Y). this yields:
X = p(a, b, c),
Y = p(aa, _1262, _1264)
X = p(a, b, c),
Y = p(_1064, _1066, cc)
X = p(a, b, p(d, e, f)),
Y = p(aa, _1074, _1076)
X = p(a, p(p(b, c, d), e, f), g),
Y = p(aa, _1082, _1084)
false
which is not what I want. I suspect there is something wrong with how my base case combines with the code doing replacements.
Any help would be greatly appreciated!
Thanks/JC
Here's a simplified approach which might have some exception cases for you to examine and explore, but it illustrates a handy use of (=..)/2 and maplist/3. (=..)/2 provides an equivalence between a term and a list (e.g., p(a, b, p(d, e, f)) =.. L results in L = [p, a, b, p(d, e, f)] and Term =.. [foo, x, y] results in Term = foo(x, y)). By getting a list equivalent of a term, you can use recursive list processing to handle arbitrary compound terms.
maplist(foo, List1, List2) exercises a query foo(X1, X2) for every corresponding element X1 of List1 and X2 of List2 and succeeds if each query succeeds and provides argument instantiations for each success as Prolog normally does on a query.
You can use maplist(r, TermList, SubList) to perform a simple substitution using the mapping r as long as r succeeds for every element of the list. However, in this case, you'd want a mapping that succeeds with the same term back again if there is no mapping. For this, you can define map_r as below.
% map_r is the mapping defined by 'r', or term maps to itself
map_r(X, M) :-
r(X, M).
map_r(X, X) :-
\+ r(X, _).
% A functor on its own is just itself after term substitution
term_subst(Term, Functor) :-
Term =.. [Functor]. % Term has no arguments
% A functor with arguments is the same functor with args substituted
term_subst(Term, TermSub) :-
Term =.. [Functor | [Arg|Args]], % Term has at least one arg
maplist(map_r, [Arg|Args], ArgsMap), % mapping of matching args
maplist(term_subst, ArgsMap, ArgsSub), % recursive substitution for sub-terms
TermSub =.. [Functor | ArgsSub].
I need to decompress a list in prolog , like in the example below :
decode([[a,1],[b,2],[c,1],[d,3]],L).
L = [a, b, b, c, d, d, d] ;
I made this code :
divide(L,X,Y):-length(X,1),append(X,Y,L).
divide2(L,X,Y):-divide(L,[X|_],[Y|_]).
makelist(_,N,[]):- N =< 0 .
makelist(X,Y,[X|Result]):-Y1 is Y-1,makelist(X,Y1,Result).
makelist2(L,L2):-divide2(L,X,Y),makelist(X,Y,L2).
decode([],[]).
decode([H|T],L):-makelist2(H,H2),append(H2,L,L2),decode(T,L2).
and when i call
makelist2([a,3],L2).
L2 = [a,a,a].
but when i call
decode([[a,3],[b,1],[c,4]],L)
runs continuously. What am i doing wrong ?
Another variation of the theme, using a slightly modified version of Boris' repeat/3 predicate:
% True when L is a list with N repeats of X
repeat([X, N], L) :-
length(L, N),
maplist(=(X), L).
decode(Encoded, Decoded) :-
maplist(repeat, Encoded, Expanded),
flatten(Expanded, Decoded).
If Encode = [[a,1],[b,2],[c,1],[d,3]], then in the above decode/2, the maplist/3 call will yield Expanded = [[a],[b,b],[c],[d,d,d]], and then the flatten/2 call results in Decoded = [a,b,b,c,d,d,d].
In SWI Prolog, instead of flatten/2, you can use append/2 since you only need a "flattening" at one level.
EDIT: Adding a "bidirectional" version, using a little CLPFD:
rle([], []).
rle([X], [[1,X]]).
rle([X,Y|T], [[1,X]|R]) :-
X \== Y, % use dif(X, Y) here, if available
rle([Y|T], R).
rle([X,X|T], [[N,X]|R]) :-
N #= N1 + 1,
rle([X|T], [[N1,X]|R]).
This will yield:
| ?- rle([a,a,a,b,b], L).
L = [[3,a],[2,b]] ? ;
(1 ms) no
| ?- rle(L, [[3,a],[2,b]]).
L = [a,a,a,b,b] ? ;
no
| ?- rle([a,a,a,Y,Y,Z], [X, [N,b],[M,c]]).
M = 1
N = 2
X = [3,a]
Y = b
Z = c ? a
no
| ?- rle([A,B,C], D).
D = [[1,A],[1,B],[1,C]] ? ;
C = B
D = [[1,A],[2,B]] ? ;
B = A
D = [[2,A],[1,C]] ? ;
B = A
C = A
D = [[3,A]] ? ;
(2 ms) no
| ?- rle(A, [B,C]).
A = [D,E]
B = [1,D]
C = [1,E] ? ;
A = [D,E,E]
B = [1,D]
C = [2,E] ? ;
A = [D,E,E,E]
B = [1,D]
C = [3,E] ? ;
...
| ?- rle(A, B).
A = []
B = [] ? ;
A = [C]
B = [[1,C]] ? ;
A = [C,D]
B = [[1,C],[1,D]] ? ;
...
As #mat suggests in his comment, in Prolog implementations that have dif/2, then dif(X,Y) is preferable to X \== Y above.
The problem is in the order of your append and decode in the last clause of decode. Try tracing it, or even better, trace it "by hand" to see what happens.
Another approach: see this answer. So, with repeat/3 defined as:
% True when L is a list with N repeats of X
repeat(X, N, L) :-
length(L, N),
maplist(=(X), L).
You can write your decode/2 as:
decode([], []).
decode([[X,N]|XNs], Decoded) :-
decode(XNs, Decoded_rest),
repeat(X, N, L),
append(L, Decoded_rest, Decoded).
But this is a slightly roundabout way to do it. You could define a difference-list version of repeat/3, called say repeat/4:
repeat(X, N, Reps, Reps_back) :-
( succ(N0, N)
-> Reps = [X|Reps0],
repeat(X, N0, Reps0, Reps_back)
; Reps = Reps_back
).
And then you can use a difference-list version of decode/2, decode_1/3
decode(Encoded, Decoded) :-
decode_1(Encoded, Decoded, []).
decode_1([], Decoded, Decoded).
decode_1([[X,N]|XNs], Decoded, Decoded_back) :-
repeat(X, N, Decoded, Decoded_rest),
decode_1(XNs, Decoded_rest, Decoded_back).
?- decode([[a,1],[b,2],[c,1],[d,3]],L).
L = [a, b, b, c, d, d, d].
?- decode([[a,3],[b,1],[c,0],[d,3]],L).
L = [a, a, a, b, d, d, d].
?- decode([[a,3]],L).
L = [a, a, a].
?- decode([],L).
L = [].
You can deal with both direction with this code :
:- use_module(library(lambda)).
% code from Pascal Bourguignon
packRuns([],[]).
packRuns([X],[[X]]).
packRuns([X|Rest],[XRun|Packed]):-
run(X,Rest,XRun,RRest),
packRuns(RRest,Packed).
run(Var,[],[Var],[]).
run(Var,[Var|LRest],[Var|VRest],RRest):-
run(Var,LRest,VRest,RRest).
run(Var,[Other|RRest],[Var],[Other|RRest]):-
dif(Var,Other).
%end code
pack_1(In, Out) :-
maplist(\X^Y^(X = [V|_],
Y = [V, N],
length(X, N),
maplist(=(V), X)),
In, Out).
decode(In, Out) :-
when((ground(In); ground(Out1)),pack_1(Out1, In)),
packRuns(Out, Out1).
Output :
?- decode([[a,1],[b,2],[c,1],[d,3]],L).
L = [a, b, b, c, d, d, d] .
?- decode(L, [a,b,b,c,d,d,d]).
L = [[a, 1], [b, 2], [c, 1], [d, 3]] .
a compact way:
decode(L,D) :- foldl(expand,L,[],D).
expand([S,N],L,E) :- findall(S,between(1,N,_),T), append(L,T,E).
findall/3 it's the 'old fashioned' Prolog list comprehension facility
decode is a poor name for your predicate: properly done, you predicate should be bi-directional — if you say
decode( [[a,1],[b,2],[c,3]] , L )
You should get
L = [a,b,b,c,c,c].
And if you say
decode( L , [a,b,b,c,c,c] ) .
You should get
L = [[a,1],[b,2],[c,3]].
So I'd use a different name, something like run_length_encoding/2. I might also not use a list to represent individual run lengths as [a,1] is this prolog term: .(a,.(1,[]). Just use a simple term with arity 2 — myself, I like using :/2 since it's defined as an infix operator, so you can simply say a:1.
Try this on for size:
run_length_encoding( [] , [] ) . % the run-length encoding of the empty list is the empty list.
run_length_encoding( [X|Xs] , [R|Rs] ) :- % the run-length encoding of a non-empty list is computed by
rle( Xs , X:1 , T , R ) , % - run-length encoding the prefix of the list
run_length_encoding( T , Rs ) % - and recursively run-length encoding the remainder
. % Easy!
rle( [] , C:N , [] , C:N ) . % - the run is complete when the list is exhausted.
rle( [X|Xs] , C:N , [X|Xs] , C:N ) :- % - the run is complete,
X \= C % - when we encounter a break
. %
rle( [X|Xs] , X:N , T , R ) :- % - the run continues if we haven't seen a break, so....
N1 is N+1 , % - increment the run length,
rle( Xs, X:N1, T, R ) % - and recurse down.
. % Easy!
In direct answer to the original question of, What am I doing wrong?...
When I ran the original code, any expected use case "ran indefinitely" without yielding a result.
Reading through the main predicate:
decode([],[]).
This says that [] is the result of decoding []. Sounds right.
decode([H|T],L) :- makelist2(H,H2), append(H2,L,L2), decode(T,L2).
This says that L is the result of decoding [H|T] if H2 is an expansion of H (which is what makelist2 does... perhaps - we'll go over that below), and H2 appended to this result gives another list L2 which is the decoded form of the original tail T. That doesn't sound correct. If I decode [H|T], I should (1) expand H, (2) decode T giving L2, then (3) append H to L2 giving L.
So the corrected second clause is:
decode([H|T], L) :- makelist2(H, H2), decode(T, L2), append(H2, L2, L).
Note the argument order of append/3 and that the call occurs after the decode of the tail. As Boris pointed out previously, the incorrect order of append and the recursive decode can cause the continuous running without any output as append with more uninstantiated arguments generates a large number of unneeded possibilities before decode can succeed.
But now the result is:
| ?- decode([[a,3]], L).
L = [a,a,a] ? ;
L = [a,a,a,a] ? ;
...
If you try out our other predicates by hand in the Prolog interpreter, you'll find that makelist2/2 has an issue:
It produces the correct result, but also a bunch of incorrect results. Let's have a look at makelist2/2. We can try this predicate by itself and see what happens:
| ?- makelist2([a,3], L).
L = [a,a,a] ? ;
L = [a,a,a,a] ? ;
...
There's an issue: makelist2/2 should only give the first solution, but it keeps going, giving incorrect solutions. Let's look closer at makelist/2:
makelist2(L,L2) :- divide2(L,X,Y), makelist(X,Y,L2).
It takes a list L of the form [A,N], divides it (via divide2/3) into X = A and Y = N, then calls an auxiliary, makelist(X, Y, L2).
makelist(_,N,[]):- N =< 0 .
makelist(X,Y,[X|Result]):-Y1 is Y-1,makelist(X,Y1,Result).
makelist/3 is supposed to generate a list (the third argument) by replicating the first argument the number of times given in the second argument. The second, recursive clause appears to be OK, but has one important flaw: it will succeed even if the value of Y is less than or equal to 0. Therefore, even though a correct solution is found, it keeps succeeding on incorrect solutions because the base case allows the count to be =< 0:
| ?- makelist(a,2,L).
L = [a,a] ? ;
L = [a,a,a] ? ;
We can fix makelist/2 as follows:
makelist(_,N,[]):- N =< 0 .
makelist(X,Y,[X|Result]):- Y > 0, Y1 is Y-1, makelist(X,Y1,Result).
Now the code will generate a correct result. We just needed to fix the second clause of decode/2, and the second clause of makelist/3.
| ?- decode([[a,3],[b,4]], L).
L = [a,a,a,b,b,b,b]
yes
The complete, original code with just these couple of corrections looks like this:
divide(L, X, Y) :- length(X, 1), append(X, Y, L).
divide2(L, X, Y) :- divide(L, [X|_], [Y|_]).
makelist(_, N, []) :- N =< 0 .
makelist(X, Y, [X|Result]) :- Y > 0, Y1 is Y-1, makelist(X,Y1,Result).
makelist2(L, L2) :- divide2(L, X, Y), makelist(X, Y, L2).
decode([], []).
decode([H|T], L) :- makelist2(H,H2), decode(T,L2), append(H2,L2,L).
Note some simple, direct improvements. The predicate, divide2(L, X, Y) takes a list L of two elements and yields each, individual element, X and Y. This predicate is unnecessary because, in Prolog, you can obtain these elements by simple unification: L = [X, Y]. You can try this right in the Prolog interpreter:
| ?- L = [a,3], L = [X,Y].
L = [a,3]
X = a
Y = 3
yes
We can then completely remove the divide/3 and divide2/3 predicates, and replace a call to divide2(L, X, Y) with L = [X,Y] and reduce makelist2/2 to:
makelist2(L, L2) :- L = [X, Y], makelist(X, Y, L2).
Or more simply (because we can do the unification right in the head of the clause):
makelist2([X,Y], L2) :- makelist(X, Y, L2).
You could just remove makelist2/2 and call makelist/2 directly from decode/2 by unifying H directly with its two elements, [X, N]. So the original code simplifies to:
makelist(_, N, []) :- N =< 0 .
makelist(X, Y, [X|Result]) :- Y > 0, Y1 is Y-1, makelist(X,Y1,Result).
decode([], []).
decode([[X,N]|T], L) :- makelist(X, N, H2), decode(T, L2), append(H2, L2, L).
And makelist/3 can be performed a bit more clearly using one of the methods provided in the other answers (e.g., see Boris' repeat/3 predicate).
I'm looking for a way to shuffle a list of numbers in a specific way.
shuffle([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]) should return [1, 3, 5, 7, 9, 11, 2, 6, 10, 4, 12, 8]
The recursion would be something like this:
[1,3,5,7,9,11] with remainder [2,4,6,8,10,12]
[2,6,10] with remainder [4,8,12]
[4,12] with remainder [8]
and then you append the result lists and return the wanted answer.
My current code looks like this. How can I adapt it so that it produces the type of recursion I explained above? the mode is shuffle(+,?).
shuffle([], _).
shuffle(List, Shuffled) :- r(List, Shuffled).
r([], []).
r([X], [X]):- !.
r([X,A|Xs], [X|Ys]) :- r(Xs, Ys).
First, a predicate that gets half the work done: reorders the list so that every second element is picked out and appended to the back, keeping the order:
untangle([], []).
untangle([X|Xs], [X|Ys]) :-
untangle_1([X|Xs], [X|Ys], Bs, Bs).
% The rest of the Untangled is the list at the back;
% the list at the back is now empty
untangle_1([], Back, Back, []).
% Keep elements in odd positions at the front
untangle_1([X|Xs], [X|Untangled], Back, Bs) :-
untangle_2(Xs, Untangled, Back, Bs).
% Same as above
untangle_2([], Back, Back, []).
% Move elements in even positions to the back
untangle_2([X|Xs], Untangled, Back, [X|Bs]) :-
untangle_1(Xs, Untangled, Back, Bs).
This is very similar to the interwine/3 defined in this answer. Instead of using two lists for the "unzipped" elements, it puts them at the front and back of the same list.
Now what you need is shuffle the elements that would otherwise be appended to the back:
shuffle([], []).
shuffle([X|Xs], Shuffled) :-
untangle_1([X|Xs], Shuffled, Back, Bs),
shuffle(Bs, Back).
Did I understand that correctly?
?- shuffle([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], S), write(S).
[a,c,e,g,i,k,m,o,q,s,u,w,y,b,f,j,n,r,v,z,d,l,t,h,x,p]
S = [a, c, e, g, i, k, m, o, q|...].
You will also notice that this shuffle/2 works in modes shuffle(+List, -Shuffled), shuffle(-List, +Shuffled), and shuffle(?List, ?Shuffled). To what I can see, it is identical in semantics (and almost identical in implementation) to the solution of false.
Here is a version using DCGs:
eo([], Ys,Ys) -->
[].
eo([X|Xs], [X|Ys0],Ys) -->
eo2(Xs, Ys0,Ys).
eo2([], Ys,Ys) -->
[].
eo2([X|Xs], Ys0,Ys) -->
[X],
eo(Xs, Ys0,Ys).
list_shuffled(Xs, Ys0) :-
phrase(eo(Xs, Ys0,Ys),Ys).
And here is the most general query showing all possible uses:
?- list_shuffled(Xs,Ys), numbervars(Xs+Ys,0,_).
Xs = Ys, Ys = []
; Xs = Ys, Ys = [A]
; Xs = Ys, Ys = [A, B]
; Xs = [A, B, C], Ys = [A, C, B]
; Xs = [A, B, C, D], Ys = [A, C, B, D]
; Xs = [A, B, C, D, E], Ys = [A, C, E, B, D]
; Xs = [A, B, C, D, E, F], Ys = [A, C, E, B, D, F]
; Xs = [A, B, C, D, E, F, G], Ys = [A, C, E, G, B, D, F]
; ... .
Here's another, somewhat transparent solution using append:
shuffle([], []).
shuffle([X|T], Shuffled) :-
unzip([X|T], Odd, Even),
shuffle(Even, EvenShuffled),
append(Odd, EvenShuffled, Shuffled).
% Split a list into odd and even elements
unzip([], [], []).
unzip([X], [X], []).
unzip([X,Y|T], [X|Tx], [Y|Ty]) :-
unzip(T, Tx, Ty).
For the record, I do prefer Boris' and false's solutions to this one (+1 to both) as both are more efficient. :)
I have to write a small prolog program which checks if a given person is a ancestor of a second one.
These are the facts and rules:
mother(tim, anna).
mother(anna, fanny).
mother(daniel, fanny).
mother(celine, gertrude).
father(tim, bernd).
father(anna, ephraim).
father(daniel, ephraim).
father(celine, daniel).
parent(X,Y) :- mother(X,Y).
parent(X,Y) :- father(X,Y).
The test if a person is an ancestor of another person is easy:
ancestor(X, Y) :- parent(X, Y).
ancestor(X, Y) :- parent(X, Z), ancestor(Z, Y).
But now I have to write a method ancestor(X,Y,Z) which also prints out the relationship between two persons. It should look like this
?- ancestor(ephraim, tim, X).
false.
?- ancestor(tim, ephraim, X).
X = father(mother(tim)).
And that is the problem: I have no clue how do to this.
You can use an accumulator to adapt #Scott Hunter's solution :
mother(anna, fanny).
mother(daniel, fanny).
mother(celine, gertrude).
father(tim, bernd).
father(anna, ephraim).
father(daniel, ephraim).
father(celine, daniel).
ancestor(X, Y, Z) :- ancestor(X, Y, X, Z).
ancestor(X, Y, Acc, father(Acc)) :- father(X, Y).
ancestor(X, Y, Acc, mother(Acc)) :- mother(X, Y).
ancestor(X, Y, Acc, Result) :-
father(X, Z),
ancestor(Z, Y, father(Acc), Result).
ancestor(X, Y, Acc, Result) :-
mother(X, Z),
ancestor(Z, Y, mother(Acc), Result).
edit : as Scott Hunter showed in his edit, there's no need for an explicit accumulator here, since we can left the inner part of the term unbound easily at each iteration. His solution is therefore better !
A term manipulation alternative to the accumulator tecnique by #Mog:
parent(X, Y, mother(X)) :- mother(X, Y).
parent(X, Y, father(X)) :- father(X, Y).
ancestor(X, Y, R) :-
parent(X, Y, R).
ancestor(X, Y, R) :-
parent(X, Z, P),
ancestor(Z, Y, A),
eldest(A, P, R).
eldest(A, P, R) :-
A =.. [Af, Aa],
( atom(Aa)
-> T = P
; eldest(Aa, P, T)
),
R =.. [Af, T].
To test, I made tim a father: father(ugo, tim).
?- ancestor(tim, ephraim, X).
X = father(mother(tim)) .
?- ancestor(ugo, ephraim, X).
X = father(mother(father(ugo))) .
Simply add a term which tracts what kind of parent is used at each step (edited to get result in proper order):
ancestor(X,Y,father(X)) :- father(X,Y).
ancestor(X,Y,mother(X)) :- mother(X,Y).
ancestor(X,Y,father(Z2)) :- father(Z,Y), ancestor(X,Z,Z2).
ancestor(X,Y,mother(Z2)) :- mother(Z,Y), ancestor(X,Z,Z2).