Prolog: quicksort using last element as pivot (infinite loop) - prolog

I'm trying to implement Quicksort in Prolog using the last element as pivot but somehow my predicate gets into an infinite loop. I'm using an accumulator to determine the part sorted so far (which in the end should be equal to the sorted list S that it should be looking for).
quicksort([], S, S).
quicksort(L, S, A ) :-
lastElement(L, P), /*last element P as pivot*/
split(L, P, Greater, Smaller), /* splits L into set Greater (than) and Smaller (than) by pivot P */
quicksort(Greater, Greater_S, A), /* require Greater to be sorted as well, calling this Greater_S */
quicksort(Smaller, S, [P|Greater_S]). /* same for Smaller, but accumulator should already have P and Greater_S sorted -> [P|Greater_S] as accumulator */
quicksort(L, S) :-
quicksort(L, S, []).
Somehow in quicksort(G, G_S, A), the list G_S seems to iteratively increase in size with the same element, i.e. [X, X, X, X, ...].
What am I doing wrong?
If anyone could help me out it'd be much appreciated!
Thanks in advance.
EDIT: Definitions of the predicates split/4 and lastElement/2:
lastElement([X], X).
lastElement([_|T], X) :- lastElement(T, X).
split([], _, [], []).
split([H|T], P, G, K) :-
H > P,
G = [H|T_],
split(T, P, T_, K).
split([H|T], P, G, K) :-
H =< P,
K = [H|T_],
split(T, P, G, T_).

Answer below; however please compare the original version to the "last element as pivot" version and you will see that "last element as pivot" is just silly. Is it possible that there is a gotcha somewhere in the problem statement that we are both missing?
It seems to me that your life will be easier if you used a simpler Quicksort implementation as a starting point. From the Prolog wiki page
partition([], _, [], []).
partition([X|Xs], Pivot, Smalls, Bigs) :-
( X #< Pivot ->
Smalls = [X|Rest],
partition(Xs, Pivot, Rest, Bigs)
; Bigs = [X|Rest],
partition(Xs, Pivot, Smalls, Rest)
).
quicksort([]) --> [].
quicksort([X|Xs]) -->
{ partition(Xs, X, Smaller, Bigger) },
quicksort(Smaller), [X], quicksort(Bigger).
You will have to use phrase:
quicksort(List, Sorted) :- phrase(quicksort(List), Sorted).
So now it sorts:
?- quicksort([c,b,a,b], S).
S = [a, b, b, c].
The only thing you would have to change is to take the last element instead of the first, probably in the second clause of quicksort//1, like this:
quicksort([X|Xs]) -->
{ append(Front, [Pivot], [X|Xs]),
partition(Front, Pivot, Smaller, Bigger)
},
quicksort(Smaller), [Pivot], quicksort(Bigger).
This use of append/3 leaves behind a choice point; you could write your own list_front_last/3 if you want, or use
once( append(...) )
Hope that helps.
EDIT:
you can change your implementation of lastElement just a bit:
list_front_last([], Last, [], Last).
list_front_last([X|Xs], X0, [X0|Front], Last) :-
list_front_last(Xs, X, Front, Last).
You have already unpacked the first value in the head of quicksort//1:
quicksort([X|Xs]) --> ...
so you can directly use
list_front_last(Xs, X, Front, Pivot)
instead of the call to append/3.

Related

Append list of lists elements in Prolog

