【挑战】获取子表

newer · 发表于 2017-6-8 22:19:29

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

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

×

(SubList <list> <start> [<length>])

例子：

(SubList '(0 1 2 3 4 5) 2 3)
>> (2 3 4)

(SubList '(0 1 2 3 4 5) 2 nil)
>> (2 3 4 5)

(SubList '(0 1 2 3 4 5) 6 3)
>> nil

提供一个：

(defun sublist1 (lst start leng / n r)
(if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
)
(setq n (+ start leng))
(while (< start n)
(setq r (cons (nth (setq n (1- n)) lst) r))
)
)

iLisp · 发表于 2017-6-9 02:10:58

本帖最后由 iLisp 于 2017-6-9 02:21 编辑

(defun sublist2 (lst pos len / _f l j k r)
(defun _f (lst j pos k / r)
(vl-catch-all-apply
(function (lambda nil
(mapcar (function (lambda (x)
(cond ((< j pos) (setq j (1+ j)))
((<= pos j k)
(setq r (cons x r)
j (1+ j)
)
)
(t (exit))
)
)
)
lst
)
)
)
)
r
)
(setq l (length lst)
j 0
)
(if (null len)
(cond
((> pos l) nil)
((< pos (/ l 2))
(while (< j pos)
(setq lst (cdr lst) j (1+ j))
)
lst
)
(t
(setq pos (- l pos)
lst (reverse lst)
)
(while (< j pos)
(setq r (cons (car lst) r) lst (cdr lst) j (1+ j))
)
r
)
)
(cond
((> pos l) nil)
((< pos (/ l 2))
(reverse (_f lst j pos (1- (+ pos len))))
)
(t
(setq pos (- l pos len)
k (1- (+ pos len))
)
(if (minusp pos)
(setq k (1- (+ pos len))
pos 0
)
)
(_f (reverse lst) j pos k)
)
)
)
)

(defun sublist2        (lst pos len / _f l j k r) 
  (defun _f (lst j pos k / r) 
    (vl-catch-all-apply 
      (function        (lambda        nil 
                  (mapcar (function (lambda (x) 
                                      (cond ((< j pos) (setq j (1+ j))) 
                                            ((<= pos j k) 
                                             (setq r (cons x r) 
                                                   j (1+ j) 
                                             ) 
                                            ) 
                                            (t (exit)) 
                                      ) 
                                    ) 
                          ) 
                          lst 
                  ) 
                ) 
      ) 
 
    ) 
    r 
  ) 
  (setq        l (length lst) 
        j 0 
  ) 
  (if (null len) 
    (cond 
      ((> pos l) nil) 
      ((< pos (/ l 2)) 
       (while (< j pos) 
         (setq lst (cdr lst) j (1+ j)) 
       ) 
       lst 
      ) 
      (t 
       (setq pos (- l pos) 
             lst (reverse lst) 
       ) 
       (while (< j pos) 
         (setq r (cons (car lst) r) lst (cdr lst) j (1+ j)) 
       ) 
       r 
      ) 
    ) 
    (cond 
      ((> pos l) nil) 
      ((< pos (/ l 2)) 
       (reverse (_f lst j pos (1- (+ pos len)))) 
      ) 
      (t 
       (setq pos (- l pos len) 
             k         (1- (+ pos len)) 
       ) 
       (if (minusp pos) 
         (setq k   (1- (+ pos len)) 
               pos 0 
         ) 
       ) 
       (_f (reverse lst) j pos k) 
      ) 
    ) 
  ) 
)

xinxirong · 发表于 2017-6-9 07:16:55

是要看谁的效率高吗？

newer · 发表于 2017-6-9 07:49:09

xinxirong 发表于 2017-6-9 07:16

1、看看各种代码的写法
2、看看谁效率高

/db_自贡黄明儒_ · 发表于 2017-6-9 08:08:36

newer 发表于 2017-6-9 07:49

这段代码您早些时候已经写过了哇，我也只在看见他们破解vlx代码中用了这个程序。

xinxirong · 发表于 2017-6-9 08:33:33

/db_自贡黄明儒_ 发表于 2017-6-9 08:08

那段代码效率奇低，几百k的fas要1个小时，最大的瓶颈就是subList了。改用arx快多了。

st788796 · 发表于 2017-6-9 08:35:47

本帖最后由 st788796 于 2017-6-9 09:09 编辑

(defun sublist3 (lst start leng / fs f len end j r)
(defun fs (lst start /)
(repeat (1+ start)
(setq lst (cdr lst))
)
lst
)
(defun f (lst n / r)
(repeat n
(setq r (cons (car lst) r)
lst (cdr lst)
)
)
r
)
(setq len (length lst))
(if (or (null leng) (> (setq end (+ start leng)) len))
(cond
((zerop start) lst)
((< start (/ len 2)) (setq lst (fs lst start)))
(t (setq lst (f (reverse lst) (- len start))))
)
(if (< start (/ len 2))
(if (> end (/ len 2))
(setq lst (fs lst start)
lst (f lst (- len end))
lst (reverse lst)
)
(setq lst (fs lst start)
lst (f lst leng)
)
)
(setq lst (fs (reverse lst) (- len end))
lst (f lst leng)
)
)
)
lst
)

(defun sublist3        (lst start leng / fs f len end j r) 
  (defun fs (lst start /) 
    (repeat (1+ start) 
      (setq lst (cdr lst)) 
    ) 
    lst 
  ) 
  (defun f (lst n / r) 
    (repeat n 
      (setq r        (cons (car lst) r) 
            lst        (cdr lst) 
      ) 
    ) 
    r 
  ) 
  (setq len (length lst)) 
  (if (or (null leng) (> (setq end (+ start leng)) len)) 
    (cond 
      ((zerop start) lst) 
      ((< start (/ len 2)) (setq lst (fs lst start))) 
      (t (setq lst (f (reverse lst) (- len start)))) 
    ) 
    (if        (< start (/ len 2)) 
      (if (> end (/ len 2)) 
        (setq lst (fs lst start) 
              lst (f lst (- len end)) 
              lst (reverse lst) 
        ) 
        (setq lst (fs lst start) 
              lst (f lst leng) 
        ) 
      ) 
      (setq lst        (fs (reverse lst) (- len end)) 
            lst        (f lst leng) 
      ) 
    ) 
  ) 
  lst 
)

且听风吟09 · 发表于 2017-6-9 11:04:56

本帖最后由且听风吟09 于 2017-6-9 11:07 编辑

[Actionscript3] 纯文本查看 复制代码

(defun kaka-list-Sub (lst start len / sublst)
  (and (null len) (setq len (length lst)))
  (while (> start 0)
    (setq lst        (cdr lst)
          start        (1- start)
    )
  )
  (while (and lst (> len 0))
    (setq sublst (cons (car lst) sublst)
          lst         (cdr lst)
          len         (1- len)
    )
  )
  (reverse sublst)
)

wowan1314 · 发表于 2017-6-9 11:18:49

(defun t11 (lst n m / l a lst1)
(setq a -1 l (length lst) m (1- (+ (if m m l) n)))
(vl-member-if
 '(lambda(x)
 (if (<= n (setq a (1+ a)) m)
 (setq lst1 (cons x lst1) )
 )
 (if (> a m) t)
 )
 lst
)
(reverse lst1)
)

newer · 发表于 2017-6-9 11:37:47

wowan1314 发表于 2017-6-9 11:18

长度20000的表，测试结果

(defun c:tt (/ lst)
(setq i 0)
(repeat 20000
(setq lst (cons i lst)
i (1+ i)
)
)
(setq lst (reverse lst))
(xd::quickbench
'(
(sublist1 lst 3000 9000)
(sublist2 lst 3000 9000)
(sublist3 lst 3000 9000)
(kaka-list-Sub lst 3000 9000)
(t11 lst 3000 9000)
)
)
(princ)
)

marting · 发表于 2017-6-9 11:46:53

(defun sublist4 (lst start len / lst1)
(setq leng (length lst))
(cond
((and (= start 0)
(>= len leng)
)
lst
)
((< start (1- leng))
(repeat start
(setq lst (cdr lst))
)
(if (numberp len)
(progn
(setq len (abs len)
i 0
)
(while (and (car lst) (< i len))
(setq lst1 (cons (car lst) lst1)
lst (cdr lst)
i (1+ i)
)
)
(setq lst (reverse lst1))
)
)
)
)
lst
)

newer · 发表于 2017-6-9 11:54:03

marting 发表于 2017-6-9 11:46

(defun c:tt (/ lst)
(setq i 0)
(repeat 20000
(setq lst (cons i lst)
i (1+ i)
)
)
(setq lst (reverse lst))
(setq aa lst)
(xd::quickbench
'(
(sublist1 lst 3000 9000)
(sublist2 lst 3000 9000)
(sublist3 lst 3000 9000)
(sublist4 lst 3000 9000)
(kaka-list-Sub lst 3000 9000)
(t11 lst 3000 9000)
)
)
(princ)
)

Lisphk · 发表于 2017-6-9 12:04:14

(defun HK:SubList ( lst st len / tempList )
(repeat st
(setq lst (cdr lst))
)
(if
(or
(not lst)
(not len)
(zerop len)
)
lst
(progn
(repeat len
(setq tempList (cons (car lst) tempList))
(setq lst (cdr lst))
)
(reverse tempList)
)
)
)

/db_自贡黄明儒_ · 发表于 2017-6-9 12:05:30

;;(SubList5 '(0 1 2 3 4 5) 2 3) => (2 3 4)
(defun sublist5 (lst start leng / L)
(repeat start
(setq lst (cdr lst))
)
(repeat leng
(setq L (cons (car lst) L))
(setq lst (cdr lst))
)
(reverse L)
)

newer · 发表于 2017-6-9 12:10:03

/db_自贡黄明儒_ 发表于 2017-6-9 12:05

缺一个 len = nil时候返回之后所有的部分，修改下吧。

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

[有奖答题] 【挑战】获取子表

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

评分

评分

评分

评分

评分