Prolog lists with lengths of constrained length [duplicate] - prolog

This question already has answers here:
Using a constrained variable with `length/2`
(4 answers)
Closed 5 years ago.
I'm using the clpfd library
?- use_module(library(clpfd)).
true.
Then I attempt to generate all 3 lists of length K with 1 <= K <= 3.
?- K in 1 .. 3, length(C, K).
K = 1,
C = [_1302] ;
K = 2,
C = [_1302, _1308] ;
K = 3,
C = [_1302, _1308, _1314] ;
ERROR: Out of global stack
I would expect the query to terminate after K = 3. For example, the following does terminate.
?- between(1, 3, K), length(X, K).
K = 1,
X = [_3618] ;
K = 2,
X = [_3618, _3624] ;
K = 3,
X = [_3618, _3624, _3630].
Why does one terminate and the other does not?

K in 1..3 simply asserts that K is somewhere between 1 and 3, without binding particular value. What you need is indomain(K) predicate, which backtracks over all values in K's domain:
K in 1..3, indomain(K), length(C, K).
Out of stack in your example happens for the following reason: length(C, K) without any of its arguments bound generates lists of different lengths, starting with 0, then 1, 2, 3, ...
Each time it generates a solution it tries bind a particular value to K, that is 0, 1, 2, ...
Now, because there are constraints applied to K, any attempts to bind a value greater than 3 will fail, meaning that length(C, K) will continue trying to find alternative solutions, that is, it will keep generating lists of length 4, 5, 6, ... and so on, all of which will be discarded. This process will continue until you exhaust your stack.

Related

First N Fibonacci Numbers in Prolog

