Related
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'm trying to get to the result on what would be a double for-loop in another language (Java or JavaScript, for instance).
So the closest I can come up with is something like this:
1> L = [1,2,3].
[1,2,3]
2> R = [X + Y || X <- L, Y <- L].
[2,3,4,3,4,5,4,5,6]
3>
...but what I do really want is: [3,4,5]. I don't want to sum the elements that were already added:
A1 + A2
A2 + A3
A2 + A1 [already computed, position switched]
A2 + A3 [already computed, position switched]
A3 + A1
A3 + A2 [already computed, position switched]
Thanks in advance...
TL;DR
[X+Y || X <- L, Y <- L, Y > X].
Other solutions
You essentially want two iterators walking alongside the same data structure and an accumulator to collect sums of distinctive elements. There is no reason why you wouldn't be able to mimic such iterators in Erlang:
-module(sum2).
-export([start/1]).
start(Max) ->
L = lists:seq(1, Max),
T = list_to_tuple(L),
do_sum(T, 1, 2, size(T), []).
do_sum(T, X, S, S, A) when X + 1 =:= S ->
lists:reverse([mk_sum(X, S, T) | A]);
do_sum(T, X, S, S, A) ->
do_sum(T, X + 1, X + 2, S, [mk_sum(X, S, T) | A]);
do_sum(T, X, Y, S, A) ->
do_sum(T, X, Y + 1, S, [mk_sum(X, Y, T) | A]).
mk_sum(X, Y, T) -> element(X, T) + element(Y, T).
The result:
7> c(sum2).
{ok,sum2}
8> sum2:start(3).
[3,4,5]
9> sum2:start(5).
[3,4,5,6,5,6,7,7,8,9]
There is actually a simpler solution if you don't have a list of elements that you want to sum but just integers:
-module(sum3).
-export([start/1]).
start(Max) -> do_sum(1, 2, Max, []).
do_sum(X, S, S, A) when X + 1 =:= S -> lists:reverse([X + S | A]);
do_sum(X, S, S, A) -> do_sum(X + 1, X + 2, S, [X + S | A]);
do_sum(X, Y, S, A) -> do_sum(X, Y + 1, S, [X + Y | A]).
Or even a simpler solution with just list comprehension:
4> L = [1, 2, 3].
[1,2,3]
5> [X+Y || X <- L, Y <- L, Y > X].
[3,4,5]
6> f().
ok
7> L = [1,2,3,4,5].
[1,2,3,4,5]
8> [X+Y || X <- L, Y <- L, Y > X].
[3,4,5,6,5,6,7,7,8,9]
Also check this question, Erlang; list comprehension without duplicates, which tackles a similar problem and has more ideas for possible solutions.
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 want to replace for example a with 2 in this term f(a,b,g(a,h(a))).
For this I first wanna unfold this term with the univ predicate =...
So far I have:
unfold(T1, T2) :-
T1 =.. T1list,
T2 = T1list.
which is true when T2 is the list represantation of T1.
But in this example I need a way to do this recursively because some arguments are functions as well!
After substitution I need to do all the way back to get f(2,b,g(2,h(2))) as an example
for the substitution I have
replace(X,Y,[],[]).
replace(X,Y,[X|T1],[Y|T2]):-
replace(X,Y,T1,T2).
replace(X,Y,[H|T1],[H|T2]):-
not(X=H),
replace(X,Y,T1,T2).
EDIT: My current Solution: my problem is, it does not work for
replace(a, 1, X, f(1,b,g(1,h(1)))).
replace(_, _, [], []).
replace(X, Y, L1, L2) :-
not(is_list(L1)),
not(is_list(L2)),
unfold(L1, L1unfold),
replace(X,Y, L1unfold, L2sub),
refold(L2sub, L2),
!.
replace(X, Y, [X|T1], [Y|T2]) :-
replace(X, Y, T1, T2),
!.
replace(X, Y, [H|T1], [H|T2]) :-
\+ is_list(H),
replace(X, Y, T1, T2),
!.
replace(X, Y, [H1|T1], [H2|T2]) :-
replace(X, Y, H1, H2),
replace(X, Y, T1, T2).
unfold(T1, [H|T2]) :-
T1 =.. [H|T1Expanded],
maplist(unfold, T1Expanded, T2).
refold([H|T2],T1):-
maplist(refold,T2,R),
T1 =.. [H|R].
You're surprisingly close.
unfold(T1, [H|T2]) :-
T1 =.. [H|T1Expanded],
maplist(unfold, T1Expanded, T2).
possible quick question here since I'm new to Prolog. I'm trying to convert this code for solving a triangular peg solitaire puzzle into solving a rectangular peg solitaire puzzle. The problem I think I'm facing is trying to figure out how to let the program know it completed the puzzle. Here's what I've got currently:
% Legal jumps along a line.
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).
% Rotate the board
rotate([[A, B, C, D, E, F],
[G, H, I, J, K, L],
[M, N, O, P, Q, R],
[S, T, U, V, W, X]],
[[S, M, G, A],
[T, N, H, B],
[U, O, I, C],
[V, P, J, D],
[W, Q, K, E],
[X, R, L, F]]).
rotateBack([[A, B, C, D],
[E, F, G, H],
[I, J, K, L],
[M, N, O, P],
[Q, R, S, T],
[U, V, W, X]],
[[D, H, L, P, T, X],
[C, G, K, O, S, W],
[B, F, J, N, R, V],
[A, E, I, M, Q, U]]).
% A jump on some line.
horizjmp([A|T],[B|T]) :- linjmp(A,B).
horizjmp([H|T1],[H|T2]) :- horizjmp(T1,T2).
% One legal jump.
jump(B,A) :- horizjmp(B,A).
jump(B,A) :- rotate(B,BR), horizjmp(BR,BRJ), rotateBack(A,BRJ).
%jump(B,A) :- rotate(BR,B), horizjmp(BR,BRJ), rotate(BRJ,A).
% 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]).
% A solution.
solution(L) :- series([[o, x, x, x, x, x],
[x, x, x, x, x, x],
[x, x, x, x, x, x],
[x, x, x, x, x, x]], L).
The triangular puzzle code required that the user input what the ending table would look like, but I didn't want that. I want this to show any possible solution. The table will always be exactly 6x4. I liked the idea of rotating the grid to continue to simply figure out horizontal jumps, so I changed the rotate function to rotate it's side, and added a RotateBack function to put it back into place. I figured I would have to do this because the grid isn't symmetrical. Since it will always be this size, I figure the simplest way to find the end is to set up a counter that will count how many moves are taken place. Once we hit 22 moves (the max moves possible to clear the whole grid except for 1 peg), then the solution will be a success.
In other words, I think I need to remove this code:
% 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]).
And change it so that it sets up a counter that stops at 22. Any suggestions?
I think you could count the pegs, or better, fail when there are at least 2.
To do it efficiently, should be (untested code)
finished(L) :-
\+ call_nth(find_peg(L), 2).
find_peg(L) :-
member(R, L),
memberchk(R, x).
call_nth/2, as defined in this answer, requires the builtin nb_setval. This is available in SWI-Prolog or Yap.