# List manipulation -- appending duplicate equal lists

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

``````(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))))
``````
• How does this differ from sorting the list by an appropriate key ? Commented Jan 1, 2017 at 7:20
• @lawlist How is the key for the comparison to be computed in general? In the first example, you seem to be comparing the elements (which are lists) contained in the top-level list. However, in the second, you seem to be using only the car of each element. I can imagine multiple general rules that would handle both of these cases. Commented Jan 4, 2017 at 0:31
• @Qudit -- thank you for looking at this thread. I am grouping by date in the format of `(1 3 2017)`. Any elements of the initial list that contain the same date should be grouped together please. I assumed (perhaps erroneously) that one answer should work for both cases, but perhaps they require different approaches. Commented Jan 4, 2017 at 0:42
• Guess I missed the differing nestings. Commented Jan 5, 2017 at 7:15

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)

(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.

• `seq-group-by` is a compiled Lisp function in 'seq.el'. Commented Jan 5, 2017 at 7:16
• Apparently, my utility for searching through the functions in emacs had a bug that caused it to ignore generic functions. Thanks for pointing this out. Commented Jan 5, 2017 at 8:57

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

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