Pack consecutive duplicates of list elements into

Question

I have a problem with returning an answer to Problem 9 of P-99: Ninety-Nine Prolog Problems:

Pack consecutive duplicates of list elements into sublists. If a list contains repeated elements they should be placed in separate sublists.

Sample query with expected results:

?- pack([a,a,a,a,b,c,c,a,a,d,e,e,e,e],X).
X = [[a,a,a,a],[b],[c,c],[a,a],[d],[e,e,e,e]].

I managed to pack elements in sublists but I don't know how to return an answer.

Here's my code:

pack(X,Y) :- pack(X,[],Y).
pack([H,H|T],Acc,X) :- pack([H|T],[H|Acc],X).
pack([H,H1|T], Acc, X) :- 
    H\=H1, 
    Acc1=[H|Acc],
    append(X, [Acc1], X1),
    pack([H1|T],[],X1).
pack([H], Acc, X) :- 
    Acc1=[H|Acc],
    append(X, [Acc1], X1).

Here's a query run in trace mode:

?- trace, pack([a,a,a,a,b,c,c],X).
   Call: (6) pack([a, a, a, a, b, c, c], _G986) ? creep
   Call: (7) pack([a, a, a, a, b, c, c], [], _G986) ? creep
   Call: (8) pack([a, a, a, b, c, c], [a], _G986) ? creep
   Call: (9) pack([a, a, b, c, c], [a, a], _G986) ? creep
   Call: (10) pack([a, b, c, c], [a, a, a], _G986) ? creep
   Call: (11) a\=b ? creep
   Exit: (11) a\=b ? creep
   Call: (11) _G1100=[a, a, a, a] ? creep
   Exit: (11) [a, a, a, a]=[a, a, a, a] ? creep
   Call: (11) lists:append(_G986, [[a, a, a, a]], _G1105) ? creep
   Exit: (11) lists:append([], [[a, a, a, a]], [[a, a, a, a]]) ? creep
   Call: (11) pack([b, c, c], [], [[a, a, a, a]]) ? creep
   Call: (12) b\=c ? creep
   Exit: (12) b\=c ? creep
   Call: (12) _G1109=[b] ? creep
   Exit: (12) [b]=[b] ? creep
   Call: (12) lists:append([[a, a, a, a]], [[b]], _G1114) ? creep
   Exit: (12) lists:append([[a, a, a, a]], [[b]], [[a, a, a, a], [b]]) ? creep
   Call: (12) pack([c, c], [], [[a, a, a, a], [b]]) ? creep
   Call: (13) pack([c], [c], [[a, a, a, a], [b]]) ? creep
   Call: (14) _G1127=[c, c] ? creep
   Exit: (14) [c, c]=[c, c] ? creep
   Call: (14) lists:append([[a, a, a, a], [b]], [[c, c]], _G1132) ? creep
   Exit: (14) lists:append([[a, a, a, a], [b]], [[c, c]], [[a, a, a, a], [b], [c, c]]) ? creep
   Exit: (13) pack([c], [c], [[a, a, a, a], [b]]) ? creep
   Exit: (12) pack([c, c], [], [[a, a, a, a], [b]]) ? creep
   Exit: (11) pack([b, c, c], [], [[a, a, a, a]]) ? creep
   Exit: (10) pack([a, b, c, c], [a, a, a], []) ? creep
   Exit: (9) pack([a, a, b, c, c], [a, a], []) ? creep
   Exit: (8) pack([a, a, a, b, c, c], [a], []) ? creep
   Exit: (7) pack([a, a, a, a, b, c, c], [], []) ? creep
   Exit: (6) pack([a, a, a, a, b, c, c], []) ? creep
X = [] .

I imagine there should be additional line at the end of last rule to somehow bind the result to the input but I have no idea how to do it.

Answer 1

Something like this ought to work, I think:

%=============================
% pack/2: The public interface
%=============================
pack( []     , []     ) .                   % packing an empty list yields the empty list
pack( [X|Xs] , [Y|Ys] ) :-                  % packing a non-empty list consists of
  construct_run( Xs , [X] , Run , Tail ) ,  % - building a run of length 1 or more from the prefix of the list
  simplify_run( Run , Y ) ,                 % - simplfying it for the special case of a run of length 1
  pack( Tail , Ys )                         % - and then recursively packing whatever is left.
  .                                         % Easy!

