Заданный список произвольного уровня вложенности разбить на четыре списка

(defun pose (w &optional v c n m &aux (a (car w)) (d (cdr w)))
  (cond ((null w)
         (list (sort v #'string<) (sort c #'string<) (sort n #'<) m))
        ((member a '(a e i o y u))
         (pose d (pushnew a v) c n m))
        ((member a '(b c d f g h j k l m n p q r s t v w x z))
         (pose d v (pushnew a c) n m))
        ((member a '(0 1 2 3 4 5 6 7 8 9))
         (pose d v c (pushnew a n) m))
        (t (pose d v c n (push a m)))))
 
(defun flat (w &optional acc) 
  (cond ((null w) acc)
        ((atom w) (cons w acc))
        ((flat (car w) (flat (cdr w) acc)))))
 
(defun arrange-vcnm (w)
  (pose (flat w)))
 
> (arrange-vcnm '(3 (2 a) b (3) b (u 1) c 1 c (!)))
((A U) (B C) (1 2 3) (!))

(defconstant vowels '(a e i o y u))
(defconstant consonants '(b c d f g h j k l m n p q r s t v w x z))
(defconstant digits '(0 1 2 3 4 5 6 7 8 9))
 
(defun flat (w &optional acc) 
  (cond ((null w) acc)
        ((atom w) (cons w acc))
        ((flat (car w) (flat (cdr w) acc)))))
 
(defun arrange-vcd (w)
  (list (loop for v in vowels when (member v w) collect v) 
        (loop for c in consonants when (member c w) collect c)
        (loop for d in digits when (member d w) collect d)))
 
(defun arrange-vcdm (w &aux (u (flat w))(v (arrange-vcd u)))
  (nconc v (list (remove-if #'(lambda (a) (member a (flat v))) u))))
 
> (arrange-vcdm '(3 (2 a a a a) b (3) b (u 1) c 1 c (!)))
((A U) (B C) (1 2 3) (!))

;; Уплощение списка
 
(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 incrn (lst n)
   (cond ((= n 0) (cons (+ 1 (car lst)) (cdr lst)))
         (t (cons (car lst) (incrn (cdr lst) (- n 1))))))
 
;; Обработать символ
 
(defun accitem (item)
   (cond ((member item (car *v*)) (setq *v* (cons (car *v*) (list (incrn (cadr *v*) (position item (car *v*)))))))
         ((member item (car *s*)) (setq *s* (cons (car *s*) (list (incrn (cadr *s*) (position item (car *s*)))))))
         ((member item (car *d*)) (setq *d* (cons (car *d*) (list (incrn (cadr *d*) (position item (car *d*)))))))
         (t (setq *o* (cons item *o*)))))
         
;; Обработать список
 
(defun acclst (lst)
   (cond ((null lst) t)
         (t (accitem (car lst)) (acclst (cdr lst)))))
         
;; Вывод результата (удаление нулевых)
 
(defun presres (l1 l2)
   (cond ((null l1) nil)
         ((= 0 (car l2)) (presres (cdr l1) (cdr l2)))
         (t (cons (car l1) (presres (cdr l1) (cdr l2))))))
         
;; Собственно решение
 
(defun task (lst)
   (setq *v* '((a e i o y u) (0 0 0 0 0 0)))
   (setq *s* '((b c d f g h j k l m n p q r s t v w x z) (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
   (setq *d* '((0 1 2 3 4 5 6 7 8 9) (0 0 0 0 0 0 0 0 0 0 0)))
   (setq *o* Nil)
   (acclst (flatten lst))
   (list (presres (car *v*) (cadr *v*)) (presres (car *s*) (cadr *s*)) (presres (car *d*) (cadr *d*)) *o*))

(defconstant vowels '(a e i o y u))
(defconstant consonants '(b c d f g h j k l m n p q r s t v w x z))
(defconstant digits '(0 1 2 3 4 5 6 7 8 9))
 
(defun flat (w)
  (loop for a in w 
        if (and a (atom a)) collect a
        else nconc (flat a)))
 
(defun arrange-vcd (w)
  (list (loop for v in vowels when (member v w) collect v) 
        (loop for c in consonants when (member c w) collect c)
        (loop for d in digits when (member d w) collect d)))
 
(defun arrange-vcdm (w &aux (u (flat w))(v (arrange-vcd u)))
  (nconc v (list (remove-if #'(lambda (a) (member a (flat v))) u))))
 
> (arrange-vcdm '(3 (2 a a a a) b (3) b (u 1) c 1 c (!)))
((A U) (B C) (1 2 3) (!))