some clever sorting

gistfile1.lisp

(defun split-alphanumeric-string (string)
  (let ((pos0 0)
        (pos1 0) )
    (labels ((end-pos-of (fn)
               (loop while (and (< pos1 (length string))
                                (funcall fn (aref string pos1)))
                     do (incf pos1))
               pos1))
      (loop while (< pos0 (length string))
            when (not (digit-char-p (aref string pos0)))
            collect (prog1 (aref string pos0) (incf pos1)
                      (setf pos0 pos1))
            else collect (prog1 (parse-integer (subseq string pos0 (end-pos-of #'digit-char-p)))
                           (setf pos0 pos1))))))

(defun clever-item-lessp (i1 i2)
  (cond ((and (characterp i1)
              (characterp i2))
         (char-lessp i1 i2))
        ((and (numberp i1)
              (numberp i2))
         (< i1 i2))
        (t (when (numberp i1)
             (setf i1 (aref (princ-to-string i1) 0)))
           (when (numberp i2)
             (setf i2 (aref (princ-to-string i2) 0)))
           (char-lessp i1 i2))))


(defun clever-string-lessp (s1 s2)
  (let ((s1s (split-alphanumeric-string s1))
        (s2s (split-alphanumeric-string s2)))
    (loop for i1 = (pop s1s) and i2 = (pop s2s)
          if (and i1 i2 (eql i1 i2) (null s1s) (null s2s))
          do (return nil)
          else if
          (and i1 i2 (clever-item-lessp i1 i2))
          do (return t)
          else if
          (and i1 i2 (not (eql i1 i2)) (not (clever-item-lessp i1 i2)))
          do (return nil)
          else if
          (and (not i1) i2)
          do (return t)
          else if
          (and i1 (not i2))
          do (return nil)
          else if (and (not i1) (not i2))
          do (return nil))))