[Thảo luận] Viết lại các hàm Express

[Doan Van Ha 3.180]

LM cũng có 2 hàm tương tự, nhưng kết quả trả về có khác nhau.

1). Dùng đệ quy:

(defun Cv:list-put-nth (val lst id)
(if lst
 (if (zerop id)
  (cons a (cdr lst))
  (cons (car lst)
(Cv:list-put-nth val (cdr lst) (1- id))))))

2). Không dùng đệ quy:

(defun Cv:list-put-nth (val lst id / i )
(setq i -1)
(mapcar '(lambda (x) (if (= (setq i (1+ i)) id) val x)) lst))

Tuy nhiên so sánh giữa 3 hàm: của Acet, của bác Thaistreetz và của LM thì có sự khác nhau như sau:

Trích dẫn:

1). Theo Acet:

(acet-list-put-nth 1 '(a b c d e) -1) => (1 B C D E nil)

(acet-list-put-nth 1 '(a b c d e) 5) => (A B C D E 1)

(acet-list-put-nth 1 '(a b c d e) 6) => (A B C D E nil 1)

2). Theo Thaistreetz:

(Cv:list-put-nth 1 '(a b c d e) -1) => (1 B C D E)

(Cv:list-put-nth 1 '(a b c d e) 5) => (A B C D E 1)

(Cv:list-put-nth 1 '(a b c d e) 6) => (A B C D E)

3). Theo LM:

(Cv:list-put-nth 1 '(a b c d e) -1) => (A B C D E)

(Cv:list-put-nth 1 '(a b c d e) 5) => (A B C D E)

(Cv:list-put-nth 1 '(a b c d e) 6) => (A B C D E)

Vậy, nên dùng cái nào thì tiện nhất nhỉ?

[Thaistreetz 539]

Ẹc! giống nhau i chang, khác mỗi cái kiểm trả điều kiện đối số. Xét về sự giống nhau của kết quả thì của mình trả về giống acet hơn. tuy nhiên mấy trường hợp đặc biệt này chắc chả mấy khi đụng fải nên dùng thế nào cũng được, tùy nhu cầu sử dụng của mỗi người thôi.

Vẫn là ACET-LIST-PUT-NTH nhưng mạnh hơn nữa đây:

(defun Cv:list-put-nth (val lst lst-id)
(if (= (type lst-id) 'LIST)
(if (<= (car lst-id) 0)
(if (and (cdr lst-id)(=(type(car lst))'LIST))(cons (Cv:list-put-nth val (car lst) (cdr lst-id)) (cdr lst))(cons val (cdr lst)))
(if lst (cons (car lst) (Cv:list-put-nth val (cdr lst) (Cv:list-put-nth (1- (car lst-id)) lst-id 0)))))
(if (<= lst-id 0)(cons val (cdr lst)) (if lst (cons (car lst) (Cv:list-put-nth val (cdr lst) (1- lst-id) ))))))

Hàm này mình nâng cấp thêm chút nữa để có thể thay thế 1 phần tử thuộc 1 list nằm trong list...n lớp. với đối số lst-id có thể là list hoặc integer miêu tả địa chỉ của phần tử cần thay thế.

VD1: (Cv:list-put-nth 1 '(a b c d e) 1) => (a 1 c d e)

VD2: (Cv:list-put-nth 1 '(a '(1 2 3 '(x y z)) c d e) '(1 3 1)) => (a '(1 2 3 '(x 1 z)) c d e)

VD3: (Cv:list-put-nth 1 '(a '(1 2 3 '(x y z)) c d e) '(1 3)) => (a '(1 2 3 1) c d e)

[ketxu 2.983]

Theo e thì viết như ACET, có thêm flag

Phần tử đầu mang

flag T : Thêm phần tử nil cho đủ số lượng (cả trước và sau)

flag nil : K thêm phần tử

[Thaistreetz 539]

mình nghĩ điều đó là không cần thiết, bởi như thế là chúng ta copy 1 cách cứng nhắc acet khi mà ta hầu như ko có xác suất sử dụng nó. trong khi đó các hàm con sử lý danh sách thì ưu tiên hàng đầu vẫn là tốc độ. cần tránh tối đa việc kiểm tra dữ liệu và lặp danh sách nhiều lần

[Thaistreetz 539]

Tiếp theo là (ACET-LIST-REMOVE-NTH nth list) : Dùng để loại bỏ phần tử thứ nth ra khỏi list

Tương tự như trên, hàm này mình cũng post 2 hàm.

Hàm cơ bản dùng cho list chỉ có 1 lớp

(defun Cv:list-remove-nth (id lst)
(if (<= id 0) (cdr lst) (if lst (cons (car lst) (Cv:list-remove-nth (1- id) (cdr lst))))))

VD1: (Cv:list-remove-nth 1 '(1 2 3)) => (1 3)

 

Hàm mạnh hơn, dùng cho list nhiều lớp

(defun Cv:list-remove-nth (lst-id lst)
(if (= (type lst-id) 'LIST)
(if (<= (car lst-id) 0)(if (and(cdr lst-id)(= (type(car lst))'LIST)) (cons(Cv:list-remove-nth(cdr lst-id)(car lst))(cdr lst))(cdr lst))
(if lst (cons (car lst) (Cv:list-remove-nth (Cv:list-put-nth (1- (car lst-id)) lst-id 0) (cdr lst)))))
(if (<= lst-id 0) (cdr lst) (if lst (cons (car lst) (Cv:list-remove-nth (1- lst-id) (cdr lst)))))))  

VD2:(Cv:list-remove-nth '(1 2 0) '(1 '(a b (x y)) 3)) => (1 '(a b (y)) 3)

VD3:(Cv:list-remove-nth 1 '(1 '(a b (x y)) 3)) => (1 3)

[Thaistreetz 539]

Và (ACET-LIST-INSERT-NTH val list nth) : Thêm phần tử val vào vị trí thứ nth của list.

Hàm cơ bản:

(defun Cv:list-insert-nth (val lst id)
(if (<= id 0) (cons val lst) (if lst (cons (car lst) (Cv:list-insert-nth val (cdr lst) (1- id))))))

Hàm nâng cao:

(defun Cv:list-insert-nth (val lst lst-id)
(if (= (type lst-id) 'LIST)
(if (<= (car lst-id) 0)
(if (and (cdr lst-id) (= (type(car lst))'LIST)) (cons (Cv:list-insert-nth val (car lst) (cdr lst-id)) (cdr lst)) (cons val lst))
(if lst (cons (car lst) (Cv:list-insert-nth val (cdr lst) (Cv:list-put-nth (1- (car lst-id)) lst-id 0)))))
(if (<= lst-id 0) (cons val lst) (if lst (cons (car lst) (Cv:list-insert-nth val (cdr lst) (1- lst-id)))))))

[Thaistreetz 539]

ACET-GEOM-VIEW-POINTS: không đối số, trả về tọa độ góc trái bên dưới và tọa độ góc phải bên trên của màn hình, của vport (nếu đang trong vport) hoặc của viewport (nếu đang trong viewport)

(defun Cv:View-points (/ Y1 X1)
(list (polar(polar(getvar "viewctr")(* -0.5 pi)(setq Y1 (* 0.5 (getvar"viewsize")))) pi (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1)))
(polar(polar(getvar "viewctr")(* 0.5 pi) (setq Y1 (* 0.5 (getvar"viewsize")))) 0 (/(* Y1 (car(setq X1 (getvar"screensize"))))(cadr X1)))))

[thuphong 18]

.....

(defun Cv:ss-drag-move (ss p / el)
 (setq el (entlast))
 (if (and (vl-cmdf "copy" ss "" p pause) (null (equal (getvar "lastpoint") p)))
  (progn
(while (setq el (entnext el)) (entdel el)) (getvar "lastpoint") ) nil)
 )

 

Bác Tuệ cho mình hỏi : Trong trường hợp khi mình nhấn ESC, hàm trên tại sao không xóa được đối tượng phát sinh (hàm ACET-SS-DRAG-MOVE có xét đến trường hợp này Bác à). Nhờ Bác fix hộ lại đoạn code trên. Cảm ơn Bác nhiều

 

Mình test bằng đoạn code sau:

 

(defun c:t1 ()

 

(defun Cv:ss-drag-move (s p / el)

(setq el (entlast))

(if (and (vl-cmdf "copy" s "" p pause) (null (equal (getvar "lastpoint") p)))

(progn

(while (setq el (entnext el)) (entdel el)) (getvar "lastpoint") ) nil)

)

 

(setq s (ssget "_:L"))

(setq p1 (getpoint "\nSpecify base point:"))

(Cv:ss-drag-move s p1)

)

 

- Lần test 1: khi nhấn L_mouse thì OK, có giá trị trả về tọa độ điểm chọn

- Lần test 2: khi nhấn R_mouse thì OK có giá trị trả về "nil", nhưng lại phát sinh đối tượng "s" (xin lỗi Bác ,chỗ này mình nhầm)

- Lần test 3: khi nhấn ESC thì OK có giá trị trả về "nil"

 

CAD mình dùng là Acad 2012. Cảm ơn Bác đã quan tâm

[Tue_NV 3.912]

 

Bác Tuệ cho mình hỏi : Trong trường hợp khi mình nhấn ESC, hàm trên tại sao không xóa được đối tượng phát sinh (hàm ACET-SS-DRAG-MOVE có xét đến trường hợp này Bác à). Nhờ Bác fix hộ lại đoạn code trên. Cảm ơn Bác nhiều

- Lần test 1: khi nhấn L_mouse thì OK, có giá trị trả về tọa độ điểm chọn

- Lần test 2: khi nhấn R_mouse thì OK có giá trị trả về "nil", nhưng lại phát sinh đối tượng "s" (xin lỗi Bác ,chỗ này mình nhầm)

- Lần test 3: khi nhấn ESC thì OK có giá trị trả về "nil"

Tue_NV chưa hiểu rõ câu hỏi của bạn vì mình nhấn ESC thì không có đối tượng nào tạo ra cả. Cũng đã xóa đối tượng phát sinh bằng hàm entdel trong code rồi cơ mà???

-------------------------------------------------------

Tue_NV đã gom 2 bài viết của bạn lại làm 1 bài viết và Fix lỗi của đoạn code trên (có kèm theo việc kiểm tra dữ liệu nhập của biến ss và biến p

Đây là code đã fix lỗi :

(defun Cv:ss-drag-move (ss p / el lp)
;;;copyright by Tue_NV
(setq el (entlast))
(if (and ss p (vl-cmdf "copy" ss "" p pause) (null (equal (getvar "lastpoint") p)))
  (setq lp (getvar "lastpoint")) (setq lp nil)
)
(while (setq el (entnext el)) (entdel el))
lp)

[Thaistreetz 539]

Một hàm mình hay dùng để thay thế hàm alert là (Acet-ui-message "noi dung thong bao" "tieu de" flags), vì nó đẹp: Hàm này tạo 1 hộp thoại thông báo như hàm alert nhưng với nhiều lựa chọn hơn: OK, Cancel, Abort, Retry, Ignore.. Có kèm âm thanh và các icon cảnh báo đặc trưng từ thư viện shell32 của window.

 

[Tham số flags = Base types + Icons +Default buttons]

 

Base types

0 = Acet:OK

1 = Acet:OKCANCEL

2 = Acet:ABORTRETRYIGNORE

3 = Acet:YESNOCANCEL

4 = Acet:YESNO

5 = Acet:RETRYCANCEL

Icons

16 = Acet:ICONSTOP

32 = Acet:ICONQUESTION

48 = Acet:ICONWARNING

64 = Acet:ICONINFORMATION

Nút chọn mặc định

0 = Acet:DEFBUTTON1

256 = Acet:DEFBUTTON2

512 = Acet:DEFBUTTON3

768 = Acet:DEFBUTTON4

 

Giá trị trả về tùy theo lựa chọn khi nhấn nút chọn

1 = Acet:IDOK

2 = Acet:IDCANCEL

3 = Acet:IDABORT

4 = Acet:IDRETRY

5 = Acet:IDIGNORE

6 = Acet:IDYES

7 = Acet:IDNO

8 = Acet:IDCLOSE

9 = Acet:IDHELP

 

Định nghiên cứu viết lại thì thấy thằng lee-mac nó viết từ đời nào rồi. Quăng link của nó qua đây cho các bác tham khảo. http://www.lee-mac.com/popup.html

[ketxu 2.983]

2 thằng này khác xa nhau về nguồn gọi bác ạ. LM gọi ws nên hỗ trợ Unicode cũng kém luôn

[Thaistreetz 539]

Uh, Mình cũng mới phát hiện ra điều này. Cứ tưởng ngon rồi cứ thế mà xơi, kú thật :(

[Thaistreetz 539]

Tiếp tục là 1 hàm xử lý list khá tiện dụng của acet: ACET-LIST-GROUP-BY-ASSOC. hàm này sẽ nhóm các phần tử trong list có cùng "assoc" (phần tử đầu tiên giống nhau)

(defun CV:list-group-by-assoc (lst / lst-i name)
(setq name (caar lst))
(mapcar '(lambda (x) (if (= name (car x)) (setq lst-i (append lst-i (cdr x)) lst (vl-remove x lst)))) lst)
(if lst (append (list (cons name lst-i)) (cv:list-group-by-assoc lst)) (list (cons name lst-i))))

Test:

(setq lst '(("a" 1 2) ("a" 3 4) ("b" 1 2) ("a" 5 6) ("b" x y z) ("c" 1 2 3)))

(CV:list-group-by-assoc lst) => (("a" 1 2 3 4 5 6) ("b" 1 2 X Y Z) ("c" 1 2 3))

[Tue_NV 3.912]

Tiếp tục là 1 hàm xử lý list khá tiện dụng của acet: ACET-LIST-GROUP-BY-ASSOC. hàm này sẽ nhóm các phần tử trong list có cùng "assoc" (phần tử đầu tiên giống nhau)

.......

Tue_NV góp thêm hàm CV:list-group-by-assoc (Viết theo cách khác)

(defun CV:list-group-by-assoc (lst / lst-temp res)
 (while (null (zerop (length lst)))
   	(setq lst-temp (vl-remove-if '(lambda(x) (/= (caar lst) (car x))) lst)
     	lst-temp (append (list (caar lst)) (apply 'append (mapcar 'cdr lst-temp)))
     	lst (vl-remove-if '(lambda(x) (= (caar lst) (car x))) lst))
   	(setq res (append res (list lst-temp)) lst-temp '())

)
 res
)

Test:

(setq lst '(("a" 1 2) ("a" 3 4) ("b" 1 2) ("a" 5 6) ("b" x y z) ("c" 1 2 3)))

(CV:list-group-by-assoc lst) => (("a" 1 2 3 4 5 6) ("b" 1 2 X Y Z) ("c" 1 2 3))

[ketxu 2.983]

Đóng góp link vậy, vì người ta nói rùi ^^

[Thaistreetz 539]

Không biết thằng leemac nó test bằng cái gì nhỉ? muốn so thử với nó quá! :D

 

các bác thử phát triển hàm này lên tổng quát chút nữa đi: nhóm các phần tử của list theo 1 điều kiện người dùng đưa vào. điều kiện có thể là kết quả thỏa mãn 1 hàm lisp hoặc 1 hàm không tên nào đó. kiểu như các hàm điều kiện của vl-remove-if hay vl-sort í.

[ketxu 2.983]

Các lisp benchmark ketxu đã post ở topic Đố vui với lisp :)

Ngoài ra như bác có nhận xét, dùng vl-remove chính là 1 lần lisp duyệt qua toàn bộ list, nhiều khả năng sẽ gây chậm. Hơn nữa, dòng (vl-remove x lst) sẽ xóa toàn bộ x trong list, điều này sẽ nảy sinh vấn đề trong list xuất hiện >= 2 phần tử sub-list y chang nhau. ACET cũng chưa xử lý trường hợp có các phần tử đơn trong list ^^

[Thaistreetz 539]

mình có theo dõi các lisp benchmark của ketxu. ý mình là muốn dùng chính chương trình benchmark của leemac dùng để đo trong topic kia thôi.

dòng (vl-remove x lst) sẽ xóa toàn bộ x trong list, điều này sẽ nảy sinh vấn đề trong list xuất hiện >= 2 phần tử sub-list y chang nhau

Chỗ này có nhầm lẫn không ketxu? thử lấy ví dụ với code của mình, có (vl-remove x lst): (list-group-by-assoc '((1 2) (1 2) (1 2)) -> ((1 2 2 2)) đạt yêu cầu và không bị mất bất kỳ phần tử nào.

 

Về việc trong list có phần tử đơn thì có thể giải quyết được, nhưng khi xem xét đến tốc độ thì tốt hơn là bỏ qua việc này, trong quá trình sử dụng có thể kiểm tra trước sự có mặt của phần tử đơn nếu nghi ngờ.

[ketxu 2.983]

Srr bác, e copy trực tiếp code nên nó mất đoạn (cons ...) cuối cùng, dẫn đến lỗi đã thông báo.

Lisp Bench mà LM test là 1 trong 2 cái e đã post thôi

[Tue_NV 3.912]

Không biết thằng leemac nó test bằng cái gì nhỉ? muốn so thử với nó quá! :D

 

các bác thử phát triển hàm này lên tổng quát chút nữa đi: nhóm các phần tử của list theo 1 điều kiện người dùng đưa vào. điều kiện có thể là kết quả thỏa mãn 1 hàm lisp hoặc 1 hàm không tên nào đó. kiểu như các hàm điều kiện của vl-remove-if hay vl-sort í.

Tue_NV vừa viết xong:

(defun cv-asc (dk lst / lst-temp res lis)
(foreach x lst
 (if (dk x)
   (setq lis (append lis (list x)))
  )
)
(append (list (caar lis)) (apply 'append (mapcar 'cdr lis)))
)

Thử :

(setq lst '(("a" 1 2) ("a" 3 4) ("b" 1 2) ("a" 5 6) ("b" x y z) ("c" 1 2 3)))

 

(cv-asc (lambda(x) (= "a" (car x))) lst)

("a" 1 2 3 4 5 6)

 

(cv-asc (lambda(x) (= "b" (car x))) lst)

("b" 1 2 X Y Z)

 

(cv-asc (lambda(x) (= "c" (car x))) lst)

("c" 1 2 3)

 

Chắc là chưa được tổng quát .Các bác góp ý thêm nhé