2014-12-05 3 views
1

я попытался реализовать естественный вид:Как реализовать естественный вид в общем 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]> 

К сожалению, приведенный выше код не работает.

Не мог бы кто-нибудь помочь мне получить естественную функцию сортировки?

ответ

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" & СтрелкаВправо; (12 ".txt")), а затем отсортировать эти списки лексически с упорядочением среди типов (например, числа до строк) , и с упорядочением в каждом типе.

+1

Вот версия, которую я когда-то писал: https: //gist.github.com/lispm/e028d3f3c11c9f74d4e7 –

+0

Кстати, когда мы используем литеральные данные в REPL, это должно быть в большинстве случаев в порядке. REPL обычно создает новые свежие данные. Вы видите проблему с использованием REPL? –

+0

Если вы оцениваете '(defun foo() (sort '(1 2 3)' <))' в SBCL, вы получите одиннадцать строк предупреждения о деструктивной модификации литералов. Так как вы получаете такое поведение, которое вы ожидаете, это, вероятно, не столь большая сделка в REPL, но хорошие привычки с небольшим успехом могут привести к хорошим привычкам. –

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))))))))) 
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 является разрушительной процедурой.

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) 

Хотя, убедитесь, что ваша реализация сортировки кэширует ключи.

Смежные вопросы