如何在通用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) 

雖然，確保執行排序緩存鍵。