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.

Tags , , , ,  | 9 comments

Comments

  1. Avatar atoku said about 1 month later:

    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)))

  2. Avatar atoku said about 1 month later:

    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)))
    
  3. Avatar Winston Smith said about 1 month later:

    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)))
    

    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

  4. Avatar atoku said about 1 month later:

    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 ;).

  5. Avatar atoku said about 1 month later:

    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.

  6. Avatar atoku said about 1 month later:

    It shifted the second “if” in the indentation. Sorry for this.

  7. Avatar atoku said about 1 month later:

    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 :)

  8. Avatar Winston Smith said about 1 month later:

    (defun pack(lst &optional groups)
      (dolist (el lst (reverse groups)) 
        (when (not (equal el (caar groups))) (push nil groups))
        (push el (car groups))))
    

  9. Avatar Winston Smith said about 1 month later:
    (defun pack(lst &optional groups)
      (dolist (el lst (reverse groups)) 
        (if (equal el (caar groups))
            (push el (car groups))
            (push (list el) groups))))
    

(leave url/email »)

   Comment Markup Help Preview comment