Đế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

#141 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 13 October 2011 - 05:03 PM

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


#142 tomboy

tomboy

    biết vẽ polygon

  • Members
  • PipPip
  • 72 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 14 October 2011 - 12:53 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 ?

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

  • 0

#143 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 October 2011 - 01:18 PM

đâ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 :(
  • 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


#144 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 14 October 2011 - 01:30 PM

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


#145 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 October 2011 - 01:53 PM

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

  • 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


#146 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 14 October 2011 - 02:43 PM

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


#147 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 October 2011 - 02:58 PM

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


  • 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


#148 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 18 October 2011 - 11:14 PM

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

#149 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 18 October 2011 - 11:43 PM

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)

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


#150 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 19 October 2011 - 07:03 AM

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)

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


#151 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 19 October 2011 - 07:08 AM


(defun check (lst / rt)
(setq rt (if (vl-some '(lambda(x y)(/=(length x)(length y))) lst (cdr lst)) 0 1))
)

  • 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


#152 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 19 October 2011 - 07:49 AM

Thanks all.

Đáp án của nPham la

(defun check (lst)
(if (apply '= (mapcar 'length lst)) 1 0)
)


Một câu khác các bác nhé, anh em mình lấy lisp làm niềm vui mà. hehe.

Hãy đảo list '((1 2 3 4)(a b c d)(5 6 7 8))
thành:

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

#153 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 19 October 2011 - 08:20 AM

Thanks all.
Đáp án của nPham la
Một câu khác các bác nhé, anh em mình lấy lisp làm niềm vui mà. hehe.

Hãy đảo list '((1 2 3 4)(a b c d)(5 6 7 8))
thành:

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


Cách của npham ngắn hơn nhưng khi thực thi thì các bước đi cũng tương tự như bác ĐVH, tức là luôn quét qua 1 lượt list :) tương đương với vl-every :)
Ở 2 lisp của bác ĐVH thì cần thiết thay đổi repeat thành while, khi nào phát hiện kết quả là 0 thì dừng ngay. Khi đó cả hàm sẽ tương đương với vl-some.
Cái đảo list của npham :

(defun Transpose(lst)(apply 'mapcar (cons 'list 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


#154 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 19 October 2011 - 09:28 AM

Ở 2 lisp của bác ĐVH thì cần thiết thay đổi repeat thành while, khi nào phát hiện kết quả là 0 thì dừng ngay. Khi đó cả hàm sẽ tương đương với vl-some.

Ket có thể giải thích vì sao nên đổi repeat thành while ?
dùng repeat có lợi gì? hại gì?
dùng while có lợi gì? hại gì?
Thanks!
  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341


#155 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 19 October 2011 - 09:59 AM

Ket có thể giải thích vì sao nên đổi repeat thành while ?
dùng repeat có lợi gì? hại gì?
dùng while có lợi gì? hại gì?
Thanks!

Trong trường hợp này Ket đúng. Repeat có số vòng lặp xác định nên nó lặp đến hết chiều dài của lst, while có số vòng lặp không xác định nên nó sẽ lặp hoặc vô tận hoặc sẽ dừng khi điều kiện cung cấp cho while không thoả mãn. Bài toán y/c kiểm tra để trả về 1 hoặc 0, do đó ta đặt thêm điều kiện cho while là khi trả về 0 thì dừng lặp. Điều này rất lợi hại khi số lần lặp đủ lớn. Ví dụ trong lst của bài toán: có 1000 sublst nhưng nếu 2 sublst đầu có chiều dài khác nhau thì dùng while nó sẽ lặp chỉ 1 lần rồi dừng, nhưng dùng repeat nó sẽ lặp 999 lần!
  • 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.


#156 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 19 October 2011 - 10:02 AM

Cách của npham ngắn hơn nhưng khi thực thi thì các bước đi cũng tương tự như bác ĐVH, tức là luôn quét qua 1 lượt list :) tương đương với vl-every :) Ở 2 lisp của bác ĐVH thì cần thiết thay đổi repeat thành while, khi nào phát hiện kết quả là 0 thì dừng ngay. Khi đó cả hàm sẽ tương đương với vl-some. Cái đảo list của npham :

 (defun Transpose(lst)(apply 'mapcar (cons 'list lst))) 


