带数字的字符串表的排序

Lisphk · 发表于 2020-2-13 13:39:19

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Lisphk 于 2020-2-13 13:49 编辑

;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05"))
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
(defun NormalizeNumberInString (str / ch i pat ret count buf)
(setq i 0
pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
ret ""
count 4 ;_Count normalize symbols
) ;_ end of setq
(while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
(if (vl-position ch pat)
(progn
(setq buf ch) ;_ end of setq
(while
(vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
(setq buf (strcat buf ch))
) ;_ end of while
(while (< (strlen buf) count) (setq buf (strcat "0" buf)))
(setq ret (strcat ret buf))
) ;_ end of progn
) ;_ end of if
(setq ret (strcat ret ch))
) ;_ end of while
ret
) ;_ end of defun
(vl-load-com)
(mapcar '(lambda (x) (nth x ListOfString))
(vl-sort-i (mapcar 'NormalizeNumberInString ListOfString)
'<
) ;_ end of VL-SORT-I
) ;_ end of mapcar
) ;_ end of defun

;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05")) 
;;Return ("A1" "A9" "A10" "B2" "B05" "B11") 
(defun SortStringWithNumberAsNumber (ListOfString) 
;;;Function Normalize (add 0 befor number) number in string 
;;; Count normalize symbols set in variable count 
  (defun NormalizeNumberInString (str / ch i pat ret count buf) 
    (setq i        0 
          pat        '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") 
          ret        "" 
          count        4 ;_Count normalize symbols 
    ) ;_ end of setq 
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "") 
      (if (vl-position ch pat) 
        (progn 
          (setq buf ch) ;_ end of setq 
          (while 
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat) 
             (setq buf (strcat buf ch)) 
          ) ;_ end of while 
          (while (< (strlen buf) count) (setq buf (strcat "0" buf))) 
          (setq ret (strcat ret buf)) 
        ) ;_ end of progn 
      ) ;_ end of if 
      (setq ret (strcat ret ch)) 
    ) ;_ end of while 
    ret 
  ) ;_ end of defun 
  (vl-load-com) 
  (mapcar '(lambda (x) (nth x ListOfString)) 
          (vl-sort-i (mapcar 'NormalizeNumberInString ListOfString) 
                     '< 
          ) ;_ end of VL-SORT-I 
  ) ;_ end of mapcar 
) ;_ end of defun

