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
        :key #'split-alpha-num))

(defun make-list-comp (fun)
  (labels ((f (a b)
               ((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))))))

(defun make-alpha-num-comp (string-comp
  #'(lambda (a b)
        ((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)
   ((equal "" string)
   ((: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))
           (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.


Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )


Connecting to %s

%d bloggers like this: