Prolog - return value from base case - prolog

Ok, here's the deal:
I've got two piles of shirts
I want to take a random shirt from each pile and put them in a new pile
Then get the new pile out
And here is the code:
mix([],[],_).
mix(P1,P2, Pile):-
takeshirt(P1,1,Taken1,Rem1), takeshirt(P2,1,Taken2,Rem2), #Take one
append(Pile,Taken1,New), append(New,Taken2,NewPile), #Put both of them
mix(Remain1,Remain2,NewPile).
This is what the result look like:
1 ?- mix([a,b],[c,d],NewPile).
NewPile = [] .
I want it to look like:
1 ?- mix([a,b],[c,d],NewPile).
NewPile = [b, d, a, c] .
Or whatever the result is. I checked via the graphical debugger and found out that when the final call to mix happens, the bindings are:
P1 = Taken1 = [b]
P2 = Taken2 = [c]
Pile = [a, d]
Rem1 = Rem2 = []
New = [a, d, b]
NewPile = [a, d, b, c] #<--- Interresting
So the wanted value is in NewPile when the final call to:
mix([],[],_).
happens. After this is it collapses like a house of cards.
So the question is:
mix([],[],_).
I'd like to return the _ value from the base case, this rule mix is actually used from a higher instance where I send in two piles and get the new pile out.
Update:
To clarify some comments about the takeshirt rule, here it is:
takeshirt(_,0,[],_).
takeshirt(List,Number,[Element|Taken],Remain) :- N > 0,
length(List,Len),
Index is random(Len) + 1,
removeshirt_at(Element,List,Index,Remain),
Number1 is Number - 1,
takeshirt(Remain,Number1,Taken,Remain).

Consider the following modifications to your code:
mix([], [], []) :- !.
mix(P1, P2, Pile) :-
takeshirt(P1, 1, Taken1, Rem1),
takeshirt(P2, 1, Taken2, Rem2),
append(Taken1, Taken2, Pile0),
mix(Rem1, Rem2, Pile1),
append(Pile0, Pile1, Pile).
It seems you need to accumulate the 'shirts' (as list atoms). Here, we are recursively appending them onto the third argument of mix/3 (Pile), until the base case (the first clause) is hit when both input lists are empty lists (note that the cut ! is necessary here as the binding pattern for the second clause matches the first, so we want to exclude it). The behaviour of the second clause, which takes a shirt from each input list for every step, requires that they must have been of equal length to start with.
To test this, I used the following definition of takeshirt/4:
takeshirt(Ps, _, [P], Rem) :-
select(P, Ps, Rem).
Note that the second argument here is unused, as select/3 is being used to take a single element (a shirt) from the list, and return the remainder. The absence of a cut (!) after the select allows this predicate to backtrack in selecting all other elements (shirts) from the list. If we now execute your example query with this definition, we can get:
1 ?- mix([a,b],[c,d],NewPile).
NewPile = [a, c, b, d] ;
NewPile = [a, d, b, c] ;
NewPile = [b, c, a, d] ;
NewPile = [b, d, a, c] ;
false.
...we can see that mix/3 enumerates all possible 'piles' on backtracking by taking a shirt from the first pile (first input list), then a shirt from the second pile (second input list), and so on, until both input lists are empty. If your definition of takeshirt/4 doesn't leave choice-points, (is non-backtracking), then you could only get one solution, if any.

Related

return first two element and last two element from the list

