Topic: -={ Challenge }=- SubStr for Lists

[CAB]

Another late entry from 2005.

http://www.theswamp.org/index.php?topic=7269.0

[CAB]

David remember this one:

Code: [Select]

;;  http://cadtutor.net/forum/showpost.php?p=218577&postcount=9
(defun sublst (l s n / tmp)
   (repeat n (setq tmp (cons (nth s l) tmp))
             (setq s (1+ s)))
   (reverse tmp))

[Lee Mac]

David remember this one:

Code: [Select]

;;  http://cadtutor.net/forum/showpost.php?p=218577&postcount=9
(defun sublst (l s n / tmp)
   (repeat n (setq tmp (cons (nth s l) tmp))
             (setq s (1+ s)))
   (reverse tmp))

Wow - that takes me back 

[David Bethel]

CAB! Good Memory!

David remember this one:

Code: [Select]

;;  http://cadtutor.net/forum/showpost.php?p=218577&postcount=9
(defun sublst (l s n / tmp)
   (repeat n (setq tmp (cons (nth s l) tmp))
             (setq s (1+ s)))
   (reverse tmp))

I actually found that 1 in one of my library macros files when I was replying here.  It just didn't quite meet the OP needs.  -David

[chlh_jd]

Hi All  
here's faster one , it's main frame like TW:sublist , just use while loops replace repeat .

Code: [Select]

(defun ss-sublist (lst i n / len r)
  (setq len (length lst)
n (if n (min (+ i n) len) len))
  (while (> n i)
    (setq r (cons (nth (setq n (1- n)) lst) r))
    )
)
when the list len=30 , (ss-sublist testlist  9 13)
_$
函数:TW:SUBLIST运行100000次测试结果00:00:02:219函数:SS-SUBLIST运行100000次测试结果00:00:01:796when the list len=10000, (ss-sublist testlist 9 13)
_$
函数:TW:SUBLIST运行10次测试结果00:00:03:688函数:SS-SUBLIST运行10次测试结果00:00:03:671
the testlist producted by this fun

Code: [Select]

(setq i 0
      TestList '()
)
(repeat 10000
  (setq TestList (cons i TestList)
        i        (1+ i)
  )
)


my test way

Code: [Select]

(progn
  (gc)
  (times 10
'sublist
(list testlist
      20
      9980
)
  )
  (gc)
  (times 10
'ss-sublist
(list testlist
      20
      9980
)
  )
  (gc)
)
(defun times (ti funname funarglist / t1 t2)
  (setq t1 (getvar "date"))
  (repeat ti
    (vl-catch-all-apply
      funname
      funarglist
    )
  )
  (setq t2 (getvar "date"))
  (princ "函数:")
  (princ funname)
  (princ (strcat "运行" (rtos ti 2 0) "次" ))
  (princ "测试结果")
  (princ (menucmd (strcat "M=$(edtime,"
 (rtos (- t2 t1) 2 16)
 ",HH:MM:SS:MSEC)"
 )
)
  )
)[/s]

[chlh_jd]

it's wrong test for me , sorry to all .
 

[chlh_jd]

this one will fasterSee

Something simple ( like me )

Code: [Select]

(defun db:subl (l s e / i tmp)
  (setq i (1- s))
  (or e (setq e (length l)))
  (while (and (nth i l)
              (< i (+ s e -1)))
         (setq tmp (cons (nth i l) tmp)
                 i (1+ i)))
  (reverse tmp))
-David

Code: [Select]

(defun sublist (l s n / tmp)
 (setq n (+ s n))
 (while (<= s n)
  (setq tmp (cons (nth s l) tmp))
  (setq s (1+ s))
 )
 (reverse tmp)
)

[Lee Mac]

Code: [Select]

