Đến nội dung


Hình ảnh
* * * * - 7 Bình chọn

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


  • Please log in to reply
391 replies to this topic

#1 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 07 September 2011 - 06:04 PM

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 ?
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 07 September 2011 - 09:08 PM

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>




  • 0

#3 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 07 September 2011 - 09:33 PM

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) ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 07 September 2011 - 11:03 PM

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...!
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 07 September 2011 - 11:08 PM

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
  • 1

#6 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 07 September 2011 - 11:39 PM

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

  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 07 September 2011 - 11:50 PM

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!
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 07 September 2011 - 11:59 PM

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

  • 1

#9 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 08 September 2011 - 12:28 AM

@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á :|
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#10 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 08 September 2011 - 01:13 AM

(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
  • 0

#11 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 08 September 2011 - 01:24 AM

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
  • 1

#12 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 08 September 2011 - 05:30 AM

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
)

  • 1

#13 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 08 September 2011 - 06:48 AM

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 ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#14 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 08 September 2011 - 09:29 AM

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
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#15 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 08 September 2011 - 09:55 AM

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ố :(
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#16 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 08 September 2011 - 11:50 AM

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
  • 0

#17 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1433 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 08 September 2011 - 12:14 PM

...............
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.
  • 1

#18 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 08 September 2011 - 12:48 PM

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

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#19 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1433 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 08 September 2011 - 02:50 PM

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
  • 1

#20 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 08 September 2011 - 04:24 PM

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???
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.