can someone help me with this, Prolog language
find the first two-element and the last two elements from the list
the answer should be like this.
?- my_list([a,b, [c,[h], d], [] ,e, h], Q).
Q = [a,b,e,h]
A simple solution is:
my_list([X1,X2|Xs], [X1,X2,X3,X4]) :- reverse(Xs, [X4,X3|_]).
How does it work?
To get the first two elements of the list (X1 and X2), you only need to use unification:
?- [a,b, [c,[h], d], [] ,e, h] = [X1,X2|Xs].
X1 = a,
X2 = b,
Xs = [[c, [h], d], [], e, h].
To get the last two elements (X3 and X4), you can use reverse/2 and unification:
?- [a,b, [c,[h], d], [] ,e, h] = [X1,X2|Xs], reverse(Xs, [X4,X3|_]).
X1 = a,
X2 = b,
Xs = [[c, [h], d], [], e, h],
X4 = h,
X3 = e.
my_list(List, Result) :-
Result = [A,B,Y,Z],
append([A,B], Tail, List),
append( _, [Y,Z], Tail).
Tells Prolog to seek an answer where Result must be a list of four elements, and the first two must fit a pattern of being at the front of the List leaving a remainder in Tail, and the second two must fit the pattern of being at the end of the remainder, leaving the middle of the list which we discard into _ because we don't care about it.
You could instead use nth1/3 to pick out the list elements by their indices; nth1(2, List, Elem) getting the second element. The last index coming from length(List, Len) and calculating the last-but-one index with math.
Or you could use pattern matching to build predicates that match the first two items in a list [A,B|Tail] and a list of two items [Y,Z] and uses recursion to trim down the Tail until it only has two elements. Then combine both those into my_list.
In Prolog folklore there is append/2, that allows a simple solution:
my_list(List,[A,B,Y,Z]) :-
append([[A,B],_,[Y,Z]],List).

Split a list in two halves, reversing the first half using difference lists