;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;; CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber
(ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
(defun NormalizeNumberInString (str count / ch i pat ret buf)
(setq i 0
pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
ret ""
) ;_ end of setq
(while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
(if (vl-position ch pat)
(progn
(setq buf ch) ;_ end of setq
(while
(vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
(setq buf (strcat buf ch))
) ;_ end of while
(while (< (strlen buf) count) (setq buf (strcat "0" buf)))
(setq ret (strcat ret buf))
) ;_ end of progn
) ;_ end of if
(setq ret (strcat ret ch))
) ;_ end of while
ret
) ;_ end of defun
;;-------------------------------------------------
;; function to Count the longest number in string
;; CAB added to get the correct COUNT
(defun getcount (lst / count pat)
(setq count 0)
(setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
(mapcar
'(lambda (str / i maxlen ch)
(setq i 0
maxlen 0
)
(while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
(if (vl-position ch pat) ; number
(setq maxlen (1+ maxlen))
(setq count (max count maxlen)
maxlen 0
)
)
)
(setq count (max count maxlen)) ;_<<< ADD 21.06.2007 by VVA
)
Lst
)
count
)
;;===============================================
(setq count (GetCount ListOfString)
NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
ListOfString
)
)
(and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
(mapcar '(lambda (x) (nth x ListOfString))
(vl-sort-i NorStrs '<)
)
) ;_ end of defun

;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil) 
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t) 
;;  CAB added Ignore Case Flag as an argument 
;;Return ("A1" "A9" "A10" "B2" "B05" "B11") 
(defun SortStringWithNumberAsNumber 
       (ListOfString IgnoreCase / NorStrs count) 
;;;Function Normalize (add 0 befor number) number in string 
;;; Count normalize symbols set in variable count 
;;; CAB added count as an argument 
  (defun NormalizeNumberInString (str count / ch i pat ret buf) 
    (setq i   0 
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9") 
          ret "" 
    ) ;_ end of setq 
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "") 
      (if (vl-position ch pat) 
        (progn 
          (setq buf ch) ;_ end of setq 
          (while 
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat) 
             (setq buf (strcat buf ch)) 
          ) ;_ end of while 
          (while (< (strlen buf) count) (setq buf (strcat "0" buf))) 
          (setq ret (strcat ret buf)) 
        ) ;_ end of progn 
      ) ;_ end of if 
      (setq ret (strcat ret ch)) 
    ) ;_ end of while 
    ret 
  ) ;_ end of defun 
  ;;------------------------------------------------- 
  ;;  function to Count the longest number in string 
  ;;  CAB added to get the correct COUNT 
  (defun getcount (lst / count pat) 
    (setq count 0) 
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")) 
    (mapcar 
      '(lambda (str / i maxlen ch) 
         (setq i 0 
               maxlen 0 
         ) 
         (while        (/= (setq ch (substr str (setq i (1+ i)) 1)) "") 
           (if (vl-position ch pat)        ; number 
             (setq maxlen (1+ maxlen)) 
             (setq count  (max count maxlen) 
                   maxlen 0 
             ) 
           ) 
         ) 
         (setq count (max count maxlen)) ;_<<< ADD 21.06.2007 by VVA 
       ) 
      Lst 
    ) 
    count 
  ) 
  ;;=============================================== 
  (setq        count        (GetCount ListOfString) 
        NorStrs        (mapcar        '(lambda (x) (NormalizeNumberInString x count)) 
                        ListOfString 
                ) 
  ) 
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs))) 
  (mapcar '(lambda (x) (nth x ListOfString)) 
          (vl-sort-i NorStrs '<) 
  ) 
) ;_ end of defun

