Clojure Сортировка атомов списка по частоте появления

(defun mk-pair (lst)
  (cond ((null lst) nil)
        (t (let* ((a (car lst))
                  (lstr (remove a lst)))
           (cons (list a (- (length lst) (length lstr))) (mk-pair lstr)))))) 
 
(defun merge (lst)
  (let ((prev (car lst)) (r nil) )
    (iter (for curr in (cdr lst))
       (cond ((> (cadr curr) (car (last prev))) (collecting prev into r) (setq prev curr))
             (t (setq prev (cons (car curr) prev)) (setq curr nil))))
       (append r (list prev))))
 
(defun task (lst)
  (merge (qsort-a (mk-pair lst) 'cadr)))
 
(task '(a a a s s v v z a s v b))
 
==> ((z b 1) (s v 3) (a 4))
 
(task '(a s v v z a s v b))
 
==> ((z b 1) (a s 2) (v 3))
 
(task '(a s v b))
 
==> ((a s v b 1))

(defun f (lst)
            (loop 
               with res for a in lst
               for c = (count a lst)
               do (let ((pos (position c res :key #'first)))
                    (if pos 
                        (setf (nth pos res)
                              (list c (pushnew a (second (nth pos res)))))
                        (push (list c (list a)) res)))
               finally (return (sort res #'< :key #'first))))

(defn task [coll]
  (into (sorted-map)
        (apply group-by ((juxt identity keys) (frequencies coll)))))
;; => #'user/task
 
(task '(a a a s s v v z a s v b))
;; => {1 [z b], 3 [s v], 4 [a]}
(task '(a s v v z a s v b))
;; => {1 [z b], 2 [a s], 3 [v]}
(task '(a s v b))
;; => {1 [a s v b]}

;;; racket-lang.org
(define (make-duplicates lst)
  (if (null? lst)
      null
      (append (list (filter (lambda (i) (eq? i (car lst))) lst))
              (make-duplicates (remove* (list (car lst)) lst)))))
 
(define (foo lst)
  (let ((l (sort (make-duplicates lst) (lambda (i j) (< (length i) (length j))))))
    (let loop ((lst l) (acc null))
      (if (null? lst)
          acc
          (loop (filter (lambda (i) (not (eq? (length i) (length (car lst))))) lst)
                (append acc (list (map car (filter (lambda (i) (eq? (length i) (length (car lst)))) lst)))))))))
 
(foo '(a a s s s d d f f f f))
;'((a d) (s) (f))

(defun sort-atoms-by-freq (w)
  (sort-atoms (sort (atom-freq w) #'< :key #'cadr)))
 
(defun atom-freq (w &aux (v (remove-duplicates w)))
  (mapcar #'(lambda (a) (list a (count a w))) v))
 
(defun sort-atoms (w &optional ac acc &aux (a (car w)) (d (cdr w)))
  (cond ((null w) (nreverse (cons (caar ac) acc)))
        ((or (null ac) (eq (cadar ac) (cadr a)))
         (sort-atoms d (cons a ac) acc))
        ((sort-atoms d (list a) (cons (if (cdr ac)
                                          (nreverse (mapcar #'car ac))
                                          (caar ac))
                                       acc)))))
 
> (sort-atoms-by-freq '(a a s s s d d f f f f))
((A D) S F)