如何在公共lisp中实现自然排序？_Lisp_Common Lisp

如何在公共lisp中实现自然排序？

lisp common-lisp

如何在公共lisp中实现自然排序？,lisp,common-lisp,Lisp,Common Lisp,我尝试实现一种自然排序： 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]> 不幸的是，上面的代码不起作用有人能

我尝试实现一种自然排序：

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]>

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

有人能帮我得到一个自然排序函数吗

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

看起来它起作用了。毕竟，您明确要求按字符串比较排序，根据字符串比较，

“2.txt”

介于

“13.txt”

和

“23.txt”

之间。如果要进行数字排序，可以使用键函数从字符串开头读取数字。另外，sort是破坏性的，所以您不应该对文字数据（如引用的列表）使用它

无论如何，拼凑出一些东西来让你得到你想要的排序并不难。以下是自然字符串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))))))

的文档和的关键字参数可能会有所帮助

一个更健壮的实现将找出如何将每个字符串转换为字符串和数字序列（例如，

“12.txt”

&rightarrow；

（12.txt”）

），然后按照类型之间的顺序（例如，字符串之前的数字）和每个类型内的顺序按字典顺序对这些列表进行排序

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

看起来它起作用了。毕竟，您明确要求按字符串比较排序，根据字符串比较，

“2.txt”

介于

“13.txt”

和

“23.txt”

之间。如果要进行数字排序，可以使用键函数从字符串开头读取数字。另外，sort是破坏性的，所以您不应该对文字数据（如引用的列表）使用它

无论如何，拼凑出一些东西来让你得到你想要的排序并不难。以下是自然字符串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))))))

的文档和的关键字参数可能会有所帮助

一个更健壮的实现将找出如何将每个字符串转换为字符串和数字序列（例如，

“12.txt”

&rightarrow；

（12.txt”）

），然后按照不同类型（例如，字符串前的数字）的顺序按字典顺序对这些列表进行排序，并在每种类型中进行排序。

这里是一个通用的

字符串自然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)))))))))

（定义字符串自然lessp（字符串-a字符串-b
&钥匙
（start-a 0）
（结束-a（长度字符串-a））
（start-b 0）
（结束-b（长度字符串-b）））
（do）（（a-索引开始-a）
（b-索引开始-b））
（（或（>=a-索引结束-a）
（>=b-索引结束-b））
（不是（>=b-索引结束-b）））
（多值绑定（a-int a-pos）
（解析整数字符串-a）
：启动a-index
：垃圾（t）
（多值绑定（b-int b-pos）
（解析整数字符串-b）
：开始b索引
：垃圾（t）
（如果（和a-int b-int）
（如果（=a-int b-int）
（setf a-索引a-位置
b-索引（b-pos）
（从字符串自然lessp（这里是一个通用的字符串自然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)))))))))

（定义字符串自然lessp（字符串-a字符串-b
&钥匙
（start-a 0）
（结束-a（长度字符串-a））
（start-b 0）
（结束-b（长度字符串-b）））
（do）（（a-索引开始-a）
（b-索引开始-b））
（（或（>=a-索引结束-a）
（>=b-索引结束-b））
（不是（>=b-索引结束-b）））
（多值绑定（a-int a-pos）
（解析整数字符串-a）
：启动a-index
：垃圾（t）
（多值绑定（b-int b-pos）
（解析整数字符串-b）
：开始b索引
：垃圾（t）
（如果（和a-int b-int）
（如果（=a-int b-int）
（setf a-索引a-位置
b-索引（b-pos）
（从字符串自然lessp（
我想这取决于用例。我想试试这样的东西
(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))

但是做了比实际需要更多的工作。请注意，natural sort
复制输入列表，因为sort
是一个破坏性的过程。
我想这取决于用例。我想试试这样的东西
(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))

但是做了比实际需要更多的工作。请注意，natural sort
复制输入列表，因为sort
是一个破坏性的过程。
为每个元素生成一个正确的排序键，然后使用这些键进行比较：
(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)

（定义跳过零（字符串偏移长度）
（do（（i偏移量（1+i）））
（（或（>=i长度）
（不是（eql（aref字符串i）#\0）））
i） ））
（定义跳过的数字（字符串偏移长度）
（do（（i偏移量（1+i）））
（（或（>=i长度）
（非数字字符p（aref