;; Alphanumerical Sort - Lee Mac
;; Sorts a list of strings containing a combination of alphabetical & numerical characters.
(defun LM:alphanumsort (lst)
(mapcar (function (lambda (n) (nth n lst)))
(vl-sort-i (mapcar 'LM:splitstring lst)
(function
(lambda (a b / x y)
(while
(and
(setq x (car a))
(setq y (car b))
(= x y)
)
(setq a (cdr a)
b (cdr b)
)
)
(cond
((null x) b)
((null y) nil)
((and (numberp x) (numberp y)) (< x y))
((numberp x))
((numberp y) nil)
((< x y))
)
)
)
)
)
)
;; Split String - Lee Mac
;; Splits a string into a list of text and numbers
(defun LM:splitstring (str)
(
(lambda (l)
(read
(strcat
"("
(vl-list->string
(apply
'append
(mapcar
(function
(lambda (a b c)
(cond
((= 92 b)
(list 32 34 92 b 34 32)
)
((or (< 47 b 58)
(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
(and (= 46 b) (< 47 a 58) (< 47 c 58))
)
(list b)
)
((list 32 34 b 34 32))
)
)
)
(cons nil l)
l
(append (cdr l) '(()))
)
)
)
")"
)
)
)
(vl-string->list str)
)
)

;; Alphanumerical Sort  -  Lee Mac 
;; Sorts a list of strings containing a combination of alphabetical & numerical characters. 
 
(defun LM:alphanumsort (lst) 
  (mapcar (function (lambda (n) (nth n lst))) 
          (vl-sort-i (mapcar 'LM:splitstring lst) 
                     (function 
                       (lambda (a b / x y) 
                         (while 
                           (and 
                             (setq x (car a)) 
                             (setq y (car b)) 
                             (= x y) 
                           ) 
                            (setq a (cdr a) 
                                  b (cdr b) 
                            ) 
                         ) 
                         (cond 
                           ((null x) b) 
                           ((null y) nil) 
                           ((and (numberp x) (numberp y)) (< x y)) 
                           ((numberp x)) 
                           ((numberp y) nil) 
                           ((< x y)) 
                         ) 
                       ) 
                     ) 
          ) 
  ) 
) 
 
 
;; Split String  -  Lee Mac 
;; Splits a string into a list of text and numbers 
 
(defun LM:splitstring (str) 
  ( 
   (lambda (l) 
     (read 
       (strcat 
         "(" 
         (vl-list->string 
           (apply 
             'append 
             (mapcar 
               (function 
                 (lambda (a b c) 
                   (cond 
                     ((= 92 b) 
                      (list 32 34 92 b 34 32) 
                     ) 
                     ((or (< 47 b 58) 
                          (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) 
                          (and (= 46 b) (< 47 a 58) (< 47 c 58)) 
                      ) 
                      (list b) 
                     ) 
                     ((list 32 34 b 34 32)) 
                   ) 
                 ) 
               ) 
               (cons nil l) 
               l 
               (append (cdr l) '(())) 
             ) 
           ) 
         ) 
         ")" 
       ) 
     ) 
   ) 
    (vl-string->list str) 
  ) 
)

(defun c:test ()
(MySort '("T2A" "AS10" "T10B" "T1" "T2" "AS2" "T10" "T1A" "AS1" "T10A" "T1B" "T2B"))
;|
ALE=====> ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T10A" "T10B" "T1A" "T2A" "T1B" "T2B")
LM:=====> ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B")
Antistar> ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" "T10B") desired result
CAB=====> ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B")
|;
)
;; CAB 01/30/14
(defun parseNum (str / lst tnum tstr)
(mapcar
(function
(lambda (x)
(cond
((< 47 x 58) ; number
(if tstr
(setq lst (cons (vl-list->string (reverse tstr)) lst)
tstr nil
)
)
(if tnum
(setq tnum (cons x tnum))
(setq tnum (list x))
)
)
(t ; non-number
(if tnum
(setq lst (cons (atoi (vl-list->string (reverse tnum))) lst)
tnum nil
)
)
(if tstr
(setq tstr (cons x tstr))
(setq tstr (list x))
)
)
)
)
)
(vl-string->list str)
)
(if tstr
(setq lst (cons (vl-list->string (reverse tstr)) lst))
)
(if tnum
(setq lst (cons (atoi (vl-list->string (reverse tnum))) lst))
)
(reverse lst)
)
(defun MySort (lst)
(mapcar '(lambda (x) (nth x lst))
(vl-sort-i (mapcar '(lambda(x) (ParseNum x)) lst)
'(lambda (e1 e2)
(if (= (car e1) (car e2))
(if (= (cadr e1) (cadr e2))
(< (caddr e1) (caddr e2))
(< (cadr e1) (cadr e2))
)
(< (car e1) (car e2))
)
)
)
)
)

(defun c:test () 
  (MySort '("T2A" "AS10" "T10B" "T1" "T2" "AS2" "T10" "T1A" "AS1" "T10A" "T1B" "T2B")) 
;| 
  ALE=====>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T10A" "T10B" "T1A" "T2A" "T1B" "T2B") 
  LM:=====>  ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B") 
  Antistar>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" "T10B") desired result 
  CAB=====>  ("AS1" "AS2" "AS10" "T1" "T1A" "T1B" "T2" "T2A" "T2B" "T10" "T10A" "T10B") 
 
|; 
  ) 
 
;;  CAB 01/30/14 
(defun parseNum        (str / lst tnum tstr) 
  (mapcar 
    (function 
      (lambda (x) 
        (cond 
          ((< 47 x 58)                        ; number 
           (if tstr 
             (setq lst        (cons (vl-list->string (reverse tstr)) lst) 
                   tstr        nil 
             ) 
           ) 
           (if tnum 
             (setq tnum (cons x tnum)) 
             (setq tnum (list x)) 
           ) 
          ) 
          (t                                ; non-number 
           (if tnum 
             (setq lst        (cons (atoi (vl-list->string (reverse tnum))) lst) 
                   tnum        nil 
             ) 
           ) 
           (if tstr 
             (setq tstr (cons x tstr)) 
             (setq tstr (list x)) 
           ) 
          ) 
        ) 
      ) 
    ) 
    (vl-string->list str) 
  ) 
  (if tstr 
    (setq lst (cons (vl-list->string (reverse tstr)) lst)) 
  ) 
  (if tnum 
    (setq lst (cons (atoi (vl-list->string (reverse tnum))) lst)) 
  ) 
  (reverse lst) 
) 
 
 
 
 
(defun MySort (lst) 
  (mapcar '(lambda (x) (nth x lst)) 
          (vl-sort-i (mapcar '(lambda(x) (ParseNum x)) lst) 
                     '(lambda (e1 e2) 
                        (if (= (car e1) (car e2)) 
                          (if (= (cadr e1) (cadr e2)) 
                            (< (caddr e1) (caddr e2)) 
                            (< (cadr e1) (cadr e2)) 
                          ) 
                          (< (car e1) (car e2)) 
                        ) 
                      ) 
          ) 
  ) 
)

(defun mysort ( l )
(vl-sort l
(function
(lambda ( a b / x y )
(if (= (car a) (car b))
(< (cadr a) (cadr b))
(progn
(setq a (LM:splitstring (car a))
b (LM:splitstring (car b))
)
(while
(and
(setq x (car a))
(setq y (car b))
(= x y)
)
(setq a (cdr a)
b (cdr b)
)
)
(cond
( (null x) b)
( (null y) nil)
( (and (numberp x) (numberp y)) (< x y))
( (numberp x))
( (numberp y) nil)
( (< x y))
)
)
)
)
)
)
)
;; Split String - Lee Mac
;; Splits a string into a list of text and numbers
(defun LM:splitstring ( str )
(
(lambda ( l )
(read
(strcat "("
(vl-list->string
(apply 'append
(mapcar
(function
(lambda ( a b c )
(cond
( (= 92 b)
(list 32 34 92 b 34 32)
)
( (or (< 47 b 58)
(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
(and (= 46 b) (< 47 a 58) (< 47 c 58))
)
(list b)
)
( (list 32 34 b 34 32))
)
)
)
(cons nil l) l (append (cdr l) '(( )))
)
)
)
")"
)
)
)
(vl-string->list str)
)
)

(defun mysort ( l ) 
    (vl-sort l 
        (function 
            (lambda ( a b / x y ) 
                (if (= (car  a) (car  b)) 
                    (< (cadr a) (cadr b)) 
                    (progn 
                        (setq a (LM:splitstring (car a)) 
                              b (LM:splitstring (car b)) 
                        ) 
                        (while 
                            (and 
                                (setq x (car a)) 
                                (setq y (car b)) 
                                (= x y) 
                            ) 
                            (setq a (cdr a) 
                                  b (cdr b) 
                            ) 
                        ) 
                        (cond 
                            (   (null x) b) 
                            (   (null y) nil) 
                            (   (and (numberp x) (numberp y)) (< x y)) 
                            (   (numberp x)) 
                            (   (numberp y) nil) 
                            (   (< x y)) 
                        ) 
                    ) 
                ) 
            ) 
        ) 
    ) 
) 
 
;; Split String  -  Lee Mac 
;; Splits a string into a list of text and numbers 
 
(defun LM:splitstring ( str ) 
    ( 
        (lambda ( l ) 
            (read 
                (strcat "(" 
                    (vl-list->string 
                        (apply 'append 
                            (mapcar 
                                (function 
                                    (lambda ( a b c ) 
                                        (cond 
                                            (   (= 92 b) 
                                                (list 32 34 92 b 34 32) 
                                            ) 
                                            (   (or (< 47 b 58) 
                                                    (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) 
                                                    (and (= 46 b) (< 47 a 58) (< 47 c 58)) 
                                                ) 
                                                (list b) 
                                            ) 
                                            (   (list 32 34 b 34 32)) 
                                        ) 
                                    ) 
                                ) 
                                (cons nil l) l (append (cdr l) '(( ))) 
                            ) 
                        ) 
                    ) 
                    ")" 
                ) 
            ) 
        ) 
        (vl-string->list str) 
    ) 
)

;|
_$ (mysort '(("A.05" 12.34 "Regular") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular") ("A.10" 12.12 "BigSize") ("A.05" 12.55 "BigSize")))
(("A.05" 12.34 "Regular") ("A.05" 12.55 "BigSize") ("A.10" 12.12 "BigSize") ("A.10" 34.54 "BigSize") ("B.9" 66.73 "Regular"))
|;

(setq lst (list "PN375-A10.dwg"
"PN375-A9.dwg"
"PN375-A04.dwg"
"PN375-A555.dwg"
"PN375-D1.dwg"
"PN375-D10.dwg"
"PN375-D14.dwg"
"PN375-D2.dwg"
"PN375-D22.dwg"
"PN375-D7r3.dwg"
"PN375-DB.dwg"
"PN375-DB10a.dwg"
"PN375-DB9.dwg"))
(mapcar '(lambda(x)(terpri)(princ x))
(SortStringWithNumberAsNumber lst))

("PN375-A10.dwg" "PN375-A9.dwg" "PN375-A04.dwg" "PN375-A555.dwg" "PN375-D1.dwg" "PN375-D10.dwg" "PN375-D14.dwg" "PN375-D2.dwg" "PN375-D22.dwg" "PN375-D7r3.dwg" "PN375-DB.dwg" "PN375-DB10a.dwg" "PN375-DB9.dwg")
_$

PN375-A04.dwg
PN375-A9.dwg
PN375-A10.dwg
PN375-A555.dwg
PN375-D1.dwg
PN375-D2.dwg
PN375-D7r3.dwg
PN375-D10.dwg
PN375-D14.dwg
PN375-D22.dwg
PN375-DB.dwg
PN375-DB9.dwg
PN375-DB10a.dwg
("PN375-A04.dwg" "PN375-A9.dwg" "PN375-A10.dwg" "PN375-A555.dwg" "PN375-D1.dwg" "PN375-D2.dwg" "PN375-D7r3.dwg" "PN375-D10.dwg" "PN375-D14.dwg" "PN375-D22.dwg" "PN375-DB.dwg" "PN375-DB9.dwg" "PN375-DB10a.dwg")
_$

dwg001 · 发表于 2020-2-13 16:36:15

疫情时刻，保持一颗安静的心做功课，赞！

aisong220 · 发表于 2020-2-15 00:00:50

aisong220 · 发表于 2020-2-17 00:00:46

dyjwyqz5221 · 发表于 2020-3-26 16:59:43

doslib有个函数，能对这种数字、字母混合的排序，很好用。
(dos_strsort lst -1)
结果为：
("PN375-A04.dwg" "PN375-A9.dwg" "PN375-A10.dwg" "PN375-A555.dwg" "PN375-D1.dwg" "PN375-D2.dwg" "PN375-D7r3.dwg" "PN375-D10.dwg" "PN375-D14.dwg" "PN375-D22.dwg" "PN375-DB.dwg" "PN375-DB9.dwg" "PN375-DB10a.dwg")

vlisp2012 · 发表于 2020-3-27 07:36:47

很好的帖子，多谢分享了

xujinhua · 发表于 2020-5-24 13:54:58

谢谢楼主！！！正在学习这方面的

账号		自动登录	找回密码
密码			立即注册

[每日一码] 带数字的字符串表的排序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。