Prolog unpacking lists predicate - prolog

I tried to create something what would work like this:
?- unpacking([[1], [1,2], [3]], Lst1, NewLst).
NewLst=[1,3]
I wrote it like this:
unpacking([], Lst1, Lst1).
unpacking([[H]|T], Lst1, NewLst):-
append([H], Lst2),
unpacking(T, Lst2, NewLst).
unpacking([_|T], Lst1, NewLst):-
unpacking(T, Lst1, NewLst).
and I know that I am doing something wrong. I am starting in Prolog so, need to learn from my mistakes :)

You probably meant:
unpacking([], []).
unpacking([[E]|T], [E|L]) :-
unpacking(T, L).
unpacking([[]|T], L) :-
unpacking(T, L).
unpacking([[_,_|_]|T], L) :-
unpacking(T, L).
There are more concise ways to write this - and more efficient, too.

What about this :
%?-unpacking([[a,b,c],[a],[b],[c,d]],Items).
unpacking(Lists,Items):-
my_tpartition(length_t(1),Lists,Items,Falses).
my_tpartition(P_2,List,Ts,Fs) :- my_tpartition_ts_fs_(List,Ts,Fs,P_2).
my_tpartition_ts_fs_([],[],[],_).
my_tpartition_ts_fs_([X|Xs0],Ts,Fs,P_2) :-
if_(call(P_2,X), (X=[NX],Ts = [NX|Ts0], Fs = Fs0),
(Ts = Ts0, Fs = [X|Fs0])),
my_tpartition_ts_fs_(Xs0,Ts0,Fs0,P_2).
length_t(X,Y,T):-
length(Y,L1),
=(X,L1,T).
This is based on Most general higher-order constraint describing a sequence of integers ordered with respect to a relation
* Update*
You could change to
length_t(X,Y,T):-
L1 #=< X,
fd_length(Y,L1),
=(X,L1,T),!.
length_t(_X,_Y,false).
fd_length(L, N) :-
N #>= 0,
fd_length(L, N, 0).
fd_length([], N, N0) :-
N #= N0.
fd_length([_|L], N, N0) :-
N1 is N0+1,
N #>= N1,
fd_length(L, N, N1).
giving:
?-unpacking([[1],[2,3],[4],[_,_|_]],U).
U= [1,4].
but:
?-unpacking([X],Xs).
X = Xs, Xs = [].

Based on #coder's solution, I made my own attempt using if_ and DCGs:
one_element_([], true).
one_element_([_|_],false).
one_element([], false).
one_element([_|Xs], T) :-
one_element_(Xs, T).
f([]) -->
[].
f([X|Xs]) -->
{ if_(one_element(X), Y=X, Y=[]) },
Y,
f(Xs).
unpack(Xs,Ys) :-
phrase(f(Xs),Ys).
I only tried for about 30s, but the queries:
?- Xs = [[] | Xs], unpack(Xs,Ys).
?- Xs = [[_] | Xs], unpack(Xs,Ys).
?- Xs = [[_, _ | _] | Xs], unpack(Xs,Ys).
didn't stop with a stack overflow. In my opinion, the critical one should be the last query, but apparently, SWI Prolog manages to optimize:
?- L = [_,_|_], one_element(L,T).
L = [_3162, _3168|_3170],
T = false.
Edit: I improved the solution and gave it a shot with argument indexing. According to the SWI Manual, indexing happens if there is exactly a case distinction between the empty list [] and the non-empty list [_|_]. I rewrote one_element such that it does exactly that and repeated the trick with the auxiliary predicate one_element_. Now that one_element is pure again, we don't lose solutions anymore:
?- unpack([A,B],[]).
A = [_5574, _5580|_5582],
B = [_5628, _5634|_5636] ;
A = [_5574, _5580|_5582],
B = [] ;
A = [],
B = [_5616, _5622|_5624] ;
A = B, B = [].
but
?- unpack([[a,b,c],[a],[b],[c,d]],Items).
Items = [a, b].
is still deterministic. I have not tried this solution in other Prologs, which might be missing the indexing, but it seems for SWI, this is a solution.
Update: Apparently GNU Prolog does not do this kind of indexing and overflows on cyclic lists:
| ?- Xs = [[] | Xs], unpack(Xs,Ys).
Fatal Error: global stack overflow (size: 32770 Kb, reached: 32768 Kb, environment variable used: GLOBALSZ)