I'm learning Prolog for about a week, so I'm a newbie.
I'm trying to do a function, that appends, the elements of a list of lists.
So the input would be: [ [[a,b,c],[g,h,i]], [[j,k,l],[m,n,o]], [[s,t,u],[v,w,x]] ].
And the output would be : [ [a,b,c,j,k,l,s,t,u], [g,h,i,m,n,o,v,w,x] ].
Or
Input: [ [[a,b], [c,d]], [[e,f], [g,h]], [[i,j],[k,l]] ].
Output: [ [a,b,e,f,i,j], [c,d,g,h,k,l] ].
It would be important, that it has to work with a lot of elements, not only 3.
I wrote this, but it only works with 2 elements, so i can only do it, with pairs.
merge([],[],[]).
merge(L1,[],L1).
merge([H1|T1],[H2|T2],LL):-
append(H1, H2, HE),
merge(T1,T2,TE),
append([HE], TE, LL).
If I understand your question correctly...
First, if you know that your input has exactly two levels of nesting in it, and if your Prolog had higher-order predicates for mapping and for folding, and if you could compose them, you could simply write:
merge_foldl([], []).
merge_foldl([X|Xs], R) :-
reverse([X|Xs], [Y|Ys]),
foldl(maplist(append), Ys, Y, R).
This works as expected for SWI-Prolog.
Here it is with your two examples:
?- merge_foldl([ [[a,b,c],[g,h,i]], [[j,k,l],[m,n,o]], [[s,t,u],[v,w,x]] ], R).
R = [[a, b, c, j, k, l, s, t, u], [g, h, i, m, n, o, v, w, x]].
?- merge_foldl([ [[a,b], [c,d], [e,f]], [[g,h], [i,j], [k,l]] ], R).
R = [[a, b, g, h], [c, d, i, j], [e, f, k, l]].
If you don't have access to neither foldr nor foldl, you would have to hardcode the folding:
merge([], []).
merge([X|Xs], Result) :-
merge_maplist(Xs, X, Result).
merge_maplist([], Result, Result).
This is not all, but it says that if you are at the end of the list of lists, the last element is the result.
Now you have to define the step where you append to the front of each sublist. This is easier with maplist:
merge_maplist([X|Xs], Prev, Result) :-
merge_maplist(Xs, X, Result0),
maplist(append, Prev, Result0, Result).
Note that here we are "emulating" a right fold by using a non-tail-recursive definition: we are doing the appending in reverse, after the recursive step. For a tail-recursive definition (identical to hard-coded left fold), you would have to reverse the original list first!
So you keep on peeling off one list of lists from your input until you are done. Then, you use maplist to apply append/3 to each pair of lists from the previous element and the result so far, to get the final result.
If you don't have access to maplist either, you'd have to hardcode the mapping as well. For the three arguments that append/3 takes:
map_append([], [], []).
map_append([X|Xs], [Y|Ys], [Z|Zs]) :-
append(X, Y, Z),
map_append(Xs, Ys, Zs).
and your merge/2 and merge_/3 become:
merge([], []).
merge([X|Xs], Result) :-
merge_(Xs, X, Result).
merge_([], Result, Result).
merge_([X|Xs], Prev, Result) :-
merge_(Xs, X, Result0),
map_append(Prev, Result0, Result).
This is a lot of code for something that can be solved quite nicely if you have higher-order predicates.

Count occurrences Prolog