I need to do an exercise similar to this:
Prolog - Split a list in two halves, reversing the first half.
I am asked to take a list of letters into two lists that are either equal in size (even sized original list I guess) or one is larger than the other by one element (odd sized list), and reverse the first one while I'm at it, but using only difference lists.
These are the required query and output
?-dividelist2([a,b,c,d,e,f | T] - T, L1-[], L2-[]).
L1 = [c,b,a]
L2 = [d,e,f]
?-dividelist2([a,b,c,d,e | T] - T, L1-[], L2-[]).
L1 = [c,b,a]
L2 = [d,e]
% OR
L1 = [b,a]
L2 = [c,d,e]
This is my code using the previous example but modified, I don't know how to properly compare the two lists
"deduct" them from the input and produce [d,e,f]?
dividelist2(In -[], L1-[], L2-[]) :-
length_dl(In - [],L), % length of the list
FL is L//2, % integer division, so half the length, Out1 will be 1 shorter than Out2 if L is odd
( \+ (FL*2 =:= L), % is odd
FLP is FL + 1 % odd case
; FLP = FL % odd and even case
),
take(In,FLP,FirstHalf),
conc([FirstHalf| L2]-l2,L2-[],In-[]),
reverse1(FirstHalf-[], L1-[]). % do the reverse
reverse1(A- Z,L - L):-
A == Z , !.
reverse1([X|Xs] - Z,L - T):-
reverse1(Xs - Z, L - [X|T]).
length_dl(L- L,0):-!.
length_dl([X|T] - L,N):-
length_dl(T- L,N1),
N is N1 + 1 .
take(Src,N,L) :- findall(E, (nth1(I,Src,E), I =< N), L).
conc(L1-T1,T1-T2,L1-T2).
This is the current trace:
Call:dividelist2([a, b, c, d, e, f|_22100]-_22100, _22116-[], _22112-[])
Call:length_dl([a, b, c, d, e, f]-[], _22514)
Call:length_dl([b, c, d, e, f]-[], _22520)
Call:length_dl([c, d, e, f]-[], _22526)
Call:length_dl([d, e, f]-[], _22532)
Call:length_dl([e, f]-[], _22538)
Call:length_dl([f]-[], _22544)
Call:length_dl([]-[], _22550)
Exit:length_dl([]-[], 0)
Call:_22554 is 0+1
Exit:1 is 0+1
Exit:length_dl([f]-[], 1)
Call:_22560 is 1+1
Exit:2 is 1+1
Exit:length_dl([e, f]-[], 2)
Call:_22566 is 2+1
Exit:3 is 2+1
Exit:length_dl([d, e, f]-[], 3)
Call:_22572 is 3+1
Exit:4 is 3+1
Exit:length_dl([c, d, e, f]-[], 4)
Call:_22578 is 4+1
Exit:5 is 4+1
Exit:length_dl([b, c, d, e, f]-[], 5)
Call:_22584 is 5+1
Exit:6 is 5+1
Exit:length_dl([a, b, c, d, e, f]-[], 6)
Call:_22590 is 6//2
Exit:3 is 6//2
Call:3*2=:=6
Exit:3*2=:=6
Call:_22590=3
Exit:3=3
Call:take([a, b, c, d, e, f], 3, _22594)
Call:'$bags' : findall(_22518, (nth1(_22514, [a, b, c, d, e, f], _22518),_22514=<3), _22614)
Exit:'$bags' : findall(_22518, '251db9a2-f596-4daa-adae-38a38a13842c' : (nth1(_22514, [a, b, c, d, e, f], _22518),_22514=<3), [a, b, c])
Exit:take([a, b, c, d, e, f], 3, [a, b, c])
Call:conc([[a, b, c]|_22112]-l2, _22112-[], [a, b, c, d, e, f]-[])
Fail:conc([[a, b, c]|_22112]-l2, _22112-[], [a, b, c, d, e, f]-[])
Fail:dividelist2([a, b, c, d, e, f|_22100]-_22100, _22116-[], _22112-[])
false
thanks
This is not an answer but testing and debugging suggestions that doesn't fit the comment length limit. The suggestions use Logtalk, which you can run with most Prolog systems.
From your question, the dividelist2/3 predicate needs to satisfy a couple of properties, one of them describing the lengths of the resulting lists. We can express this property easily using a predicate, p/1:
p(DL) :-
difflist::length(DL, N),
dividelist2(DL, DL1, DL2),
difflist::length(DL1, N1),
difflist::length(DL2, N2),
N is N1 + N2,
abs(N1 - N2) =< 1.
Here I'm using Logtalk's difflist library object to compute the length of the difference lists. Given this predicate, we can now perform some property-testing of your dividelist2/3 predicate.
Using Logtalk lgtunit tool implementation of property-testing, we get:
?- lgtunit::quick_check(p(+difference_list(integer))).
* quick check test failure (at test 1 after 0 shrinks):
* p(A-A)
false.
I.e. your code fails for the trivial case of an empty difference list. In the query, we use the difference_list(integer) type simply to simplify the generated counter-examples.
Let's try to fix the failure by adding the following clause to your code:
dividelist2(A-A, B-B, C-C).
Re-trying our test query, we now get:
?- lgtunit::quick_check(p(+difference_list(integer))).
* quick check test failure (at test 2 after 0 shrinks):
* p([0|A]-A)
false.
I.e. the dividelist2/3 predicate fails for a difference list with a single element. You can now use the difference list in the generated counter-example as a starting point for debugging:
?- dividelist2([0|A]-A, L1, L2).
A = [0|A],
L1 = _2540-_2540,
L2 = _2546-_2546 ;
false.
You can also use property-testing with your auxiliary predicates. Take the length_dl/2 predicate. We can compare it with another implementation of a predicate that computes the length of a difference list, e.g. the one in the Logtalk library, by defining another property:
q(DL) :-
difflist::length(DL, N),
length_dl(DL, N).
Testing it we get:
?- lgtunit::quick_check(q(+difference_list(integer))).
* quick check test failure (at test 3 after 0 shrinks):
* q([-113,446,892|A]-A)
false.
Effectively, using the counter.example, we get:
?- length_dl([-113,446,892|A]-A, N).
A = [-113, 446, 892|A],
N = 0.
Hope that this insight helps in fixing your code.
Ok, my idea can work, but seems somewhat inelegant. We'll begin with a handy utility that'll turn a list into a difference list:
list_dl([], W-W).
list_dl([H|T1], [H|T2]-W) :-
list_dl(T1, T2-W).
Now we want a predicate to take the first and last element from the difference list. The case where there's only one element left will need to be handled differently, so we'll make that one unique.
head_last(Head, Head, DL-Hole, one) :-
once(append([Head|_], [Last, Hole], DL)),
var(Last), !.
head_last(Head, Last, DL-Hole, New) :-
once(append([Head|Mid], [Last, Hole], DL)),
list_dl(Mid, New).
Now we can create our recursive split and reverse predicate, which has 3 base cases:
splitrev(W-W, [], []) :- var(W), !. % Empty base case.
splitrev(DL, [V|[]], []) :- head_last(V, V, DL, one).
splitrev(DL, [], [V|[]]) :- head_last(V, V, DL, one).
splitrev(DL, [Head|Front], [Last|Back]) :-
head_last(Head, Last, DL, Rest),
splitrev(Rest, Front, Back).
Unfortunately it's much easier to add an element to the back of a difference list than it is to get an element from the back, plus getting that element closed the hole in the list. Therefore I think a different strategy would be better.

