3

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))))
  • How does this differ from sorting the list by an appropriate key ? – politza Jan 1 '17 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. – Qudit Jan 4 '17 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. – lawlist Jan 4 '17 at 0:42
  • Guess I missed the differing nestings. – politza Jan 5 '17 at 7:15
1
+100

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.

  • 2
    seq-group-by is a compiled Lisp function in 'seq.el'. – politza Jan 5 '17 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. – Qudit Jan 5 '17 at 8:57
1

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

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.