After some thought, here is my implementation using if_/3:
unpacking(L,L1):-if_( =(L,[]), L1=[], unpack(L,L1)).
unpack([H|T],L):-if_(one_element(H), (H = [X],L=[X|T1],unpacking(T,T1)), unpacking(T,L)).
one_element(X, T) :-
( var(X) ->(T=true,X=[_]; T=false,X=[])
; X = [_] -> T = true
; X \= [_] -> T = false).
Some testcases:
?- unpacking([Xss],[]).
Xss = [].
?- unpacking([[1],[2,3],[4],[_,_|_]],U).
U = [1, 4].
?- unpacking([[1],[2,3],[4]],U).
U = [1, 4].
?- unpacking([[E]],[1]), E = 2.
false.
?- unpacking(non_list, []).
false.
?- unpacking([Xs],Xs).
Xs = [_G6221] ;
Xs = [].
UPDATE
To fix the case that #false referred in the comment we could define:
one_element([],false).
one_element([_],true).
one_element([_,_|_],false).
But this leaves some choice points...

One way to do it is with a findall I dont think its what the bounty is for though ;)
unpacking(Lists,L1):-
findall(I,(member(M,Lists),length(M,1),M=[I]),L1).
or
unpacking2(Lists,L1):-
findall(I,member([I],Lists),L1).

Related

Better pure version of same_length/2

Given the frequent pure definition of same_length/2 as
same_length([],[]).
same_length([_|As], [_|Bs]) :-
same_length(As, Bs).
?- same_length(L, [_|L]).
loops.
Is there a pure definition that does not loop for such cases? Something in analogy to the pure (but less efficient) version of append/3 called append2u/3.
I know how to catch such cases manually with var/1 and the like, but ideally a version that is just as pure as the original definition would be desirable. Or at least it should be simple.
What I have tried is the definition above.
One clarification seems to be in order:
Note that there are certain queries that inherently must not terminate. Think of:
?- same_length(Ls, Ks).
Ls = [], Ks = []
; Ls = [_A], Ks = [_B]
; Ls = [_A,_B], Ks = [_C,_D]
; Ls = [_A,_B,_C], Ks = [_D,_E,_F]
; Ls = [_A,_B,_C,_D], Ks = [_E,_F,_G,_H]
; ... .
There is no other way to enumerate all solutions using the language of syntactic answer substitutions.
But still an implementation may terminate for the queries given.
This answer aims at minimising runtime costs.
It is built on '$skip_max_list'/4 and runs on Scryer Prolog.
First up, some auxiliary code:
:- use_module(library(lists)).
'$skip_list'(N,Xs0,Xs) :-
'$skip_max_list'(N,_,Xs0,Xs).
is_list([]).
is_list([_|Xs]) :-
is_list(Xs).
sam_length_([],[]).
sam_length_([_|Xs],[_|Ys]) :-
sam_length_(Xs,Ys).
Now the main dish:
sam_length(Ls1,Ls2) :-
'$skip_list'(L1,Ls1,Rs1),
( Rs1 == []
-> length(Ls2,L1)
; var(Rs1),
'$skip_max_list'(L2,L1,Ls2,Rs2),
( L2 < L1
-> var(Rs2),
Rs1 \== Rs2,
'$skip_max_list'(_,L2,Ls1,Ps1),
sam_length_(Ps1,Rs2)
; '$skip_list'(N2,Rs2,Ts2),
( Ts2 == []
-> M1 is N2-L1,
length(Rs1,M1)
; var(Ts2),
( N2 > 0
-> Ts2 \== Rs1,
sam_length_(Rs2,Rs1) % switch argument order
; Rs1 == Rs2
-> is_list(Rs1) % simpler enumeration
; sam_length_(Rs1,Rs2)
)
)
)
).
Sample queries:
?- sam_length(L,[_|L]).
false.
?- sam_length([_],L).
L = [_A].
?- sam_length(L,M).
L = [], M = []
; L = [_A], M = [_B]
; ... .
A solution using '$skip_max_list'/4:
% Clause for `?- L = [a|L], same_length(L, _)`.
same_length(As, Bs) :-
(Cs = As ; Cs = Bs),
'$skip_max_list'(_, _, Cs, Cs0),
subsumes_term([_|_], Cs0), !,
false.
% Clause for `?- same_length(L, [_|L])`.
same_length(As, Bs) :-
As \== Bs,
'$skip_max_list'(S, _, As, As0),
'$skip_max_list'(T, _, Bs, Bs0),
As0 == Bs0,
S \== T, !,
false.
same_length(As, Bs) :-
same_length_(As, Bs).
same_length_([], []).
same_length_([_|As], [_|Bs]) :-
same_length_(As, Bs).
Queries:
?- L = [a|L], same_length(L, _).
false.
?- same_length(L, [_|L]).
false.
?- same_length([_], L).
L = [_A].
?- same_length(L, M).
L = [], M = []
; L = [_A], M = [_B]
; ... .
UPDATED SOLUTION
Here is my solution:
same_length(A, A).
same_length([_|A], [_|B]) :- same_length(A, B).
?- same_length(L, [_|L]).
L = [_1696|L]
I am not sure if it has all the properties you're looking for. For example if you call
? - same_length(L, [1,2,3]).
then it lists many answers, e.g. L = [_X, 2, 3], rather than just [_X, _Y, _Z]. But it's pure and produces a correct answer for the query quoted.

