A Haskell and Lisp Comparison
Posted by Daniel Lyons Mon, 11 Dec 2006 21:33:00 GMT
This struck me as I was working through the L-99 99 Lisp problems:
P09 (
**) Pack consecutive duplicates of list elements into sublists.
If a list contains repeated elements they should be placed in separate sublists.
Example:
* (pack ‘(a a a a b c c a a d e e e e))
((A A A A) (B) (C C) (A A) (D) (E E E E))
Well, naturally I was using Haskell rather than Lisp, so I came up with this:
pack :: (Eq a) => [a] -> [[a]]
pack [] = []
pack (x:xs) = pack_it [x] xs where
pack_it y [] = [y]
pack_it (y:ys) (l:ls) = if y == l
then pack_it (y:l:ys) ls
else (y:ys) : pack (l:ls)
It’s not amazingly readable, but in plain English, what’s happening here is I’m using a function pack_it which takes two lists. If the first thing in the second list is the same as the first thing in the first list, it recurs, shifting the element over to the first list. If that isn’t the case, it produces the first list concatenated with the recursive invocation of the parent function pack with the remainder of the list. The parent function just calls pack_it with the first item of the list in its own list as the first list, and the remainder as the second list.
It’s kind of surprising to me that I’m able to write code such as this.
Anyway, for comparison, I thought I’d take a peek at the Lisp implementation on the same site. It looks like this:
(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))))
How about that. 19 lines versus… 6. Or 7 if you include the type.
Edit: Justin Dressel suggests this implementation with guards and the @ pattern:
pack (x:xs) = pack_it [x] xs
where
pack_it y [] = [y]
pack_it y@(y1:ys) l@(l1:ls)
| y1 == l1 = pack_it (l1:y) ls
| otherwise = y : pack l
Beeyuteeful.
Edit #2:
My Haskell implementation of pack, translated into Lisp:
(defun pack (l)
(if (null l) nil
(let ((x (car l))
(xs (cdr l)))
(pack-it (list x) xs))))
(defun pack-it (h l)
(let ((kind (car h))
(hd (car l))
(tl (cdr l)))
(if (eq hd kind)
(pack-it (cons hd h) tl)
(cons h (pack l)))))
This is a mere 13 lines of code compared to the 19 of the tira/pega implementation. Which makes me think I may have done something cleverer.

I am very sorry… Your lisp implementation is very bad. That is why it is longer than Haskell’s. I love Haskell but Lisp deserves better code :) Below is just an example of a possible better way ;) just 6 lines. It beats your Haskell super-duper implementation. I like to discuss it. My e-mail is anton at kulchitsky dot org
(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)))
sorry, i did not know how to format the code
(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)))Here is a variation on Atoku’s elegant lisp solution. Note the unification of cases made possible by the side-effect of pop.
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) (caar g)) (pop g))) g)))))x@yahoo.com, where x=winsmithton
Winston Smith, very nice code! The first version is destructive so nreverse could be better? It is funny that you made this just in 4 lines. Well, the code could be split in more lines though.
I like also the loop version. The “no mercy” version is funny – I cannot understand how it works:)
PS. Daniel, sorry for saying that your code was bad. It was not. I tried to appologize the Lisp and overreacted ;).
Well, there is another version of pick maden without reverse and any other auxilary functions, and without an extra function as well. I made it as sparse as I could (for example, I use let and make two extra lines for if). It is still only 7 lines!
It uses just a simple recursion (tail recursion).
(defun pack (lst-from &optional lst-to) (if (null lst-from) (reverse lst-to) (let ((el (car lst-from))) (if (eql el (caar lst-to)) (pack (cdr lst-from) (cons (cons el (car lst-to)) (cdr lst-to))) (pack (cdr lst-from) (cons (list el) lst-to))))))PS. By destructive, I meant that pop in pick-new is working on the same list lst.
It shifted the second “if” in the indentation. Sorry for this.
I also see that Winston’s recursive and “no-mercy” variations are almost the same. I tryed to be “very functional” in the last variation :)
(defun pack(lst &optional groups) (dolist (el lst (reverse groups)) (when (not (equal el (caar groups))) (push nil groups)) (push el (car groups))))(defun pack(lst &optional groups) (dolist (el lst (reverse groups)) (if (equal el (caar groups)) (push el (car groups)) (push (list el) groups))))