Prolog Out of stack error

I'm working on Problem 26 from 99 Prolog Problems:
P26 (**) Generate the combinations of K distinct objects chosen from
the N elements of a list
Example:
?- combination(3,[a,b,c,d,e,f],L).
L = [a,b,c] ;
L = [a,b,d] ;
L = [a,b,e] ;
So my program is:
:- use_module(library(clpfd)).
combination(0, _, []).
combination(Tot, List, [H|T]) :-
length(List, Length), Tot in 1..Length,
append(Prefix, [H], Stem),
append(Stem, Suffix, List),
append(Prefix, Suffix, SubList),
SubTot #= Tot-1,
combination(SubTot, SubList, T).
My query result starts fine but then returns a Global out of stack error:
?- combination(3,[a,b,c,d,e,f],L).
L = [a, b, c] ;
L = [a, b, d] ;
L = [a, b, e] ;
L = [a, b, f] ;
Out of global stack
I can't understand why it works at first, but then hangs until it gives Out of global stack error. Happens on both SWISH and swi-prolog in the terminal.
if you try to input, at the console prompt, this line of your code, and ask for backtracking:
?- append(Prefix, [H], Stem).
Prefix = [],
Stem = [H] ;
Prefix = [_6442],
Stem = [_6442, H] ;
Prefix = [_6442, _6454],
Stem = [_6442, _6454, H] ;
...
maybe you have a clue about the (main) problem. All 3 vars are free, then Prolog keeps on generating longer and longer lists on backtracking. As Boris already suggested, you should keep your program far simpler... for instance
combination(0, _, []).
combination(Tot, List, [H|T]) :-
Tot #> 0,
select(H, List, SubList),
SubTot #= Tot-1,
combination(SubTot, SubList, T).
that yields
?- aggregate(count,L^combination(3,[a,b,c,d,e],L),N).
N = 60.
IMHO, library(clpfd) isn't going to make your life simpler while you're moving your first steps into Prolog. Modelling and debugging plain Prolog is already difficult with the basic constructs available, and CLP(FD) is an advanced feature...
I can't understand why it works at first, but then hangs until it gives Out of global stack error.
The answers Prolog produces for a specific query are shown incrementally. That is, the actual answers are produced lazily on demand. First, there were some answers you expected, then a loop was encountered. To be sure that a query terminates completely you have to go through all of them, hitting SPACE/or ; all the time. But there is a simpler way:
Simply add false at the end of your query. Now, all the answers are suppressed:
?- combination(3,[a,b,c,d,e,f],L), false.
ERROR: Out of global stack
By adding further false goals into your program, you can localize the actual culprit. See below all my attempts: I started with the first attempt, and then added further false until I found a terminating fragment (failure-slice).
combination(0, _, []) :- false. % 1st
combination(Tot, List, [H|T]) :-
length(List, Length), Tot in 1..Length, % 4th terminating
append(Prefix, [H], Stem), false, % 3rd loops
append(Stem, Suffix, List), false, % 2nd loops
append(Prefix, Suffix, SubList),
SubTot #= Tot-1, false, % 1st loops
combination(SubTot, SubList, T).
To remove the problem with non-termination you have to modify something in the remaining visible part. Evidently, both Prefix and Stem occur here for the first time.
The use of library(clpfd) in this case is very suspicious. After length(List, Length), Length is definitely bound to a non-negative integer, so why the constraint? And your Tot in 1..Length is weird, too, since you keep on making a new constrained variable in every step of the recursion, and you try to unify it with 0. I am not sure I understand your logic overall :-(
If I understand what the exercise is asking for, I would suggest the following somewhat simpler approach. First, make sure your K is not larger than the total number of elements. Then, just pick one element at a time until you have enough. It could go something like this:
k_comb(K, L, C) :-
length(L, N),
length(C, K),
K =< N,
k_comb_1(C, L).
k_comb_1([], _).
k_comb_1([X|Xs], L) :-
select(X, L, L0),
k_comb_1(Xs, L0).
The important message here is that it is the list itself that defines the recursion, and you really don't need a counter, let alone one with constraints on it.
select/3 is a textbook predicate, I guess you should find it in standard libraries too; anyway, see here for an implementation.
This does the following:
?- k_comb(2, [a,b,c], C).
C = [a, b] ;
C = [a, c] ;
C = [b, a] ;
C = [b, c] ;
C = [c, a] ;
C = [c, b] ;
false.
And with your example:
?- k_comb(3, [a,b,c,d,e,f], C).
C = [a, b, c] ;
C = [a, b, d] ;
C = [a, b, e] ;
C = [a, b, f] ;
C = [a, c, b] ;
C = [a, c, d] ;
C = [a, c, e] ;
C = [a, c, f] ;
C = [a, d, b] ;
C = [a, d, c] ;
C = [a, d, e] ;
C = [a, d, f] ;
C = [a, e, b] ;
C = [a, e, c] . % and so on
Note that this does not check that the elements of the list in the second argument are indeed unique; it just takes elements from distinct positions.
This solution still has problems with termination but I don't know if this is relevant for you.

Take elements from one list and append to other

I want a function that will take two lists A and B and return lists Aout and Bout, such that elements from the beginning of A up to a given element (say the atom 'a') have been removed and appended to the end of B, discarding the character. My attempt below:
% usage: take_while(A, Aout, B, Bout)
take_while([], [], B, B).
take_while(['a'|As], As, B, B).
take_while([A|As], As, B, Bout) :-
append(B, [A], Bout),
%take_while(???
The last clause might be the wrong approach. How do I do this?
Looks like you need to simply add the call to take_while to that last clause: (Actually, I am not sure why the second parameter is needed so I'm removing it from this answer).
take_while([], [], B, B).
take_while(['a'|As], As, B, B).
take_while([A|As], ARem, B, Bout) :-
append(B, [A], BTemp), take_while(As, ARem, BTemp, Bout).

Prolog - get the first list from a list of lists

I've got a list consisting of smaller lists inside of it, each list consisting of 2 items:
[[a,1],[b,2],[c,3]]
I'm using a function called take(1,L,R) to take the first item from list L and return the item R. The code for the take function is here:
take(0,X,X).
take(N,[H|T],[H|R]):-
N>0, M is N-1,
take(M,T,R).
At the moment a run may look like this:
1 ?- take(1,[[a],[b],[c]],Taken).
Taken = [[a], [b], [c]]
Which is the same as the input! This is the same for a "regular" 1-level-depth list:
2 ?- take(1,[a,b,c],Taken).
Taken = [a, b, c]
Question:
The question for you is how can I make the result look like:
1 ?- take(1,[[a],[b],[c]],Taken).
Taken = [a]
I want to return the first N items of the list I send it.
Your base case take(0, X, X). is doing exactly what it says -- given any value X, the result is X. What I think you were trying to say is take(1, [H|T], H). (which yields the first element of a list).
What I think you're actually after is take(0, _, [ ]). which yields an empty list when "taking" 0 items from any list. This works well with your existing recursive case.
You say that you want to get the "first N items of the list" -- such a result must be stored in a list of N items. It follows that take(1, [a, b, c], Taken) would yield Taken = [a], not Taken = a. Similarly, take(1, [[a], [b], [c]], Taken). would yield Taken = [[a]].. To special-case the take(1, ...) form to return the first item only (without it being wrapped in a list) would break your recursion.

Resources