How to rotate using difference-list in Prolog

Using difference-lists,How to rotate a given list by moving the first two elements to the end of the list, so that [a,b,c,d] becomes [c,d,a,b].
If you're being provided with a difference list, then can use:
?- L = [a,b,c,d,e,f|R], L = [H1, H2|T], R = [H1, H2].
T = [c,d,e,f,a,b].
As a DCG (more human-friendly than difference lists), in swi-prolog:
% For remainder/1
:- use_module(library(dcg/basics)).
% Show lists of codes nicely
:- portray_text(true).
rotate2, Rem, [E1, E2] --> [E1, E2], remainder(Rem).
Result in swi-prolog:
?- phrase(rotate2, `abcdef`, R).
R = `cdefab`.
Alternatively, if you need the tail also:
rotate2_tail([A, B|T]) --> T, [A, B].
?- phrase(rotate2_tail(`abcdef`), L, R).
L = `cdefab|R`.
As a third method (note that there is no actual difference list specified in the question):
?- L = [a,b,c,d,e,f], L = [H1, H2|T], append(T, [H1, H2], L2).
L2 = [c,d,e,f,a,b].

How do I rewrite the following so it uses if_?

I am doing some easy exercises to get a feel for the language.
is_list([]).
is_list([_|_]).
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
(is_list(X), !, append(X,R,RR); RR = [X | R]).
Here is a version using cut, for a predicate that flattens a list one level.
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
if_(is_list(X), append(X,R,RR), RR = [X | R]).
Here is how I want to write it, but it does not work. Neither does is_list(X) = true as the if_ condition. How am I intended to use if_ here?
(Sorry, I somewhat skipped this)
Please refer to P07. It clearly states that it flattens out [a, [b, [c, d], e]], but you and #Willem produce:
?- my_flatten([a, [b, [c, d], e]], X).
X = [a,b,[c,d],e]. % not flattened!
And the solution given there succeeds for
?- my_flatten(non_list, X).
X = [non_list]. % unexpected, nothing to flatten
Your definition of is_list/1 succeeds for is_list([a|non_list]). Commonly, we want this to fail.
What you need is a safe predicate to test for lists. So let's concentrate on that first:
What is wrong with is_list/1 and if-then-else? It is as non-monotonic, as many other impure type testing predicates.
?- Xs = [], is_list([a|Xs]).
Xs = [].
?- is_list([a|Xs]). % generalization, Xs = [] removed
false. % ?!? unexpected
While the original query succeeds correctly, a generalization of it unexpectedly fails. In the monotonic part of Prolog, we expect that a generalization will succeed (or loop, produce an error, use up all resources, but never ever fail).
You have now two options to improve upon this highly undesirable situation:
Stay safe with safe inferences, _si!
Just take the definition of list_si/1 in place of is_list/1. In problematic situations, your program will now abort with an instantiation error, meaning "well sorry, I don't know how to answer this query". Be happy for that response! You are saved from being misled by incorrect answers.
In other words: There is nothing wrong with ( If_0 -> Then_0 ; Else_0 ), as long as the If_0 handles the situation of insufficient instantiations correctly (and does not refer to a user defined program since otherwise you will be again in non-monotonic behavior).
Here is such a definition:
my_flatten(Es, Fs) :-
list_si(Es),
phrase(flattenl(Es), Fs).
flattenl([]) --> [].
flattenl([E|Es]) -->
( {list_si(E)} -> flattenl(E) ; [E] ),
flattenl(Es).
?- my_flatten([a, [b, [c, d], e]], X).
X = [a,b,c,d,e].
So ( If_0 -> Then_0 ; Else_0 ) has two weaknesses: The condition If_0 might be sensible to insufficient instantiations, and the Else_0 may be the source of non-monotonicity. But otherwise it works. So why do we want more than that?
In many more general situations this definition will now bark back: "Instantiation error"! While not incorrect, this still can be improved. This exercise is not the ideal example for this, but we will give it a try.
Use a reified condition
In order to use if_/3 you need a reified condition, that is, a definition that carries it's truth value as an explicit extra argument. Let's call it list_t/2.
?- list_t([a,b,c], T).
T = true.
?- list_t([a,b,c|non_list], T).
T = false.
?- list_t(Any, T).
Any = [],
T = true
; T = false,
dif(Any,[]),
when(nonvar(Any),Any\=[_|_])
; Any = [_],
T = true
; Any = [_|_Any1],
T = false,
dif(_Any1,[]),
when(nonvar(_Any1),_Any1\=[_|_])
; ... .
So list_t can also be used to enumerate all true and false situations. Let's go through them:
T = true, Any = [] that's the empty list
T = false, dif(Any, []), Any is not [_|_] note how this inequality uses when/2
T = true, Any = [_] that's all lists with one element
T = true, Any = [_|_Any1] ... meaning: we start with an element, but then no list
list_t(Es, T) :-
if_( Es = []
, T = true
, if_(nocons_t(Es), T = false, ( Es = [_|Fs], list_t(Fs, T) ) )
).
nocons_t(NC, true) :-
when(nonvar(NC), NC \= [_|_]).
nocons_t([_|_], false).
So finally, the reified definition:
:- meta_predicate( if_(1, 2, 2, ?,?) ).
my_flatten(Es, Fs) :-
phrase(flattenl(Es), Fs).
flattenl([]) --> [].
flattenl([E|Es]) -->
if_(list_t(E), flattenl(E), [E] ),
flattenl(Es).
if_(C_1, Then__0, Else__0, Xs0,Xs) :-
if_(C_1, phrase(Then__0, Xs0,Xs), phrase(Else__0, Xs0,Xs) ).
?- my_flatten([a|_], [e|_]).
false.
?- my_flatten([e|_], [e|_]).
true
; true
; true
; ... .
?- my_flatten([a|Xs], [a]).
Xs = []
; Xs = [[]]
; Xs = [[],[]]
; ... .
?- my_flatten([X,a], [a]).
X = []
; X = [[]]
; X = [[[]]]
; X = [[[[]]]]
; ... .
?- my_flatten(Xs, [a]).
loops. % at least it does not fail
In Prolog, the equivalen of an if … then … else … in other languages is:
(condition -> if-true; if-false)
With condition, if-true and if-false items you need to fill in.
So in this specific case, you can implement this with:
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
( is_list(X)
-> append(X,R,RR)
; RR = [X | R] ).
or we can flatten recursively with:
my_flatten([],[]).
my_flatten([X|Xs],RR) :-
my_flatten(Xs,R),
( flatten(X, XF)
-> append(XF,R,RR)
; RR = [X | R] ).
Your if_/3 predicate is used for reified predicates.
This worked for me:
myflat([], []).
myflat([H|T], L) :-
myflat(H, L1),
myflat(T, L2),
append(L1, L2, L).
myflat(L, [L]).