I want to generate the 1st N fibonacci numbers in Prolog. That means whenever I will give N = 5, it should print : 0,1,1,2,3, But whenever I run it suppose with N =5 then it gives output as : 1,2,1,3,1,2,5.
Below is my program:
fib(0,0).
fib(1,1).
fib(F,N) :-
N>1,
N1 is N-1,
N2 is N-2,
fib(F1,N1),
fib(F2,N2),
F is F1+F2,
format('~w, ',[F]).
Just so we're all on the same page, this is what happens when running your code with N = 5:
?- fib(Fib, 5).
1, 2, 1, 3, 1, 2, 5,
Fib = 5 ;
false.
You are trying to print results rather than computing a data structure (a list) of the results. This is almost always not the way to go in Prolog.
(As an aside, the usual order of arguments in Prolog is "inputs" first, then "outputs". I believe most Prolog programmers would expect this predicate to be fib(N, Fib) rather than fib(Fib, N). We'll continue with your version, but it is confusing!)
One of the problems with printing intermediate results is that it can be difficult to understand which results are printed, and in which order. We can change your printing goal to be a bit more explicit about that is going on:
format('computed fib(~w, ~w)~n',[F, N]).
This gives:
?- fib(Fib, 5).
computed fib(1, 2)
computed fib(2, 3)
computed fib(1, 2)
computed fib(3, 4)
computed fib(1, 2)
computed fib(2, 3)
computed fib(5, 5)
Fib = 5 ;
false.
As you can see, this "naive" Fibonacci computation computes intermediate results several times, which is why you get more outputs than you expected. For example (in functional notation), computing fib(4) will compute fib(2) and fib(3), but computing fib(5) will also compute fib(3) separately.
If you remove the printing, your predicate does work correctly, for example:
?- fib(Fib, 4).
Fib = 3 .
?- fib(Fib, 5).
Fib = 5 .
?- fib(Fib, 6).
Fib = 8 .
?- fib(Fib, 7).
Fib = 13 .
There are several ways of getting the results into a list if you really want. For example, using some predicates from the SWI-Prolog library:
?- numlist(1, 20, Ns), maplist(fib, Fibs, Ns).
Ns = [1, 2, 3, 4, 5, 6, 7, 8, 9|...],
Fibs = [1, 1, 2, 3, 5, 8, 13, 21, 34|...] ;
false.
There are several problems with this: Do you really want a list? Prolog's backtracking for computing results one after the other is often superior to computing a list of results "all at once". More importantly, this naive Fibonacci implementation is very very inefficient. The above goal takes over a second on my machine.
From "Approach 3" on this answer, completely reviewed here:
At
rosettacode.org,
under Fibonacci/Prolog, the following quite interesting solution is
given. It uses a "lazy list", which is an open list (a list where the
termination (the "fin") is not [] but an unbound variable), where a
"frozen goal" is attached to the list-terminating unbound variable using
the predicate
freeze/2.
The frozen goal is run (a "coroutine") whenever the value of that
unbound variable is needed.
Proceed "bottom-up" with a "lazy list" as cache. The "lazy list"
is an open list that has a frozen goal to compute the next list
entry on its "fin".
Retrieving a member of the list using nth0(N,Cache,F) causes unification of the unbound "fin" with a new listbox [|]. This
thaws the goal on the "fin", which then computes the next
Fibonacci number, unifies it with arg1 of the listbox and then
sets up a new frozen goal on arg2 of the listbox, the
% new "fin" of the lazy list.
It is not directly evident why this works with nth0/3, so a replacement predicate retrieve/3 which also prints debugging messages has been provided.
Example:
?- debug(fib_bll).
?- fib_bottomup_lazylist_cache(10,F,Cache).
% At this point, the cache just contains [0,1|_]: [0,1|_28196]
% At K = 0, N = 10, No unfreeze at this point
% At K = 1, N = 10, No unfreeze at this point
% At K = 2, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 0, FB = 1, FIN has been unified to [1|_28628]
% At K = 3, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 1, FB = 1, FIN has been unified to [2|_28910]
% At K = 4, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 1, FB = 2, FIN has been unified to [3|_29192]
% At K = 5, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 2, FB = 3, FIN has been unified to [5|_29474]
% At K = 6, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 3, FB = 5, FIN has been unified to [8|_29756]
% At K = 7, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 5, FB = 8, FIN has been unified to [13|_30038]
% At K = 8, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 8, FB = 13, FIN has been unified to [21|_30320]
% At K = 9, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 13, FB = 21, FIN has been unified to [34|_30602]
% At K = 10, N = 10, Will call unification with a listbox that will unfreeze the goal
% Unfrozen: FA = 21, FB = 34, FIN has been unified to [55|_30884]
% Unfrozen: FA = 21, FB = 34, FIN has been unified to [55|_30884]
% F = 55,
% Cache = [0,1,1,2,3,5,8,13,21,34,55|_31458],
% freeze(_31458,fibonacci_algorithms:bll_frozen(34,55,_31458)).
Note that for call to retrieve/3, where K==N, the same debug
message is issued twice. This is because
retrieve_3(K,N,[_|More],F) is attempted first, leading to
thawing, but then a rollback is issued due to K<N, and the
frozen goal is reinstated. The second clause
retrieve_3(N,N,[F|_],F) is then attempted, leading to the same
thawing. Side-effects in Prolog: interesting.
This approach allows you to widen the cache on request, too.
For example,
This approach allows you to widen the cache on request, too. For
example, if I want fib(10) first, but then also fib(13) I can just reuse the cache, lengthening it:
?-
fibb_bottomup_lazylist_cache(10,Fib10,Cache),nth0(13,Cache,Fib13).
Fib10 = 55,
Cache = [0,1,1,2,3,5,8,13,21,34,55,89,144,233|_55906],
Fib13 = 233,
freeze(_55906,fibonacci_algorithms:bll_frozen(144,233,_55906)).
Note the residual goal being printed out.
% Carve the constants fib(0) and fib(1) out of the code.
const(fib0,0).
const(fib1,1).
% :- debug(fib_bll). % Uncomment to allow debugging printout
fib_bottomup_lazylist_cache(N,F,Cache) :-
const(fib0,F0),
const(fib1,F1),
Cache=[F0,F1|Fin],
freeze(
Fin,
bll_frozen(F0,F1,Fin)),
debug(fib_bll,"At this point, the cache just contains [0,1|_]: ~q",Cache),
% nth0(N,Cache,F).
retrieve(N,Cache,F).
bll_frozen(FA,FB,FIN) :-
FC is FA + FB,
FIN=[FC|NewFIN],
debug(fib_bll,"Unfrozen: FA = ~d, FB = ~d, FIN has been unified to ~q",[FA,FB,FIN]),
freeze(
NewFIN,
bll_frozen(FB,FC,NewFIN)).
% A replacement for nth0/3 to show what's going on
retrieve(N,Cache,F) :-
retrieve_2(0,N,Cache,F).
retrieve_2(K,N,Cache,F) :-
(var(Cache)
-> debug(fib_bll,"At K = ~d, N = ~d, Will call unification with a listbox that will unfreeze the goal",[K,N])
; debug(fib_bll,"At K = ~d, N = ~d, No unfreeze at this point",[K,N])),
retrieve_3(K,N,Cache,F).
retrieve_3(K,N,[_|More],F) :-
K < N,
!,
Kp is K+1,
retrieve_2(Kp,N,More,F).
retrieve_3(N,N,[F|_],F).

Prolog subgroup of list of size n

I'm trying to create a rule to determine if a list is a sublist of size n of another list.
isSubgroup/3
isSubgroup(+Subgroup, +Group, +N)
For example, isSubgroup([1, 2, 4], [1, 2, 3, 4, 5], 3) would return True
However, isSubgroup([4, 2, 1], [1, 2, 3, 4, 5], 3) would return False (because of the different order)
I thought of checking for each member of the subgroup whether or not it's a member of the large group, but that would ignore the order.
Is the idea feasible?
Really, try to write an inductive relation. Meanwhile, library(yall) coupled with library(apply) can make one liner:
isSubgroup(S,G,N) :- length(S,N),
foldl({G}/[E,P,X]>>(nth1(X,G,E),X>=P),S,1,_F).
As #WillemVanOnsem suggested, an inductive solution:
subGroups([], []).
subGroups([X|Xs], [X|Ys]):-
subGroups(Xs, Ys).
subGroups(Xs, [_|Ys]):-
subGroups(Xs, Ys).
subGroupsN(Options, N, Solution) :-
length(Solution, N),
subGroups(Solution, Options).
We can define this predictate by an inductive definition. A Subgroup is a subgroup of Group if:
the Subgroup is an empty list;
the first element of the Subgroup is the same as the first element of Group, and the rest of the Subgroup is a subgroup of the rest of the Group;
the Subgroup is a subgroup of the rest of the Group.
We need to update N accordingly such that, if the Subgroup is empty, then the length is 0:
isSubgroup([], _, 0). %% (1)
isSubgroup([H|TS], [H|TG], N) :- %% (2)
N1 is N-1,
isSubgroup(TS, TG, N1).
isSubgroup(S, [_|TG], N) :- %% (3)
isSubgroup(S, TG, N).
The above however results in duplicate trues for the same subgroup. This is due to the fact that we can satisfy the predicate in multiple ways. For example if we call:
isSubgroup([], [1,2], 0).
then it is satisfied through the fact (1), but the last clause (3) also calls this with isSubgroup([], [1], 0)., that will then get satisfied through the fact (1), etc.
We can avoid this by making the last clause more restrictive:
isSubgroup([], _, 0). %% (1)
isSubgroup([H|TS], [H|TG], N) :- %% (2)
N1 is N-1,
isSubgroup(TS, TG, N1).
isSubgroup([HS|TS], [_|TG], N) :- %% (3)
isSubgroup([HS|TS], TG, N).
The above works for the given "directions" (all arguments should be grounded, are "input"). But typically one wants to use a predicate in other directions as well. We can implement a version that works basically when we use arguments as "output" as well, and still make use of tail-call optimization (TCO):
isSubgroup(S, G, N) :-
isSubgroup(S, G, 0, N).
isSubgroup([], _, L, L). %% (1)
isSubgroup([H|TS], [H|TG], L, N) :- %% (2)
L1 is L+1,
isSubgroup(TS, TG, L1, N).
isSubgroup([HS|TS], [_|TG], L, N) :- %% (3)
isSubgroup([HS|TS], TG, L, N).
For example:
?- isSubgroup([1,4,2], G, N).
G = [1, 4, 2|_2974],
N = 3 ;
G = [1, 4, _2972, 2|_2986],
N = 3 ;
G = [1, 4, _2972, _2984, 2|_2998],
N = 3 ;
G = [1, 4, _2972, _2984, _2996, 2|_3010],
N = 3 .
Here Prolog is thus able to propose groups for which [1,4,2] is a subgroup, and it is capable to determining the length N of the subgroup.
We can query in the opposite direction as well:
?- isSubgroup(S, [1,4,2], N).
S = [],
N = 0 ;
S = [1],
N = 1 ;
S = [1, 4],
N = 2 ;
S = [1, 4, 2],
N = 3 ;
S = [1, 2],
N = 2 ;
S = [4],
N = 1 ;
S = [4, 2],
N = 2 ;
S = [2],
N = 1 ;
false.
Prolog can, for a given group [1,4,2] enumerate exhaustively all possible subgroups, together with N the length of that subgroup.

Prolog - Multiples of a Number Below an Upper Limit

I am currently making a program in Prolog that will calculate all of the multiples (including itself) of a number, that do not exceed the value of another number. I was testing with the query below:
?- multiples(4,12,R,0)
This query would list all multiples of 4 that are less than or equal to 12 eg. 4, 8, 12. The R would return the result and 0 is where I was intending to implement a counter that would count up for each multiplication eg. 4*1,4*2,4*3. I am stuck and I am not sure if it would be a better design to simply add the multiples and check if it is below the upper bound or if it can be done with a counter or accumulator.
multiples(N,U,R,Ctr) :-
N =< U,
R is Ctr * N,
R =< U,
increment(Ctr,Ctr2),
multiples(N,U,R,Ctr2).
increment(Num, Num1) :-
Num1 is Num+1.
I believe my program is failing at the recursive step of calling multiples from within itself. I know that recursion needs a base case to allow it to exit, but I am completely stuck here and would appreciate some direction.
The problem with you approach is that there is no basecase: indeed your algorithm will always produce false. It will unify R with N, then do the recursion and that recursion will try to unify R with 2*N which will fail.
Well an idea could be to use an accumulator to which you add the delta each time. Something like:
multiples(N,U,R) :-
multiples(N,N,U,R).
multiples(_,C,U,C) :-
C =< U.
multiples(N,C,U,R) :-
C =< U,
C1 is C+N,
multiples(N,C1,U,R).
So here we call multiples(3,12,R). and it will result in:
?- multiples(4,12,R).
R = 4 ;
R = 8 ;
R = 12 ;
false.
CLP(FD) is very helpful here:
:- use_module(library(clpfd)).
multiple(Multiplicand, Max, Multiple) :-
MaxMultiplier #= Max // Multiplicand,
label([MaxMultiplier]),
Multiplier in 1 .. MaxMultiplier,
Multiple #= Multiplier * Multiplicand,
label([Multiple]).
?- multiple(4, 12, M).
M = 4 ;
M = 8 ;
M = 12.
?-
With CLP(FD) in this case, you can also query with the first argument as a variable:
|?- multiple(N, 12, 8).
N = 8 ;
N = 4 ;
N = 2 ;
N = 1.
Or both the multiplier and result:
?- multiple(N, 4, M).
N = M, M = 3 ;
N = M, M = 4 ;
N = M, M = 2 ;
N = 2,
M = 4 ;
N = M, M = 1 ;
N = 1,
M = 2 ;
N = 1,
M = 3 ;
N = 1,
M = 4.
?-
If you want to collect them in a list, you can use findall/3:
?- findall(Multiple, multiple(4, 12, Multiple), Multiples).
Multiples = [4, 8, 12].
?-

clpfd - generate the list of all integers between 5 and 10

I'm working with SWI-Prolog to get clpfd generate the list of all distinct integers between 5 and 10:
q1(Answer) :-
length(Xs, Answer),
Xs ins 0..20,
chain(Xs, #<),
maplist(q1constraints, Xs).
q1constraints(X) :-
X #>= 5,
X #=< 10.
Kind of works, but generates a solution for each of the lengths 0, 1, ... 6 and then hangs seeking a solution of length 7:
?- q1(Answer).
Answer = 0 ;
Answer = 1 ;
Answer = 2 ;
Answer = 3 ;
Answer = 4 ;
Answer = 5 ;
Answer = 6 ;
<hangs>
Is there a good way to generate the list of all integers that satisfy the desired constraints?
Your question is not that clear to me. But I will try:
?- length(Xs,6), Xs ins 5..10, chain(Xs,#<), Xs = [5|_], last(Xs, 10).
Xs = [5,6,7,8,9,10].
Note that with these elements, it is necessary to fix the length of the list first. Otherwise:
?- length(Xs,N), Xs ins 5..10, chain(Xs,#<), Xs = [5|_], last(Xs, 10).
Xs = [5,10], N = 2
; Xs = [5,_A,10], N = 3, _A in 6..9
; Xs = [5,_A,_B,10], N = 4, _A#=<_B+ -1, _A in 6..8, _B in 7..9
; Xs = [5,_C,_A,_B,10], N = 5, _A#=<_B+ -1, _C#=<_A+ -1, _A in 7..8, _C in 6..7, _B in 8..9
; Xs = [5,6,7,8,9,10], N = 6
; loops.
In fact, even the (ins)/2 is not needed:
?- length(Xs,6), chain(Xs,#<), Xs = [5|_], last(Xs, 10).
Xs = [5,6,7,8,9,10].
(In newer versions of clpfd called clpz the argument order of chain/2` is reversed adhering to the common argument ordering.)
Here is what your program does:
Generate a list of increasing lengths, starting with an empty list
For each element X in the list, pose a constraint that X is in [0, 20]
For the whole list, pose a constraint that values are strictly increasing in magnitude
For each element in the list, pose an additional constraint that X is in [5, 10].
You then ask for the length of the generated list.
There are 6 values that are in [0, 20] and in [5,10]: 5, 6, 7, 8, 9, 10. For the empty list you generate first, there are no constrained variables; for the list with 1 variable, there would be 6 possible values of the variable, but you don't ask for these values, only for the length of the list; for the list with 2 variables, you will have 5 possible combinations: {5,6}, {6,7}, ..., {9,10}, but again, you don't ask for them, just for the length of the list.
Eventually, you get to list with 7 values. Since there are only 6 values that each element could have, there are no solutions.
So what is your goal here? Maybe you should try and explain better. To get all values between 5 and 10 by backtracking, you could say: between(5, 10, X), or, with CLPFD, X in 5..10, label([X]). If it is neither of these, you need to re-write your question.
If you want the total number of even integers in 5..10 (SPOILER: there are 3 of them!):
?- aggregate(count, X^(X in 5..10, X mod 2 #= 0, indomain(X)), Answer).
Answer = 3.
Breaking it down:
X in 5..10, X mod 2 #= 0 just constrains X to be an even integer between 5 and 10:
?- X in 5..10, X mod 2 #= 0.
X in 6..10,
X mod 2#=0.
indomain(X) does the actual search, succeeding once for each feasible value of X:
?- X in 5..10, X mod 2 #= 0, indomain(X).
X = 6 ;
X = 8 ;
X = 10.
X^(...) existentially quantifies X within the parentheses, limiting its scope. If we instead leave it as a free variable, aggregation will respect it:
?- aggregate(count, (X in 5..10, X mod 2 #= 0, indomain(X)), Answer).
X = 6,
Answer = 1 ;
X = 8,
Answer = 1 ;
X = 10,
Answer = 1.

Generate all permutations of the list [1, 1, 2, 2, ..., n, n] where the number of elements between each pair is even in Prolog

I recently started learning Prolog and I got a task to write a predicate list(N, L) that generates lists L such that:
L has length 2N,
every number between 1 and N occurs exactly twice in L,
between each pair of the same element there is an even number of other elements,
the first occurrences of each number are in increasing order.
The author states that there are N! such lists.
For example, for N = 3 all solutions are:
?- list(3, L).
L = [1, 1, 2, 2, 3, 3] ;
L = [1, 1, 2, 3, 3, 2] ;
L = [1, 2, 2, 1, 3, 3] ;
L = [1, 2, 2, 3, 3, 1] ;
L = [1, 2, 3, 3, 2, 1] ;
L = [1, 2, 3, 1, 2, 3] ;
false.
My current solution looks like:
even_distance(H, [H | _]) :-
!.
even_distance(V, [_, _ | T]) :-
even_distance(V, T).
list(N, [], _, Length, _, _) :-
Length =:= 2*N,
!.
list(N, [New | L], Max, Length, Used, Duplicates) :-
select(New, Duplicates, NewDuplicates),
even_distance(New, Used),
NewLength is Length + 1,
list(N, L, Max, NewLength, [New | Used], NewDuplicates).
list(N, [New | L], Max, Length, Used, Duplicates) :-
Max < N,
New is Max + 1,
NewLength is Length + 1,
list(N, L, New, NewLength, [New | Used], [New | Duplicates]).
list(N, L) :-
list(N, L, 0, 0, [], []).
It does two things:
if current maximum is less than N, add that number to the list, put it on the list of duplicates, and update the max;
select some duplicate, check if there is an even number of elements between it and the number already on the list (ie. that number is on odd position), then add it to the list and remove it from duplicates.
It works, but it's slow and doesn't look really nice.
The author of this exercise shows that for N < 12, his solution generates a single list with average of ~11 inferences (using time/1 and dividing the result by N!). With my solution it grows to ~60.
I have two questions:
How to improve this algorithm?
Can this problem be generalized to some other known one? I know about similar problems based on the multiset [1, 1, 2, 2, ..., n, n] (eg. Langford pairing), but couldn't find something like this.
I'm asking because the original problem is about enumerating intersections in a self-intersecting closed curve. You draw such curve, pick a point and direction and follow the curve, enumerating each intersection when met for the first time and repeating the number on the second meeting: example (with the answer [1, 2, 3, 4, 5, 3, 6, 7, 8, 1, 9, 5, 4, 6, 7, 9, 2, 8]).
The author states that every such curve satisfies the predicate list, but not every list corresponds to a curve.
I had to resort to arithmetic to satisfy the requirement about pairs of integers separated by even count of elements. Would be nice to be able to solve without arithmetic at all...
list(N,L) :- numlist(1,N,H), list_(H,L), even_(L).
list_([D|Ds],[D|Rs]) :-
list_(Ds,Ts),
select(D,Rs,Ts).
list_([],[]).
even_(L) :-
forall(nth0(P,L,X), (nth0(Q,L,X), abs(P-Q) mod 2 =:= 1)).
select/3 is used in 'insert mode'.
edit to avoid arithmetic, we could use this more verbose schema
even_(L) :-
maplist(even_(L),L).
even_(L,E) :-
append(_,[E|R],L),
even_p(E,R).
even_p(E,[E|_]).
even_p(E,[_,_|R]) :- even_p(E,R).
edit
Here is a snippet based on assignment in a prebuilt list of empty 'slots'. Based on my test, it's faster than your solution - about 2 times.
list(N,L) :-
N2 is N*2,
length(L,N2),
numlist(1,N,Ns),
pairs(Ns,L).
pairs([N|Ns],L) :- first(N,L,R),even_offset(N,R),pairs(Ns,L).
pairs([],_).
first(N,[N|R],R) :- !.
first(N,[_|R],S) :- first(N,R,S).
even_offset(N,[N|_]).
even_offset(N,[_,_|R]) :- even_offset(N,R).
My first attempt, filtering with even_/1 after every insertion, was much slower. I was initially focused on pushing the filter immediately after the select/3, and performance was indeed almost good as the last snippet, but alas, it loses a solution out of 6...

Resources