如何在常见的lisp中实现自然排序?

时间:2014-12-05 02:12:19

标签: 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]>

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

有人可以帮助我获得自然排序功能吗?

4 个答案:

答案 0 :(得分: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)))))))))

答案 1 :(得分:2)

取决于用例,我想。我会尝试像

这样的东西
(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> 

但做的工作比实际需要多一点。请注意natural-sort复制输入列表,因为sort是破坏性过程。

答案 2 :(得分:1)

  

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

看起来很有效。毕竟,您明确要求按字符串比较排序,并根据字符串比较,"2.txt"介于"13.txt""23.txt"之间。如果要以数字方式排序,可以使用一个键函数来读取字符串开头的数字。此外,排序具有破坏性,因此您不应在文字数据(如引用列表)上使用它。

无论如何,要拼凑一些可以帮助你进行排序的东西并不是很难。以下是 natural-string-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"(12 ".txt")),然后按字典顺序对这些列表进行排序,并按类型排序(例如,字符串前的数字),以及每种类型中的排序。

答案 3 :(得分:1)

为每个元素生成一个合适的排序键,然后使用它们进行比较:

(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)

但是,请确保您的排序实现缓存密钥。