Human Order Sorting

There’s a post over at lispcast about developing a “human order sort” function for strings using Common Lisp. This is a very
handy utility to have, the final code looks like this:

(defun human-sort (list &key
                   (string-comparison #'string-lessp)
                   (number-comparison #'<)
                   (numbers-before-strings-p t))
  (sort list
        (make-list-comp (make-alpha-num-comp string-comparison
                                             number-comparison
                                             numbers-before-strings-p))
        :key #'split-alpha-num))

(defun make-list-comp (fun)
  (labels ((f (a b)
             (cond
               ((null b) nil)
               ((null a) t)
               ((funcall fun (first a) (first b)) t)
               ((funcall fun (first b) (first a)) nil)
               (t (f (rest a) (rest b))))))
    #'f))

(defun make-alpha-num-comp (string-comp
                            num-comp
                            nums-before-strings-p)
  #'(lambda (a b)
      (cond
        ((and (stringp a) (stringp b)) (funcall string-comp a b))
        ((and (numberp a) (stringp b)) nums-before-strings-p)
        ((and (stringp a) (numberp b)) (not nums-before-strings-p))
        ((and (numberp a) (numberp b)) (funcall num-comp a b)))))

(defun split-alpha-num (string)
  (pcond:pcond
   ((equal "" string)
    nil)
   ((:re "^(\\d+)(.*)" string ((#'parse-integer num) rest))
    (cons num (split-alpha-num rest)))
   ((:re "^(\\D+)(.*)" string (alpha rest))
    (cons alpha (split-alpha-num rest)))))

Unfortunately, the function SPLIT-ALPHA-NUM depends on PCOND which I’d rather not use. So I rewrote SPLIT-ALPHA-NUM using only standard Lisp:

(defun split-alpha-num (string)
  (mapcar #'parse-integer-if-integer
          (split-sequence-at-boundary #'digit-char-p string)))

(defun parse-integer-if-integer (string)
  (or (parse-integer string :junk-allowed t) string))

(defun split-sequence-at-boundary (predicate sequence)
  (labels ((split1 (start predicate complement)
             (let ((end (position-if predicate sequence :start start)))
               (if end
                   (cons (subseq sequence start end)
                         (split1 end complement predicate))
                   (list (subseq sequence start))))))
    (cond ((zerop (length sequence)) nil)
          ((funcall predicate (elt sequence 0))
           (split1 0 (complement predicate) predicate))
          (t
           (split1 0 predicate (complement predicate))))))

This version is longer, but it also produces SPLIT-SEQUENCE-AT-BOUNDARY which could potentially be reused in other contexts.