Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Common lisp identity-groups

I am a lisp beginner and i wrote a function to group equal adjacent items in a list. I would be grateful if Lisp experts could give me some advice about a better lispy writing of this function. Thanks in advance!

(defun identity-groups (lst)
  (labels ((travel (tail group groups)
         (cond ((endp tail) (cons group groups))
           ((equal (car tail) (car (last group)))
            (travel (cdr tail) (cons (car tail) group) groups))
           (t (travel (cdr tail) (list (car tail)) (cons group groups))))))
    (reverse (travel (cdr lst) (list (car lst)) nil))))

(identity-groups '(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7))
;; => ((1) (3) (5) (4 4 4 4) (5) (1) (2 2 2) (1) (2) (3 3 3 3 3) (4) (5) (6) (7))

2 Answers

Looks pretty good!

  • (equal (car tail) (car (last group))) seems equivalent to (equal (car tail) (car group))

  • To keep the elements in the original order, reverse the items of every group.

  • As you build the resulting list groups yourself, it's safe and more efficient to use nreverse instead of reverse.

  • There is no name clash when using list as parameter, instead of lst, as variables and functions live in different namespaces ("Lisp-2").

  • It's considered good style to give utility functions like this &key test key arguments so callers can decide on when list elements are considered equal (see e.g. Common lisp :KEY parameter use), to join the club of general functions like member, find and sort.

  • And a documentation string! :)

Updated version:

(defun identity-groups (list &key (test #'eql) (key #'identity))
  "Collect adjacent items in LIST that are the same. Returns a list of lists."
  (labels ((travel (tail group groups)
             (cond ((endp tail) (mapcar #'nreverse (cons group groups)))
                   ((funcall test
                             (funcall key (car tail))
                             (funcall key (car group)))
                    (travel (cdr tail) (cons (car tail) group) groups))
                   (t (travel (cdr tail) (list (car tail)) (cons group groups))))))
    (nreverse (travel (cdr list) (list (car list)) nil))))

Tests:

(identity-groups '(1 2 2 2 3 3 3 4 3 2 2 1))
-> ((1) (2 2 2) (3 3 3) (4) (3) (2 2) (1))

;; Collect numbers in groups of even and odd:
(identity-groups '(1 3 4 6 8 9 11 13 14 15) :key #'oddp)
-> ((1 3) (4 6 8) (9 11 13) (14) (15))

;; Collect items that are EQ:
(identity-groups (list 1 1 2 2 (list "A") (list "A")) :test 'eq)
-> ((1 1) (2 2) (("A")) (("A")))
like image 64
zut Avatar answered Apr 12 '26 14:04

zut


The desired function fits the pattern which consists in building a value G1 from a known subresult G0 and a new value, and can be implemented using REDUCE.

The first parameter of the anonymous reducing function is the accumulator, here a list of groups. The second parameter is the new value.

(reduce (lambda (groups value)
           (let ((most-recent-group (first groups)))
              (if (equal (first most-recent-group) value)
                  (list* (cons value most-recent-group) (rest groups))
                  (list* (list value) groups))))
        '(1 3 5 4 4 4 4 5 1 2 2 2 1 2 3 3 3 3 3 4 5 6 7)
        :initial-value ())

The result is:

((7) (6) (5) (4) (3 3 3 3 3) (2) (1) (2 2 2) (1) (5) (4 4 4 4) (5) (3) (1))

One problem in your code is the call to last to access the last group, which makes the code traverse lists again and again. Generally you should avoid treating lists as arrays, but use them as stacks (only manipualte the top elment).

If you need to reverse elements, you can use do it at the end of each group (order among equivalent values), or at the end of the whole function (order among groups).

like image 24
coredump Avatar answered Apr 12 '26 14:04

coredump