_$ (sublist '(0 1 2 3 4 5) 2 nil)
; error: bad argument type: numberp: nil
 

[kraz]

Wow~ It's very nice Kerry's BenchMarking tool 
Here is my poor code. it will be very slow...
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun KZ:SubList(lst stnum len / nlst c )
;----------------------------------------------------------------------------------------
;(KZ:SubList '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) 5 -3)
;(6 5 4)
;(KZ:SubList '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) 5 3)
;(6 7
;----------------------------------------------------------------------------------------
  (setq nlst '() c 0)
  (if (> stnum -1)
    (progn
    (if (not len) (setq len (length lst)))
    (while (and (> (abs len) c) (< stnum (length lst)))
      (setq nlst (append nlst (list (nth stnum lst))))
      (if (> len 0)
         (setq stnum (1+ stnum))
         (setq stnum (1- stnum))
      )
      (if (>= stnum 0)
         (setq c (1+ c))
         (setq c (+ c (abs len)))
      )
    );while
   )
  );if
  nlst
)

[chlh_jd]

Code: [Select]

_$ (sublist '(0 1 2 3 4 5) 2 nil)
; error: bad argument type: numberp: nil

Hi , Lee
This will do

Code: [Select]

(defun sublist (l s n / tmp)
  (setq n (if (not n)
    (length l)
    (1- (+ s n))
  )
  )
  (while (<= s n)
    (setq tmp (cons (nth s l) tmp))
    (setq s (1+ s))
  )
  (reverse tmp)
)


Ahhhh That's another story
(setq i 0
      TestList '()
)
(repeat 10000
  (setq TestList (cons i TestList)
        i        (1+ i)
  )
)


Benchmarking [M.P. 2005] ........Elapsed milliseconds for 32 iteration(s)/ relative Timing :
    ...
    (AT:SUBLIST TESTLIST 4000 4000)...........156 / 1.6596
    (TW:SUBLIST TESTLIST 4000 4000)...........140 / 1.4894
    (VK_GETSUBLIST51 TESTLIST 4000 4000)......125 / 1.3298
    (EE:F2 TESTLIST 4000 4000).................94 / 1.0000 <fastest>

Benchmarking [M.P. 2005] ........Elapsed milliseconds for 32 iteration(s)/ relative Timing :
    ...
    (VK_GETSUBLIST51 TESTLIST 20 9980).......109 / 1.0000
    (LM:SUBLIST3 TESTLIST 20 9980)...........109 / 1.0000
    (AT:SUBLIST TESTLIST 20 9980)............109 / 1.0000
    (TW:SUBLIST TESTLIST 20 9980)............109 / 1.0000 <fastest>
 

Did this need add the case (funname Testlist 20 5000) to Test ?

[chlh_jd]

in the following long list perhaps change the result ?

Code: [Select]

(setq i 1
      TestList '()
)
(repeat 10000 
  (setq TestList (cons (list i (1+ i) (+ i 2)) TestList)
        i        (+ i 3)
  )
)
Test fun

Code: [Select]

(defun ss-test (ti funlist / t1 t2 tilst ilst i)
  ;;时间测试函数,funlist 格式为 ((test1 arg) (test2 arg) (test3 arg))
  ;;GSLS(SS) 2011-5-21
  (foreach funname funlist
    (gc)
    (setq t1 (getvar "DATE")
  t1 (* 86400000.0 (- t1 (fix t1))))
    (repeat ti
      (vl-catch-all-apply
(car funname)
(cdr funname)
      )
    )
    (setq t2 (getvar "DATE")
  t2 (* 86400000.0 (- t2 (fix t2)))
  tilst (append tilst (list(* 1. (- t2 t1))))
  t1 nil
  t2 nil)
  )
  (setq ilst (vl-sort-i tilst (function <)))
  (princ (strcat "\n测试耗时......毫秒 / 相对速度 ...... 迭代次数" (rtos ti 2 0) "...:"))
  (foreach i ilst
    (princ (strcat "\n "
   (vl-prin1-to-string
     (car (nth i funlist))
     )
     "......"      
     (rtos (nth i tilst) 2 0)
     " / "
     (rtos (/ (nth (last ilst) tilst) (nth i tilst)) 2 2)
     "......"
   (cond ((= i (car ilst)) "<Fastest>")
((= i (last ilst)) "<Slowest>")
(t ""))
   )
   )
    ) 
  (princ)
)
(ss-test 100000 '((AT:SubList TestList 20 5000) (LM:SubList TestList 20 5000) (LM:SubList3 TestList 20 5000) (vk_GetSubList51 TestList 20 5000) (TW:SubList TestList 20 5000)
(TW:SubList2 TestList 20 5000) (TW:SubList3 TestList 20 5000) (gc:SubList TestList 20 5000) (gc:SubLst TestList 20 5000) (ee:f TestList 20 5000)
(ee:f1 TestList 20 5000) (ee:f2 TestList 20 5000)))
Tested in CPU:Core-i7 , Member:4G, System:32bits Win7 , Compiled: No , ACADversion : 2010

Consumed time...............ms / rv ................ repeat times 100000...:

 GC:SUBLIST...............1046 / 1.77......<Fastest>
 LM:SUBLIST...............1061 / 1.75......
 EE:F..........................1077 / 1.72......
 GC:SUBLST................1107 / 1.68......
 TW:SUBLIST..............1216 / 1.53......
 AT:SUBLIST...............1232 / 1.51......
 TW:SUBLIST3.............1233 / 1.51......
 EE:F2........................1248 / 1.49......
 LM:SUBLIST3.............1310 / 1.42......
 EE:F1........................1544 / 1.20......
 VK_GETSUBLIST51......1669 / 1.11......
 TW:SUBLIST2.............1856 / 1.00......<Slowest>

Code: [Select]

(ss-test 100000 '((AT:SubList TestList 20 9980) (LM:SubList TestList 20 9980) (LM:SubList3 TestList 20 9980) (vk_GetSubList51 TestList 20 9980) (TW:SubList TestList 20 9980)
(TW:SubList2 TestList 20 9980) (TW:SubList3 TestList 20 9980) (gc:SubList TestList 20 9980) (gc:SubLst TestList 20 9980) (ee:f TestList 20 9980)
(ee:f1 TestList 20 9980) (ee:f2 TestList 20 9980) (ss:sublist TestList 20 9980)))
测试耗时......................毫秒 / 相对速度 ...... 迭代次数100000...:
 GC:SUBLIST..............1045 / 1.79......<Fastest>
 LM:SUBLIST..............1061 / 1.76......
 EE:F.........................1092 / 1.71......
 GC:SUBLST...............1092 / 1.71......
 SS:SUBLIST..............1217 / 1.54......
 AT:SUBLIST..............1232 / 1.52......
 TW:SUBLIST3............1233 / 1.52......
 TW:SUBLIST..............1233 / 1.52......
 EE:F2........................1264 / 1.48......
 LM:SUBLIST3.............1326 / 1.41......
 EE:F1........................1529 / 1.22......
 VK_GETSUBLIST51......1670 / 1.12......
 TW:SUBLIST2.............1872 / 1.00......<Slowest>

Code: [Select]

(ss-test 100000 '((AT:SubList TestList 4000 4000) (LM:SubList TestList 4000 4000) (LM:SubList3 TestList 4000 4000) (vk_GetSubList51 TestList 4000 4000) (TW:SubList TestList 4000 4000)
(TW:SubList2 TestList 4000 4000) (TW:SubList3 TestList 4000 4000) (gc:SubList TestList 4000 4000) (gc:SubLst TestList 4000 4000) (ee:f TestList 4000 4000)
(ee:f1 TestList 4000 4000) (ee:f2 TestList 4000 4000) (ss:sublist TestList 4000 4000)))
测试耗时.......................毫秒 / 相对速度 ...... 迭代次数100000...:
 GC:SUBLIST...............1045 / 1.81......<Fastest>
 LM:SUBLIST...............1061 / 1.78......
 EE:F..........................1076 / 1.75......
 GC:SUBLST................1093 / 1.73......
 SS:SUBLIST................1201 / 1.57......
 TW:SUBLIST3.............1233 / 1.53......
 TW:SUBLIST...............1233 / 1.53......
 AT:SUBLIST................1242 / 1.52......
 EE:F2.........................1248 / 1.51......
 LM:SUBLIST3..............1326 / 1.42......
 EE:F1.........................1544 / 1.22......
 VK_GETSUBLIST51......1669 / 1.13......
 TW:SUBLIST2.............1887 / 1.00......<Slowest>