run length encoding using DCGs - prolog

problem from: https://web.archive.org/web/20200718175929/http://www.pathwayslms.com/swipltuts/dcg/
Use a dcg to convert a sparse sequence like
[0,0,0,0,0,0,7,4,3,0,0,0,0,0,0,0,8,9,14,0,0,0,0....]
to
[zero(6), 7,4,3, zero(7), 8,9,14, ...]
i feel like i understand the material on this page up to here but don't really know how to start this one. any pointers would be appreciated

Try doing something like this:
code([X|Xs]) --> item(X), code(Xs).
code([]) --> [].
item(X) --> [0], zeros(1, X).
item(X) --> [X], { X \= 0 }.
zeros(M, N) --> [0], { M1 is M + 1 }, zeros(M1, N).
zeros(N, zero(N)) --> \+ [0].
Example:
?- phrase(code(C), [0,0,0,0,0,0,7,4,3,0,0,0,0,0,0,0,8,9,14,0,0,0,0]).
C = [zero(6), 7, 4, 3, zero(7), 8, 9, 14, zero(4)] ;
false.

Alternate style:
% For eos
:- use_module(library(dcg/basics)).
list_rle(Lst, LstRle) :-
must_be(list, Lst),
phrase(rle, Lst, LstRle),
% The first is correct
!.
% Check for list of zeros
rle, [zero(N)] --> [0], zeros(1, N), rle.
% Accept anything otherwise
rle, [C] --> [C], rle.
% Being greedy - check for end last
% eos means no more input - better than [] which can leave a remainder
rle --> eos.
zeros(N, Tot) --> [0], { N1 is N + 1 }, zeros(N1, Tot).
% Being greedy - check for end last
zeros(N, N) --> [].
Result in swi-prolog:
?- time(list_rle([0,0,0,0,0,0,7,4,3,0,0,0,0,0,0,0,8,9,14,0,0,0,0], L)).
% 39 inferences, 0.000 CPU in 0.000 seconds (92% CPU, 545073 Lips)
L = [zero(6),7,4,3,zero(7),8,9,14,zero(4)].
Another minor variant which can also be used as a generator:
rle --> eos.
rle, [zero(N)] --> [0], zeros(1, N), rle.
rle, [C] --> [C], { dif(C, 0) }, rle.
zeros(N, Tot) --> [0], !, { N1 is N + 1 }, zeros(N1, Tot).
zeros(N, N) --> [].
Result:
?- length(L, _), list_rle(L, LR).
L = LR, LR = [] ;
L = [0],
LR = [zero(1)] ;
L = LR, LR = [_A],
dif(_A,0) ;
L = [0,0],
LR = [zero(2)] ;
L = [_A,0],
LR = [_A,zero(1)],
dif(_A,0) ;
L = LR, LR = [_A,_B],
dif(_A,0),
dif(_B,0) ;
L = [0,0,0],
LR = [zero(3)] ;
L = [_A,0,0],
LR = [_A,zero(2)],
dif(_A,0) ;

Related

Sum elements of list in prolog