Tail-recursive program in prolog which outputs odd numbers in a list

I've written a tail-recursive predicate in Prolog which outputs the integers between A and B in a list K. I've used "reverse" to bring the numbers into the right order:
numbers(A,B,K) :- numbers(A,B,[],K).
numbers(Y,Y,X,K) :- !, reverse([Y|X],K).
numbers(A,B,X,K) :- A<B, C is A+1, numbers(C,B,[A|X],K).
Query:
?- numbers(3,6, K).
K=[3,4,5,6]
All works fine. What I now want to do is that I only want to have odd numbers of the range between A and B in the list K. How can I do that? Thanks in advance!
Firstly, I would try to avoid using reverse/2. If you have such a solution, it's often an indicator that there's a better way to get the answer forwards more directly. Not always, but most often. reverse/2 is probably the 2nd favorite band-aid in Prolog right behind use of the cut. :)
In many problems, an auxiliary accumulator is needed. In this particular case, it is not. Also, I would tend to use CLP(FD) operations when involving integers since it's the more relational approach to reasoning over integers. But you can use the solution below with is/2, etc, if you wish. It just won't be as general.
numbers(S, E, []) :- S #> E. % null case
numbers(X, X, [X]).
numbers(S, E, [S|T]) :-
S #< E,
S1 #= S + 1,
numbers(S1, E, T).
| ?- numbers(3, 8, L).
L = [3,4,5,6,7,8] ? ;
no
| ?- numbers(A, B, [2,3,4,5]).
A = 2
B = 5 ? ;
no
| ?-
This solution avoids reverse/2 and is tail recursive.
To update it for odd integers, the first thought is that we can easily modify the above to do every other number by just adding 2 instead of 1:
every_other_number(S, E, []) :- S #> E.
every_other_number(X, X, [X]).
every_other_number(S, E, [S|T]) :-
S #< E,
S1 #= S + 2,
every_other_number(S1, E, T).
| ?- every_other_number(3, 7, L).
L = [3,5,7] ? ;
no
| ?- every_other_number(3, 8, L).
L = [3,5,7] ? ;
no
| ?- every_other_number(4, 8, L).
L = [4,6,8] ? ;
no
| ?-
Then we can do odd numbers by creating an initial predicate to ensure the condition that the first value is odd and calling every_other_number/3:
odd_numbers(S, E, L) :-
S rem 2 #= 1,
every_other_number(S, E, L).
odd_numbers(S, E, L) :-
S rem 2 #= 0,
S1 #= S + 1,
every_other_number(S1, E, L).
| ?- odd_numbers(2, 8, L).
L = [3,5,7] ? ;
no
| ?- odd_numbers(2, 9, L).
L = [3,5,7,9] ? ;
no
| ?- odd_numbers(3, 8, L).
L = [3,5,7] ? ;
no
| ?-
This could be a solution, using mod/2 operator.
numbers(A,B,K) :-
B1 is B+1,
numbers(A,B1,[],K).
numbers(Y,Y1,X,K) :-
Y = Y1,
reverse(X,K).
numbers(A,B,X,K) :-
A<B,
C is A+1,
C1 is mod(C,2),
(C1 = 0 ->
numbers(C,B,[A|X],K)
; numbers(C,B,X,K)).
Another possibility is to use DCG :
numbers(A,B,K) :-
phrase(odd(A,B), K).
odd(A,B) --> {A > B, !}, [].
odd(A,B) --> {A mod2 =:= 0, !, C is A+1}, odd(C,B).
odd(A,B) --> {C is A+2}, [A], odd(C, B).

