[Hỏi]Đố vui với LISP

[npham 75]

Sao nó luôn trả về 100?

@npham: sao bạn đố mà người ta trả lời hay cũng chẳng thấy bạn thưởng thank?

 

Mấy bác toàn cao thủ không. Thank chắc cả ngày . hehe. Nói chơi thôi. Để thank cái.

 

@Kexu: Đã AND sao bác không AND hết luôn?

(and

(setq a (getreal "\na:"))

(setq b (getreal "\nb:"))

(setq c (getreal "\nc:"))

(+ a b c)

)

[ketxu 2.984]

@Kexu: Đã AND sao bác không AND hết luôn?

Nếu AND luôn như bác thì kết quả trả về T hoặc Nil, chứ không trả về kết quả hàm tổng (+ a b c). Nếu muốn ghi như bác thì cần (setq sum (+ a b c)) để sau này còn nắm cổ nó :)

[Tue_NV 3.912]

....

Một câu khác, Hãy tính tổng giá trị của tất cả các phần tử trong tất cả các list sau: (l1 +...+l5)

Hoặc :

(eval (append '(+) l1 l2 l3 l4 l5))

 

@DoanVanHa :

(not a) -> T

(setq a (car(vl-remove nil (list a 100)))) -> 100

(setq a 50)

(setq a (car(vl-remove nil (list a 100)))) -> 50

Cái của Ketxu bỏ a ra khỏi List thì cái này bỏ NIL ra khỏi List vậy :)

[npham 75]

Hoặc :

(eval (append '(+) l1 l2 l3 l4 l5))

 

@DoanVanHa :

(not a) -> T

(setq a (car(vl-remove nil (list a 100)))) -> 100

(setq a 50)

(setq a (car(vl-remove nil (list a 100)))) -> 50

Cái của Ketxu bỏ a ra khỏi List thì cái này bỏ NIL ra khỏi List vậy

 

Theo câu đố gốc thì chỉ trả ra kết quả nil hoặc 100 thôi bác.

(setq a 50)

(if (not a) (setq a 100)(setq a nil)) -> nil

(setq a T)

(if (not a) (setq a 100)(setq a nil)) -> nil

 

 

Thêm 1 câu đố nữa:

Cho 3 điểm p1 p2 p3 bất kỳ, và điểm p0 nằm ngoài mặt phẳng m tạo bởi p1 p2 p3

gọi d là đường thẳng đi qua p0 và vuông góc với mặt phẳng m

Hãy tìm điểm giao của đường thẳng d với mặt phẳng m

[ketxu 2.984]

@npham : mọi người hì hụi trả lời mà cũng chưa thấy bác đưa ra các đáp án của mình để so sánh ?????

Còn câu hỏi bên trên :

(defun ST:Point_On_Plane ( pt p1 p2 p3 )
(or cal (arxload "geomcal"))
(setq nor (cal "nor(p1,p2,p3)")) 
(setq pt  (trans pt  0 nor)
 	p1 (trans p1 0 nor)
)
 (trans (list (car pt) (cadr pt) (caddr p1)) nor 0)
)

[Doan Van Ha 3.191]

Khác Ketxu chút xíu, chơi toàn CAL

(defun HA(pt p1 p2 p3 / vt pt1)
(or cal (arxload "geomcal"))
(setq vt (cal "nor(p1,p2,p3)"))
(setq pt1 (cal "pt+vt"))
(cal "ilp(pt,pt1,p1,p2,p3)"))

[ketxu 2.984]

Expression nor của cal có thể nên thay bằng

(setq nor

(list (- (* (cadr (setq x (mapcar '- P2 P1)))(caddr (setq y (mapcar '- P3 P2)))) (* (caddr x)(cadr y)))

(- (* (caddr x)(car y)) (* (car x)(caddr y)))

(- (* (car x)(cadr y)) (* (cadr x)(car y)))

)

)

[npham 75]

@npham : mọi người hì hụi trả lời mà cũng chưa thấy bác đưa ra các đáp án của mình để so sánh ?????

 

Hehe, hai bác thông cảm, "thầy" này gà mờ quá nên đang học hỏi mấy bài giải của các "thí sinh".

 

Câu đố l1+..+l5: lời giải (appy '+ (append l1...l5)) của kexu là đơn giản nhất và trùng ý của npham

câu tìm điểm giao nPham thich cách của DVH hơn, nó dễ hiểu hơn.

 

Thanks cả 2 bác.

[Doan Van Ha 3.191]

Mời các bạn viết code để gọi dialoge "HA" của file dcl đính kèm!

http://www.cadviet.c...iles/3/ha_2.zip

[ketxu 2.984]

(ACET-UI-MESSAGE "Doan Van Ha" "CADViet.com")

[Doan Van Ha 3.191]

Trước hết, chúc mừng Ketxu bước qua tuổi thank 1000, sau nữa "chê' một cái là hay lợi dụng sự sơ hở của người khác. Muốn có cách gọi "chính thống" để gọi dialoge "HA" kia (tức là khi giả dụ nó không phải là ": text {").

[ketxu 2.984]

Thực ra thì bác bảo gọi cái Dialog có hình như vậy thì xài luôn, chứ bác bảo

Muốn có cách gọi "chính thống" để gọi dialoge "HA"

thì e thú thực không biết ý bác là sao ?? Là gọi cái hộp thoại HA đã được viết sẵn đó lên á ?

[Doan Van Ha 3.191]

Thực ra thì bác bảo gọi cái Dialog có hình như vậy thì xài luôn, chứ bác bảo

thì e thú thực không biết ý bác là sao ?? Là gọi cái hộp thoại HA đã được viết sẵn đó lên á ?

đúng vây, tức là gọi kiểu (setq dcl_id (load_dialog "HA.dcl")).......

[phamthanhbinh 3.146]

Khác Ketxu chút xíu, chơi toàn CAL

(defun HA(pt p1 p2 p3 / vt pt1)
(or cal (arxload "geomcal"))
(setq vt (cal "nor(p1,p2,p3)"))
(setq pt1 (cal "pt+vt"))
(cal "ilp(pt,pt1,p1,p2,p3)"))

Hề hề hề,

Cái thằng Cal này cũng lắm tài ghê nhỉ???

Còn cái thẳng "nor (p1,p2,p3)" thì giờ mới thấy mặt.

Hề hề hề.

Cái vụ ni nếu mình nhớ không lầm thì hình như bác NPham cũng đã tham gia làm khi giải cái đề tài nội suy mặt phẳng của bạn chi chi đó rùi mà.

Hề hề hề,...

[ketxu 2.984]

đúng vây, tức là gọi kiểu (setq dcl_id (load_dialog "HA.dcl")).......

Hề hề, thế thì e chịu thua, vì Load_dialog là cách duy nhất e biết ^^

P/s : "chê" bác về cách trình bày vấn đề

[Doan Van Ha 3.191]

Hề hề, thế thì e chịu thua, vì Load_dialog là cách duy nhất e biết ^^

P/s : "chê" bác về cách trình bày vấn đề

Chê thì nhận ngay! Túm lại: có file dcl như đã gởi kèm, hãy gọi dialoge "HA" từ file dcl đó. Ket không biết thì quá vô lý, vậy chứ bình thường có 1 dialoge trong file dcl thì Ket gọi nó bằng cách nào?

[tomboy 21]

Bắt chước bên box Kỹ thuật và THư giãn, ket mở topic đố vui để anh em lispers thể hiện tí ^^

Mục đích đầu tiên là mọi người cùng trao đổi các hàm để thực hiện 1 công việc sao cho nhanh nhất, đây là điều mà ai cũng nghĩ tới khi làm việc với số lượng dữ liệu lớn.

Ketxu mở bát đầu tiên, mong anh em ra tay tương trợ

 

- Tìm list vị trí các item bằng với item cho trước trong List có sẵn. (Hàm có dạng (finditem item list), item là dạng dữ liệu bất kỳ, nếu là string thì phân biệt CASE)

 

Ví dụ : (Finditem 4 '(1 2 3 4 5 6 7 8 7 6 5 4 3 2 1)) => (3 11)

 

Cơ bản nhất, có lẽ là chạy qua từng phần tử của list và kiểm tra xem nó có bằng item cho trước không, nếu bằng thì cho thứ tự của phần tử đó vào list kết quả => sử dụng while, foreach, repeat...

Hàm sẽ tựa tựa như sau :

(defun finditem1 (item lst / rt)
(setq i -1)
(repeat (length lst)
(if (equal (nth (setq i (1+ i)) lst) item)(setq rt (cons i rt)))
)
(reverse rt)
)

 

Vậy còn cách nào nhanh hơn , nhanh hơn và nhanh hơn nữa ?? Mong các bác giúp đỡ

Sau 2 ngày em xin biếu các bác 2 ngày thanks ^^

 

Phương thức Test : Tạm thời ta sẽ dùng 3 lisp dưới đây làm công cụ Test :

1. Makelist : tạo list số ngẫu nhiên với số lượng item n

(defun makelist (num / lst)(setq i 0)(repeat num (setq lst (cons (setq i (+ i (getvar "CDATE"))) lst))) lst)

Ví dụ :

(setq lst (makelist 100000))

2.Bench tốc độ thực hiện của hàm :

;Update by Ketxu
(defun Timer  (Func                                                 			; function to time
  			Args                                                 			; arguments for function
  			Count                                                        	; # of times to repeat
  			/
  			FuncArgs                                             			; read string of function & arguments
  			Start)                                               			; start time
(gc)                                                               			; perform garbage collection
(setq Start (getvar "Millisecs"))    
(while (< (getvar "Millisecs") (+ Start 1000)))	; wait for 1 second before entering loop
(if (= (type Args) 'STR)                                           			; if looking at (defun) functions
     	;; Below code is time sensitive, not written to be algorithm optimized
 (progn                                                                    	; then...
  (setq FuncArgs (read (strcat "(" Func " " Args ")")) ; create function to eval
	Start	(getvar "Millisecs"))                             			; turn on timer
  (repeat Count (eval FuncArgs))
  (- (getvar "Millisecs") Start))                                          	; return elapsed time
 (progn                                                                    	; else...
  (setq Start (getvar "Millisecs"))                                        	; turn on timer
  (repeat Count (apply Func Args))                                 			; put arguments to function
  (- (getvar "Millisecs") Start))))                                        	; return elapsed time
(defun Bench  (Funcs                                                        	; list of functions
  			Args                                                 			; list of arguments
  			Count                                                        	; # of times to repeat
  			/
  			Time)
(foreach Func  Funcs                                               			; for each function in list
 (terpri)                                                                  	; print blank line
 (princ Func)                                                              	; print function name
 (princ
  (_PadBetWeen "\nT\U+1ED5ng : " (strcat  (itoa (setq Time (timer Func Args Count))) " mili gi\U+00E2y" ) "." 50))
 (princ (strcat "\nTrung b\U+00ECnh : " (rtos (/ (float Time) Count) 2 4) " mili gi\U+00E2y / 1 l\U+1EA7n "))
 (terpri))
(princ))


(defun _PadBetween ( s1 s2 ch ln )
   	(
       	(lambda ( a b c )
           	(repeat (- ln (length B) (length c)) (setq c (cons a c)))
           	(vl-list->string (append b c))
       	)
       	(ascii ch)
       	(vl-string->list s1)
       	(vl-string->list s2)
   	)
)

Sử dụng : (bench '(Tên_hàm) (list đối số) Số_lần_thực_hiện)

Ví dụ : (bench '(finditem) (list 4 lst) 100)

 

3. Hàm so sánh tổng quát (hàm trên cũng có chức năng này nhưng dùng hay lỗi)

(defun sosanh

;;;  	(sosanh statements)
;;;
;;;        
;;;
;;;=================================================================
;;;
;;;  VD:
;;;
;;;  	(sosanh
;;; 		'(
;;;          	(1+ 1)
;;;          	(+ 1 1)
;;;          	(+ 1 1.0)
;;;          	(+ 1.0 1.0)
;;;      	)
;;;  	)
;;;
;;;=================================================================
    			(statements / _lset _rset _tostring _eval _princ _main)
;;;=================================================================
;;;
;;;  (_LSet text len fillChar)
;;;
;;;=================================================================
(defun _lset (text len fillchar / padding result)
 (setq
  padding (list (ascii fillchar))
  result  (vl-string->list text)
 ) ;_  setq
 (while
  (< (length
  	(setq padding
			(append padding padding)
  	) ;_  setq
 	) ;_  length
 	len
  ) ;_  <
 ) ;_  while
 (while
  (< (length
  	(setq result
			(append result padding)
  	) ;_  setq
 	) ;_  length
 	len
  ) ;_  <
 ) ;_  while
 (substr (vl-list->string result) 1 len)
) ;_  defun
;;;=================================================================
;;;
;;;  (_RSet text len fillChar)
;;;
;;;=================================================================
(defun _rset (text len fillchar / padding result)
 (setq
  padding (list (ascii fillchar))
  result  (vl-string->list text)
 ) ;_  setq
 (while
  (< (length
  	(setq padding
			(append padding padding)
  	) ;_  setq
 	) ;_  length
 	len
  ) ;_  <
 ) ;_  while
 (while
  (< (length
  	(setq result
			(append padding result)
  	) ;_  setq
 	) ;_  length
 	len
  ) ;_  <
 ) ;_  while
 (substr
  (vl-list->string result)
  (1+ (- (length result) len))
 ) ;_  substr
) ;_  defun
;;;=================================================================
;;;
;;;  (_ToString x)
;;;
;;;=================================================================
(defun _tostring (x / result)
 (if
  (< (strlen
  	(setq result
			(vl-prin1-to-string x)
  	) ;_  setq
 	) ;_  strlen
 	40
  ) ;_  <
  result
  (strcat (substr result 1 36) "..." (chr 41))
 ) ;_  if
) ;_  defun
;;;=================================================================
;;;
;;;  (_Eval statement iterations)
;;;
;;;=================================================================
(defun _eval (statement iterations / start)
 (gc)
 (setq start (getvar "millisecs"))
 (repeat iterations (eval statement))
 (- (getvar "millisecs") start)
) ;_  defun
;;;=================================================================
;;;
;;;  (_Princ x)
;;;
;;;=================================================================
(defun _princ (x)
 (princ x)
 (princ)
;;; forces screen update
) ;_  defun
;;;=================================================================
;;;
;;;  (_Main statements)
;;;
;;;=================================================================
(defun _main
   	(statements / boundary iterations timings slowest fastest lsetlen rsetlen index count)
 (setq
  boundary 1000
  iterations 1
 ) ;_  setq
 (_princ "\U+0110ang so s\U+00E1nh t\U+1ED1c \U+0111\U+1ED9....")
 (while
  (or
(< (apply 'max
         	(setq timings
               	(mapcar
        			'(lambda (statement)
          			(_eval statement iterations)
                 	) ;_  lambda
        			statements
               	) ;_  mapcar
         	) ;_  setq
  	) ;_  apply
  	boundary
) ;_  <
(< (apply 'min timings)
  	boundary
) ;_  <
  ) ;_  or
  (setq iterations
	(* 2 iterations)
  ) ;_  setq
  (_princ ".")
 ) ;_  while
 (_princ
  (strcat
"\rElapsed milliseconds / relative speed for "
(itoa iterations)
" iteration(s):\n\n"
  ) ;_  strcat
 ) ;_  _princ
 (setq
  slowest (float (apply 'max timings))
  fastest (apply 'min timings)
 ) ;_  setq
 (setq lsetlen
   	(+ 5
  		(apply 'max
             	(mapcar (function strlen)
                     	(setq statements
                           	(mapcar (function _tostring)
                                   	statements
                           	) ;_  mapcar
                     	) ;_  setq
             	) ;_  mapcar
  		) ;_  apply
   	) ;_  +
 ) ;_  setq
 (setq rsetlen
   	(apply 'max
  			(mapcar
           	'(lambda (ms) (strlen (itoa ms)))
           	timings
  			) ;_  mapcar
   	) ;_  apply
 ) ;_  setq
 (setq
  index 0
  count (length statements)
 ) ;_  setq
 (foreach pair
           	(vl-sort
    			(mapcar 'cons statements timings)
    			'(lambda (a B) (< (cdr a) (cdr B)))
           	) ;_  vl-sort
  ((lambda (pair / ms)
(_princ
 	(strcat
  	"	"
  	(_lset (car pair) lsetlen ".")
  	(_rset
   	(itoa (setq ms (cdr pair)))
   	rsetlen
   	"."
  	) ;_  _rset
  	" / "
  	(rtos (/ slowest ms) 2 2)
  	(cond
   	((eq 1 (setq index (1+ index))) " <Nhanh nh\U+1EA5t>")
   	((eq index count) " <Ch\U+1EADm nh\U+1EA5t>")
   	("")
  	) ;_  cond
  	"\n"
 	) ;_  strcat
) ;_  _princ
) ;_  lambda
pair
  )
 ) ;_  foreach
 (princ)
) ;_  defun
;;;=================================================================
;;;
;;;  Program is defined, let's rock and roll ...
;;;
;;;=================================================================
(_main statements)
) ;_  defun

Sử dụng :

(sosanh '((Ten_ham1 Đối_số)(Tên_ham2 Đối số)...))

Ví dụ : (sosanh '((finditem1 4 lst)(finditem2 4 lst)(finditem3 4 lst)))

 

Vậy quá trình kiểm tra sẽ là :

- Kiểm tra tốc độ thực hiện 1 lần với list nhỏ, 1 lần list lớn (makelist 1000000)

- Kiểm tra tốc độ thực hiện 1000 lần với list nhỏ, 1000 lần với list lớn (makelist 100000)

 

Với câu này, câu hỏi là liệu có thể thao tác 1000 lần với list 100000 item (số đơn giản) trong dưới 1,5s không ?

đây là đoạn lisp của mình, nói chung là mình không biết đánh giá như thế nào, nhưng có lẽ hàm này là nhanh nhất và ngắn nhất. mình đố bạn nào qua mặt được mình.

 
(defun position(a listA)
 (setq len(length listA))
 (setq pos(vl-position a listA))
 (if pos (list pos len) nil)
 )

[ketxu 2.984]

đây là đoạn lisp của mình, nói chung là mình không biết đánh giá như thế nào, nhưng có lẽ hàm này là nhanh nhất và ngắn nhất. mình đố bạn nào qua mặt được mình.

(defun position(a listA)
 (setq len(length listA))
 (setq pos(vl-position a listA))
 (if pos (list pos len) nil)
 )

 

Mời bạn đọc lại những bài sau bài đố đầu tiên này! Lisp chạy sai yêu cầu nên vượt mần chi ??

Ngay cả trong code của bạn, hoàn toàn có thể đưa dòng (setq pos(vl-position a listA)) vào trong điều kiện kiểm tra if, và từ nil trong biểu thức If này không có nghĩa gì cả. Code chưa loại biến tạm = > Không biết phải nhận xét thế nào ^^

 

@Bác ĐVH : Em gọi như bác ví dụ ấy ạ : new_dialog, rồi start, rồi thì unload :(

[Doan Van Ha 3.191]

@Bác ĐVH : Em gọi như bác ví dụ ấy ạ : new_dialog, rồi start, rồi thì unload :(

Đâu, Ket đưa lên coi. Mà phải gọi Dialoge "HA" của file dcl gởi kèm nhé Ket.

[ketxu 2.984]

Đâu, Ket đưa lên coi. Mà phải gọi Dialoge "HA" của file dcl gởi kèm nhé Ket.

Hà hà, hóa ra là đố mẹo ^^ Ketxu vừa mới load mới để ý file đó không phải Ansi :|

 

(defun c:HAHAHA()
(defun vk_WriteTextStream (Stream FileName Charset / ADODBStreamObj Result)
 (if (setq ADODBStreamObj (vlax-create-object "ADODB.Stream"))
(progn (setq Result (vl-catch-all-apply
	(function
  	(lambda ()
    	(vlax-put ADODBStreamObj "Charset" Charset)
    	(vlax-invoke ADODBStreamObj "Open")
    	(vlax-invoke-method ADODBStreamObj "WriteText" Stream 0)
    	(vlax-invoke ADODBStreamObj "SaveToFile" FileName 2)
  	)
	)
  )
)
(vlax-release-object ADODBStreamObj)
(if (not (vl-catch-all-error-p Result))
 	FileName
)
)
 )
)
(defun vk_ReadTextStream (FileName Charset / ADODBStreamObj Result)
 (if (and (setq FileName (findfile FileName))
(setq ADODBStreamObj (vlax-create-object "ADODB.Stream"))
 	)
(progn (setq Result (vl-catch-all-apply
	(function
  	(lambda ()
    	(vlax-put ADODBStreamObj "Charset" Charset)
    	(vlax-invoke ADODBStreamObj "Open")
    	(vlax-invoke ADODBStreamObj "LoadFromFile" FileName)
    	(vlax-invoke-method ADODBStreamObj "ReadText" -1)
  	)
	)
  )
)
(vlax-release-object ADODBStreamObj)
(if (not (vl-catch-all-error-p Result))
 	Result
)
)
 )
)
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq fl (VK_WRITETEXTSTREAM (vk_ReadTextStream "D:\\_KVTNL\\HA.dcl" "utf-8") fl "ascii")) ;Thay duong dan trong may
(setq dcl_id (load_dialog fl)) ; Load the DCL file.
 (if (not (new_dialog "HA" dcl_id))   ; Initialize the dialog.
(exit)                           	; Exit if this doesn't
                                     	; work.
 )
 (start_dialog)  
 (unload_dialog dcl_id) 
)

[Doan Van Ha 3.191]

Hà hà, hóa ra là đố mẹo ^^ Ketxu vừa mới load mới để ý file đó không phải Ansi :|

Lâu lâu cũng phải giải stress bằng 1 câu đố vui chứ Ket! Có khi ta cứ vùi đầu vào tìm lỗi, hoá ra tác giả lừa ta. Tuy nhiên câu đố vui này cũng là để cảnh báo đấy! Nhưng Ket giải được thì quá siêu!

[ketxu 2.984]

Thực ra vấn đề đọc file Utf rồi chuyển sang ASCII em cũng đau đáu 1 thời gian, vớ được con Charset kia thì cũng suýt giải quyết được, tiện câu đố của bác thì đưa lên luôn ^^ Các thể loại chấp nhận được trong 2 hàm trên là :

(vl-registry-descendents"HKEY_CLASSES_ROOT\\MIME\\Database\\Charset")

[npham 75]

Khuấy động phong trào xí hè:

 

Cho 1 list gồm các sub list , ví dụ

'((1 2 3 4)(a b c d)(5 6 7 8))

 

Hãy kiểm tra số lượng phần tử các sublist có bằng nhau hay không. có trả ra 1, không trả ra 0.

[Doan Van Ha 3.191]

Khuấy động phong trào xí hè:

 

Cho 1 list gồm các sub list , ví dụ

'((1 2 3 4)(a b c d)(5 6 7 8))

 

Hãy kiểm tra số lượng phần tử các sublist có bằng nhau hay không. có trả ra 1, không trả ra 0.

Không y/c ngắn dài nên viết vội cái này:

(defun HA(lis / x ok)
(setq x 0 ok 1)
(repeat (- (length lis) 1)
 (if (/= (length (nth x lis)) (length (nth (1+ x) lis)))
  (setq ok 0))
 (setq x (1+ x)))
ok)

[Doan Van Ha 3.191]

Hoặc:

(defun HA1(lis / ok n)
(setq ok 1 n (length lis))
(repeat (- n 2)
 (if (/= (length (car lis)) (length (setq lis (car (cdr lis)))))
  (setq ok 0)))
ok)