Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
Duong Nhat Duy

Hỏi về hàm sắp xếp

Bởi Duong Nhat Duy , trong AutoLisp

Các bài được khuyến nghị

Duong Nhat Duy    302

Duong Nhat Duy
Đã đăng

Mình có sưu tầm được 1 hàm sắp xếp list string của cụ Lee Mac khá hay, đại ý nó sort
(LM:alphanumsort (list "1" "10" "10A" "10B" "2" "20" "25" "3" "4"))
;thành (list "1" "2" " "3" "4" "10" "10A" "10B" "20" "25") 

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

Nhưng mình muốn dùng nó ở dạng "này" (vì mình chả biết phải gọi nó là gì nữa :(( ) 

(setq lst (list
	    (cons "1" ent1)
	    (cons "10A" ent2)
	    (cons "25" ent3)
	    ))
(vl-sort lst '(lambda (a b) (< (car a) (car b))))

;Mình muốn từ cái hàm sắp xếp LeeMac, biến nó thành 1 quy luật (thay cho cái chỗ (< (car a) (car b)) để sort các list cho nó tổng quát hơn, ví dụ như cái list mình đang có ở trên, sort theo nguyên tố đứng đầu

Các bạn giúp mình với, mình cảm ơn !

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    489

Doan Nguyen Van
Đã đăng
15 giờ trước, Duong Nhat Duy đã nói:

Mình có sưu tầm được 1 hàm sắp xếp list string của cụ Lee Mac khá hay, đại ý nó sort
(LM:alphanumsort (list "1" "10" "10A" "10B" "2" "20" "25" "3" "4"))
;thành (list "1" "2" " "3" "4" "10" "10A" "10B" "20" "25") 


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

Nhưng mình muốn dùng nó ở dạng "này" (vì mình chả biết phải gọi nó là gì nữa :(( ) 


(setq lst (list
	    (cons "1" ent1)
	    (cons "10A" ent2)
	    (cons "25" ent3)
	    ))
(vl-sort lst '(lambda (a b) (< (car a) (car b))))

;Mình muốn từ cái hàm sắp xếp LeeMac, biến nó thành 1 quy luật (thay cho cái chỗ (< (car a) (car b)) để sort các list cho nó tổng quát hơn, ví dụ như cái list mình đang có ở trên, sort theo nguyên tố đứng đầu

Các bạn giúp mình với, mình cảm ơn !

Thay (mapcar 'LM:splitstring lst) thành (mapcar 'LM:splitstring (mapcar '(lambda (x) (car x)) lst)) nhé bác

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Duong Nhat Duy    302

Duong Nhat Duy
Đã đăng
Vào lúc 15/7/2023 tại 06:54, Doan Nguyen Van đã nói:

Thay (mapcar 'LM:splitstring lst) thành (mapcar 'LM:splitstring (mapcar '(lambda (x) (car x)) lst)) nhé bác

Cảm ơn bác nhưng ý mình là viết tổng quát để gọi nó ra trong function của hàm vl-sort á bác, list trên là 1 ví dụ thôi, giả sử 1 list khác là các text entity list, mình muốn sort theo giá trị string thì lại phải sửa hàm con chỗ (mapcar 'LM:splitstring (mapcar '(lambda (x) (car x)) lst)) thành ... (cdr (assoc 1 (entget x))), nó hơi bất tiện ấy bác. Mình muốn nó hoạt động như thế này (mình ko biết có thể viết đc kiểu đó ko vì mình quá gà :((( ): 

(vl-sort lst '(lambda (a b) (< (convert (cdr (assoc 1 (entget a)))) (convert (cdr (assoc 1 (entget b)))))))

lst là list các Text entity

(convert) là hàm chế từ hàm sắp xếp của leemac

Code trên chỉ là ý tưởng của mình do mình chưa biết kết quả cuối cùng sẽ phải ra sao, mong các bạn thông cảm và giúp đỡ.

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ngokiet    169

ngokiet
Đã đăng
Vào lúc 17/7/2023 tại 09:54, Duong Nhat Duy đã nói:

Cảm ơn bác nhưng ý mình là viết tổng quát để gọi nó ra trong function của hàm vl-sort á bác, list trên là 1 ví dụ thôi, giả sử 1 list khác là các text entity list, mình muốn sort theo giá trị string thì lại phải sửa hàm con chỗ (mapcar 'LM:splitstring (mapcar '(lambda (x) (car x)) lst)) thành ... (cdr (assoc 1 (entget x))), nó hơi bất tiện ấy bác. Mình muốn nó hoạt động như thế này (mình ko biết có thể viết đc kiểu đó ko vì mình quá gà :((( ): 


(vl-sort lst '(lambda (a b) (< (convert (cdr (assoc 1 (entget a)))) (convert (cdr (assoc 1 (entget b)))))))

lst là list các Text entity

(convert) là hàm chế từ hàm sắp xếp của leemac

Code trên chỉ là ý tưởng của mình do mình chưa biết kết quả cuối cùng sẽ phải ra sao, mong các bạn thông cảm và giúp đỡ.

Mình có viết thử cho vui

Test   (vl-sort '("1" "10" "10C" "10A" "10B" "2" "20" "25" "3" "4") 'ssnt)

hay (vl-sort lst '(lambda(a b) (ssnt (cdr(assoc 1 a)) (cdr(assoc 1 b))))

 

  

(defun ssnt(s1 s2 / t1 t2)
  (if (/= s1 "")
    (if (/= s2 "")
      (if (< 47 (ascii s1) 58)      
	(if (< 47 (ascii s2) 58)
	  (if (eq (setq t1 (atoi s1)) (setq t2 (atoi s2)))
	    (ssnt (vl-string-left-trim "0123456789" s1) (vl-string-left-trim "0123456789" s2))
	    (< t1 t2)))
	(if (eq (ascii s1) (ascii s2))
	  (ssnt (substr s1 2) (substr s2 2))
	  (or (< 47 (ascii s2) 58) (< (ascii s1) (ascii s2))))))))

 

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    489

Doan Nguyen Van
Đã đăng
14 phút trước, ngokiet đã nói:

Mình có viết thử cho vui

Test   (vl-sort '("1" "10" "10C" "10A" "10B" "2" "20" "25" "3" "4") 'ssnt)

hay (vl-sort lst '(lambda(a b) (ssnt (cdr(assoc 1 a)) (cdr(assoc 1 b))))

 

  


(defun ssnt(s1 s2 / t1 t2)
  (if (/= s1 "")
    (if (/= s2 "")
      (if (< 47 (ascii s1) 58)      
	(if (< 47 (ascii s2) 58)
	  (if (eq (setq t1 (atoi s1)) (setq t2 (atoi s2)))
	    (ssnt (vl-string-left-trim "0123456789" s1) (vl-string-left-trim "0123456789" s2))
	    (< t1 t2)))
	(if (eq (ascii s1) (ascii s2))
	  (ssnt (substr s1 2) (substr s2 2))
	  (or (< 47 (ascii s2) 58) (< (ascii s1) (ascii s2))))))))

 

Cái này gặp lỗi với các list dạng số 

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

ngokiet    169

ngokiet
Đã đăng
3 giờ trước, Doan Nguyen Van đã nói:

Cái này gặp lỗi với các list dạng số 

Lisp dạng số là sao? So sánh string mà.

Mà cách trên viết suy nghĩ theo hướng của leemac với đệ quy nên hơi rối 

Dùng cách mới này thử xem. Ai test thử xem có trường hợp nào không đúng không?

  

(defun ssnt(s1 s2 / t1 t2)
  (while (and (/= s1 "") (/= s2 "") (eq (ascii s1) (ascii s2)))
    (setq s1 (substr s1 2) s2 (substr s2 2)))
  (setq t1 (atoi (strcat "1" s1))
	t2 (atoi (strcat "1" s2)))
  (If (eq t1 t2) (< (ascii s1) (ascii s2)) (< t1 t2)))

Test 

(vl-sort '("T1A" "AS2" "AS10" "T10B" "T1" "AS1" "T2" "T10" "T2A" "T2AC" "T2AB" "T10A" "T2A1" "T1B" "T2B") 'ssnt)
(vl-sort '("1" "10" "10C" "10A" "10B" "A" "2" "20" "25" "3" "4") 'ssnt)       

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Duong Nhat Duy    302

Duong Nhat Duy
Đã đăng
20 giờ trước, ngokiet đã nói:

Lisp dạng số là sao? So sánh string mà.

Mà cách trên viết suy nghĩ theo hướng của leemac với đệ quy nên hơi rối 

Dùng cách mới này thử xem. Ai test thử xem có trường hợp nào không đúng không?

  


(defun ssnt(s1 s2 / t1 t2)
  (while (and (/= s1 "") (/= s2 "") (eq (ascii s1) (ascii s2)))
    (setq s1 (substr s1 2) s2 (substr s2 2)))
  (setq t1 (atoi (strcat "1" s1))
	t2 (atoi (strcat "1" s2)))
  (If (eq t1 t2) (< (ascii s1) (ascii s2)) (< t1 t2)))

Test 

(vl-sort '("T1A" "AS2" "AS10" "T10B" "T1" "AS1" "T2" "T10" "T2A" "T2AC" "T2AB" "T10A" "T2A1" "T1B" "T2B") 'ssnt)
(vl-sort '("1" "10" "10C" "10A" "10B" "A" "2" "20" "25" "3" "4") 'ssnt)       

Code của bạn quá là ngon luôn, cảm ơn bạn nhiều nhé !

Nhưng có 2 vấn đề:

   1. Lisp đang sắp xếp chữ ở trước số (a b c trước 1 2 3)

   2. Đối với những nhóm string có giá trị là số thực ví dụ "1.1" "1.2" "1.15" thì lisp đang sort là 1.1 1.2 1.15, vậy mình muốn có thêm 1 argument để có thể sort theo string là số thực

Code mình gà, bạn xem có cách nào ngắn gọn hơn ko ? 

;ssnt: so sanh 2 string
;s1,s2: string
;nump: boolean (so sanh string so thuc)
(defun ssnt (s1 s2 nump / r1 r2 t1 t2)
  (if nump
    (vl-catch-all-error-p
      (vl-catch-all-apply
	(function
	  (lambda ()
	    (setq r1 (read s1) r2 (read s2))
	    )))))
  (if (not (and (numberp r1) (numberp r2)))
    (progn
      (while (and (/= s1 "") (/= s2 "") (eq (ascii s1) (ascii s2)))
	(setq s1 (substr s1 2) s2 (substr s2 2))
	)
      (setq t1 (atoi (strcat "1" s1)) t2 (atoi (strcat "1" s2)))
      )
    )
  (cond
    ((and nump (numberp r1) (numberp r2)) (< r1 r2))
    ((or
       (eq t1 t2)
       (and (>= (ascii s1) 48) (<= (ascii s1) 57) (or (< (ascii s2) 48) (> (ascii s2) 57)))
       (and (>= (ascii s2) 48) (<= (ascii s2) 57) (or (< (ascii s1) 48) (> (ascii s1) 57)))
       )
     (< (ascii s1) (ascii s2))
     )
    (t (< t1 t2))
    )
  )

;TEST
;(vl-sort '("-1" "-2" "0" "1" "2" "3.1" "3.15" "3.2") '(lambda (a b) (ssnt a b t)))
;(vl-sort '("-1" "-2" "0" "1" "2" "3.1" "3.15" "3.2" "N1" "N2" "N10" "T20" "T20A" "T20B") '(lambda (a b) (ssnt a b nil)))

 

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×