三种等分表的函数效率测试

fools · 发表于 2007-2-10 10:52:03

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

近来编程需要做大量的等分表操作,于是比较了以下三个函数,供大家参考:
第一个函数摘录于std程序包
[pcode=lisp,true]
;;; STD-SPLIT-LIST splits list into sublists of maximal length n
;;; n must be > 0!
;;; Iterative version by Serge Pashkov, safer than recursive version
;;; (std-split-list 2 '(1 2 3 4 5 6)) => ((1 2) (3 4) (5 6))
(defun STD-SPLIT-LIST (n lst / ret out cnt)
 (setq ret nil) ; possible VL lsa compiler bug
 ;; adjust cnt to set incomplete number of elements (if any) for the
 ;; last segment
 (setq cnt (- n (rem (length lst) n)) lst (reverse lst))
 (while lst
(setq ret (cons (car lst) ret) lst (cdr lst))
(if (zerop (rem (setq cnt (1+ cnt)) n))
 (setq out (cons ret out) ret nil)))
 (if ret (cons ret out) out))
[/pcode]

第二个函数是本论坛函数库收集提供的
;;http://www.xdcad.net/forum/showthread.php?s=&threadid=451886

[pcode=lisp,true]

;; a-->(1 2 3 4 5 6 7 8)
;; (split 2 a)-->((1 2) (3 4) (5 6) (7 8))
;; (split 3 a)-->((1 2 3) (4 5 6) (7 8))
;;By Aeo
(defun lst-split(n li / return a len)
(while li
(setq a nil
 len(length li)
)
(repeat (if(<= n len)n len)
 (setq a(cons (car li)a) li(cdr li))
)
(setq return(cons(reverse a)return))
)
(reverse return)
)
[/pcode]

第三个函数是明经通道ALISP函数库收集提供的

[pcode=lisp,true]

;;http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=1004
;|(xl_div lst nom)表分段. -> 返回分段的表. －－－－－－by 无痕.2004.1
; lst ＝表，nom = 分段的子表元素个数(从1开始计).
; 测试: (xl_div '(1 2 3 4 5 6 7 8 9) 3) -> ((1 2 3) (4 5 6) (7 8 9))
 (xl_div '(1 2 3 4 5 6 7 8 9 10 11) 3) -> ((1 2 3) (4 5 6) (7 8 9) (10 11))
 (xl_div '(17086.8 5666.8 0.0 16093.0 8693.12 0.0 16093.0 7827.36 0.0 16093.0 6639.13 0.0) 3)
 －> ((17086.8 5666.8 0.0) (16093.0 8693.12 0.0) (16093.0 7827.36 0.0) (16093.0 6639.13 0.0))
 (xl_div nil 2) -> nil
|;
;;方法７. ok!**************************************************
(defun xl-div (lst x / lst2)
(foreach n lst
 (if (and lst2 (/= x (length (car lst2))))
 (setq lst2 (cons (append (car lst2)(list n))(cdr lst2)))
 (setq lst2 (cons (list n) lst2))
 )
)(reverse lst2)
)
[/pcode]
测试数据准备
[pcode=lisp,true]
;;等份单元为length 4
(setq a 4)
(SETQ b '(17086.8 5666.8 0.0 16093.0 8693.12 0.0 16093.0 -236290.0 94625.0 7827.36))
;;典型的PLINE点表
(SETQ c '((10 -236290.0 94625.0) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -314670.0 24235.5) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -285278.0 13047.7) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -247487.0 43347.9) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -231625.0 11649.3) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -210630.0 11649.3) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -200833.0 -3267.72) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -237223.0 -14921.6) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -266149.0 -1869.25) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 (10 -301607.0 -18184.7) (40 . 0.0) (41 . 0.0) (42 . 0.0)
 )
)
(setq d c)
; length 1280 长表
(repeat 5 (setq d (append d d)))
[/pcode]
测试结果
[pcode=lisp,true]
(benchmark '((STD-SPLIT-LIST a b) (lst-split a b) (xl-div b a)))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

(STD-SPLIT-LIST A B).....1516 / 1.2 <fastest>
(LST-SPLIT A B)..........1688 / 1.07
(XL-DIV B A).............1812 / 1 <slowest>

(benchmark '((STD-SPLIT-LIST a c) (lst-split a c) (xl-div c a)))
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):

(STD-SPLIT-LIST A C).....1140 / 1.49 <fastest>
(LST-SPLIT A C)..........1437 / 1.19
(XL-DIV C A).............1703 / 1 <slowest>

(benchmark '((STD-SPLIT-LIST a d) (lst-split a d) (xl-div d a)))
Benchmarking ...........Elapsed milliseconds / relative speed for 256 iteration(s):

(STD-SPLIT-LIST A D).....1344 / 2.06 <fastest>
(XL-DIV D A).............2406 / 1.15
(LST-SPLIT A D)..........2766 / 1 <slowest>
[/pcode]

结论:
1.推荐使用第一个函数,效率较高.
2.后两个函数因为频繁调用length,表项越多,效率越低,表项1300时,执行速度和第一个函数已经相差接近1倍.

本贴仅为测试函数,请Aeo和无痕不要介意.

雨箭风刀 · 发表于 2008-3-30 22:19:38

关于列表分段，我自己也写过很多个版本，你可试试下面的这个版本。----------无痕

[FONT=courier new]
;| (xl-div n lst) = 表分段----------by lxx.
测试：(xl-div 2 '(1 2 3 4 5 6 7)) -> ((1 2) (3 4) (5 6) (7))
|;
(defun xl-div (n lst / A I LL)
(setq i 1)
(mapcar '(lambda (x)
(if (< i n)
(setq a (cons x a)
i (1+ i))
(setq ll (cons (reverse (cons x a)) ll)
a nil
i 1)
)
)
lst
)
(reverse (if a (cons (reverse a) ll) ll))
)
[/FONT]

[FONT=courier new]
_$ (c:test)
Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):
(XL-DIV A B).............1406 / 1.09 <fastest>
(STD-SPLIT-LIST A B).....1422 / 1.08
(LST-SPLIT A B)..........1531 / 1.00 <slowest>
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):
(XL-DIV A C).............1172 / 1.32 <fastest>
(STD-SPLIT-LIST A C).....1359 / 1.14
(LST-SPLIT A C)..........1547 / 1.00 <slowest>
Benchmarking .......Elapsed milliseconds / relative speed for 16 iteration(s):
(XL-DIV A D)..............1578 / 15.98 <fastest>
(STD-SPLIT-LIST A D)......1875 / 13.45
(LST-SPLIT A D)..........25219 / 1.00 <slowest> [/FONT]

复制代码

taner · 发表于 2008-6-7 13:48:54

[FONT=courier new]
;;; 经测试,以下的最快.
(defun hao-lst-split (lst n)
(if lst
(cons (th-del-lst>mn< 0 (1- n) lst) (hao-lst-split
(th-del-lst>mn< n
(length lst)
lst
) n
)
)
)
)
(defun th-del-lst>mn< (m n lst / j) ; 保留列表的第m~n项
(setq j -1)
(vl-remove-if-not '(lambda (x)
(and
(setq j (1+ j))
(<= m j)
(>= n j)
)
) lst
)
)
[/FONT]

狂刀 · 发表于 2008-6-8 23:08:36

用 vl-remove-* 还能最快，说什么也不相信。据我的经验，这个函数的效率并不算高。
你自己先用测试函数测试一下贴出来。
这是我测试的结果
Elapsed milliseconds / relative speed for 8192 iteration(s):
(XL-DIV A B).............1265 / 7.82 <fastest>
(STD-SPLIT-LIST A B).....1281 / 7.72
(HAO-LST-SPLIT B A)......9890 / 1.00 <slowest>

Elapsed milliseconds / relative speed for 4096 iteration(s):
(XL-DIV A C)..............1000 / 17.75 <fastest>
(STD-SPLIT-LIST A C)......1141 / 15.56
(HAO-LST-SPLIT C A)......17750 / 1.00 <slowest>

Elapsed milliseconds / relative speed for 512 iteration(s):
(XL-DIV A D)...............1968 / 221.50 <fastest>
(STD-SPLIT-LIST A D).......2547 / 171.15
(HAO-LST-SPLIT D A)......435921 / 1.00 <slowest>

附上测试函数

(defun Benchmark
;;=================================================================
;;
;; Benchmark.lsp | ?? 2005 Michael Puckett | All Rights Reserved
;;
;;=================================================================
;;
;; Purpose:
;;
;; Compare the performance of various statements.
;;
;; Notes:
;;
;; I make no claims that this is definitive benchmarking. I
;; wrote this utility for my own purposes and thought I'd
;; share it. Many considerations go into evaluating the
;; performance or suitability of an algorythm for a given
;; task. Raw performance as profiled herein is just one.
;;
;; Please note that background dramatically affect results.
;;
;; Disclaimer:
;;
;; This program is flawed in one or more ways and is not fit
;; for any particular purpose, stated or implied. Use at your
;; own risk.
;;
;;=================================================================
;;
;; Syntax:
;;
;; (Benchmark statements)
;;
;; Where statements is a quoted list of statements.
;;
;;=================================================================
;;
;; Example:
;;
;; (BenchMark
;; '(
;; (1+ 1)
;; (+ 1 1)
;; (+ 1 1.0)
;; (+ 1.0 1.0)
;; )
;; )
;;
;;=================================================================
;;
;; Output:
;;
;; Elapsed milliseconds / relative speed for 32768 iteration(s):
;;
;; (1+ 1)..........1969 / 1.09 <fastest>
;; (+ 1 1).........2078 / 1.03
;; (+ 1 1.0).......2125 / 1.01
;; (+ 1.0 1.0).....2140 / 1.00 <slowest>
;;
;;=================================================================
(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)
)
(while
(< (length
(setq padding
(append padding padding)
)
)
len
)
)
(while
(< (length
(setq result
(append result padding)
)
)
len
)
)
(substr (vl-list->string result) 1 len)
)
;;=================================================================
;;
;; (_RSet text len fillChar)
;;
;;=================================================================
(defun _RSet (text len fillChar / padding result)
(setq
padding (list (ascii fillChar))
result (vl-string->list text)
)
(while
(< (length
(setq padding
(append padding padding)
)
)
len
)
)
(while
(< (length
(setq result
(append padding result)
)
)
len
)
)
(substr
(vl-list->string result)
(1+ (- (length result) len))
)
)
;;=================================================================
;;
;; (_ToString x)
;;
;;=================================================================
(defun _ToString (x / result)
(if
(< (strlen
(setq result
(vl-prin1-to-string x)
)
)
40
)
result
(strcat (substr result 1 36) "..." (chr 41))
)
)
;;=================================================================
;;
;; (_Eval statement iterations)
;;
;;=================================================================
(defun _Eval (statement iterations / start)
(gc)
(setq start (getvar "millisecs"))
(repeat iterations (eval statement))
(- (getvar "millisecs") start)
)
;;=================================================================
;;
;; (_Princ x)
;;
;;=================================================================
(defun _Princ (x)
(princ x)
(princ)
;; forces screen update
)
;;=================================================================
;;
;; (_Main statements)
;;
;;=================================================================
(defun _Main
(statements / boundary iterations timings
slowest fastest lsetLen rsetLen index
count
)
(setq
boundary 1000
iterations
1
)
(_Princ "Benchmarking ...")
(while
(or
(< (apply 'max
(setq timings
(mapcar
'(lambda (statement)
(_Eval statement iterations)
)
statements
)
)
)
boundary
)
(< (apply 'min timings)
boundary
)
)
(setq iterations
(* 2 iterations)
)
(_Princ ".")
)
(_Princ
(strcat
"\rElapsed milliseconds / relative speed for "
(itoa iterations)
" iteration(s):\n\n"
)
)
(setq
slowest (float (apply 'max timings))
fastest (apply 'min timings)
)
(setq lsetLen
(+ 5
(apply 'max
(mapcar 'strlen
(setq statements
(mapcar '_ToString
statements
)
)
)
)
)
)
(setq rsetLen
(apply 'max
(mapcar
'
(lambda (ms) (strlen (itoa ms)))
timings
)
)
)
(setq
index 0
count (length statements)
)
(foreach pair
(vl-sort
(mapcar 'cons statements timings)
'
(lambda (a b) (< (cdr a) (cdr b)))
)
((lambda (pair / ms)
(_Princ
(strcat
" "
(_LSet (car pair) lsetLen ".")
(_RSet
(itoa (setq ms (cdr pair)))
rsetLen
"."
)
" / "
(rtos (/ slowest ms) 2 2)
(cond
((eq 1 (setq index (1+ index))) " <fastest>")
((eq index count) " <slowest>")
("")
)
"\n"
)
)
)
pair
)
)
(princ)
)
;;=================================================================
;;
;; Program is defined, let's rock and roll ...
;;
;;=================================================================
(_Main statements)
)

(defun Benchmark 
                 ;;=================================================================   
                 ;;   
                 ;;  Benchmark.lsp | ?? 2005 Michael Puckett | All Rights Reserved   
                 ;;   
                 ;;=================================================================   
                 ;;   
                 ;;  Purpose:   
                 ;;   
                 ;;      Compare the performance of various statements.   
                 ;;   
                 ;;  Notes:   
                 ;;   
                 ;;      I make no claims that this is definitive benchmarking. I   
                 ;;      wrote this utility for my own purposes and thought I'd   
                 ;;      share it. Many considerations go into evaluating the   
                 ;;      performance or suitability of an algorythm for a given   
                 ;;      task. Raw performance as profiled herein is just one.   
                 ;;   
                 ;;      Please note that background dramatically affect results.   
                 ;;   
                 ;;  Disclaimer:   
                 ;;   
                 ;;      This program is flawed in one or more ways and is not fit   
                 ;;      for any particular purpose, stated or implied. Use at your   
                 ;;      own risk.   
                 ;;   
                 ;;=================================================================   
                 ;;   
                 ;;  Syntax:   
                 ;;   
                 ;;      (Benchmark statements)   
                 ;;   
                 ;;          Where statements is a quoted list of statements.   
                 ;;   
                 ;;=================================================================   
                 ;;   
                 ;;  Example:   
                 ;;   
                 ;;      (BenchMark   
                 ;;         '(   
                 ;;              (1+ 1)   
                 ;;              (+ 1 1)   
                 ;;              (+ 1 1.0)   
                 ;;              (+ 1.0 1.0)   
                 ;;          )   
                 ;;      )   
                 ;;   
                 ;;=================================================================   
                 ;;   
                 ;;  Output:   
                 ;;   
                 ;;      Elapsed milliseconds / relative speed for 32768 iteration(s):   
                 ;;   
                 ;;          (1+ 1)..........1969 / 1.09 <fastest>   
                 ;;          (+ 1 1).........2078 / 1.03   
                 ;;          (+ 1 1.0).......2125 / 1.01   
                 ;;          (+ 1.0 1.0).....2140 / 1.00 <slowest>       
                 ;;   
                 ;;=================================================================   
 
                 (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) 
    ) 
    (while 
      (< (length 
           (setq padding 
                  (append padding padding) 
           ) 
         ) 
         len 
      ) 
    ) 
    (while 
      (< (length 
           (setq result 
                  (append result padding) 
           ) 
         ) 
         len 
      ) 
    ) 
    (substr (vl-list->string result) 1 len) 
  ) 
  ;;=================================================================   
  ;;   
  ;;  (_RSet text len fillChar)   
  ;;   
  ;;=================================================================   
  (defun _RSet (text len fillChar / padding result) 
    (setq 
      padding (list (ascii fillChar)) 
      result  (vl-string->list text) 
    ) 
    (while 
      (< (length 
           (setq padding 
                  (append padding padding) 
           ) 
         ) 
         len 
      ) 
    ) 
    (while 
      (< (length 
           (setq result 
                  (append padding result) 
           ) 
         ) 
         len 
      ) 
    ) 
    (substr 
      (vl-list->string result) 
      (1+ (- (length result) len)) 
    ) 
  ) 
  ;;=================================================================   
  ;;   
  ;;  (_ToString x)   
  ;;   
  ;;=================================================================   
  (defun _ToString (x / result) 
    (if 
      (< (strlen 
           (setq result 
                  (vl-prin1-to-string x) 
           ) 
         ) 
         40 
      ) 
       result 
       (strcat (substr result 1 36) "..." (chr 41)) 
    ) 
  ) 
  ;;=================================================================   
  ;;   
  ;;  (_Eval statement iterations)   
  ;;   
  ;;=================================================================   
  (defun _Eval (statement iterations / start) 
    (gc) 
    (setq start (getvar "millisecs")) 
    (repeat iterations (eval statement)) 
    (- (getvar "millisecs") start) 
 
  ) 
  ;;=================================================================   
  ;;   
  ;;  (_Princ x)   
  ;;   
  ;;=================================================================   
  (defun _Princ        (x) 
    (princ x) 
    (princ) 
    ;; forces screen update   
  ) 
  ;;=================================================================   
  ;;   
  ;;  (_Main statements)   
  ;;   
  ;;=================================================================   
  (defun _Main 
               (statements /              boundary         iterations timings 
                slowest           fastest    lsetLen         rsetLen    index 
                count 
               ) 
 
    (setq 
      boundary 1000 
      iterations 
       1 
    ) 
    (_Princ "Benchmarking ...") 
    (while 
      (or 
        (< (apply 'max 
                  (setq        timings 
                         (mapcar 
                           '(lambda (statement) 
                             (_Eval statement iterations) 
                           ) 
                           statements 
                         ) 
                  ) 
           ) 
           boundary 
        ) 
        (< (apply 'min timings) 
           boundary 
        ) 
      ) 
       (setq iterations 
              (* 2 iterations) 
       ) 
       (_Princ ".") 
    ) 
    (_Princ 
      (strcat 
        "\rElapsed milliseconds / relative speed for " 
        (itoa iterations) 
        " iteration(s):\n\n" 
      ) 
    ) 
    (setq 
      slowest (float (apply 'max timings)) 
      fastest (apply 'min timings) 
    ) 
    (setq lsetLen 
           (+ 5 
              (apply 'max 
                     (mapcar 'strlen 
                             (setq statements 
                                    (mapcar '_ToString 
                                            statements 
                                    ) 
                             ) 
                     ) 
              ) 
           ) 
    ) 
    (setq rsetLen 
           (apply 'max 
                  (mapcar 
                    ' 
                    (lambda (ms) (strlen (itoa ms))) 
                    timings 
                  ) 
           ) 
    ) 
    (setq 
      index 0 
      count (length statements) 
    ) 
    (foreach pair 
             (vl-sort 
                    (mapcar 'cons statements timings) 
                    ' 
                    (lambda (a b) (< (cdr a) (cdr b))) 
                  ) 
      ((lambda (pair / ms) 
         (_Princ 
           (strcat 
             "    " 
             (_LSet (car pair) lsetLen ".") 
             (_RSet 
               (itoa (setq ms (cdr pair))) 
               rsetLen 
               "." 
             ) 
             " / " 
             (rtos (/ slowest ms) 2 2) 
             (cond 
               ((eq 1 (setq index (1+ index))) " <fastest>") 
               ((eq index count) " <slowest>") 
               ("") 
             ) 
             "\n" 
           ) 
         ) 
       ) 
        pair 
      ) 
    ) 
    (princ) 
  ) 
  ;;=================================================================   
  ;;   
  ;;  Program is defined, let's rock and roll ...   
  ;;   
  ;;=================================================================   
  (_Main statements) 
)

taner · 发表于 2008-6-12 13:12:37

Benchmark,测试结果与里面的表达式排序有关!不同排序会有不同测试结果.
上面的确实是最慢的!

cbetcbet · 发表于 2009-1-2 15:26:54

试一下,正在学习中.

lukern · 发表于 2009-5-15 14:40:41

都是高手,慢慢学习中

yxpxa · 发表于 2013-5-28 17:40:17

正需要啊，感谢！
我也测试一下。

账号		自动登录	找回密码
密码			立即注册

[研讨] 三种等分表的函数效率测试

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子