如何在通用lisp中实现自然排序？

Question

我试图实现一个自然排序：

Break 21 [92]> (defparameter *sss* '("1.txt" "10.txt" "13.txt" "12.txt" "2.txt" "23.txt")) 
*SSS* 
Break 21 [92]> (sort *sss* #'string-lessp) 
("1.txt" "10.txt" "12.txt" "13.txt" "2.txt" "23.txt") 
Break 21 [92]> 

不幸的是，上面的代码不起作用。

有人可以帮助我得到一个自然的排序功能吗？

Answer 1

不幸的是，上面的代码不起作用。

它看起来像它的工作。毕竟，您明确要求按字符串比较排序，并且根据字符串比较，"2.txt"介于"13.txt"和"23.txt"之间。如果你想对数字进行排序，你可以使用一个可以从字符串的开头读取数字的关键函数。另外，排序是破坏性的，所以你不应该在文字数据（如引用列表）上使用它。

无论如何，将一些能够帮助您找到所需排序的东西拼凑起来并不难。下面是一个自然字符串lessp函数的定义：

(defun natural-string-lessp (a b) 
    (multiple-value-bind (ai aend) 
     (parse-integer a :junk-allowed t) 
    (multiple-value-bind (bi bend) 
     (parse-integer b :junk-allowed t) 
     (or (and ai 
       (or (not bi) 
        (and bi 
         (or (< ai bi) 
          (and (= ai bi) 
           (string-lessp a b :start1 aend :start2 bend)))))) 
      (and (not ai) 
       (not bi) 
       (string-lessp a b)))))) 

它只能处理的领先数字，而在字符串中间没有编号，因此，例如，"a-100-foo.txt"仍将"a-3-foo.txt"前到来，但它可能足以满足您的需求。下面是使用它的一个例子：

(let ((sss (copy-list '("1.txt" "10.txt" "13.txt" "12.txt" 
         "2.txt" "23.txt")))) 
    (sort sss #'natural-string-lessp)) 
;=> ("1.txt" "2.txt" "10.txt" "12.txt" "13.txt" "23.txt") 

为parse-integer和string-lessp关键字参数的文件可能会有所帮助。

更健壮的实现将弄清楚如何将每个字符串转换成字符串和数字的序列（例如，"12.txt"＆RIGHTARROW; (12 ".txt")），然后将这些名单按字典与类型之间的顺序进行排序（如字符串前数字） ，并在每种类型中进行排序。

Answer 2

这是一个普遍的string-natural-lessp：

(defun string-natural-lessp (string-a string-b 
          &key 
           (start-a 0) 
           (end-a (length string-a)) 
           (start-b 0) 
           (end-b (length string-b))) 
    (do ((a-index start-a) 
     (b-index start-b)) 
     ((or (>= a-index end-a) 
      (>= b-index end-b)) 
     (not (>= b-index end-b))) 
    (multiple-value-bind (a-int a-pos) 
     (parse-integer string-a 
         :start a-index 
         :junk-allowed t) 
     (multiple-value-bind (b-int b-pos) 
      (parse-integer string-b 
         :start b-index 
         :junk-allowed t) 
     (if (and a-int b-int) 
      (if (= a-int b-int) 
       (setf a-index a-pos 
         b-index b-pos) 
       (return-from string-natural-lessp (< a-int b-int))) 
      (if (char-equal (aref string-a a-index) 
          (aref string-b b-index)) 
       (progn 
        (incf a-index) 
        (incf b-index)) 
       (return-from string-natural-lessp 
        (char-lessp (aref string-a a-index) 
           (aref string-b b-index))))))))) 

Answer 3

取决于所使用的情况下，我猜。我会尝试像

(defun natural-compare (a b) 
    (labels ((int (str) (parse-integer str :junk-allowed t))) 
    (let ((n-a (int a)) 
      (n-b (int b))) 
     (if (and n-a n-b (/= n-a n-b)) 
      (<= n-a n-b) 
      (string<= a b))))) 

(defun natural-sort (strings) 
    (sort (copy-list strings) #'natural-compare)) 

它的工作原理：

CL-USER> (defparameter *sss* '("1.txt" "test.txt" "36-test.txt" "36-taste.txt" "sicp.pdf" "answers.txt" "10.txt" "13.txt" "12.txt" "2.txt" "23.txt")) 
*SSS* 
CL-USER> (natural-sort *sss*) 
("1.txt" "2.txt" "10.txt" "12.txt" "13.txt" "23.txt" "36-taste.txt" 
"36-test.txt" "answers.txt" "sicp.pdf" "test.txt") 
CL-USER> 

但确实更多的工作比它真正需要。请注意0​​复制输入列表，因为sort是一个破坏性的过程。

Answer 4

生成每个元素的正确排序键，然后用这些作比较：

(defun skip-zeros (string offset length) 
    (do ((i offset (1+ i))) 
     ((or (>= i length) 
      (not (eql (aref string i) #\0))) 
     i))) 

(defun skip-digits (string offset length) 
    (do ((i offset (1+ i))) 
     ((or (>= i length) 
      (not (digit-char-p (aref string i)))) 
     i))) 

(defun skip-alphas (string offset length) 
    (do ((i offset (1+ i))) 
     ((or (>= i length) 
      (not (alpha-char-p (aref string i)))) 
     i))) 

(defun make-natural-sorting-key (string) 
    (let* ((length (length string)) 
     (key (make-array (+ length 5) 
          :element-type 'character 
          :fill-pointer 0 
          :adjustable t)) 
     (offset 0)) 
    (do() 
     ((>= offset length) (coerce key 'simple-string)) 
     (block eater 
     (let ((c (aref string offset)) 
       (end)) 
      (cond 
      ((digit-char-p c) (setf offset (skip-zeros string offset length)) 
           (setf end (skip-digits string offset length)) 
           (do ((digits (- end offset) (- digits 9))) 
            ((< digits 9) (vector-push-extend (digit-char digits) key)) 
           (vector-push-extend #\9 key))) 
      ((alpha-char-p c) (setf end (skip-alphas string offset length))) 
      (t (incf offset) 
       (return-from eater))) 
      (do ((i offset (1+ i))) 
       ((>= i end)) 
      (vector-push-extend (aref string i) key)) 
      (vector-push-extend #\nul key) 
      (setf offset end)))))) 


(sort data #'string< :key #'make-natural-sorting-key) 

虽然，确保执行排序缓存键。