List manipulation — appending duplicate equal lists

Question

START WITH:

(let ((my-list '((12 1 2016)
                 (12 2 2016)
                 (12 3 2016)
                 (12 1 2016)
                 (12 4 2016)
                 (12 5 2016)
                 (12 1 2016))))
    INSERT MAGIC HERE
  my-list)

DESIRED RESULT:

'(((12 1 2016)
   (12 1 2016)
   (12 1 2016))
  (12 2 2016)
  (12 3 2016)
  (12 4 2016)
  (12 5 2016))

---

START WITH (a more complicated example):

(let ((my-list '(((12 1 2016) ("foo string" . foo-symbol))
                 ((12 6 2016) ("bar string" . bar-symbol))
                 ((12 3 2016) ("baz string" . baz-symbol))
                 ((12 6 2016) ("doe string" . doe-symbol))
                 ((12 4 2016) ("roe string" . roe-symbol))
                 ((12 5 2016) ("moe string" . moe-symbol))
                 ((12 6 2016) ("joe string" . joe-symbol)))))
    INSERT MAGIC HERE
  my-list)

DESIRED RESULT:

'(((12 1 2016) ("foo string" . foo-symbol))
  ((12 3 2016) ("baz string" . baz-symbol))
  ((12 4 2016) ("roe string" . roe-symbol))
  ((12 5 2016) ("moe string" . moe-symbol))
  (((12 6 2016) ("bar string" . bar-symbol))
   ((12 6 2016) ("doe string" . doe-symbol))
   ((12 6 2016) ("joe string" . joe-symbol))))

Answer 1

In my opinion, your two examples look like the same algorithm but comparing with different keys. In the first example, the elements of the outer list are being compared to each other directly while in the second, the car's of the elements are being compared.

We can handle both cases using a group-by operation with the proper key and a little post-processing. Vanilla Emacs has an implementation in seq.el. There's also one in dash.el and it's easy enough to implement yourself by using a hash table. We'll use our own implementation here.

(require 'cl)
(require 'subr-x)

(defun lex< (list list2)
  (cond
   ((null list) nil)
   ((< (car list) (car list2))
    t)
   ((= (car list) (car list2))
    (lex< (cdr list) (cdr list2)))))

(defun reorder-date (date)
  (list (caddr date) (car date) (cadr date)))

(defun date< (date date2)
  (lex< (reorder-date date) (reorder-date date2)))

(defun group-by (key-fn list)
  (let ((groups (make-hash-table :test 'equal))
        grouped-list)
    (dolist (x list)
      (setf (gethash (funcall key-fn x) groups)
            (cons x (gethash (funcall key-fn x) groups))))
    (dolist (key (hash-table-keys groups))
      (push (reverse (gethash key groups)) grouped-list))
    grouped-list))

(defun unwrap-singleton (x)
  (if (and (consp x)
           (null (cdr x)))
      (car x)
    x))

(defun group-dates (key-fn list)
  (mapcar 'unwrap-singleton (sort (group-by key-fn list)
                                  (lambda (x y)
                                    (date< (funcall key-fn (car x))
                                           (funcall key-fn (car y)))))))

You can then handle your examples like so:

(group-dates 'identity '((12 1 2016)
                         (12 2 2016)
                         (12 3 2016)
                         (12 1 2016)
                         (12 4 2016)
                         (12 5 2016)
                         (12 1 2016)))

(group-dates 'car '(((12 1 2016) ("foo string" . foo-symbol))
                    ((12 6 2016) ("bar string" . bar-symbol))
                    ((12 3 2016) ("baz string" . baz-symbol))
                    ((12 6 2016) ("doe string" . doe-symbol))
                    ((12 4 2016) ("roe string" . roe-symbol))
                    ((12 5 2016) ("moe string" . moe-symbol))
                    ((12 6 2016) ("joe string" . joe-symbol))))

It's also possible to write a more general key function that works for both examples, but it's hard to write one that isn't arbitrary without knowing more about the context.

Answer 2

There is one way: count the number of elements and save the result into alist, then expand the alist to what you want.

(let* ((my-list '((12 1 2016)
                  (12 2 2016)
                  (12 3 2016)
                  (12 1 2016)
                  (12 4 2016)
                  (12 5 2016)
                  (12 1 2016)))
       ;; ⇒ (((12 1 2016) . 3) ((12 2 2016) . 1) ((12 3 2016) . 1) ((12 4 2016) . 1) ((12 5 2016) . 1))
       (counted
        (loop with res = nil
              for i in my-list
              if (assoc i res) do (incf (cdr (assoc i res)))
              else do (push (cons i 1) res)
              finally return (nreverse res)))
       (expanded
        (loop for al in counted
              if (= 1 (cdr al)) collect (car al)
              else collect (make-list (cdr al) (car al)))))
  expanded)
     ⇒ (((12 1 2016)
         (12 1 2016)
         (12 1 2016))
        (12 2 2016)
        (12 3 2016)
        (12 4 2016)
        (12 5 2016))

Answer 3

Here's my attempt. I split it up into several little functions to show the steps.

(defun my-list-to-sortable-date (date-list)
  (string-to-number
   (format "%d%02d%02d" (nth 2 date-list) (nth 0 date-list) (nth 1 date-list))))

(defun my-sort-predicate (a b)
  (let ((a-dt (my-list-to-sortable-date (car a)))
        (b-dt (my-list-to-sortable-date (car b))))
    (<= a-dt b-dt)))

(defun my-unwrap-singles (list)
  (if (> (length list) 1) list (car list)))

(defun my-sort-and-collect (list)
  (let* ((sorted (sort list #'my-sort-predicate))
         (res (list (list (car sorted))))
         (last-key (caar sorted)))
    (dolist (curr (cdr sorted))
      (let* ((curr-key (car curr)))
        (if (equal curr-key last-key)
            (push curr (car res))
          (push (list curr) res))
        (setq last-key curr-key)))
    (nreverse (mapcar #'my-unwrap-singles res))))

(let ((my-list '(((12 1 2016) ("foo string" . foo-symbol))
                 ((12 6 2016) ("bar string" . bar-symbol))
                 ((12 3 2016) ("baz string" . baz-symbol))
                 ((12 6 2016) ("doe string" . doe-symbol))
                 ((12 4 2016) ("roe string" . roe-symbol))
                 ((12 5 2016) ("moe string" . moe-symbol))
                 ((12 6 2016) ("joe string" . joe-symbol)))))
  (my-sort-and-collect my-list))