Logically pure/impure predicate implementations in the std lib

Just wanted to vent quickly. Working on something and was disappointed to see that clumped/2 is not bidirectional, as another commenter “LogicalCaptain” pointed out in a comment aptly titled “Missed opportunity”.

I understand that implementations are often a matter of tradeoffs and I’m guessing there was a reason, such as performance, for the predicate to have this limitation, but for every predicate in std lib that’s not logically pure, it would be nice if there was a corresponding pure one to give the user the option. ie. there should also be a clumped_pure/2.

I did find this SO post where the checked answer claims to have a pure version of clumped, but I have not been able to test it out because it uses scryer which I don’t have.

This is one of the holy wars of Prolog, with all kinds strong opinions getting thrown around. In general, if integers are involved it becomes quite difficult to keep it “logically pure” without getting very fancy or hacky. Either way:

You should implement this and make a PR. I assume there are other ways to get what you want out of SWI-Prolog but this one is the purest.

nowhere in the SO post you linked I see scryer mentioned at all. The accepted answer explicitly claims that it was tested with SWI-Prolog. Maybe I am seeing things.

DCG to the rescue!

runs(R, L) :- runs(L, R, []).

runs([X-N|R]) --> [X], {var(N)}, !, run(X, M), {N is M+1}, runs(R).
runs([X-N|R]) --> [X], {N > 0}, !, {M is N-1}, run(X, M), runs(R).
runs([]) --> [].

run(X, N) --> [X], {var(N)}, !, run(X, M), {N is M+1}.
run(X, N) --> [X], {N > 0}, !, {M is N-1}, run(X, M).
run(_, 0) --> [].

It wurks:

?- runs([a,a,b,c,c,c], L). 
L = [a-2, b-1, c-3].

?- runs(R, [a-2, b-1, c-3]). 
R = [a, a, b, c, c, c].
2 Likes

Great answer!

just curious, why not

runs(R, L) :- phrase(runs(R), L).

?

Please note it should be:

runs(R, L) :- phrase(runs(L), R).

My runs/2 is a little dirty, it swaps the argument order. Also you get more
bang out of phrase/2 if you use it together with library(apply_macros).

Edit 28.02.2023
Its not a very good solution, since it uses the cut and not dif/2.
That it is not a very good solution is seen here below.

This works:

?- dif(X,Y), runs([X,X,Y,Y,Y], L).
L = [X-2, Y-3],
dif(X, Y).

But this doesn’t work:

?- runs([X,X,Y,Y,Y], L), dif(X,Y).
false.

Can this be fixed via dif/2 in the code of runs itself?

I could be mistaken. It uses :- use_module(library(reif)). which I was not able to find in swi but was in scryer.

library(reif) is available as a pack now: "reif" pack for SWI-Prolog

Sorry for the perhaps silly question: I’m still learning. How do you work with these packages? For :- use_module(library(clpfd)). nothing really needed to be done except import from top of your source. How do I import reif?

It has been a while since I wrote this topic

Installing a SWI-Prolog pack

but it should still work or at least give you enough of the details to get you headed in the right direction.

1 Like

short answer:

?- pack_install(reif).
1 Like

Awesome, will try this. Appreciate the support.

Writing a run-length encoder is a classical rabbit hole with endless efforts at solving it… I am not sure when it would be needed, ever, but maybe it is so prominent because of the “99 Prolog Problems”. It appears there in different variations starting with P08 and maybe that’s why it keeps popping up on different forums.

If I weren’t so lazy I would make a study about how often it gets asked, what solutions are proposed, how these solutions have been maturing over time…

1 Like