%--------------------------
% private helper predicates
%--------------------------

%
% construct_run/4
%
construct_run( []     , Run    , Run    , []     ) .  % the run is complete if the source list is exhausted
construct_run( [X|Xs] , [R|Rs] , [R|Rs] , [X|Xs] ) :- % the run is complete if the head of the source list differs
  T \= R                                              %   from what's already in the run
  .                                                   %
construct_run( [X|Xs] , [R|Rs] , Run    , Tail   ) :  % otherwise, 
  T =  R ,                                            % - if the head of the source list matches what's already in the run,
  construct_run( Xs , [T,R|Rs] , Run , Tail )         % - we prepend it to the run and recurse down.
  .                                                   %

%
% simplify_run/2 - deal with the special case of run length 1
%
simplify_run( [A]     , A       ) . % run length = 1
simplify_run( [A,B|C] , [A,B|C] ) . % run length > 1

Answer 2

I think this one will work. I used an "accumulator" for gathering the duplicate member sublists.

pack([], []).
pack(L, Pack) :-
    pack(L, [], Pack).

pack([X], FrontPack, [[X|FrontPack]]).
pack([X,X|T], FrontPack, Pack) :-
    pack([X|T], [X|FrontPack], Pack).
pack([X,Y|T], FrontPack, [[X|FrontPack]|Pack]) :-
    X \= Y,
    pack([Y|T], [], Pack).

Results:

| ?- pack([a],X).

X = [[a]] ? ;

no.
| ?- pack([a,a,a,a,b,c,c,a,a,d,e,e,e,e],X).

X = [[a,a,a,a],[b],[c,c],[a,a],[d],[e,e,e,e]] ? ;

no
| ?-

Answer 3

here is the minimal modification required to make your code working: add a 'return only' variable, to 'emerge' the result from the inner working append to top level:

pack(X,Y) :- pack(X,[],_,Y).
pack([H,H|T],Acc,X,R) :- pack([H|T],[H|Acc],X,R).

pack([H,H1|T], Acc, X,R) :-
    H\=H1,
    Acc1=[H|Acc],
    append(X, [Acc1], X1),
    pack([H1|T],[],X1,R).

pack([H], Acc, X,R) :-
    Acc1=[H|Acc],
    append(X, [Acc1], X1),
    R = X1.

test:

?- pack([a,a,a,a,b,c,c],X).
X = [[a, a, a, a], [b], [c, c]] .

as you have seen, there are plenty of alternative algorithms available: here is mine, I attempted to make it simple as possible:

pack(L, P) :- pack(L, [], P).

pack([X|Xs], R, P) :-
    add_pack(X, R, R1), pack(Xs, R1, P).
pack([], R, P) :-
    reverse(R, P).

add_pack(X, [[X|Xs]|R], [[X,X|Xs]|R]).
add_pack(X, [R|Rs], [[X],R|Rs]).
add_pack(X, [], [[X]]).

its behaviour is most similar to 'naive insertion sort': take the front element and put it at the right place. To avoid appending the element, I use an accumulator, to be reversed at the end (as most of other answers here).

edit I guess, reading other answers, that someone else (like me) found your code difficult to understand. The cause could be that you are mixing 'input/output' arguments. As a stylistic choice, Prologgers usually stick to 'input first, output last'. This not always make sense (after all, Prolog is about relations, not functions), but nevertheless is often an useful, simple technique to follow.

HTH

Answer 4

If you use SWI-Prolog, with module(library(lambda)) and foldl, you can write :

:- use_module(library(lambda)).

pack(L, PL) :-
L = [A | B],
foldl(\X^Y^Z^(Y = [LY | RY],
          (   member(X, LY)
          ->  Z = [[X | LY]|RY]
          ;   Z = [[X]| [LY | RY]])),
      B, [[A]], RPL),
reverse(RPL, PL).

