Упорядочивание цифр

 (defun f (l)
           (let* ((only-num (sort (loop for a in l
                                     if (numberp (read-from-string (string a)))
                                     collect a) #'char<))
                  (brr (loop for a in l if (numberp (read-from-string (string 
 
a)))
                          collect (pop only-num) else collect a))) brr))

(defun acc-atom (a)
  (let* ((k 0)
         (r nil)
         (al (explode a))
         (diglist (qsort (remove-if-not #'numberp al))))
        (iter (for s in al)
         (cond ((numberp s) (collecting (nth k diglist) into r) (setq k (+ k 1)))
               (t (collecting s into r))))
        (implode r)))
 
==> acc-atom
 
(acc-atom 'ghj7dr4534)
 
==> ghj3dr4457

(defun main (list)
  (loop :for symbol :in list
        :collect (intern (sort-digits (string symbol)))))
 
(defun sort-digits (string)
  (let ((digits (sort (select-digits string) #'char<)))
    (loop :for i :upfrom 0
          :for c :across string
          :when (digit-char-p c)
          :do (setf (elt string i) (pop digits)))
    string))
 
(defun select-digits (string)
  (loop :for c :across string
        :when (digit-char-p c)
        :collect c))

(main '(a53r2 1b0gh9rt55))
; (A23R5 0B1GH5RT59)

(defun f (atom)
            (let ((dl (sort (delete-if-not #'digit-char-p 
                                     (coerce atom 'list))
                            #'< :key #'digit-char-p)))
              (intern
               (coerce
                (loop for a across atom with n = dl
                   if (digit-char-p a) collect (pop n)
                   else collect a) 'string))))

(defun acc-atom (a &optional (r nil) (al (explode a)) (nu (remove-if-not 'numberp al)))
  (cond ((null al) (implode (reverse r)))
        ((numberp (car al)) (let ((mi (apply 'min nu)))
                                  (acc-atom a (cons mi r) (cdr al) (removef mi nu))))
        (t (acc-atom a (cons (car al) r) (cdr al) nu))))
 
==> acc-atom
 
(acc-atom 'ghr563ss)
 
==> ghr356ss

(defun task (lst)
  (mapcar #'acc-atom lst))
 
==> task
 
(task '(a v c sd416k k83b3 231))
 
==> (a v c sd146k k33b8 123)

(defun Atom-to-List (a)
  (do* ((a (string a))
        (b (length a) (1- b))
        acc)
       ((zerop b) acc)
     (push (read-from-string (subseq a (1- b) b)) acc)))
 
(defun Replace-Number (x y)
  (cond
    ((null x) ())
    ((numberp (car x)) (cons (car y) (Replace-Number (cdr x) (cdr y))))
    (t (cons (car x) (Replace-Number (cdr x) y)))))
 
(defun List-to-String (lst &optional (acc ""))
  (if lst
      (List-to-String (cdr lst) (concatenate 'string acc (write-to-string (car lst))))
      acc))
 
(defun Sort-Numbers-by-Atom (a)
  (let* ((b (Atom-to-List a))
         (c (sort (copy-list (remove-if-not #'numberp b)) #'<)))
    (values (read-from-string (List-to-String (Replace-Number b c))))))
 
> (Sort-Numbers-by-Atom 'a5bc32)
A2BC35

; SLIME 2013-09-30
INSOMNIA> (defparameter
              lst
            (loop repeat 10000000
               collect (random 10)))
LST
INSOMNIA> (time 
           (prog1 ()
             (sort lst #'<)))
Evaluation took:
  6.999 seconds of real time
  6.952000 seconds of total run time (6.952000 user, 0.000000 system)
  99.33% CPU
  16,755,140,317 processor cycles
  34,160 bytes consed
  
NIL

(defun explode (a)
 (mapcar #'(lambda (x) (read-from-string (coerce (list x) 'string))) (coerce  (string a) 'list)))
 
(defun implode (l)
 (read-from-string 
    (coerce (mapcar #'(lambda (x) (if (numberp x) (code-char (+ 48 x)) (coerce x 'character))) l) 
            'string)))
        
(defun acc-atom (a &optional (r nil) (al (explode a)) (nu (remove-if-not 'numberp al)))
  (cond ((null al) (implode (reverse r)))
        ((numberp (car al)) (let ((mi (apply 'min nu)))
                                  (acc-atom a (cons mi r) (cdr al) (remove mi nu :count 1))))
        (t (acc-atom a (cons (car al) r) (cdr al) nu))))
 
(defun task (l)
  (mapcar #'acc-atom l))
 
;; Проверка:
 
(task '(a2c3 ghj 90da7))
 
(A2C3 GHJ 07DA9) ;; верно!

(defun F (l &optional   (lst (explode l)) 
                        (nums (qsort (remove-if #'symbolp (explode l))))
                         res)
    (cond
        ((null lst) (implode res))
        ((numberp (car lst)) (F l (cdr lst) (cdr nums) (append res (list (car nums)))))
        (t (F l (cdr lst) nums (append res (list (car lst)))))))
        
 
(f 'ghj7dr4534) ==> ghj3dr4457
    
(f 'a53r2) ==> a23r5