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

Tháng 9 7, 2011

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 ?

Tháng 9 7, 2011

Ketxu thử với code này sẽ nhanh hơn nhiều : Vì có hạn chế số lần lặp và Với việc thử tốc độ của hàm so sanh mà Ketxu đã post

(defun finditem2 (item lst / rt i memb)
;;;copyright by Tue_NV
(while (= (car (setq memb (member item lst))) item)
(setq rt (append rt (list (- (length lst) (length memb)) )))
(setq lst (cdr memb))
)
rt
)

Thử :

(setq lst '(1 2 3 4 5 6 7 8 7 6 5 4 3 2 1))

(sosanh '((finditem1 4 lst) (finditem2 4 lst)))

Elapsed milliseconds / relative speed for 8192 iteration(s):

(FINDITEM2 4 LST).....1531 / 1.09 <Nhanh nhất>

(FINDITEM1 4 LST).....1672 / 1.00 <Chậm nhất>

Tháng 9 7, 2011

Cám ơn bác Tuệ đã tham gia, tuy nhiên kết quả hàm chạy chưa đúng, có lẽ cần fix lại dòng này: (- (length lst) (length memb))

vì list đã thay đổi nên cần để length lst làm hằng số ban đầu, không tính lại trong vòng while nữa</pre>

. Tốc độ khá kinh khủng ^^ Ketxu up thêm 1 bench nữa bên trên, ta sẽ lấy làm cơ sở Test tốc độ của hàm

Ví dụ :

(finditem2 4 '(1 2 3 4 4 3 2 1 1 2 3 4 5))

=> (3 0 6) thay vì (3 4 11) ^^

Tháng 9 7, 2011

Cám ơn bác Tuệ đã tham gia, tuy nhiên kết quả hàm chạy chưa đúng, có lẽ cần fix lại. Tốc độ khá kinh khủng ^^ Ketxu up thêm 1 bench nữa bên trên, ta sẽ lấy làm cơ sở Test tốc độ của hàm

Ví dụ :

(finditem2 4 '(1 2 3 4 4 3 2 1 1 2 3 4 5))

=> (3 0 6) thay vì (3 4 11) ^^

Chà, cái hàm (sosanh) của Ket sao ngộ ghê:

Command: (sosanh '((+ 1 6)(+ 1 6)))

Elapsed milliseconds / relative speed for 32768 iteration(s):

(+ 1 6).....1139 / 1.15 <Nhanh nhất>

(+ 1 6).....1310 / 1.00 <Chậm nhất>

Hoặc sửa từ VD của Ket:

Command: (sosanh '((1+ 1)(1+ 1)(1+ 1)(1+ 1)))

Elapsed milliseconds / relative speed for 32768 iteration(s):

(1+ 1).....1029 / 1.15 <Nhanh nhất>

(1+ 1).....1107 / 1.07

(1+ 1).....1139 / 1.04

(1+ 1).....1186 / 1.00 <Chậm nhất>

==> Thằng tính trước đang khoẻ thì nhanh, thằng tính sau mệt rồi nên chậm!

Ôi! Tính lại lần 2 nó lại khác, tính lại lần 3 nó lại khác nữa...!

Tháng 9 7, 2011

Mình cũng tham gia cho vui với hàm thế này

(defun finditem3( it li / i lt1)

(setq i 0 lt1 nil)

(foreach a li (if (equal a it) (setq lt1 (append lt1 (list i)) i (1+ i)) (setq i (1+ i))))

lt1

)

Sửa lại như vậy có lẽ chạy nhanh hơn.

(defun finditem3( it li / i lt1)

(setq i 0 lt1 nil)

(foreach a li (if (equal a it) (setq lt1 (cons i lt1) i (1+ i)) (setq i (1+ i))))

(reverse lt1)

)

Nhưng hàm sosanh có lẽ kg ổn định

Tháng 9 7, 2011

Mình không biết cách dùng hàm sosanh với lại Bench, nhưng đoạn code cải tiến (từ code của Ketxu) dưới đây mình cho rằng nhanh hơn finditem1 của Ketxu:

(defun finditem4 (item lst / rt)
(setq i -1)
(mapcar '(lambda(x) (setq i (1+ i)) (if (= x item) (setq rt (cons i rt)))) lst)
(reverse rt)
)

Tháng 9 7, 2011

Mình không biết cách dùng hàm sosanh với lại Bench, nhưng đoạn code cải tiến (từ code của Ketxu) dưới đây mình cho rằng nhanh hơn finditem1 của Ketxu:
(defun finditem4 (item lst / rt)
(setq i -1)
(mapcar '(lambda(x) (setq i (1+ i)) (if (= x item) (setq rt (cons i rt)))) lst)
(reverse rt)
)

Dưới đây là kết quả test 2 hàm (dựa trên hàm sosanh):

Command: (sosanh '((finditem1 '5 '(1 2 3 4 5 6))(finditem4 '5 '(1 2 3 4 5 6))))

Elapsed milliseconds / relative speed for 32768 iteration(s):

(FINDITEM1 (QUOTE 5) (QUOTE (1 2 3 4...).....1607 / 1.23 <Nhanh nhất>

(FINDITEM4 (QUOTE 5) (QUOTE (1 2 3 4...).....1981 / 1.00 <Chậm nhất>

Không biết đúng sai thế nào, chịu!

Tháng 9 7, 2011

Thử đánh giá hàm này xem:

(defun finditem4 (item lst / rt)


 (setq len (length lst))
 (while (setq lst (member item lst))
(setq rt (cons (- len (length lst)) rt)
     lst (cdr lst)
)
 )
 (reverse rt)
)

Tháng 9 7, 2011

@Bác ĐVH : mọi benchmark bất kể lúc nào cũng cần thực hiện nhiều lần để lấy tỉ lệ nhiều nhất, đó là nguyên tắc cơ bản :) . 1 lần thử không thể kết luận được ngay, và nó không phải là số tuyệt đối. Vì tốc độ làm việc của máy không phải là hằng số như môi trường lý tưởng

@TrungNgaMy : cám ơn bác, đây là cách dễ hiểu nhất, tuy nhiên, nếu làm với list lớn (1000000 item) thì chờ tương đối ^^

Command: (bench '(finditem3) (list 4 lst) 1)
;1 trieu phan tu

FINDITEM3

Tổng : .................796 mili giây

Trung bình : 796.0000 mili giây / 1 lần

Command: (setq lst (makelist 100000) dump 0)

0

Command: (bench '(finditem3) (list 4 lst) 1000)

FINDITEM3

Tổng : ...............91916 mili giây

Trung bình : 91.9160 mili giây / 1 lần

@Bác Hoành : đoạn code e post đầu tiên là ví dụ chào khách thôi ^^. Nếu làm với 1tr phần tử thì CAD e đơ luôn ^^

Code cuối của bác sử dụng hiệu length để tìm ra position quá hay, e phải note vào mới được ^^

Kết quả thử quá tuyệt : 1 lần 1 triệu item chỉ mất 140 ms , 1000 lần list 100000 mất 15s :wub:

P/s : phương án của bác Tuệ cũng là đây, đúng là tư tưởng lớn gặp nhau ^^

Command: (setq lst (makelist 100000) dump 0)
0

Command: (bench '(finditem4) (list 4 lst) 1000)

FINDITEM4

Tổng : ...............15210 mili giây

Trung bình : 15.2100 mili giây / 1 lần

Command: (setq lst (makelist 1000000) dump 0)

0

Command: (bench '(finditem4) (list 4 lst) 1)

FINDITEM4

Tổng : .................140 mili giây

Trung bình : 140.0000 mili giây / 1 lần

Tuy nhiên vẫn nhiều hơn yêu cầu mười mấy giây ^^

Từ hàm của bác Hoành, có thể biến đổi thêm 1 kiểu nữa là :

(defun finditem7 (item lst / rt len)
(repeat (- (setq len (length lst))(length (vl-remove item lst)))
(setq lst (cdr (member item lst))
  rt ( cons (1- (- len (length lst))) rt )  
)
)
(reverse rt)
)

Hoặc

(defun finditem8 (item lst / rt idtmp)
(setq id -1)
(repeat (- (length lst)(length (vl-remove item lst)))
(setq idtmp (vl-position item lst)
  rt ( cons (setq id (+ id idtmp 1)) rt )
  lst (cdr (member item lst))
)
)
(reverse rt)
)

Tốc độ kiểm nghiệm nói chung là nhanh hơn chút , tuy nhiên thời gian có thể tăng lên theo số lần xuất hiện của item, nên chưa chính xác được ^^

Command: (bench '(finditem7) (list 4 lst) 1000)

FINDITEM7

Tổng : ................8205 mili giây

Trung bình : 8.2050 mili giây / 1 lần

Command: (setq lst (makelist 1000000) dump 0)

0

Command: (bench '(finditem7) (list 4 lst) 1)

FINDITEM7

Tổng : .................125 mili giây

Trung bình : 125.0000 mili giây / 1 lần

Vẫn còn xa con số đưa ra ban đầu quá :|

Tháng 9 7, 2011

(defun finditem3( it li / i lt1)

(setq i 0 lt1 nil)

(foreach a li (if (equal a it) (setq lt1 (cons i lt1) i (1+ i)) (setq i (1+ i))))

(reverse lt1)

)

Sau khi sửa một chút, Mình thử kiểm tra kết quả của bạn , nó như sau :

Command: (setq lst (makelist 1000000) dump 0)

0

Command: (bench '(finditem7) (list 4 lst) 1)

FINDITEM7

Tổng : ..................47 mili giây

Trung bình : 47.0000 mili giây / 1 lần

Command: (bench '(finditem4) (list 4 lst) 1)

FINDITEM4

Tổng : .................140 mili giây

Trung bình : 140.0000 mili giây / 1 lần

Command: (bench '(finditem3) (list 4 lst) 1)

FINDITEM3

Tổng : .................782 mili giây

Trung bình : 782.0000 mili giây / 1 lần

Command: (finditem7 4 lst)

nil

Command: (finditem4 4 lst)

nil

Command: (finditem3 4 lst)

nil

Nghĩa là trong biến lst của bạn kg có số 4 nào. kết quả trên chỉ là ảo thôi. Có lẽ nên test một biến mà số ngẫu nhiên chỉ lặp từ 0 đến 10 cho chắc ăn

Tháng 9 7, 2011

Với một trị cụ thể nó cho ra như vậy.

Command: (setq lis '(40 0 0 4 0 4 0 4 7 9 3 0 1 0 5 4 4 0 5 4 4 6 4 46 8 48 8 4

40 0 4 4 4 0 0 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 0 0 0 4 4 4 4 9 8 4))

(40 0 0 4 0 4 0 4 7 9 3 0 1 0 5 4 4 0 5 4 4 6 4 46 8 48 8 4 40 0 4 4 4 0 0 4 4

4 4 4 4 4 4 4 4 4 4 4 4 4 0 0 0 4 4 4 4 9 8 4)

Command: (bench '(finditem3) (list 4 lis) 1000)

FINDITEM3

Tổng : ..................47 mili giây

Trung bình : 0.0470 mili giây / 1 lần

Command: (bench '(finditem4) (list 4 lis) 1000)

FINDITEM4

Tổng : ..................47 mili giây

Trung bình : 0.0470 mili giây / 1 lần

Command: (bench '(finditem7) (list 4 lis) 1000)

FINDITEM7

Tổng : ..................63 mili giây

Trung bình : 0.0630 mili giây / 1 lần

Có thể nhận xét rằng tốc độ của finditem4 giảm khi số lần xuất hiện của item tăng và lst lớn. Lúc đó số lần nhớ lại và độ lớn của lst cũng rất lớn. tốc độ của finditem3 ổn định hơn vì đây là cách tìm kiếm tuần tự.

Nếu viết thêm đoạn code để thêm số 4 vào lst như sau :

(defun tam (num l / lst i)

(setq lst (makelist num))

(setq i 0)

(while (< i l)

(setq lst (cons 4 lst) lst (append lst (list 4)))

(setq i (1+ i))

)

lst

)

Sau đó chạy thử và xem kết quả

Command: (setq lst (tam 1000000 100) dump 0)

0

Command: (bench '(finditem3) (list 4 lst) 1)

FINDITEM3

Tổng : .................765 mili giây

Trung bình : 765.0000 mili giây / 1 lần

Command: (bench '(finditem4) (list 4 lst) 1)

FINDITEM4

Tổng : ................1078 mili giây

Trung bình : 1078.0000 mili giây / 1 lần

Command: (bench '(finditem7) (list 4 lst) 1)

FINDITEM7

Tổng : ................1141 mili giây

Trung bình : 1141.0000 mili giây / 1 lần

Tháng 9 7, 2011

Cám ơn bác Tuệ Cám ơn bác Tuệ đã tham gia, tuy nhiên kết quả hàm chạy chưa đúng, có lẽ cần fix lại dòng này: (- (length lst) (length memb))
vì list đã thay đổi nên cần để length lst làm hằng số ban đầu, không tính lại trong vòng while nữa</pre>

. Tốc độ khá kinh khủng ^^ Ketxu up thêm 1 bench nữa bên trên, ta sẽ lấy làm cơ sở Test tốc độ của hàm

Ví dụ :

(finditem2 4 '(1 2 3 4 4 3 2 1 1 2 3 4 5))

=> (3 0 6) thay vì (3 4 11) ^^

Ôi! Qua 1 đêm mà có bao nhiêu là bài viết.

Cái này Tue_NV định sửa hồi tối qua. Nhưng chức năng Sửa bài viết không có tác dụng!!!! Không hiểu nữa

Mình cũng định sửa lại điều kiện WHILE cho gọn hơn. Nay post lên luôn

(defun finditem2 (item lst / rt i memb)
;;;copyright by Tue_NV
(setq L (length lst))
(while (setq memb (member item lst))
(setq rt (append rt (list (- L (vl-list-length memb)) )))
(setq lst (cdr memb))
)
rt
)

Tháng 9 7, 2011

Cám ơn bác Trung, đấy chính là vấn đề của list kiểm tra. Sử dụng list đã thêm số 4 của bác thì ổn hơn ^^

Hàm fiditem3 của bác về lý thuyết sẽ tương đương với hàm finditem4 đầu tiên của bác Hoành , và có tính ổn định cao ^^ Tuy nhiên, nếu thử test với bài toán 1000 lần 1 list lớn thì ở máy cùi của em chờ mãi vẫn Not reponsding :(

Hàm tam của bác e viết lại 1 tẹo để cho lst 4 vào đầu + cuối, chứ cons vào list lớn mỗi vòng lặp thì chờ lâu lắm ^^

(defun tam (num l / lst1 lst i)
(setq lst (makelist num))
(setq i 0)
(while (< i l)
(setq lst1 (cons 4 lst1)
i (1+ i))
)
(append lst1 lst lst1)
)

Nếu số lần xuất hiện của kết quả nhiều thì lại thấy rõ sự khác nhau giữa finditem2,3,4,7 và 8

Kết quả kiểm nghiệm 1 lần chạy với list :

(setq lst (tam 1000000 100000) dump 0)

;Bác Tuệ :

Command: (bench '(finditem2) (list 4 lst)1)

FINDITEM2; error: Function cancelled => Máy em cùi nên treo..

Command: *Cancel*

;Bác TrungNgaMy :

Command: (bench '(finditem3) (list 4 lst)1)

FINDITEM3; error: Function cancelled => tương tự...

Command: *Cancel*

Command: (bench '(finditem4) (list 4 lst)1)

;Bác Hoành :

FINDITEM4

Tổng : .................920 mili giây

Trung bình : 920.0000 mili giây / 1 lần (?)

;Em

Command: (bench '(finditem7) (list 4 lst)1)

FINDITEM7; error: Function cancelled => cũng không chờ được

Command: *Cancel*

;Em :

Command: (bench '(finditem8) (list 4 lst)1)

FINDITEM8

Tổng : .................624 mili giây

Trung bình : 624.0000 mili giây / 1 lần

Em đang nghiêng về phương án finditem8 ^^, bác nào máy mạnh mạnh 1 chút Test giùm em với ^^

Tháng 9 8, 2011

Cám ơn bác Trung, đấy chính là vấn đề của list kiểm tra. Sử dụng list đã thêm số 4 của bác thì ổn hơn ^^

Hàm fiditem3 của bác về lý thuyết sẽ tương đương với hàm finditem4 đầu tiên của bác Hoành , và có tính ổn định cao ^^ Tuy nhiên, nếu thử test với bài toán 1000 lần 1 list lớn thì ở máy cùi của em chờ mãi vẫn Not reponsding :(

Hàm tam của bác e viết lại 1 tẹo để cho lst 4 vào đầu + cuối, chứ cons vào list lớn mỗi vòng lặp thì chờ lâu lắm ^^
(defun tam (num l / lst1 lst i)
(setq lst (makelist num))
(setq i 0)
(while (< i l)
(setq lst1 (cons 4 lst1)
i (1+ i))
)
(append lst1 lst lst1)
)
Nếu số lần xuất hiện của kết quả nhiều thì lại thấy rõ sự khác nhau giữa finditem2,3,4,7 và 8

Kết quả kiểm nghiệm 1 lần chạy với list :

(setq lst (tam 1000000 100000) dump 0)

Em đang nghiêng về phương án finditem8 ^^, bác nào máy mạnh mạnh 1 chút Test giùm em với ^^

Với: (setq lst (tam 1000000 100000) dump 0) thì đợi lâu quá nên giảm 1 số 0 là (setq lst (tam 100000 10000) dump 0) thì kết quả như sau:

FINDITEM1

Tổng : ...............38767 mili giây

Trung bình : 38767.0000 mili giây / 1 l\1EA7n

FINDITEM2

Tổng : ...............17394 mili giây

Trung bình : 17394.0000 mili giây / 1 l\1EA7n

Command: (bench '(finditem3)(list 4 lst)1)

FINDITEM3

Tổng : ..................78 mili giây

Trung bình : 78.0000 mili giây / 1 l\1EA7n

Command: (bench '(finditem4)(list 4 lst)1)

FINDITEM4

Tổng : ................5460 mili giây

Trung bình : 5460.0000 mili giây / 1 l\1EA7n

Command: (bench '(finditem7)(list 4 lst)1)

FINDITEM7

Tổng : ................5413 mili giây

Trung bình : 5413.0000 mili giây / 1 l\1EA7n

Command: (bench '(finditem8)(list 4 lst)1)

FINDITEM8

Tổng : ..................47 mili giây

Trung bình : 47.0000 mili giây / 1 l\1EA7n

Tháng 9 8, 2011

Cám ơn bác ĐVH đã test. Kết quả finditem8 vẫn nhỉnh hơn. Còn 1 hàm đệ quy nữa e đã viết, tuy nhiên đệ quy bị giới hạn số lượng vòng lồng nên chưa biết cách khắc phục khi xử lý với list khủng bố :(

Tháng 9 8, 2011

Với: (setq lst (tam 1000000 100000) dump 0) thì đợi lâu quá nên giảm 1 số 0 là (setq lst (tam 100000 10000) dump 0) thì kết quả như sau:

FINDITEM1

Tổng : ...............38767 mili giây

Trung bình : 38767.0000 mili giây / 1 l\1EA7n

FINDITEM2

Tổng : ...............17394 mili giây

Trung bình : 17394.0000 mili giây / 1 l\1EA7n

Command: (bench '(finditem3)(list 4 lst)1)

FINDITEM3

Tổng : ..................78 mili giây

Trung bình : 78.0000 mili giây / 1 l\1EA7n

Command: (bench '(finditem4)(list 4 lst)1)

FINDITEM4

Tổng : ................5460 mili giây

Trung bình : 5460.0000 mili giây / 1 l\1EA7n

Command: (bench '(finditem7)(list 4 lst)1)

FINDITEM7

Tổng : ................5413 mili giây

Trung bình : 5413.0000 mili giây / 1 l\1EA7n

Command: (bench '(finditem8)(list 4 lst)1)

FINDITEM8

Tổng : ..................47 mili giây

Trung bình : 47.0000 mili giây / 1 l\1EA7n

Kết quả test khác để tham khảo

Command: (setq lst (tam 10000 100000) dump 0)

0

Command: (bench '(finditem1)(list 4 lst)1)

FINDITEM1

Tổng : ..............203141 mili giây

Trung bình : 203141.0000 mili giây / 1 lần

Command: (bench '(finditem3)(list 4 lst)1)

FINDITEM3

Tổng : .................188 mili giây

Trung bình : 188.0000 mili giây / 1 lần

Command: (bench '(finditem8)(list 4 lst)1)

FINDITEM8

Tổng : .................343 mili giây

Trung bình : 343.0000 mili giây / 1 lần

Command: (setq lst (tam 1000000 100000) dump 0)

0

Command: (bench '(finditem8)(list 4 lst)1)

FINDITEM8

Tổng : .................532 mili giây

Trung bình : 532.0000 mili giây / 1 lần

Command: (bench '(finditem3)(list 4 lst)1)

FINDITEM3

Tổng : .................953 mili giây

Trung bình : 953.0000 mili giây / 1 lần

Tháng 9 8, 2011

...............

Command: (bench '(finditem8)(list 4 lst)1)

FINDITEM8

Tổng : ..................47 mili giây

Trung bình : 47.0000 mili giây / 1 l\1EA7n

Kết quả test khác để tham khảo

...............

Command: (bench '(finditem3)(list 4 lst)1)

FINDITEM3

Tổng : .................953 mili giây

Trung bình : 953.0000 mili giây / 1 lần

Hàm bench có vấn đề ?!

Giá trị tổng và trung bình giống nhau.

Dùng hàm sosanh thì lisp của Hoành - Tuệ là nhanh nhất.

Tháng 9 8, 2011

Hi bác gia_bach, hàm bench đối số cuối cùng là số lần thực hiện hàm. Do các bác ấy để là 1 nên tổng time sẽ bằng time trung bình. Hàm sosanh ở đằng sau thì dùng tiện hơn nhưng bị động hơn về số lần thực hiện hàm

Đây là hàm đệ quy em viết, vì số lượng truy hồi bị giới hạn (e cũng chửa biết là bằng bao nhiêu, tràn bộ nhớ thì thôi), nên nó sẽ chỉ nên áp dụng khi ta biết số

lượng truy hồi ngược là nhỏ (ít nghiệm thỏa trong list).

(defun find_1 ( key lst / tmp)
(if (setq tmp (vl-position key lst))
   	(cons (setq id (1+ (+ id tmp))) (find_1 key (cdr (member key lst))))
)
)
(defun find (key lst / id)
(setq id -1)
(find_1 key lst)
)

Tháng 9 8, 2011

Hi bác gia_bach, hàm bench đối số cuối cùng là số lần thực hiện hàm. Do các bác ấy để là 1 nên tổng time sẽ bằng time trung bình. Hàm sosanh ở đằng sau thì dùng tiện hơn nhưng bị động hơn về số lần thực hiện hàm

Đây là hàm đệ quy em viết, vì số lượng truy hồi bị giới hạn (e cũng chửa biết là bằng bao nhiêu, tràn bộ nhớ thì thôi), nên nó sẽ chỉ nên áp dụng khi ta biết số

lượng truy hồi ngược là nhỏ (ít nghiệm thỏa trong list).

...........

Hi ketxu : sorry, Anh có sự nhầm lẫn.

- hàm đệ quy chạy nhanh nhưng hạn chế về chiều dài list.

Với list có ch/dài = 21000 thì bị out.

Command: (length lst)

21000

Command: (bench '(find) (list 4 lst) 1)

FINDHard error occurred ***

internal stack limit reached (simulated)

Với list có ch/dài nhỏ thì lisp của Hoành - Tuệ là nhanh nhất. ??? (phù hợp với thực tế hay gặp)

Bổ sung thêm 1 hàm :

(defun finditem9 (item lst / i res pos);Gia Bach
 (setq i -1)
 (while (setq pos (vl-position item lst))
(setq i (+ 1 i pos)
  res (cons i res)
  lst (cdr(member item lst))    	)  )
 (reverse res))

Kết quả :

Command: (setq lst (tam 100000 10000))

Command: (bench '(finditem8)(list 4 lst)1)

FINDITEM8

Tong : ..............................63 mili giay

Trung binh : 63.0000 mili giay / 1 lan

Command: (bench '(finditem9)(list 4 lst)1)

FINDITEM9

Tong : ..............................47 mili giay

Trung binh : 47.0000 mili giay / 1 lan

Command: (setq lst (tam 10000 100000) )

Command: (bench '(finditem8)(list 4 lst)1)

FINDITEM8

Tong : .............................609 mili giay

Trung binh : 609.0000 mili giay / 1 lan

Command: (bench '(finditem9)(list 4 lst)1)

FINDITEM9

Tong : .............................609 mili giay

Trung binh : 609.0000 mili giay / 1 lan

Command: (setq lst (tam 1000000 100000))

Command: (bench '(finditem8)(list 4 lst)1)

FINDITEM8

Tong : .............................609 mili giay

Trung binh : 609.0000 mili giay / 1 lan

Command: (bench '(finditem9)(list 4 lst)1)

FINDITEM9

Tong : .............................328 mili giay

Trung binh : 328.0000 mili giay / 1 lan

Tháng 9 8, 2011

Hi bác gia_bach, hàm bench đối số cuối cùng là số lần thực hiện hàm. Do các bác ấy để là 1 nên tổng time sẽ bằng time trung bình. Hàm sosanh ở đằng sau thì dùng tiện hơn nhưng bị động hơn về số lần thực hiện hàm Đây là hàm đệ quy em viết, vì số lượng truy hồi bị giới hạn (e cũng chửa biết là bằng bao nhiêu, tràn bộ nhớ thì thôi), nên nó sẽ chỉ nên áp dụng khi ta biết số lượng truy hồi ngược là nhỏ (ít nghiệm thỏa trong list).
 (defun find_1 ( key lst / tmp) (if (setq tmp (vl-position key lst)) (cons (setq id (1+ (+ id tmp))) (find_1 key (cdr (member key lst)))) ) ) (defun find (key lst / id) (setq id -1) (find_1 key lst) ) 

Hề hề hề,

Chửa biết test ra sao, song mình có tí thắc mắc là sao không thấy mọi người đề cập tới cái hàm có sẵn trong Help Developer nhỉ???? cái hàm vl-position ấy mà.

Mình xin phép thử cái ni xem sao:

(defun finditemmay (item lst)

(setq count 0)

(setq polst (list))

(foreach x lst

(if (equal x item)

(progn

(setq polst (cons (+ (vl-position x lst) count) polst)

(setq count (1+ count))

(setq lst (vl-remove x lst))

)

(setq polst (reverse polst))

polst

)

Hề hề hề, nhờ các bác test giùm hỉ, mình viết vội nên chửa rõ có đúng cái bác ketxu muốn hay không???

Tháng 9 8, 2011

@bác Bình : hề, có mấy cái bên trên dùng position đó thôi bác ^^ Hàm của bác e chưa có CAD để chạy tuy nhiên đoán là có chút vấn đề, vì (vl-remove x lst) sẽ xóa toàn bộ item có giá trị X trong list của bác, nên vòng lặp sẽ chỉ chạy lần đầu xong là nghỉ ^^

@bác Giabach : Hàm của bác kết hợp ngon nghẻ giữa 4 và 8 đúng không ạ. Có lẽ tốc độ sẽ nhanh hơn cả 2 ^^

Tháng 9 8, 2011

Cám ơn Ketxu về cái chủ đề và hàm Bench đánh giá tốc độ của bạn

- Nếu vđ này quan trọng với bạn, bạn hãy thử với một dữ liệu thực và lớn, phức tạp như danh sách lồng trong danh sách xem sao.

Mình cũng một vđ "đố vui" như sau :

Có rất nhiều đoạn thẳng trong mặt phẳng có tọa độ (x1 y1), (x2 y2) và đã được đánh số thứ tự. Hãy thiết kế dữ liệu và giải thuật sao cho khi ta cung cấp một điểm bất kỳ, sẽ trả về số thứ tự đoạn thẳng nằm gần nó nhất (nghĩa là đoạn nối từ điểm đến một điểm bất kỳ trên đoạn thẳng ngắn nhất) nhanh nhất.

Có thể tạo dữ liệu ban đầu bằng cách vào CAD chọn dữ liệu line, số thứ tự có thể là vị trí của nó trong tập hợp chọn. (Chú ý: Mình kg phải tìm đối tượng gần điểm trên bản vẽ mà tìm trong dữ liệu tọa độ và số thứ tự của chúng)

Vấn đề này hơi khó. Mình nghĩ vậy. Xin cám ơn các bạn

Tháng 9 8, 2011

@bác TrungNgaMy : ^^ em làm XDDD thì có bao giờ phải xử lý list với dữ liệu lớn đâu ^^ VĐ cũng không quan trọng với em, mà chủ yếu là "vui" mà ^^

Ngoài ra, khi đố 1 câu nào đó, bác cần có đáp án ( chuẩn hoặc gần chuẩn) của nó trước rồi nhé ^^ Hề hề

Bài toán bác đưa ra tạm thời e mới nghĩ ra là có công thức tính khoảng cách từ 1 điểm đến 1 đường thẳng vecto (x1,y1) (x2,y2), ta cứ thế mà làm tới thôi chứ hỉ ?

P/S : e kiểm nghiệm thấy hàm bác gia_bach trong câu trước nhanh nhứt, có bác nào có kết quả test khác không ạ ?

Tháng 9 9, 2011

@Ketxu

Mình hay nghi ngờ độ chuẩn xác của giải thuật nên cố kiểm tra xem thôi, mình chưa hiều các hàm xác định thời gian của bạn vì trước giờ mình cũng kg quan tâm lắm. Thấy bạn đưa ra hay hay nên mình định sd kiểm tra một số hàm mình viết. Tuy nhiên, khi sd mình có cảm giác thời gian thực kg hợp lý lắm nên làm cái hàm thủ công test thử hàm bench của bạn. Mình làm như sau đây các bạn xem hợp lý kg nhé :

(defun Testbench(Funcs ; list of functions

Args ; list of arguments

Count )

(command "_.time" "")

(bench Funcs Args Count)

(command "_.time" "")

)

Kết quả test thử như sau:

Command: (setq lst (tam 10 10) a (length lst))

30

Command: Specify opposite corner:

Command: (testbench '(finditem3) (list 2 lst) 1)

_.time

Current time: Friday, September 09, 2011 6:28:50:234 PM

Times for this drawing:

Created: Friday, September 09, 2011 5:48:58:281 PM

Last updated: Friday, September 09, 2011 5:48:58:281 PM

Total editing time: 0 days 00:39:52:391

Elapsed timer (on): 0 days 00:39:51:969

Next automatic save in: <no modifications yet>

Enter option [Display/ON/OFF/Reset]:

Command:

FINDITEM3

Tổng : ...................0 mili giây

Trung bình : 0.0000 mili giây / 1 lần

_.time

Current time: Friday, September 09, 2011 6:28:51:281 PM

Times for this drawing:

Created: Friday, September 09, 2011 5:48:58:281 PM

Last updated: Friday, September 09, 2011 5:48:58:281 PM

Total editing time: 0 days 00:39:53:437

Elapsed timer (on): 0 days 00:39:53:015

Next automatic save in: <no modifications yet>

Enter option [Display/ON/OFF/Reset]:

Command: nil

Command: (testbench '(finditem8) (list 2 lst) 1)

_.time

Current time: Friday, September 09, 2011 6:29:13:984 PM

Times for this drawing:

Created: Friday, September 09, 2011 5:48:58:281 PM

Last updated: Friday, September 09, 2011 5:48:58:281 PM

Total editing time: 0 days 00:40:16:141

Elapsed timer (on): 0 days 00:40:15:719

Next automatic save in: <no modifications yet>

Enter option [Display/ON/OFF/Reset]:

Command:

FINDITEM8

Tổng : ...................0 mili giây

Trung bình : 0.0000 mili giây / 1 lần

_.time

Current time: Friday, September 09, 2011 6:29:15:015 PM

Times for this drawing:

Created: Friday, September 09, 2011 5:48:58:281 PM

Last updated: Friday, September 09, 2011 5:48:58:281 PM

Total editing time: 0 days 00:40:17:172

Elapsed timer (on): 0 days 00:40:16:750

Next automatic save in: <no modifications yet>

Enter option [Display/ON/OFF/Reset]:

Command: nil

Command: (testbench '(finditem9) (list 2 lst) 1)

_.time

Current time: Friday, September 09, 2011 6:29:47:031 PM

Times for this drawing:

Created: Friday, September 09, 2011 5:48:58:281 PM

Last updated: Friday, September 09, 2011 5:48:58:281 PM

Total editing time: 0 days 00:40:49:187

Elapsed timer (on): 0 days 00:40:48:765

Next automatic save in: <no modifications yet>

Enter option [Display/ON/OFF/Reset]:

Command:

FINDITEM9

Tổng : ...................0 mili giây

Trung bình : 0.0000 mili giây / 1 lần

_.time

Current time: Friday, September 09, 2011 6:29:48:062 PM

Times for this drawing:

Created: Friday, September 09, 2011 5:48:58:281 PM

Last updated: Friday, September 09, 2011 5:48:58:281 PM

Total editing time: 0 days 00:40:50:219

Elapsed timer (on): 0 days 00:40:49:812

Next automatic save in: <no modifications yet>

Enter option [Display/ON/OFF/Reset]:

Command: nil

Căn cứ vào dòng

Current time: Friday, September 09, 2011 6:29:48:062 PM

trước và sau khi chạy lệnh bench của bạn cũng có thể xác định đc thời gian. Các bạn xem thử, Kg biết mình có nhầm lẫn gì kg

Tháng 9 10, 2011

Xin lỗi bác TrungNgaMy ket đi 2 ngày nay ^^ Ketxu chưa hiểu rõ ý bác : Test hàm Bench tức là làm sao nhỉ ^^

- Hai hàm sosanh và bench không phải do Ketxu viết ^^ Tuy nhiên về cơ bản cơ chế nó cũng như nhau và rất dễ hiểu, đó là :

Bước 1 : Lấy thời gian điểm đầu

Bước 2 : Thực hiện công việc (có thể lặp đi lặp lại)

Bước 3 : Lấy mốc thời gian cuối, trừ đi thời gian đầu -> Ra thời gian tổng thực hiện => Chia cho số lần thực hiện công việc để ra thời gian trung bình

Để lấy điểm mốc thời gian đầu và cuối có thể dựa theo nhiều cách

Ở cả 2 lisp Bench và sosanh bác có thể thấy công việc (getvar "Millisecs")) ở thời điểm đầu và cuối ^^. Ngoài ra còn có CDATE,DATE...

Hàm Testbench của bác viết cũng chính là đi theo con đường như vậy.

Nếu bác nghi ngờ, hãy kiểm tra với cách tính thủ công và cách dùng Bench.

Ketxu lấy ví dụ với hàm finditem8 và lấy time bằng _VL-Times cho 1 lần thực hiện hàm nhé :

Thủ công :

(defun test1 () ;thu cong
(setq start (car(_VL-TIMES)))
(repeat 1 ;Hoac so lan khac
(finditem8 4 lst) ; Cong viec can tinh thoi gian
)
(princ (strcat "\n "
(rtos (/ (- (car (_VL-TIMES)) start) 1000.) 2 4)
" secs."
) ;_ strcat
) ;_ princ
)

Command: (setq lst (tam 1000 100) a (length lst))
19200

Command: (test1)

0.0310 secs."\n 0.0310 secs."

Command: (bench '(finditem8) (list 4 lst) 1)

FINDITEM8

Tổng : ..................31 mili giây

Trung bình : 31.0000 mili giây / 1 lần

P/S : những đoạn chữ dẫn chứng mong bác cho vào thẻ quote cho dễ đọc

Đăng nhập

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

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

ketxu 2.983

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

Tue_NV 3.912

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

ketxu 2.983

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 Van Ha 3.180

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

TRUNGNGAMY 91

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

Nguyen Hoanh 4.663

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 Van Ha 3.180

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

Nguyen Hoanh 4.663

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

ketxu 2.983

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

TRUNGNGAMY 91

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

TRUNGNGAMY 91

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

Tue_NV 3.912

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

ketxu 2.983

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 Van Ha 3.180

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

ketxu 2.983

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

TRUNGNGAMY 91

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

gia_bach 1.548

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

ketxu 2.983

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

gia_bach 1.548

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

phamthanhbinh 3.146