How to make a list of integers from 1 to N

I'm using GNU Prolog, and was told that this can be solved with Finite Domain Solver, or just member/2 and is/2. I can only come up with using both together, but it's not working. Here is what I have so far:
unique([],N,0).
unique([H|T],N,N1) :-
length([H|T],N1),
N2 is N1-1,
unique(T,N,N2),
H #> 0,
H #=< N.
\+ member(H,T).
When I debug unique(X,3,3) with trace, I can see that when it calls member/2, it's comparing 2 domains, 1..3 and 1..3 and succeed, which it shouldn't. Anyone can help?
Sorry this solution doesn't use FD or member/2. ;)
Using a prior solution to the problem of generating the list of integers from 1 to N:
n_ups(N, Xs) :-
length(Xs, N),
numbered_from(Xs, 1).
numbered_from([], _).
numbered_from([I0|Is], I0) :-
I1 is I0+1,
numbered_from(Is, I1).
You can then use the GNU built-in permutation predicate:
unique(N, P) :-
n_ups(N, L),
permutation(L, P).
Results for unique(3, L):
| ?- unique(3, L).
L = [1,2,3] ? a
L = [1,3,2]
L = [2,1,3]
L = [2,3,1]
L = [3,1,2]
L = [3,2,1]
no
| ?-
If you want to roll your own permutation, then:
perm([], []).
perm(List, [H|Perm]) :-
select(H, List, Rest),
perm(Rest, Perm).

Resources