Программа, возвращающую список вида: первый элемент — атом, появляющийся в списке один раз, второй - два раза и т.д

;; Сделать список одноуровневым
 
(defun flatten (lst)
  (cond ((null lst) nil)
        ((atom (car lst)) (cons (car lst) (flatten (cdr lst))))
        (t (append (flatten (car lst)) (flatten (cdr lst)))))) 
 
;; Строим список пар (атом число_вхождений)
 
(defun mkpair (lst)
  (cond ((null lst) nil)
        (t (let* ((a (car lst))
                  (c (remove a lst))
                  (n (- (length lst) (length c))))
            (cons (list a n) (mkpair c))))))
 
;; Сортировка по числу вхождений
 
(defun qsort (plist)
  (cond ((null plist) nil)
        (t (append (qsort (remove-if (lambda (z) (> (cadr z) (cadar plist))) (cdr plist))) 
                   (list (car plist))
                   (qsort (remove-if (lambda (z) (<= (cadr z) (cadar plist))) (cdr plist)))))))
 
;; Группировка
 
(defun group (plist &optional (n 0) (r nil))
  (cond ((null plist) (if (null (cdr r)) r (list r)))
        ((zerop n) (group (cdr plist) (cadar plist) (list (caar plist))))
        ((= (cadar plist) n) (group (cdr plist) n (cons (caar plist) r)))
        (t (if (null (cdr r))
               (cons (car r) (group (cdr plist) (cadar plist) (list (caar plist))))
               (cons r (group (cdr plist) (cadar plist) (list (caar plist))))))))
 
;; Решение задачи
 
(defun task (lst)
  (group (qsort (mkpair (flatten lst)))))
 
==> TASK
 
(task '(a b c (a ((b c) c) c) c))
 
==> ((A B) C)
 
(task '(z b c (a ((b c) c) c) c))
 
==> ((Z A) B C)

(defun flatten (w) 
  (if (atom w) `(,w) (mapcan #'flatten w)))
 
(defun count-deep (w &aux (v (flatten w)))
  (loop for a in (remove-duplicates v)
        collect (list a (count a v))))
 
(defun sort-count (w)
  (sort (count-deep w) #'< :key #'cadr))
 
(defun glue (w &optional (b (cadar w)) ac &aux (a (car w)))
  (cond ((null w) ac)
        ((equal b (cadadr w)) (glue (cdr w) b (cons (car a) ac)))
        ((cons (if ac (reverse (cons (car a) ac)) (car a))
               (glue (cdr w) (caddr a) nil)))))
 
(defun glue-sort-count-deep (w)
  (glue (sort-count w)))
 
> (glue-sort-count-deep '(a b c (a ((b c) c) c) c))
((A B) C)
> (glue-sort-count-deep '(z b c (a ((b c) c) c) c))
((Z A) B C)

(defun flatten (w) 
  (if (atom w) `(,w) (mapcan #'flatten w)))
 
(defun sort-count (w &aux (v (flatten w)))
  (sort (loop for a in (remove-duplicates v)
              collect `(,a ,(count a v)))
        #'< :key #'cadr))
 
(defun glue (w &optional (b (cadar w)) ac &aux (a (car w)))
  (cond ((null w) ac)
        ((equal b (cadadr w)) (glue (cdr w) b (cons (car a) ac)))
        ((cons (if ac (reverse (cons (car a) ac)) (car a))
               (glue (cdr w) (caddr a) nil)))))
 
(defun glue-sort-count-deep (w)
  (glue (sort-count w)))    
 
> (glue-sort-count-deep '(a b c (a ((b c) c) c) c))
((A B) C)
> (glue-sort-count-deep '(z b c (a ((b c) c) c) c))
((Z A) B C)

(defun flatten (w) 
  (if (atom w) `(,w) (mapcan #'flatten w)))
 
(defun sort-count (w &aux (v (flatten w)))
  (sort (loop for a in (remove-duplicates v)
              collect `(,a ,(count a v)))
        #'< :key #'cadr))
 
(defun glue (w &optional (b (cadar w)) ac)
  (cond ((null w) ac)
        ((equal b (cadadr w)) (glue (cdr w) b (cons (caar w) ac)))
        ((cons (if ac (reverse (cons (caar w) ac)) (caar w))
               (glue (cdr w) (caddar w) nil)))))
 
(defun glue-sort-count-deep (w)
  (glue (sort-count w)))  
 
> (glue-sort-count-deep '(a b c (a ((b c) c) c) c))
((A B) C)
> (glue-sort-count-deep '(z b c (a ((b c) c) c) c))
((Z A) B C)