I'm new in Prolog and trying to do some programming with Lists
I want to do this :
?- count_occurrences([a,b,c,a,b,c,d], X).
X = [[d, 1], [c, 2], [b, 2], [a, 2]].
and this is my code I know it's not complete but I'm trying:
count_occurrences([],[]).
count_occurrences([X|Y],A):-
occurrences([X|Y],X,N).
occurrences([],_,0).
occurrences([X|Y],X,N):- occurrences(Y,X,W), N is W + 1.
occurrences([X|Y],Z,N):- occurrences(Y,Z,N), X\=Z.
My code is wrong so i need some hits or help plz..
Here's my solution using bagof/3 and findall/3:
count_occurrences(List, Occ):-
findall([X,L], (bagof(true,member(X,List),Xs), length(Xs,L)), Occ).
An example
?- count_occurrences([a,b,c,b,e,d,a,b,a], Occ).
Occ = [[a, 3], [b, 3], [c, 1], [d, 1], [e, 1]].
How it works
bagof(true,member(X,List),Xs) is satisfied for each distinct element of the list X with Xs being a list with its length equal to the number of occurrences of X in List:
?- bagof(true,member(X,[a,b,c,b,e,d,a,b,a]),Xs).
X = a,
Xs = [true, true, true] ;
X = b,
Xs = [true, true, true] ;
X = c,
Xs = [true] ;
X = d,
Xs = [true] ;
X = e,
Xs = [true].
The outer findall/3 collects element X and the length of the associated list Xs in a list that represents the solution.
Edit I: the original answer was improved thanks to suggestions from CapelliC and Boris.
Edit II: setof/3 can be used instead of findall/3 if there are free variables in the given list. The problem with setof/3 is that for an empty list it will fail, hence a special clause must be introduced.
count_occurrences([],[]).
count_occurrences(List, Occ):-
setof([X,L], Xs^(bagof(a,member(X,List),Xs), length(Xs,L)), Occ).
Note that so far all proposals have difficulties with lists that contain also variables. Think of the case:
?- count_occurrences([a,X], D).
There should be two different answers.
X = a, D = [a-2]
; dif(X, a), D = [a-1,X-1].
The first answer means: the list [a,a] contains a twice, and thus D = [a-2]. The second answer covers all terms X that are different to a, for those, we have one occurrence of a and one occurrence of that other term. Note that this second answer includes an infinity of possible solutions including X = b or X = c or whatever else you wish.
And if an implementation is unable to produce these answers, an instantiation error should protect the programmer from further damage. Something along:
count_occurrences(Xs, D) :-
( ground(Xs) -> true ; throw(error(instantiation_error,_)) ),
... .
Ideally, a Prolog predicate is defined as a pure relation, like this one. But often, pure definitions are quite inefficient.
Here is a version that is pure and efficient. Efficient in the sense that it does not leave open any unnecessary choice points. I took #dasblinkenlight's definition as source of inspiration.
Ideally, such definitions use some form of if-then-else. However, the traditional (;)/2 written
( If_0 -> Then_0 ; Else_0 )
is an inherently non-monotonic construct. I will use a monotonic counterpart
if_( If_1, Then_0, Else_0)
instead. The major difference is the condition. The traditional control constructs relies upon the success or failure of If_0 which destroys all purity. If you write ( X = Y -> Then_0 ; Else_0 ) the variables X and Y are unified and at that very point in time the final decision is made whether to go for Then_0 or Else_0. What, if the variables are not sufficiently instantiated? Well, then we have bad luck and get some random result by insisting on Then_0 only.
Contrast this to if_( If_1, Then_0, Else_0). Here, the first argument must be some goal that will describe in its last argument whether Then_0 or Else_0 is the case. And should the goal be undecided, it can opt for both.
count_occurrences(Xs, D) :-
foldl(el_dict, Xs, [], D).
el_dict(K, [], [K-1]).
el_dict(K, [KV0|KVs0], [KV|KVs]) :-
KV0 = K0-V0,
if_( K = K0,
( KV = K-V1, V1 is V0+1, KVs0 = KVs ),
( KV = KV0, el_dict(K, KVs0, KVs ) ) ).
=(X, Y, R) :-
equal_truth(X, Y, R).
This definition requires the following auxiliary definitions:
if_/3, equal_truth/3, foldl/4.
If you use SWI-Prolog, you can do :
:- use_module(library(lambda)).
count_occurrences(L, R) :-
foldl(\X^Y^Z^(member([X,N], Y)
-> N1 is N+1,
select([X,N], Y, [X,N1], Z)
; Z = [[X,1] | Y]),
L, [], R).
One thing that should make solving the problem easier would be to design a helper predicate to increment the count.
Imagine a predicate that takes a list of pairs [SomeAtom,Count] and an atom whose count needs to be incremented, and produces a list that has the incremented count, or [SomeAtom,1] for the first occurrence of the atom. This predicate is easy to design:
increment([], E, [[E,1]]).
increment([[H,C]|T], H, [[H,CplusOne]|T]) :-
CplusOne is C + 1.
increment([[H,C]|T], E, [[H,C]|R]) :-
H \= E,
increment(T, E, R).
The first clause serves as the base case, when we add the first occurrence. The second clause serves as another base case when the head element matches the desired element. The last case is the recursive call for the situation when the head element does not match the desired element.
With this predicate in hand, writing count_occ becomes really easy:
count_occ([], []).
count_occ([H|T], R) :-
count_occ(T, Temp),
increment(Temp, H, R).
This is Prolog's run-of-the-mill recursive predicate, with a trivial base clause and a recursive call that processes the tail, and then uses increment to account for the head element of the list.
Demo.
You have gotten answers. Prolog is a language which often offers multiple "correct" ways to approach a problem. It is not clear from your answer if you insist on any sort of order in your answers. So, ignoring order, one way to do it would be:
Sort the list using a stable sort (one that does not drop duplicates)
Apply a run-length encoding on the sorted list
The main virtue of this approach is that it deconstructs your problem to two well-defined (and solved) sub-problems.
The first is easy: msort(List, Sorted)
The second one is a bit more involved, but still straight forward if you want the predicate to only work one way, that is, List --> Encoding. One possibility (quite explicit):
list_to_rle([], []).
list_to_rle([X|Xs], RLE) :-
list_to_rle_1(Xs, [[X, 1]], RLE).
list_to_rle_1([], RLE, RLE).
list_to_rle_1([X|Xs], [[Y, N]|Rest], RLE) :-
( dif(X, Y)
-> list_to_rle_1(Xs, [[X, 1],[Y, N]|Rest], RLE)
; succ(N, N1),
list_to_rle_1(Xs, [[X, N1]|Rest], RLE)
).
So now, from the top level:
?- msort([a,b,c,a,b,c,d], Sorted), list_to_rle(Sorted, RLE).
Sorted = [a, a, b, b, c, c, d],
RLE = [[d, 1], [c, 2], [b, 2], [a, 2]].
On a side note, it is almost always better to prefer "pairs", as in X-N, instead of lists with two elements exactly, as in [X, N]. Furthermore, you should keep the original order of the elements in the list, if you want to be correct. From this answer:
rle([], []).
rle([First|Rest],Encoded):-
rle_1(Rest, First, 1, Encoded).
rle_1([], Last, N, [Last-N]).
rle_1([H|T], Prev, N, Encoded) :-
( dif(H, Prev)
-> Encoded = [Prev-N|Rest],
rle_1(T, H, 1, Rest)
; succ(N, N1),
rle_1(T, H, N1, Encoded)
).
Why is it better?
we got rid of 4 pairs of unnecessary brackets in the code
we got rid of clutter in the reported solution
we got rid of a whole lot of unnecessary nested terms: compare .(a, .(1, [])) to -(a, 1)
we made the intention of the program clearer to the reader (this is the conventional way to represent pairs in Prolog)
From the top level:
?- msort([a,b,c,a,b,c,d], Sorted), rle(Sorted, RLE).
Sorted = [a, a, b, b, c, c, d],
RLE = [a-2, b-2, c-2, d-1].
The presented run-length encoder is very explicit in its definition, which has of course its pros and cons. See this answer for a much more succinct way of doing it.
refining joel76 answer:
count_occurrences(L, R) :-
foldl(\X^Y^Z^(select([X,N], Y, [X,N1], Z)
-> N1 is N+1
; Z = [[X,1] | Y]),
L, [], R).