It’s more elegant with CLP(FD), but unfortunately leaves a choicepoint; on the other hand, the inverse solution is not unique (although it appears that @j4n_bur53 's solution gets the minimal clumping):

:- use_module(library(clpfd)).

runs(R, L) :- phrase(runs(L), R).

runs([X-N|R]) --> {N #> 0}, run(X, N), runs(R).
runs([]) --> [].

run(X, N) --> {N #> 0, M #= N-1}, [X], run(X, M).
run(_, 0) --> [].
?- forall(runs(L, [a-2,b-1,c-3]), writeln(L)).
[a,a,b,c,c,c]
true.
?- forall(runs([a, a, b, c, c, c], L), writeln(L)).
[a-2,b-1,c-3]
[a-2,b-1,c-2,c-1]
[a-2,b-1,c-1,c-2]
[a-2,b-1,c-1,c-1,c-1]
[a-1,a-1,b-1,c-3]
[a-1,a-1,b-1,c-2,c-1]
[a-1,a-1,b-1,c-1,c-2]
[a-1,a-1,b-1,c-1,c-1,c-1]
true.
1 Like

dif/2 to the rescue!

:- use_module(library(clpfd)).

runs(R, L) :- phrase(runs(_, L), R).

runs(X, [X-N|R]) --> {N #> 0}, run(X, N), {dif(X,Y)}, runs(Y, R).
runs(_, []) --> [].

run(X, N) --> {N #> 0, M #= N-1}, [X], run(X, M).
run(_, 0) --> [].

Gives me, spurious choice point, but otherwise ok:

?- runs(L, [a-2,b-1,c-3]).
L = [a, a, b, c, c, c] ;
false.

?- runs([a, a, b, c, c, c], L).
L = [a-2, b-1, c-3] ;
false.
1 Like

And we don’t need clp(fd); freeze/2 and when/2 work just fine:

runs(R, L) :- phrase(runs(_, L), R).
% runs(X, R, L) :- phrase(runs(X, L), R).

runs(X, [X-N|R]) --> {freeze(N, N > 0)}, run(X, N), {dif(X,Y)}, runs(Y, R).
runs(_, []) --> [].

run(X, N) --> {freeze(N, N > 0)}, {when_plus1(M, N)}, [X], run(X, M).
run(_, 0) --> [].

when_plus1(A,C) :-
    when((nonvar(A);nonvar(C)), plus(A,1,C)).
?- runs([a, a, b, c, c, c], L).
L = [a-2, b-1, c-3] ;
false.

?- runs(L, [a-2, b-1, c-3]).
L = [a, a, b, c, c, c] ;
false.
1 Like

The below is mildly deterministic:

:- use_module(library(reif)).

clumped2([H|T], [H-N|Pairs]) :-
    clumped2_(T, H, 1, [H-N|Pairs]).

clumped2_([], P, U, [P-U]).
clumped2_([H|T], P, U, [P-N|Pairs]) :-
    if_(H = P,
        clumped2_same_([P-N|Pairs], T, H, P, U), 
        clumped2_dif_([P-N|Pairs], T, H, P, U)
    ).

clumped2_same_([P-N|Pairs], T, P, P, U) :-
    (integer(N) -> N @> U ; var(N)),
    U1 is U + 1,
    clumped2_(T, P, U1, [P-N|Pairs]).

clumped2_dif_([P-N|Pairs], L, H, P, N) :-
    clumped2_(L, H, 1, Pairs).

Results:

?- clumped2([X,X,Y,Y,Y], C).
X = Y,
C = [Y-5] ;
C = [X-2, Y-3],
dif(Y, X).

?- clumped2([a,b,b,c,c,c], C).
C = [a-1, b-2, c-3].

?- clumped2(L, [a-1, b-2, c-3]).
L = [a, b, b, c, c, c] ;
false. % Unwanted choicepoint

The pack for library(reif) doesn’t have any documentation, but I found this – is it the best place to start?

Yes, plus usages on stackoverflow.

Seems a bit more elegant, but still an unwanted choicepoint:

clumped2([]) --> [].
clumped2([Elem-Len|Pairs]) -->
    elem_same_dl(Elem, Len),
    clumped2(Pairs).

elem_same_dl(Elem, Len, [Elem|L], R) :-
    elem_same_dl_(L, R, Elem, 1, Len).

elem_same_dl_(L, R, Elem, U, Len) :-
    (   integer(Len) ->
        Len @>= U, 
        (   L = R, U = Len -> true
        ;   elem_same_dl_inc_(L, R, Elem, U, Len)
        )
    % Non-deterministic
    ;   elem_same_dl_inc_(L, R, Elem, U, Len)
    ;   elem_same_dl_dif_(L, R, Elem, U, Len)
    ).

elem_same_dl_inc_([Elem|T], R, Elem, U, Len) :-
    U1 is U + 1,
    elem_same_dl_(T, R, Elem, U1, Len).

elem_same_dl_dif_(L, L, Elem, Len, Len) :-
    (   L = []
    ;   L = [H|_],
        dif(H, Elem)
    ).

Results:

?- phrase(clumped2(Ps), [a,b,X,c]).
Ps = [a-1, b-2, c-1],
X = b ;
Ps = [a-1, b-1, c-2],
X = c ;
Ps = [a-1, b-1, X-1, c-1],
dif(X, b),
dif(X, c) ;
false.

?- phrase(clumped2([a-1,b-2,c-3]), L).
L = [a, b, b, c, c, c].

?- phrase(clumped2(Ps), [a,b,b,c,c,c]).
Ps = [a-1, b-2, c-3] ;
false. % Unwanted choicepoint