Сортировка строк как чисел

В одном из чатов возникла задачка - есть перечень номеров типа "1.1", "1.2.16", "1.12.5.64", "1.12.5.642" и т.д. Их надо отсортировать, но не как строки, а как числа - т.е. в результате должно получиться нечто типа "1.1", "1.2.16", "1.12.5.64". "1.12.5.642". Стартуем :)

Самое простое что приходит в голову:

  1. каждую строку преобразовать в список по разделителю ".": "1.1" -> '("1" "1"); "1.12.5.642" -> '("1" "12" "5" "642")
  2. вычислить максимальную длину подстроки. В данном случае это будет 3
  3. каждый элемент дополнить слева нулями до 3 символов: "1.1" -> '("001" "001"); "1.12.5.642" -> '("001" "012" "005" "642")
  4. сложить строки: "1.1" -> '("001" "001") -> "001001"; "1.12.5.642" -> '("001" "012" "005" "642") -> "001012005642"
  5. собственно отсортировать эти строки

Первое что делаем - пишем разбивку строки по разделителю. Поскольку задачка локальная, универсальный код писать не требуется:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
  (defun fun_conv-str-to-list (str sep)
    (if (vl-string-search sep str)
      ((lambda (/ pos res)
         (while (setq pos (vl-string-search sep str))
           (setq res (cons (substr str 1 pos) res)
                 str (substr str (+ (strlen sep) 1 pos))
           ) ;_ end of setq
         ) ;_ end of while
         (reverse (cons str res))
       )
      )
      (list str)
    )
  )

Далее - дополнение строки до указанной длины:

1
2
3
4
(defun fun_ext-string (str len symbol)
  (while (< (strlen str) len) (setq str (strcat symbol str)))
  str
) ;_ end of defun

Теперь, если у нас есть некий список

1
(setq lst '("1.1" "1.2.16" "1.12.5.64" "1.12.5.642" "2" "2.6.5.642" "0.2"))

то (нам же надо помнить исходные значения!) преобразовываем его примерно в следующий вид:

1
2
3
4
5
6
7
8
9
10
11
(setq conv (mapcar (function (lambda (x) (cons x (fun_conv-str-to-list x ".")))) lst))
;|
'(("1.1" "1" "1")
  ("1.2.16" "1" "2" "16")
  ("1.12.5.64" "1" "12" "5" "64")
  ("1.12.5.642" "1" "12" "5" "642")
  ("2" "2")
  ("2.6.5.642" "2" "6" "5" "642")
  ("0.2" "0" "2")
 )
|;

Вычисляем максимальную длину подстроки:

1
2
3
4
(setq len (apply (function max)
                 (mapcar (function strlen) (apply (function append) (mapcar (function cdr) conv)))
          ) ;_ end of apply
) ;_ end of setq

И допиливаем conv:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
(setq conv (mapcar (function
                     (lambda (item)
                       (cons (car item)
                             (apply (function strcat) (mapcar (function (lambda (x) (fun_ext-string x len "0"))) (cdr item)))
                       ) ;_ end of cons
                     ) ;_ end of lambda
                   ) ;_ end of function
                   conv
           ) ;_ end of mapcar
) ;_ end of setq
;|
'(("1.1" . "001001")
  ("1.2.16" . "001002016")
  ("1.12.5.64" . "001012005064")
  ("1.12.5.642" . "001012005642")
  ("2" . "002")
  ("2.6.5.642" . "002006005642")
  ("0.2" . "000002")
 )
|;

Осталось отсортировать и отбросить "хвосты":

1
(mapcar (function car) (vl-sort conv (function (lambda (a b) (< (cdr a) (cdr b))))))

После объединения получается такой код:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
(defun sort-as-numbers (lst / fun_ext-string fun_conv-str-to-list conv len)
  ;; (sort-as-numbers '("1.1" "1" "1.4.245" "1.0.0.163"))
  (defun fun_conv-str-to-list (str sep)
    (if (vl-string-search sep str)
      ((lambda (/ pos res)
         (while (setq pos (vl-string-search sep str))
           (setq res (cons (substr str 1 pos) res)
                 str (substr str (+ (strlen sep) 1 pos))
           ) ;_ end of setq
         ) ;_ end of while
         (reverse (cons str res))
       ) ;_ end of lambda
      )
      (list str)
    ) ;_ end of if
  ) ;_ end of defun
  (defun fun_ext-string (str len symbol)
    (while (< (strlen str) len) (setq str (strcat symbol str)))
    str
  ) ;_ end of defun
  (setq conv (mapcar (function (lambda (x) (cons x (fun_conv-str-to-list x ".")))) lst)
        len  (apply (function max)
                    (mapcar (function strlen) (apply (function append) (mapcar (function cdr) conv)))
             ) ;_ end of apply
        conv (mapcar (function
                       (lambda (item)
                         (cons (car item)
                               (apply (function strcat) (mapcar (function (lambda (x) (fun_ext-string x len "0"))) (cdr item)))
                         ) ;_ end of cons
                       ) ;_ end of lambda
                     ) ;_ end of function
                     conv
             ) ;_ end of mapcar
  ) ;_ end of setq
  (mapcar (function car) (vl-sort conv (function (lambda (a b) (< (cdr a) (cdr b))))))
) ;_ end of defun

Размещено в AutoCAD, Код LISP, Функции LISP · Метки: ,



Поделитесь своим мнением


Я не робот.