Chuyển đến nội dung
Diễn đàn CADViet

ketxu

Moderator
  • Số lượng nội dung

    5.836
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    312

Mọi thứ được đăng bởi ketxu

  1. ketxu

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

    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 ?
  2. ketxu

    Chia sẻ Blog có nhìu lisp hay nè mọi người

    Cảm ơn bạn đã chia sẻ, nhưng không nhất thiết phải lập một nick mới để share chính thành quả của mình đâu ^^
×