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

Автор: | Дата: 20 Март 2021 · 2 коммент. 

В одном из чатов возникла задачка - есть перечень номеров типа "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 · Метки: ,



Комментарии

Есть 2 коммент. к “Сортировка строк как чисел”
  1. Елена пишет:
    24 Июнь 2021 в 10:39

    Есть лисп подсчета суммы чисел (размеров) с выводом суммы. Возможно ли вывод суммы записать строкой выбранных чисел, например, 10+20+30=60?
    ;|============= Команда SumT ==================================
    Назначение: Суммирование Тектса,Мтекста, Размеров указанием или рамкой.
    Угловые размеры игнорируются
    Особенности: Безразлична к разделителям точка или запятая.
    Ввиду особенности работы atof стоки вида "22.3мама"
    будут учтены как число 22.3

    При выводе результата число округляется в соответствии
    с текущими установками переменной LUPREC. Команда _UNITS
    |;
    (defun c:sumT ( / res selset ins_pt txt_height blk obj ed *error*)
    (defun *error* (msg)
    (setvar "NOMUTT" 0) ;_ Восстанавливаем NOMUTT
    (princ msg)
    )
    (vl-load-com)(setq res 0.)
    (princ "\nВыберите тексты или размеры: ")
    (setvar "NOMUTT" 1) ;_ Отключаем NOMUTT
    (setq selset (ssget '((0 . "TEXT,MTEXT,*DIMENSION"))))
    (setvar "NOMUTT" 0) ;_ Восстанавливаем NOMUTT
    (if selset
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
    (setq obj (vlax-ename->vla-object ent)
    ed (entget ent)
    )
    (if (and (wcmatch (cdr(assoc 0 ed)) "*DIMENSION")
    (or
    (member '(100 . "AcDbAlignedDimension") ed) ;_Параллельный или линейный
    (member '(100 . "AcDbDiametricDimension") ed);_Диаметр
    (member '(100 . "AcDbRadialDimension") ed) ;_Радиус
    (member '(100 . "AcDbArcDimension") ed) ;_Дуговой
    )
    )
    (progn
    (setq blk
    (vla-item (vla-get-blocks
    (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-get-Blocks
    (cdr (assoc 2 ed))
    ) ;_ end of vla-item
    ) ;_ end of setq
    (vlax-for item blk
    (if (= (vla-get-objectname item) "AcDbMText")
    (setq obj item)
    )
    )
    )
    )
    (if (vlax-property-available-p obj 'Textstring)
    (progn
    (setq str (str-str-lst (vla-get-textstring obj) "\\P")
    str (mapcar '(lambda(x)(mip_mtext_unformat x)) str)
    str (mapcar '(lambda(x)(vl-string-translate "," "." (vl-string-trim "%UuoOcC \t" x))) str)
    str (mapcar '(lambda(x)(vl-string-trim "%UuoOcC \t" x)) str)
    res (+ res (apply '+ (mapcar 'atof str))))
    )
    )
    ) ;_ end of foreach
    ) ;_ end of if
    (princ "\nРезультат=")(princ (rtos res 2))
    (if (not (equal res 0. 1e-3))
    (progn
    (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0) ;_ end of =
    (progn ;; нулевая высота текста
    (if (not (setq txt_height (getreal "\nВведите высоту текста : ")))(setq txt_height 250))
    (vl-cmdf "_.TEXT" "0,0" txt_height 0 (rtos res 2))) ;_ end of progn
    (progn ;; фиксированнная высота
    (vl-cmdf "_.TEXT" "0,0" 0 txt (rtos res 2))) ;_ end of progn
    )
    (command "_.copybase" "0,0" (entlast) "" "_.erase" (entlast) "" "_.pasteclip" pause)
    ) ;_ end of progn
    ) ;_ end of if
    (princ)
    )
    (princ "\nНаберите в командной строке SumT")
    (defun mip_MTEXT_Unformat ( Mtext / text Str )
    (setq Text "")
    (while (/= Mtext "")
    (cond
    ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
    (setq Mtext (substr Mtext 3) Text (strcat Text Str)))
    ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
    ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
    (setq Mtext (substr Mtext 3)))
    ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
    (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
    ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
    (if (or(= " " (substr Text (strlen Text)))
    (= " " (substr Mtext 3 1)))
    (setq Mtext (substr Mtext 3))
    (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
    ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
    (setq Str (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
    Text (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
    Mtext (substr Mtext (+ 4 (strlen Str)))))
    (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))
    ))
    Text
    )
    ;|
    * Ф-ция str-str-lst
    * Сервисная ф-ция извлечения из строки данных, разделенных
    * каким либо символом или строкой символов
    * Возвращает список строк
    * Аргументы [Type]:
    str - строка для разбора [STRING]
    pat - разделитель [STRING]
    * Пример запуска
    (setq str "мы;изучаем;рекурсии" pat ";")
    (setq str "мы — изучаем — рекурсии" pat " — ")
    (str-str-lst str pat)
    * Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
    |;
    (defun str-str-lst (str pat / i)
    (cond ((= str "") nil)
    ((setq i (vl-string-search pat str))
    (cons (substr str 1 i)
    (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
    ) ;_ cons
    )
    (t (list str))
    ) ;_ cond
    ) ;_ defun

  2. Кулик Алексей aka kpblc пишет:
    24 Июнь 2021 в 11:21

    Возможно. Но какое это имеет отношение к сортировке строк как чисел?

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


Я не робот.