Compress a list that contains segments of continuous numbers to a list which contains list of range of segments [start,end]

[triska]

Dear all,

today I came across an interesting question: https://stackoverflow.com/questions/78401978/prolog-compress-a-list-that-contains-segments-of-continuous-numbers-to-a-list-w

It is phrased quite imperatively and a bit hard to understand as "Compressing a list of integers to a compressed list. List contains segments of continuous integers. A segment with length greater than 2 will be encoded to list [start, end], end is inclusive. If the length is not greater than 2 will be kept no change."

An example is also specified:

?- compress([3,4,6,7,8,9,10,15,16,17,20,22,23,24,25], CompressedList).
   CompressedList = [3, 4, [6,10],[15, 17],20, [22,25]].

I used this opportunity to try out a few of the constructs we have available in Scryer Prolog, as currently the only Prolog system that provides them by default, notably library(reif) and the new predicate clpz_t/2 thanks to @librarianmage.

The solution I came up with is:

:- use_module(library(reif)).
:- use_module(library(clpz)).

clpz:monotonic.

compress([], []).
compress([L|Ls], Cs) :-
        compress_(Ls, L, Cs).

compress_([], L, [#L]).
compress_([L|Ls], L0, Cs) :-
        if_(clpz_t(#L #= #L0 + 1),
            compress_more(Ls, L, L0, Cs),
            (   Cs = [#L0|Rest],
                compress([L|Ls], Rest)
            )).

compress_more([], L, L0, Cs) :-
        if_(clpz_t(#L #= #L0 + 1),
            Cs = [#L0,#L],
            Cs = [L0-L]).
compress_more([M|Ms], L, L0, Cs) :-
        if_(clpz_t(#M #= #L + 1),
            compress_more(Ms, M, L0, Cs),
            (   if_(clpz_t(#L #= #L0 + 1),
                    Cs = [#L0,#L|Rest],
                    Cs = [L0-L|Rest]),
                compress([M|Ms], Rest)
            )).

Note that I am using a clean representation for the second argument: I use the prefix operator # to mark integers, so that we can symbolically distinguish them from ranges of the form Start-End. With this representation, I get:

?- compress([3,4,6,7,8,9,10,15,16,17,20,22,23,24,25], CompressedList).
   CompressedList = [#3,#4,6-10,15-17,#20,22-25].

One very nice property of the code is that we can also use it in other directions and modes, for instance we can ask the most general query:

?- compress(As, Bs).
   As = [], Bs = []
;  As = [_A], Bs = [#_A]
;  As = [_C,_A], Bs = [#_C,#_A], clpz:(#_A#\= #_B), clpz:(#_C+1#= #_B)
;  As = [_D,_A,_E], Bs = [#_D,#_A,#_E], clpz:(#_A#\= #_B), clpz:(#_A+1#= #_C), clpz:(#_D+1#= #_B), clpz:(#_E#\= #_C)
;  As = [_D,_A,_E,_G], Bs = [#_D,#_A,#_E,#_G], clpz:(#_A#\= #_B), clpz:(#_A+1#= #_C), clpz:(#_D+1#= #_B), clpz:(#_E#\= #_C), clpz:(#_E+1#= #_F), clpz:(#_G#\= #_F)
;  ... .

We can also try different search strategies, for example iterative deepening:

?- length(As, _), compress(As, Bs).
   As = [], Bs = []
;  As = [_A], Bs = [#_A]
;  As = [_C,_A], Bs = [#_C,#_A], clpz:(#_A#\= #_B), clpz:(#_C+1#= #_B)
;  As = [_C,_A], Bs = [_C-_A], clpz:(#_A#\= #_B), clpz:(#_C+1#= #_A), clpz:(#_C+1#= #_B)
;  As = [_A,_B], Bs = [#_A,#_B], clpz:(#_A+1#= #_B), clpz:(#_A+1#= #_B)
;  As = [_D,_A,_E], Bs = [#_D,#_A,#_E], clpz:(#_A#\= #_B), clpz:(#_A+1#= #_C), clpz:(#_D+1#= #_B), clpz:(#_E#\= #_C)
;  ... .

Using iterative deepening, we can use the same code to find a list that results in a given "compressed" list:

?- length(As, _), compress(As, [#3,#4,6-10,15-17,#20,22-25]).
   As = [3,4,6,7,8,9,10,15,16,17,20,22,23,24,25]
;  ... .

We get all this generality by construction, because only pure monotonic constructs are used in the code. This ensures that the code yields correct results in all usage modes.

I leave finding a better name for the predicate as a challenge.

One other point I noticed: I think this solution would benefit from a DCG non-terminal if__//3 that is analogous to if_/3, except that it can be used within DCGs. I think such a non-terminal would yield a shorter and more elegant solution in this case, and I would greatly appreciate any feedback and help with these issues.

Thank you a lot, and enjoy!
Markus

[triska]

I have now implemented this, using the DCG non-terminal if__//3 as building block, defined as:

:- use_module(library(error)).

:- meta_predicate(if__(1, 2, 2, ?, ?)).

if__(If_1, Then, Else) -->
        { call(If_1, T) },
        (   { T == true } -> Then
        ;   { T == false } -> Else
        ;   { must_be(boolean, T) }
        ).

With this building block, we can write:

:- use_module(library(dcgs)).
:- use_module(library(reif)).
:- use_module(library(clpz)).

clpz:monotonic.

compression([]) --> [].
compression([L|Ls]) -->
        compression_(Ls, L).

compression_([], L) --> [#L].
compression_([L|Ls], L0) -->
        if__(clpz_t(#L #= #L0 + 1),
             more_compression(Ls, L, L0),
             ([#L0], compression([L|Ls]))).

more_compression([], L, L0) --> finish_run(L0, L).
more_compression([M|Ms], L, L0) -->
        if__(clpz_t(#M #= #L + 1),
             more_compression(Ms, M, L0),
             (finish_run(L0, L), compression([M|Ms]))).

finish_run(L0, L) -->
        if__(clpz_t(#L #= #L0 + 1),
             [#L0,#L],
             [L0-L]).

Yielding for example:

?- phrase(compression([3,4,6,7,8,9,10,15,16,17,20,22,23,24,25]), Cs).
   Cs = [#3,#4,6-10,15-17,#20,22-25].

[infradig]

Nice. Works fine with Trealla as well.

[librarianmage]

This was a fun puzzle! I tried solving the problem in reverse, using your if__//3 DCG non-terminal:

:- use_module(library(reif)).
:- use_module(library(clpz)).
:- use_module(library(dcgs)).
:- use_module(library(lists)).
:- use_module(library(error)).

clpz:monotonic.

if__(If_1, Then, Else) -->
        { call(If_1, T) },
        (   { T == true } -> Then
        ;   { T == false } -> Else
        ;   { must_be(boolean, T) }
        ).

range(X, Y) --> { #X #=< #Y }, [X], if__(#=(X, Y), [], ({#X1 #= #X + 1}, range(X1, Y))).

expansion([]) --> [].
expansion([L|Ls]) --> expand_(L, _, I), expansion_(Ls, I).

expansion_([], _) --> [].
expansion_([L|Ls], I0) --> expand(L, I0, I), expansion_(Ls, I).

expand(Item, I0, I) --> expand_(Item, X, I), { #X #\= #I0 + 1 }.

expand_(#X, X, X) --> [X].
expand_(X-Y, X, Y) --> { #X #< #Y }, range(X, Y).

It seems to work mostly the same, though my implementation doesn't quite work when trying to use iterative deepening:

?- length(X, L), phrase(expansion(X), Y).
   X = [], L = 0, Y = []
;  X = [#_A], L = 1, Y = [_A]
;  ^C   error('$interrupt_thrown',repl/0).

---

Addendum: made this cmp//5 DCG non-terminal while playing around:

cmp(X, Y, Lt, Eq, Gt) --> if__(#<(X, Y), Lt, if__(#=(X, Y), Eq, Gt)).

[triska]

For iterative deepening, I think you should constrain the length of Y?