Fact for each element of a list Prolog

I want to solve this problem in Prolog. i want give a list of natural numbers to find all the elements in the list that satisfy this condition:
All elements on the left of it are smaller than it and all the elements on the right of it are larger than it.
For example give a list [3,2,4,1,5,7,8,9,10,8] the answer would be 5,7
So far I've manage to make this function that given an element of the list it returns true or false if the element satisfises the condition described above.
check(Elem, List) :-
seperate(Elem, List, List1, List2),
lesser(Elem, List1, X1),
bigger(Elem, List2, X2),
size(X1, L1),
size(X2, L2),
size(List, L3),
match(L1, L2, L3),
Now I want to make another predicate that given a list, it does the above computations for each element of the list. Due to the fact that more than one element may satisfy it I want to create another list with all the elements that satisfy the problem.
The question would be something like ?-predicate_name([[3,2,4,1,5,7,8,9,10,8],N). and the result would be a list of elements.
Sry If I am not using the right terms of Prolog. I will describe what I want to do in sequential logic language to be more specific although it's not a good idea to think like that. If we consider a the predicate check as a function that given a list and element of the list it would return true or false whether or not the element satisfied the conditions of the problem. Now I want to parse each element of the list and for each one of it call the function check. If that would return true then I would add the element in another list a.k.a result. I want to do this in Prolog but I don't know how to iterate a list.
Here is a version using DCGs and assuming we want to compare arithmetically.
list_mid(L, M) :-
phrase(mid(M), L).
mid(M) -->
seq(Sm),
[M],
{maplist(>(M),Sm)},
seq(Gr),
{maplist(<(M),Gr)}.
seq([]) -->
[].
seq([E|Es]) -->
[E],
seq(Es).
Often it is not worth optimizing this any further. The first seq(Sm) together with the subsequent maplist/2 might be merged together. This is a bit tricky, since one has to handle separately the cases where Sm = [] and Sm = [_|_].
mid(M) -->
( [M]
| max(Mx),
[M],
{Mx < M}
),
min(M).
max(M) -->
[E],
maxi(E, M).
maxi(E, E) -->
[].
maxi(E, M) -->
[F],
{G is max(F,E)},
maxi(G, M).
min(_) -->
[].
min(M) -->
[E],
{M < E},
min(M).
I'm going to take a different approach on the problem.
We want to find all of the values that meet the criteria of being a "mid" value, which is one defined as being greater than all those before it in the list, and less than all those after.
Define a predicate mid(L, M) as meaning M is a "mid" value of L:
mid([X|T], X) :- % The first element of a list is a "mid" if...
less(X, T). % it is less than the rest of the list
mid([X|T], M) :- % M is a "mid" of [X|T] if...
mid(T, X, M). % M is a "mid" > X
% (NOTE: first element is not a "mid" by definition)
mid([X|T], LastM, X) :- % X is a "mid" > Y if...
X > LastM, % X > the last "mid"
less(X, T). % X < the rest of the list, T
mid([X|T], LastM, M) :- % Also, M is a "mid" if...
Z is max(X, LastM), % Z is the larger of X and the last "mid"
mid(T, Z, M). % M is the "mid" of T which is > Z
less(X, [Y|T]) :- % X is less than the list [Y|T] if...
X < Y, % X < Y, and
less(X, T). % X < the tail, T
less(_, []). % An element is always less than the empty list
Each query will find the next "mid":
| ?- mid([3,2,4,1,5,7,8,9,10,8], M).
M = 5 ? ;
M = 7 ? ;
no
Then they can be captured with a findall:
mids(L, Ms) :-
findall(M, mid(L, M), Ns).
| ?- mids([3,2,4,1,5,7,8,9,10,8], Ms).
Ms = [5,7]
yes
| ?- mids([2], L).
L = [2]
(1 ms) yes
This is probably not the most computationally efficient solution since it doesn't take advantage of a couple of properties of "mids". For example, "mids" will all be clustered together contiguously, so once a "mid" is found, it doesn't make sense to continue searching if an element is subsequently encountered which is not itself a "mid". If efficiency is a goal, these sorts of ideas can be worked into the logical process.
ADDENDUM
With credit to #false for reminding me about maplist, the above predicate call less(X, T) could be replaced by maplist(<(X), T) eliminating the definition of less in the above implementation.

How to take the head of one list in a list of lists and put it in another list?

I have a list of lists, which looks something like this:
[[b,c],[],[a]]
I want to write a predicate that will take a specific letter from the top of one of the lists, and put it in another list. The letter to be moved is specified beforehand. It can be placed on top of a list which is either empty, or contains a letter that is larger (b can be placed on c, but not otherwise). The letter should be removed from the original list after it has been moved.
I am having trouble telling Prolog to look for a list which starts with the specified letter, and also how to tell Prolog to put this in another list.
here is my solution, based no [nth1][1]/4 (well, you should read documentation for nth0/4, really)
/* takes a specific letter from the top of one of the lists, and puts it in another list.
The letter to be moved is specified beforehand.
It can be placed on top of a list which is either empty, or contains a letter that is larger (b can be placed on c, but not otherwise).
The letter should be removed from the original list after it has been moved.
*/
move_letter(Letter, Lists, Result) :-
% search Letter, Temp0 miss amended list [Letter|Rest]
nth1(I, Lists, [Letter|Rest], Temp0),
% reinsert Rest, Temp1 just miss Letter
nth1(I, Temp1, Rest, Temp0),
% search an appropriate place to insert Letter
nth1(J, Temp1, Candidate, Temp2),
% insertion constraints
J \= I, (Candidate = [] ; Candidate = [C|_], C #> Letter),
% update Result
nth1(J, Result, [Letter|Candidate], Temp2).
Usage examples:
?- move_letter(a,[[b,c],[],[a]],R).
R = [[a, b, c], [], []] ;
R = [[b, c], [a], []] ;
false.
?- move_letter(b,[[b,c],[],[a]],R).
R = [[c], [b], [a]] ;
false.
I followed this 'not idiomatic' route to ease the check that the insertion occurs at different place than deletion.
Below are some rules to find lists that starts with some element.
starts_with([H|T], H).
find_starts_with([],C,[]).
find_starts_with([H|T],C,[H|Y]) :- starts_with(H,C),find_starts_with(T,C,Y).
find_starts_with([H|T],C,L) :- \+ starts_with(H,C), find_starts_with(T,C,L).
Example:
| ?- find_starts_with([[1,2],[3,4],[1,5]],1,X).
X = [[1,2],[1,5]] ? ;
I like #CapelliC's concise solution. Here's an alternative solution that doesn't use the nth1 built-in. Apologies for the sucky variable names.
% move_letter : Result is L with the letter C removed from the beginning
% of one sublist and re-inserted at the beginning of another sublist
% such that the new letter is less than the original beginning letter
% of that sublist
%
move_letter(C, L, Result) :-
removed_letter(C, L, R, N), % Find & remove letter from a sublist
insert_letter(C, R, 0, N, Result). % Result is R with the letter inserted
% removed_letter : R is L with the letter C removed from the beginning of a
% sublist. The value N is the position within L that the sublist occurs
%
removed_letter(C, L, R, N) :-
removed_letter(C, L, R, 0, N).
removed_letter(C, [[C|T]|TT], [T|TT], A, A).
removed_letter(C, [L|TT], [L|TTR], A, N) :-
A1 is A + 1,
removed_letter(C, TT, TTR, A1, N).
% Insert letter in empty sublist if it's not where the letter came from;
% Insert letter at front of a sublist if it's not where the letter came from
% and the new letter is less than the current head letter;
% Or insert letter someplace later in the list of sublists
%
insert_letter(C, [[]|TT], A, N, [[C]|TT]) :-
A \== N.
insert_letter(C, [[C1|T]|TT], A, N, [[C,C1|T]|TT]) :-
A \== N,
C #< C1.
insert_letter(C, [L|TT], A, N, [L|TTR]) :-
A1 is A + 1,
insert_letter(C, TT, A1, N, TTR).
Results in:
| ?- move_letter(a, [[b,c],[],[a]], R).
R = [[a,b,c],[],[]] ? a
R = [[b,c],[a],[]]
no
| ?- move_letter(b, [[b,c],[],[a]], R).
R = [[c],[b],[a]] ? a
no
| ?- move_letter(b, [[b,c], [], [a], [b,d]], R).
R = [[c],[b],[a],[b,d]] ? a
R = [[b,c],[b],[a],[d]]
no

return all levels of a binarytree in prolog

I'm trying to get a program to return the levels of a BT in the way of a list and I'm stuck at this:
nivel(nodo(L,Root,R)) :- nivel(nodo(L,Root,R),X),writeln(X).
nivel(vacio,[]).
nivel(nodo(L,Root,R),[Root|T]) :- nivel(L,T),nivel(R,T),writeln(T).
An example input-output of what I'm trying is:
nivel(nodo(nodo(vacio,4,vacio), t, nodo(vacio,r,vacio))
X =[t]
X =[4,r]
problem is I don't know how to make the program get the new Roots.
Any ideas? Also, thanks in advance!
Here goes a solution, it traverses the tree once an builds a list of the items in each level.
nivel(Arbol, SubNivel):-
nivel(Arbol, [], [], Items),
member(SubNivel, Items),
SubNivel \= [].
nivel(vacio, Items, SubNiveles, [Items|SubNiveles]).
nivel(nodo(Izq, Item, Der), Items, [], [[Item|Items]|NSubNiveles]):-
nivel(Izq, [], [], [MSubItems|MSubNiveles]),
nivel(Der, MSubItems, MSubNiveles, NSubNiveles).
nivel(nodo(Izq, Item, Der), Items, [SubItems|SubNiveles], [[Item|Items]|NSubNiveles]):-
nivel(Izq, SubItems, SubNiveles, [MSubItems|MSubNiveles]),
nivel(Der, MSubItems, MSubNiveles, NSubNiveles).
The second clause of nivel/4 is a hack due to the fact that the algorithm does not know in advance the height of the tree.
Test case:
?- nivel(nodo(nodo(nodo(nodo(vacio,f,vacio),e,nodo(vacio,g,vacio)),b,vacio),a,nodo(vacio,c,nodo(vacio,d,vacio))), X).
X = [a] ; --> Root
X = [c, b] ; --> First Level
X = [d, e] ; --> Second Level
X = [g, f] ; --> Third Level
Quite a tricky one for Prolog, but here's one solution to consider which provides a true level-order (L-R breadth-first) tree traversal:
nivel(nodo(L,Root,R), Level) :-
depth_value_pairs(nodo(L,Root,R), 0, DVPairs),
keylistmerge(DVPairs, Groups),
maplist(keyvalue, Groups, _, Values),
member(Level, Values).
nivel/2 is your entry predicate. Basically, it uses depth_value_pairs/3, which generates solutions of the form Depth-Value (e.g., 0-t to represent the root node t at ply depth 0, or 1-4 to represent the node 4 at ply depth 1, etc.). Then, it uses keylistmerge/2 to merge the list all depth-value pairs into depth groups, e.g., [0-[t], 1-[4,t], ...]. Then, the maplist(keyvalue... call busts the Depth- parts from the lists, and the final predicate call member/2 selects each list to bind to the output Level.
Here are the other predicate definitions:
depth_value_pairs(vacio, _, []).
depth_value_pairs(nodo(L, Root, R), Depth, [Depth-Root|Level]) :-
NextLevel is Depth + 1,
depth_value_pairs(L, NextLevel, LL),
depth_value_pairs(R, NextLevel, RL),
append(LL, RL, Level).
keyvalue(K-V, K, V).
keylistmerge(KVL, MKVL) :-
keysort(KVL, [K-V|KVs]),
keylistmerge([K-V|KVs], K, [], MKVL).
keylistmerge([], K, Acc, [K-Acc]).
keylistmerge([K0-V|KVs], K, Acc, MKVL) :-
K == K0, !,
append(Acc, [V], NewAcc),
keylistmerge(KVs, K, NewAcc, MKVL).
keylistmerge([K0-V|KVs], K, Acc, [K-Acc|MKVs]) :-
keylistmerge(KVs, K0, [V], MKVs).
Exercising this gives us:
?- nivel(nodo(nodo(vacio,4,nodo(vacio,5,vacio)), t, nodo(vacio,r,vacio)), Level).
Level = [t] ;
Level = [4, r] ;
Level = [5] ;
false.
Note that we rely on the built-in keysort/2 to be order-preserving (stable) so as to preserve the L-R order of nodes in the binary tree.

Resources