Related
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.
I have the following experimental code
s(a,b).
s(b,c).
s(c,b).
r(a).
r(c).
r(d).
p(X,Y) :- s(X,Y), not(r(Y)).
q(X,Y) :- q(Y,X), r(X).
q(X,Y) :- p(Y,X), s(X,Y).
t(X,Y) :- r(X), q(X,Y).
Querying for t(X,Y) will result in a endless recursion blowing up the stack. But I can actually think of X=c,Y=b being the solution because
t(c,b) <- r(c), q(c,b)
q(c,b) <- q(b,c), r(c)
q(b,c) <- p(c,b), s(b,c)
p(c,b) <- s(c,b), not(r(b))
Can someone explain to me, why prolog doesn't come to this solution and gets caught in an endless recursion around q(c,b) and q(b,c)
Many thanks!
In SWI-Prolog, you can solve the problem using tabled execution.
:- table q/2.
s(a,b).
s(b,c).
s(c,b).
r(a).
r(c).
r(d).
p(X,Y) :- s(X,Y), not(r(Y)).
q(X,Y) :- q(Y,X), r(X).
q(X,Y) :- p(Y,X), s(X,Y).
t(X,Y) :- r(X), q(X,Y).
Examples:
?- t(X,Y).
X = c,
Y = b ;
false.
?- q(X,Y).
X = c,
Y = b ;
X = b,
Y = c.
What is the easiest way to find who is the tallest in Prolog:
height(lisa,1.65).
height(sam,1.70).
height(luke,1.92).
height(nicole,1.54).
I want to write
tallest(X) :- Y is bigger than other Y's
SWI-Prolog has some different ways to solve this problem, for instance by means of library(solution_sequences)
?- order_by([desc(H)],height(P,H)).
H = 1.92,
P = luke ;
...
or using library(aggregate):
?- aggregate(max(H,P),height(P,H),max(_,P)).
P = luke.
less sophisticate Prologs probably will offer setof/3 and last/2:
?- setof(H:P,height(P,H),L),last(L,_:P).
P = luke,
L = [1.54:nicole, 1.65:lisa, 1.7:sam, 1.92:luke].
and still more basic engines, lacking setof/3, will offer
?- height(P,H),\+((height(_,L),L>H)).
P = luke,
H = 1.92 ;
Supposing that tallest(X) succeeds if, and only if, person X is taller than all other persons, I think that a correct answer would be:
tallest(X) :-
height(X, H),
forall((height(Y, H1),
X \= Y),
H > H1), !.
First scenario:
height(lisa,1.65).
height(sam,1.70).
height(luke,1.92).
height(nicole,1.54).
?- tallest(X).
X = luke.
Second scenario:
height(lisa, 1.65).
height(sam, 1.70).
height(luke, 1.92).
height(nicole, 1.54).
height(bob, 1.92). % Bob is as tall as Luke!
?- tallest(X).
false.
height(lisa,1.65).
height(sam,1.70).
height(luke,1.92).
height(nicole,1.54).
max_height(Person, Height, [[Person, Height]]).
max_height(P , H , [[P, H]|Tail]) :- max_height(_ , H2, Tail), H > H2.
max_height(P2, H2, [[_, H]|Tail]) :- max_height(P2, H2, Tail), H =< H2.
tallest(X) :- findall([P, H], height(P, H), Bag), max_height(X, _, Bag).
There are ways to avoid writing max_height : Prolog, find minimum in a list
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).
This works:
assert(p(X) :- q(X)).
This does not work:
P = p,Q = q, assert(P(X) :- Q(X)).
How can I make the latter work?
You need to make the terms first; you can use the "univ" operator, =.. for this:
?- P = p, Q = q, Head =.. [P, X], Body =.. [Q, X], assertz((Head :- Body)).
P = p,
Q = q,
Head = p(X),
Body = q(X).
?- listing(p/1).
:- dynamic p/1.
p(A) :-
q(A).
You need the second pair of parentheses in most implementations, apparently. You will need them anyway if you had for example a conjunction in the body.
?- assertz(a :- b).
true.
?- assertz(a :- b, c).
ERROR: assertz/2: Uninstantiated argument expected, found c (2-nd argument)
?- assertz((a :- b, c)).
true.