in reply to 99 Problems in Perl6

How embarrassing. My first version of problem 9 (packing lists into sublists) had a bug. Here's a cleaner version which actually works. I know the bug in problem 9. Can you spot it?

sub pack (@array) returns Array {
    my @unpacked = @array;
    my (@list, @packed);
    while @unpacked {
        @list.push(@unpacked.shift) while !@list || @list[0] eq @unpac
+ked[0];
        @packed.push([@list]);
        @list = ();
    }
    return @packed;
}
pack(<a a a a b c c a a d e e e e>).perl.say;

[download]

And for the Lisp weenies who claim Lisp is so much better, here's one way to do it in Lisp (can you make it shorter?):

(defun pack (lista)
    (if (eql lista nil) 
        nil
        (cons (pega lista) (pack (tira lista)))
    )
)

(defun pega (lista)
    (cond ((eql lista nil) nil)
      ((eql (cdr lista) nil) lista)
          ((equal (car lista) (cadr lista))
              (cons (car lista) (pega (cdr lista))))
          (t (list (car lista)))
    )
)

(defun tira (lista)
    (cond ((eql lista nil) nil)
      ((eql (cdr lista) nil) nil)
          ((equal (car lista) (cadr lista))
              (tira (cdr lista)))
          (t (cdr lista))
    )
)

[download]

But the Prolog folks still have a neat solution:

pack([],[]).
pack([X|Xs],[Z|Zs]) :- transfer(X,Xs,Ys,Z), pack(Ys,Zs).

transfer(X,[],[],[X]).
transfer(X,[Y|Ys],[Y|Ys],[X]) :- X \= Y.
transfer(X,[X|Xs],Ys,[X|Zs]) :- transfer(X,Xs,Ys,Zs).

[download]

And Haskell still makes us all look like chumps:

group (x:xs) = let (first,rest) = span (==x) xs
               in (x:first) : group rest
group [] = []

[download]

Cheers,
Ovid

New address of my CGI Course.

Replies are listed 'Best First'.
Re^2: 99 Problems in Perl6 (Lisp, Prolog, Haskell)
by TimToady (Parson) on Dec 15, 2006 at 23:02 UTC
    Here's a prettier way to write the Perl 6 solution: 
    sub group (*@array is copy) {
    gather {
        while @array {
            take [
                gather {
                    my $h = shift @array;
                    take $h;
                    while @array and $h eq @array[0] {
                        take shift @array;
                    }
                }
            ];
        }
    }
}

    [download]
    It would be slightly prettier if take could harvest a value en passant.
[reply]
[d/l]

      Sweet!

      Why do you flatten the array? I played with that in Pugs and the asterisk seems superfluous. It seems like one is copy the elements and the other is copying the array. I thought that maybe your version would avoid aliasing problems, but even in checking that, I'm not seeing it happening.

      sub group (@array is copy) {   # didn't flatten
    gather {
        while @array {
            take [
                gather {
                    my $h = shift @array;
                    take $h;
                    while @array and $h eq @array[0] {
                        take shift @array;
                    }
                }
            ];
        }
    }
}

      [download]

      Cheers,
      Ovid

      New address of my CGI Course.

[reply]
[d/l]
        I just chose to write it as a list operator so that you could say 
        @result = group 1,2,2,2,3,3,4,4,4,4,5,5,6,6;

        [download]
        instead of doing it all with "scalar" arrays: 
        @result := group [1,2,2,2,3,3,4,4,4,4,5,5,6,6];

        [download]
        But either approach is fine.
[reply]
[d/l]
[select]
Re^2: 99 Problems in Perl6 (Lisp, Prolog, Haskell)
by Anonymous Monk on Jun 30, 2009 at 18:26 UTC
    atoku says: Lisp deserves better code :) Below is just an example of a possible better way ;) just 6 lines. 
    (defun pick-new (lst el)
  (if (eql (car (car lst)) el)
      (cons (cons el (car lst)) (cdr lst))
      (cons (list el) lst)))

(defun pack (lst)
  (reverse (reduce #'pick-new lst :initial-value nil)))

    [download]
    Winston Smith says: Here is a variation on Atoku’s elegant lisp solution. Note the unification of cases made possible by the side-effect of pop. 
    (defun pick-new (lst el)
  (cons (cons el (when (equal el (caar lst)) (pop lst))) lst))

(defun pack (lst)
  (reverse (reduce #'pick-new lst :initial-value nil)))

    [download]
    Here are three solutions in lisp that don’t require auxiliary functions. 
    ;;With loop:

(defun pack(lst &optional groups)
  (loop for el in lst 
        for first-group = (when (equal el (caar groups)) (pop groups))
        do (push (cons el first-group) groups))
  (reverse groups))

;;With recursion:

(defun pack(lst &optional groups)
  (if (not lst) (reverse groups) 
      (let* ((el (pop lst))
             (first-group (when (equal el (caar groups)) (pop groups))
+))
        (pack lst (cons (cons el first-group) groups)))))

;;With no mercy:

(defun pack(lst &optional g)
  (if (not lst) (reverse g) 
      (pack (cdr lst) (cons (cons (car lst) (when (equal (car lst) (ca
+ar g)) (pop g))) g)))))

    [download]
[reply]
[d/l]
[select]

In Section Meditations