I want to sum element of a list like this:
sum([1,[2,3],4],S).
I used that but I have a problem:
sum([],0).
sum([T|R],M) :- sum(R,S), M is T+S.
I get the following error:
ERROR: is/2: Type error: `[]' expected, found `[2,3]' (a list) ("x" must hold one character)
The problem is that you can't add T if T is a list. You could easily solve using is_list/1 that succeds if T is a list:
sum([],0).
sum([T|R],M) :- (is_list(T) -> sum(T,N1),sum(R,S), M is N1+S
; sum(R,S), M is T+S ).
Examples:
?- sum([1,[2,3],4],S).
S = 10.
?- sum([1,2,3,4],S).
S = 10.
?- sum([1,[2],[3],4],S).
S = 10.
?- sum([1,[[2],[3]],4],S).
S = 10.
A better approach would be using CLPFD:
:- use_module(library(clpfd)).
sum([],0).
sum([[]],0).
sum([T|R],M) :- (is_list(T) -> sum(T,N1),sum(R,S), M #= N1+S
; sum(R,S), M #= T+S ).
Now you can query more general questions like:
?- sum(L,N).
L = [],
N = 0 ;
L = [[]],
N = 0 ;
L = [N],
N in inf..sup ;
L = [N, []],
N in inf..sup ;
L = [_1836, _1842],
_1836+_1842#=N ;
L = [_1842, _1848, []],
_1842+_1848#=N ;
L = [_2142, _2148, _2154],
_2142+_2192#=N,
_2148+_2154#=_2192 ;
L = [_2148, _2154, _2160, []],
_2148+_2204#=N,
_2154+_2160#=_2204 ;
L = [_2448, _2454, _2460, _2466],
_2448+_2504#=N,
_2454+_2528#=_2504,
_2460+_2466#=_2528 ;
and goes on...
Another approach:
% Old code, with vars renamed:
%sum([], 0).
%sum([Num|Tail], TotalSum) :- sum(Tail, TailSum), TotalSum is Num + TailSum.
% New code:
sum([], 0).
sum([Elem|Tail], TotalSum) :-
sum(Elem, ElemSum),
sum(Tail, TailSum),
TotalSum is ElemSum + TailSum.
sum(Num, Num).
Demo: http://swish.swi-prolog.org/p/cmzcsXrJ.pl.
You can use flatten/2 plus foldl/4 or sum_list/2 library predicates in Swi-Prolog:
% flatten/2 + foldl/4 based implementation
sum_nested_list(List, Sum) :-
flatten(List, Flat),
foldl(plus, Flat, 0, Sum).
% flatten/2 + sum_list/2 based implementation
sum_nested_list(List, Sum) :-
flatten(List, Flat),
sum_list(Flat, Sum).

CLP(FD)-ying Simultaneous Recursion for Fibonacci Lukas Numbers Possible?

There are some instances where recursive predicates can be CLP(FD)-fied with the benefit that the predicate turns bidirectional. What are the limits of this method? For example can the following computation CLP(FD)-fied:
Fn: n-th Fibonacci Number
Ln: n-th Lucas Number (starting with 2)
By this doubling recursion step:
F2n = Fn*Ln
L2n = (5*Fn^2+Ln^2)//2
And this incrementing recursion step:
Fn+1 = (Fn+Ln)//2
Ln+1 = (5*Fn+Ln)//2
The traditional Prolog realization works already from n to Fn. Can this be turned into a CLP(FD) program preserving the fast recursion and at the same time making it bidirectionally, for example figuring out the index n for Fn=377? If yes how? If not why?
Bye
Yes, it can be done by constraining the values. You can also move the recursion to be tail recursion, although it's not required to get the solutions:
fibluc(0, 0, 2).
fibluc(1, 1, 1).
fibluc(N, F, L) :-
N in 2..1000, % Pick a reasonable value here for 1000
[F, L] ins 1..sup,
N rem 2 #= 1,
M #= N-1,
F #= (F1 + L1) // 2,
L #= (5*F1 + L1) // 2,
fibluc(M, F1, L1).
fibluc(N, F, L) :-
N in 2..1000, % Pick a reasonable value here for 1000
[F, L] ins 1..sup,
N rem 2 #= 0,
M #= N // 2,
F #= F1 * L1,
L #= (5*F1*F1 + L1*L1) // 2,
fibluc(M, F1, L1).
Will yield:
?- fibluc(10, X, Y).
X = 55,
Y = 123 ;
false.
?- fibluc(N, 55, Y).
N = 10,
Y = 123 ;
false.
?- fibluc(N, X, 123).
N = 10,
X = 55 ;
false.
?- fibluc(N, 55, 123).
N = 10 ;
false.
?- fibluc(N, 55, 125).
false.
?- fibluc(N, X, Y).
N = X, X = 0,
Y = 2 ;
N = X, X = Y, Y = 1 ;
N = 3,
X = 2,
Y = 4 ;
N = 7,
X = 13,
Y = 29 ;
N = 15,
X = 610,
Y = 1364 ;
N = 31,
X = 1346269,
Y = 3010349 ;
N = 63,
X = 6557470319842,
Y = 14662949395604 ;
...
This could be modified to generate results for increasing values of N when N is uninstantiated.
Here's a timed, compound query example, run in SWI Prolog 7.1.33 under Linux:
?- time((fibluc(100, X, Y), fibluc(N, X, Z))).
% 11,337,988 inferences, 3.092 CPU in 3.100 seconds (100% CPU, 3666357 Lips)
X = 354224848179261915075,
Y = Z, Z = 792070839848372253127,
N = 100 ;
% 1,593,620 inferences, 0.466 CPU in 0.468 seconds (100% CPU, 3417800 Lips)
false.
?-
Using SWI Prolog 7.2.3 with the same code above and the same compound query, the code does go off for a very long time. I waited at least 15 minutes without termination. It's still running right now... I may check on it in the morning. :)
I did, however, re-arrange the above code to move the recursive call back to where the original code had it as follows:
fibluc(0, 0, 2).
fibluc(1, 1, 1).
fibluc(N, F, L) :-
N in 2..1000, % Pick a reasonable value here for 1000
[F, L] ins 1..sup,
N rem 2 #= 1,
M #= N-1,
fibluc(M, F1, L1),
F #= (F1 + L1) // 2,
L #= (5*F1 + L1) // 2.
fibluc(N, F, L) :-
N in 2..1000, % Pick a reasonable value here for 1000
[F, L] ins 1..sup,
N rem 2 #= 0,
M #= N // 2,
fibluc(M, F1, L1),
F #= F1 * L1,
L #= (5*F1*F1 + L1*L1) // 2.
In this case, the favorable results returned:
?- time((fibluc(100, X, Y), fibluc(N, X, Z))).
% 10,070,701 inferences, 3.216 CPU in 3.222 seconds (100% CPU, 3131849 Lips)
X = 354224848179261915075,
Y = Z, Z = 792070839848372253127,
N = 100 ;
% 1,415,320 inferences, 0.493 CPU in 0.496 seconds (100% CPU, 2868423 Lips)
false.
Note that the performance of CLP(FD) can be vastly different between different Prolog interpreters. It's interesting that, with SWI Prolog, the ability to handle the tail recursive case was temporarily there with version 7.1.33.

Defining Prolog DCG with extra arguments

I am trying to define a Prolog DCG for the set of strings 0^N 1^M 2^N+M of length 2N + 2M for N, M >= 0 using extra arguments. An example of a correct string would be "011222" but not "012".
I have used the following code to create this DCG.
s --> a(N), b(M), c(N), c(M).
a(0) --> [].
a(succ(X)) --> [0], a(X).
b(0) --> [].
b(succ(X)) --> [1], b(X).
c(0) --> [].
c(succ(X)) --> [2], c(X).
When I run the query
s([0,1,1,2,2,2], []).
Prolog returns true as expected.
However when I run
s(X, []).
Prolog returns the following:
X = []
X = [1,2]
X = [1,1,2,2]
X = [1,1,1,2,2,2]
These are not valid strings. I think this may be because N and M are being decremented by the c predicate before prolog runs the a and b predicates. Is this the case? How could this be resolved?
Edit:
I've tried modifying the s production to this:
s --> a(N), b(M), c(NplusM), {NplusM is N + M}.
but that gives an error when running queries.
IMO the answers you are getting are correct!
I renamed your grammar from s to aN_bM_cNM and added two additional arguments, one for N, the other for M. Also, I renamed succ to s:
aN_bM_cNM(N, M) --> n_reps(N, 0), n_reps(M, 1), n_reps(N, 2), n_reps(M, 2).
n_reps( 0 , _) --> [].
n_reps(s(N), E) --> [E], n_reps(N, E).
Now let's run the query that #CapelliC gave. The goal length(Xs, _) ensures fair enumeration of the infinite solution set of aN_bM_cNM//2:
?- length(Xs, _), phrase(aN_bM_cNM(N,M), Xs).
( Xs = [] , N = 0 , M = 0
; Xs = [1,2] , N = 0 , M = s(0)
; Xs = [0,2] , N = s(0) , M = 0
; Xs = [1,1,2,2] , N = 0 , M = s(s(0))
; Xs = [0,1,2,2] , N = s(0) , M = s(0)
; Xs = [0,0,2,2] , N = s(s(0)) , M = 0
; Xs = [1,1,1,2,2,2] , N = 0 , M = s(s(s(0)))
; Xs = [0,1,1,2,2,2] , N = s(0) , M = s(s(0))
; Xs = [0,0,1,2,2,2] , N = s(s(0)) , M = s(0)
; Xs = [0,0,0,2,2,2] , N = s(s(s(0))), M = 0
; Xs = [1,1,1,1,2,2,2,2], N = 0 , M = s(s(s(s(0))))
...
To raise the lower bound of N or M, just state an additional goal of the form X = s(s(_)) (for a minimum value of 2).
In the following query both N and M are to be greater than 0:
?- N = s(_) , M = s(_) , length(Xs, _), phrase(aN_bM_cNM(N,M), Xs).
( N = s(0) , M = s(0) , Xs = [0,1,2,2]
; N = s(0) , M = s(s(0)) , Xs = [0,1,1,2,2,2]
; N = s(s(0)), M = s(0) , Xs = [0,0,1,2,2,2]
; N = s(0) , M = s(s(s(0))), Xs = [0,1,1,1,2,2,2,2]
...
You're misusing succ/2, maybe because you expect Prolog evaluates functions in head patterns. It doesn't. Then, try to replace your rules with
a(0) --> [].
a(Y) --> {succ(X,Y)}, [0], a(X).
etc etc
edit since succ/2 needs at least one argument instantiated to an integer, we could supply N,M to the DCG entry, or, using CLP(FD):
:- use_module(library(clpfd)).
s --> a(N), b(M), c(N), c(M).
a(0) --> [].
a(Y) --> {Y #= X-1}, [0], a(X).
b(0) --> [].
b(Y) --> {Y #= X-1}, [1], b(X).
c(0) --> [].
c(Y) --> {Y #= X-1}, [2], c(X).
but still, list' length must be provided. For example
?- length(L,_),phrase(s,L).
L = [] ;
L = [1, 2] ;
L = [0, 2] ;
L = [1, 1, 2, 2] ;
L = [0, 1, 2, 2] ;
L = [0, 0, 2, 2] ;
...

Prolog, split list into two lists

I got a problem with lists. What I need to do is to split one list [1,-2,3,-4], into two lists [1,3] and [-2,-4]. My code looks like the following:
lists([],_,_).
lists([X|Xs],Y,Z):- lists(Xs,Y,Z), X>0 -> append([X],Y,Y) ; append([X],Z,Z).
and I'm getting
Y = [1|Y],
Z = [-2|Z].
What am I doing wrong?
If your Prolog system offers clpfd you could preserve logical-purity. Want to know how? Read on!
We take the second definition of lists/3 that #CapelliC wrote in
his answer as a starting point, and replace partition/4 by tpartition/4 and (<)/2 by (#<)/3:
lists(A,B,C) :- tpartition(#<(0),A,B,C).
Let's run a sample query!
?- As = [0,1,2,-2,3,4,-4,5,6,7,0], lists(As,Bs,Cs).
As = [0,1,2,-2,3,4,-4,5,6,7,0],
Bs = [ 1,2, 3,4, 5,6,7 ],
Cs = [0, -2, -4, 0].
As we use monotone code, we get logically sound answers for more general queries:
?- As = [X,Y], lists(As,Bs,Cs).
As = [X,Y], Bs = [X,Y], Cs = [ ], X in 1..sup, Y in 1..sup ;
As = [X,Y], Bs = [X ], Cs = [ Y], X in 1..sup, Y in inf..0 ;
As = [X,Y], Bs = [ Y], Cs = [X ], X in inf..0 , Y in 1..sup ;
As = [X,Y], Bs = [ ], Cs = [X,Y], X in inf..0 , Y in inf..0 .
Here you have. It splits a list, and does not matter if have odd or even items number.
div(L, A, B) :-
append(A, B, L),
length(A, N),
length(B, N).
div(L, A, B) :-
append(A, B, L),
length(A, N),
N1 is N + 1,
length(B, N1).
div(L, A, B) :-
append(A, B, L),
length(A, N),
N1 is N - 1,
length(B, N1).
Refer this:
domains
list=integer*
predicates
split(list,list,list)
clauses
split([],[],[]).
split([X|L],[X|L1],L2):-
X>= 0,
!,
split(L,L1,L2).
split([X|L],L1,[X|L2]):-
split(L,L1,L2).
Output :
Goal: split([1,2,-3,4,-5,2],X,Y)
Solution: X=[1,2,4,2], Y=[-3,-5]
See, if that helps.
Just for variety, this can also be done with a DCG, which is easy to read for a problem like this:
split([], []) --> [].
split([X|T], N) --> [X], { X >= 0 }, split(T, N).
split(P, [X|T]) --> [X], { X < 0 }, split(P, T).
split(L, A, B) :-
phrase(split(A, B), L).
As in:
| ?- split([1,2,-4,3,-5], A, B).
A = [1,2,3]
B = [-4,-5] ? ;
no
It also provides all the possible solutions in reverse:
| ?- split(L, [1,2,3], [-4,-5]).
L = [1,2,3,-4,-5] ? ;
L = [1,2,-4,3,-5] ? ;
L = [1,2,-4,-5,3] ? ;
L = [1,-4,2,3,-5] ? ;
L = [1,-4,2,-5,3] ? ;
L = [1,-4,-5,2,3] ? ;
L = [-4,1,2,3,-5] ? ;
L = [-4,1,2,-5,3] ? ;
L = [-4,1,-5,2,3] ? ;
L = [-4,-5,1,2,3] ? ;
(2 ms) no
Gaurav's solution will also do this if the cut is removed and an explicit X < 0 check placed in the third clause of the split/3 predicate.
There are several corrections to be done in your code.
If you enjoy compact (as readable) code, a possibility is
lists([],[],[]).
lists([X|Xs],Y,Z) :-
( X>0 -> (Y,Z)=([X|Ys],Zs) ; (Y,Z)=(Ys,[X|Zs]) ), lists(Xs,Ys,Zs).
But since (SWI)Prolog offers libraries to handle common list processing tasks, could be as easy as
lists(A,B,C) :- partition(<(0),A,B,C).

constraint programming, repetition of number in a list, prolog

How can I limit the repetition of a number in a list?
What is a suitable constraint in the following code example?
limit(X) :-
length(X,10),
domain(X,1,4),
% WANTED CONSTRAINT: maximum repetition of each number is 5 times.
labeling([],X).
Some sample queries and expected answers:
?- limit([1,1,1,1,1,1,1,1,1]).
false.
?- limit([1,1,1,1,1,2,2,2,2,2]).
true.
This works, L is the list of the number of repetitions of each number from 1 to 4.
:- use_module(library(clpfd)).
limit(X) :-
length(L, 4),
L ins 0..5,
sum(L, #=, 10),
label(L),
maplist(make_list, [1,2,3,4], L, LX),
flatten([LX],X).
make_list(Val, Nb, L) :-
length(L, Nb),
L ins Val .. Val.
The problem is that the numbers are group by values.
The code may be generalized to
limit(X, Min, Max, Len, Rep) :-
Nb is Max -Min + 1,
length(L, Nb),
L ins 0..Rep,
sum(L, #=, Len),
label(L),
numlist(Min, Max, Lst),
maplist(make_list, Lst, L, LX),
flatten([LX],X).
You try : limit(X, 1, 4, 10, 5).
In this answer we use two different clpfd "flavors": sicstus-prolog and gnu-prolog.
:- use_module(library(clpfd)).
limited_repetitions__SICStus(Zs) :-
length(Zs, 10),
domain(Zs, 1, 4),
domain([C1,C2,C3,C4], 0, 5),
global_cardinality(Zs, [1-C1,2-C2,3-C3,4-C4]),
labeling([], Zs).
limited_repetitions__gprolog(Zs) :-
length(Zs, 10),
fd_domain(Zs, 1, 4),
maplist(fd_atmost(5,Zs), [1,2,3,4]),
fd_labeling(Zs).
Simple sample query run with SICStus Prolog version 4.3.2 and GNU Prolog 1.4.4:
?- limited_repetitions__SICStus(Zs). % ?- limited_repetitions__gprolog(Zs).
Zs = [1,1,1,1,1,2,2,2,2,2] % Zs = [1,1,1,1,1,2,2,2,2,2]
; Zs = [1,1,1,1,1,2,2,2,2,3] % ; Zs = [1,1,1,1,1,2,2,2,2,3]
; Zs = [1,1,1,1,1,2,2,2,2,4] % ; Zs = [1,1,1,1,1,2,2,2,2,4]
; Zs = [1,1,1,1,1,2,2,2,3,2] % ; Zs = [1,1,1,1,1,2,2,2,3,2]
; Zs = [1,1,1,1,1,2,2,2,3,3] % ; Zs = [1,1,1,1,1,2,2,2,3,3]
; Zs = [1,1,1,1,1,2,2,2,3,4] % ; Zs = [1,1,1,1,1,2,2,2,3,4]
; Zs = [1,1,1,1,1,2,2,2,4,2] % ; Zs = [1,1,1,1,1,2,2,2,4,2]
... % ...
Let's measure the time required for counting the number of solutions!
call_succeeds_n_times(G_0, N) :-
findall(t, call(G_0), Ts),
length(Ts, N).
?- call_time(call_succeeds_n_times(limited_repetitions__SICStus(_), N), T_ms).
N = 965832, T_ms = 6550. % w/SICStus Prolog 4.3.2
?- call_time(call_succeeds_n_times(limited_repetitions__gprolog(_), N), T_ms).
N = 965832, T_ms = 276. % w/GNU Prolog 1.4.4
In this previous answer we utilized the SICStus Prolog clpfd predicate global_cardinality/2. As an non-constraint alternative, we could also use selectd/3 like this:
multi_selectd_rest([],Ds,Ds).
multi_selectd_rest([Z|Zs],Ds0,Ds) :-
selectd(Z,Ds0,Ds1),
multi_selectd_rest(Zs,Ds1,Ds).
Putting it to good use in limited_repetitions__selectd/3 we define:
limited_repetitions__selectd(Zs) :-
length(Zs, 10),
multi_selectd_rest(Zs,[1,1,1,1,1,2,2,2,2,2,3,3,3,3,3,4,4,4,4,4],_).
Again, let's measure the time required for counting the number of solutions!
?- call_time(call_succeeds_n_times(limited_repetitions__selectd(_),N), T_ms).
N = 965832, T_ms = 4600.
Here is a way, but not for sequences:
:- [library(clpfd)].
limit_repetition(Xs, Max) :-
maplist(vs_n_num(Xs, Max), Xs).
vs_n_num(Vs, Max, X) :-
maplist(eq_b(X), Vs, Bs),
% sum(Bs, #=, EqC),
% EqC #=< Max.
sum(Bs, #=<, Max).
eq_b(X, Y, B) :- X #= Y #<==> B.
vs_n_num/3 is an adapted version of what you can find in docs.
Here's a way to delimite sequences:
limit_repetition([X|Xs], Max) :-
limit_repetition(X, 1, Xs, Max).
limit_repetition(X, C, [Y|Xs], Max) :-
X #= Y #<==> B,
( B #/\ C + B #=< Max #/\ D #= C + B ) #\/ ( (#\ B) #/\ D #= 1 ),
limit_repetition(Y, D, Xs, Max).
limit_repetition(_X, _C, [], _Max).
yields
?- length(X,4), X ins 1..4, limit_repetition(X, 1) ,label(X).
X = [1, 2, 1, 2] ;
X = [1, 2, 1, 3] ;
...
Seems the former version is more related to your sample.

Resources