Trời !!! Sao hay vậy ta. Két chỉ giáo thêm về cái giải thuật này đuwocj không, lạ quá, đọc hoài không hiểu :D
  • 0

#157 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 19 October 2011 - 10:25 AM

Thanks all.

Đáp án của nPham la



Một câu khác các bác nhé, anh em mình lấy lisp làm niềm vui mà. hehe.

Hãy đảo list '((1 2 3 4)(a b c d)(5 6 7 8))
thành:

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

Hơi dài, nhưng xài được. Cách của Ket độc quá nên chả hiểu nổi!

(defun HA3(ds / ds1 ds2 ds3 n m x y)
(setq n (length ds) m (length (setq ds1 (reverse (apply 'append ds)))) x 0)
(repeat (/ m n)
(setq y 0 ds2 nil)
(repeat n
(setq ds2 (cons (nth (+ x y) ds1) ds2))
(setq y (+ (/ m n) y)))
(setq x (1+ x))
(setq ds3 (cons ds2 ds3)))
ds3)

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


#158 npham

npham

    biết lệnh rotate

  • Members
  • PipPipPip
  • 136 Bài viết
Điểm đánh giá: 75 (tàm tạm)

Đã gửi 19 October 2011 - 11:43 AM

Ket chơi độc quá. còn đây Cách của nPham nè.

(defun vlp-list-trans (s / data subdata i x)
(setq i 0)
(setq data (append))
(repeat (length (car s))
(setq subdata (append))
(foreach x s (setq subdata (append subdata (list (nth i x)))))
(setq data (append data (list subdata)))
(setq i (1+ i))
)
data
)


  • 0

#159 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 19 October 2011 - 12:04 PM

Ket chơi độc quá. còn đây Cách của nPham nè.

Hề hề hề,
Cái độc của Ketxu là không chỉ ở đây đâu. Việc hiểu cặn kẽ các hàm và áp dụng kết hợp chúng với nhau là một biệt tài của ketxu. Thông thường người học mót như mình thjì chỉ ráng hiểu từng hàm riêng biệt và sử dụng nó theo cái cách độc lập mà tốt thì đã là một hạnh phúc rùi. Còn với Ketxu thì chưa đủ, phải là làm sao để kết hợp chúng một cách nhuần nhuyễn nhất và càng nhiều hàm lồng nhau càng ....... khoái. Khoái không chỉ vì nó gọn đẹp mà còn là khoái vì hiểu chúng rõ hơn...
Hề hề hề, bái phục, bái bái phục.
Cái cỡ đi mót như mình thì chắc đến khi sang tiểu vẫn chửa hiểu được hết cái thâm nho của.... lispKet.
Hề hề hề,....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#160 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 19 October 2011 - 01:34 PM

Trong trường hợp này Ket đúng. Repeat có số vòng lặp xác định nên nó lặp đến hết chiều dài của lst, while có số vòng lặp không xác định nên nó sẽ lặp hoặc vô tận hoặc sẽ dừng khi điều kiện cung cấp cho while không thoả mãn. Bài toán y/c kiểm tra để trả về 1 hoặc 0, do đó ta đặt thêm điều kiện cho while là khi trả về 0 thì dừng lặp. Điều này rất lợi hại khi số lần lặp đủ lớn. Ví dụ trong lst của bài toán: có 1000 sublst nhưng nếu 2 sublst đầu có chiều dài khác nhau thì dùng while nó sẽ lặp chỉ 1 lần rồi dừng, nhưng dùng repeat nó sẽ lặp 999 lần!

Cái lợi của while bạn DOAN VAN HA đã nói đúng nhưng với bài toán đề ra thì dùng repeat đúng hơn vì nhanh hơn đó là lý do vì sao repeat vẫn tồn tại song song với while.
phần code của bạn nếu thêm (exit) khi ok =0 thì sao?
theo lý thuyết là thế nhưng chưa test với lisp. bạn nào đã test thì cho xin cái đáp án.
Thanks!
  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341