Module lambda.pl can be found there : http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl

Answer 5

Here's how you could do it in a logically pure way: Use the meta-predicate splitlistIfAdj/3 in combination with dif/3, a reified variant of prolog-dif. Let's do some queries right now!

?- Xs = [a], splitlistIfAdj(dif,Xs,Pss).
Xs  = [ a ],
Pss = [[a]].                                    % succeeds deterministically

?- Xs = [a,a,a,a,b,c,c], splitlistIfAdj(dif,Xs,Pss).
Xs  = [ a,a,a,a,  b,  c,c ],
Pss = [[a,a,a,a],[b],[c,c]].                    % succeeds deterministically

?- Xs = [a,a,a,a,b,c,c,a,a,d,e,e,e,e], splitlistIfAdj(dif,Xs,Pss).
Xs  = [ a,a,a,a,  b,  c,c,  a,a,  d,  e,e,e,e ],
Pss = [[a,a,a,a],[b],[c,c],[a,a],[d],[e,e,e,e]].% succeeds deterministically

Unlike impure code, the implementation is monotone and can be used with non-ground terms:

?- Xs = [A,B], splitlistIfAdj(dif,Xs,Pss), A=1, B=2.
Xs = [1,2], A = 1, B = 2, Pss = [[1],[2]].

?- Xs = [A,B], A=1, B=2, splitlistIfAdj(dif,Xs,Pss). % logically equivalent
Xs = [1,2], A = 1, B = 2, Pss = [[1],[2]].

Note that more general queries like the following one also give logically sound answers:

?- Xs = [A,B,C,D], splitlistIfAdj(dif,Xs,Pss).
Xs = [D,D,D,D], Pss = [[D,D,D,D]],           A=B ,     B=C ,     C=D  ;
Xs = [C,C,C,D], Pss = [[C,C,C],[D]],         A=B ,     B=C , dif(C,D) ;
Xs = [B,B,D,D], Pss = [[B,B],[D,D]],         A=B , dif(B,C),     C=D  ;
Xs = [B,B,C,D], Pss = [[B,B],[C],[D]],       A=B , dif(B,C), dif(C,D) ;
Xs = [A,D,D,D], Pss = [[A],[D,D,D]],     dif(A,B),     B=C ,     C=D  ;
Xs = [A,C,C,D], Pss = [[A],[C,C],[D]],   dif(A,B),     B=C , dif(C,D) ;
Xs = [A,B,D,D], Pss = [[A],[B],[D,D]],   dif(A,B), dif(B,C),     C=D  ;
Xs = [A,B,C,D], Pss = [[A],[B],[C],[D]], dif(A,B), dif(B,C), dif(C,D).

Answer 6

First things first: you have a singleton variable warning about X1:

pack([H], Acc, X) :- 
    Acc1=[H|Acc],
    append(X, [Acc1], X1).

This whole rule reduces to this:

pack([H], Acc, X) :- append(X, [[H|Acc]], _).

That surely isn't what you want, but looking at what you've got here I'm not sure what you do want. For one thing I wouldn't approach the problem with append/3. Your solution actually generates lists of distinct values, which tells me there's been a pretty severe misfire somewhere.

?- pack([a, a, a, a, b, c, c], X).
X = [] ;
X = [_G704] ;
X = [_G704, _G710] ;
X = [_G704, _G710, _G716] ;
X = [_G704, _G710, _G716, _G722] a

I wish I could see the problem, because in the trace I see you're building up the result correctly. Someone with more insight may furnish a fix for your typo.

Anyway, this is what I came up with:

pack([X|Unpacked], Packed) :- pack(Unpacked, [[X]], Packed).

pack([H|T], [[H|Acc]|Rest], Packed) :- pack(T, [[H,H|Acc]|Rest], Packed).
pack([X|T], [[Y|Acc]|Rest], Packed) :-
    X \= Y,
    pack(T, [[X],[Y|Acc]|Rest], Packed).
pack([], RPacked, Packed) :- reverse(RPacked, Packed).

In fact a difference list solution would allow prepending without using append/3 or using reverse/2 at the end, but I don't have one in my back pocket.