移除列表的第n项,看看有多少条路！

taner · 发表于 2008-12-24 08:47:13

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

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

×

大部份来自theswamp,大家玩个接龙！

(defun removenth1 (ind lst)
(if (or
(zerop ind)
(null lst)
)
(cdr lst)
(cons (car lst) (removenth1 (1- ind) (cdr lst)))
)
)
(defun removenth2 (index lst / c)
(setq c -1)
(apply
'append
(mapcar
'(lambda (x)
(if (/= (setq c (1+ c))
index
)
(list x)
)
)
lst
)
)
)
(defun removenth3 (n lst / j)
(setq j -1)
(vl-remove-if '(lambda (x)
(= n (setq j (1+ j)))
) lst
)
)
(defun removenth4 (n lst / len foo i)
(defun foo (x)
(if (eq n (setq i (1+ i)))
(defun foo (x)
nil
)
)
)
(cond
((zerop n)
(cdr lst)
)
((eq n (1- (setq len (length lst))))
(reverse (cdr (reverse lst)))
)
((< (setq i -1)
n len
)
(vl-remove-if 'foo lst)
)
(lst)
)
)
(defun removenth5 (idx lst / nlst cnt)
(setq cnt 0)
(foreach elem lst
(if (/= cnt idx)
(setq nlst (cons elem nlst))
)
(setq cnt (1+ cnt))
)
(reverse nlst)
)
(defun removenth6 (n lst / lngth newlst)
(setq lngth -1)
(repeat (length lst)
(setq lngth (+ lngth 1))
(if (not (= lngth n))
(setq newlst (append
newlst
(list (nth lngth lst))
)
)
)
)
newlst
)
(defun removenth7 (n l / a)
(while (and
l
(> n 0)
)
(setq a (cons (car l) a)
l (cdr l)
n (1- n)
)
)
(append
(reverse a)
(cdr l)
)
)
(defun removenth8 (ndx lst / count newlist)
(setq count 0)
(repeat (length lst)
(if (/= count ndx)
(setq newlist (append
newlist
(list (car lst))
)
)
)
(setq lst (cdr lst)
count (1+ count)
)
)
newlist
)
(defun removenth9 (i lst / tmp)
(if (and
i
(vl-consp lst)
(not (minusp i))
)
(progn
(repeat (min
i
(length lst)
)
(setq tmp (cons (car lst) tmp)
lst (cdr lst)
)
)
(append
(reverse tmp)
(cdr lst)
)
)
lst
)
)
(defun removenth10 (ndx lst)
(append
(reverse (cdr (member (nth ndx lst) (reverse lst))))
(cdr (member (nth ndx lst) lst))
)
)
(defun removenth11 (i lst / a b)
(cond
((> i (length lst))
lst
)
((setq a lst
b (reverse lst)
)
(append
(reverse (repeat (- (length b) i)
(setq b (cdr b))
)
)
(repeat (1+ i)
(setq a (cdr a))
)
)
)
)
)
(defun removenth12 (e l)
(apply
'append
(subst
nil
(list (nth e l))
(mapcar
'list
l
)
)
)
)

(defun removenth1 (ind lst) 
  (if (or 
        (zerop ind) 
        (null lst) 
      ) 
    (cdr lst) 
    (cons (car lst) (removenth1 (1- ind) (cdr lst))) 
  ) 
) 
(defun removenth2 (index lst / c) 
  (setq c -1) 
  (apply 
    'append 
    (mapcar 
      '(lambda (x) 
         (if (/= (setq c (1+ c)) 
                 index 
             ) 
           (list x) 
         ) 
       ) 
      lst 
    ) 
  ) 
) 
(defun removenth3 (n lst / j) 
  (setq j -1) 
  (vl-remove-if '(lambda (x) 
                   (= n (setq j (1+ j))) 
                 ) lst 
  ) 
) 
(defun removenth4 (n lst / len foo i) 
  (defun foo (x) 
    (if (eq n (setq i (1+ i))) 
      (defun foo (x) 
        nil 
      ) 
    ) 
  ) 
  (cond 
    ((zerop n) 
      (cdr lst) 
    ) 
    ((eq n (1- (setq len (length lst)))) 
      (reverse (cdr (reverse lst))) 
    ) 
    ((< (setq i -1) 
        n len 
     ) 
      (vl-remove-if 'foo lst) 
    ) 
    (lst) 
  ) 
) 
(defun removenth5 (idx lst / nlst cnt) 
  (setq cnt 0) 
  (foreach elem lst 
    (if (/= cnt idx) 
      (setq nlst (cons elem nlst)) 
    ) 
    (setq cnt (1+ cnt)) 
  ) 
  (reverse nlst) 
) 
(defun removenth6 (n lst / lngth newlst) 
  (setq lngth -1) 
  (repeat (length lst) 
    (setq lngth (+ lngth 1)) 
    (if (not (= lngth n)) 
      (setq newlst (append 
                     newlst 
                     (list (nth lngth lst)) 
                   ) 
      ) 
    ) 
  ) 
  newlst 
) 
(defun removenth7 (n l / a) 
  (while (and 
           l 
           (> n 0) 
         ) 
    (setq a (cons (car l) a) 
          l (cdr l) 
          n (1- n) 
    ) 
  ) 
  (append 
    (reverse a) 
    (cdr l) 
  ) 
) 
(defun removenth8 (ndx lst / count newlist) 
  (setq count 0) 
  (repeat (length lst) 
    (if (/= count ndx) 
      (setq newlist (append 
                      newlist 
                      (list (car lst)) 
                    ) 
      ) 
    ) 
    (setq lst (cdr lst) 
          count (1+ count) 
    ) 
  ) 
  newlist 
) 
(defun removenth9 (i lst / tmp) 
  (if (and 
        i 
        (vl-consp lst) 
        (not (minusp i)) 
      ) 
    (progn 
      (repeat (min 
                i 
                (length lst) 
              ) 
        (setq tmp (cons (car lst) tmp) 
              lst (cdr lst) 
        ) 
      ) 
      (append 
        (reverse tmp) 
        (cdr lst) 
      ) 
    ) 
    lst 
  ) 
) 
(defun removenth10 (ndx lst) 
  (append 
    (reverse (cdr (member (nth ndx lst) (reverse lst)))) 
    (cdr (member (nth ndx lst) lst)) 
  ) 
) 
(defun removenth11 (i lst / a b) 
  (cond 
    ((> i (length lst)) 
      lst 
    ) 
    ((setq a lst 
           b (reverse lst) 
     ) 
      (append 
        (reverse (repeat (- (length b) i) 
                   (setq b (cdr b)) 
                 ) 
        ) 
        (repeat (1+ i) 
          (setq a (cdr a)) 
        ) 
      ) 
    ) 
  ) 
) 
(defun removenth12 (e l) 
  (apply 
    'append 
    (subst 
      nil 
      (list (nth e l)) 
      (mapcar 
        'list 
        l 
      ) 
    ) 
  ) 
)

CADVL · 发表于 2008-12-24 20:07:17

移除第n项又如何写？

敏敏◆特穆尔 · 发表于 2008-12-24 20:14:01

最初由 taner 发布
[B]大部份来自theswamp,大家玩个接龙！

[CODE]

(defun removenth1 (ind lst)
  (if (or
(zerop ind)
(null lst)
   )
(cdr lst)
(cons (car lst) (removenth1 (1- ind) (... [/B]

咋接阿，该有的方法你那里都写了吧。

aeo · 发表于 2009-1-5 23:27:01

我肯定用removenth3

以前好像都是apply 'append list... nil ..

eachy · 发表于 2009-1-6 09:04:53

俺是这样写的

(defun ybl-lst-removenth (n lst / ll)
(repeat n
(setq ll (cons (car lst) ll)
lst (cdr lst)
)
)
(append (reverse ll) (cdr lst))
)

再扩展下

(defun ybl-lst-removenth (n lst / ll m)
(if (= (type n) 'INT)
(progn
(repeat n
(setq ll (cons (car lst) ll)
lst (cdr lst)
)
)
(append (reverse ll) (cdr lst))
)
(progn
(setq m -1)
(vl-remove "ea-nil"
(mapcar '(lambda (x)
(setq m (1+ m))
(if (member m n)
"ea-nil"
x
)
)
lst
)
)
)
)
)

taner · 发表于 2009-1-6 09:43:47

速度比较

_$ lst
(1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 8 9)
_$ (benchmark '((removenth1 10 lst) (removenth2 10 lst)
(removenth3 10 lst)
(removenth4 10 lst)
(removenth5 10 lst)
(removenth6 10 lst)
(removenth7 10 lst)
(removenth8 10 lst)
(removenth9 10 lst)
(removenth10 10 lst)
(removenth11 10 lst)
(removenth12 10 lst)
(ybl-lst-removenth 10 lst)
)
)
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):
(REMOVENTH1 10 LST)............1844 / 2.88 <fastest>
(REMOVENTH7 10 LST)............1969 / 2.7
(REMOVENTH5 10 LST)............2187 / 2.43
(REMOVENTH9 10 LST)............2234 / 2.38
(REMOVENTH4 10 LST)............2360 / 2.25
(YBL-LST-REMOVENTH 10 LST).....2969 / 1.79
(REMOVENTH2 10 LST)............3015 / 1.76
(REMOVENTH11 10 LST)...........3266 / 1.63
(REMOVENTH6 10 LST)............3859 / 1.38
(REMOVENTH10 10 LST)...........4219 / 1.26
(REMOVENTH8 10 LST)............4328 / 1.23
(REMOVENTH3 10 LST)............4750 / 1.12
(REMOVENTH12 10 LST)...........5312 / 1 <slowest>
_$
[/FONT]

复制代码

俺也扩展一个：

[FONT=courier new]
(defun th-remove-nlst (nlst lst / i)
(cond
((= (type nlst) 'int)
(setq i -1)
(vl-remove-if '(lambda (x)
(= nlst (setq i (1+ i)))
) lst
)
)
((= (type nlst) 'list)
(setq i -1)
(vl-remove-if '(lambda (x)
(vl-position (setq i (1+ i))
nlst
)
) lst
)
)
(t
lst
)
)
)
[/FONT]

测试速度：

[FONT=courier new]
_$ lst
(1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 8 9)
_$ (benchmark '((ybl-lst-removenth '(1 3 5 7 9) lst) (th-remove-nlst '
(1 3 5 7 9)
lst
)
)
)
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
(YBL-LST-REMOVENTH (QUOTE (1 3 5 7 9...).....1765 / 1.55 <fastest>
(TH-REMOVE-NLST (QUOTE (1 3 5 7 9)) ...).....2734 / 1 <slowest>
_$

复制代码

雄啸 · 发表于 2009-1-6 12:27:53

subst 是有缺陷的不能用，会替换掉值相同的项的

(removenth12 3 '(0 2 1 2 3 4))
-> (0 1 3 4)
正确的应该返回->(0 2 1 3 4)

taner · 发表于 2009-1-6 13:09:54

刀，你到底有几个户头？

雄啸 · 发表于 2009-1-7 13:15:32

是最近找回来的户头。
我的个人点评：
排除不完善的程序
removenth1，removenth10 ，ybl-lst-removenth
效率较高，构思也比较巧妙
这几个程序都用了一条：一找到目标，余下的部分就 cdr
因此效率比mapcar等要高，尤其是 n 是比较靠前的时候，优势更明显。

eachy · 发表于 2009-1-7 14:16:28

member 对有相同元素的表可能返回不正确

_$ (setq lst '(1 2 3 0 1 2 3 0 1 2 3))
(1 2 3 0 1 2 3 0 1 2 3)
_$ (nth 8 lst)
1
_$ (nth 7 lst)
0
_$ (member (nth 7 lst) lst)
(0 1 2 3 0 1 2 3)
_$

处于表的后半部，如果减少 repeat 次数就要用 Reverse 一次，不知道哪个更快

雄啸 · 发表于 2009-1-7 23:42:51

member效率不见得高（估计）
因为要做一些额外的处理，且member实际就是逐个判断的过程

gotosealiu · 发表于 2009-2-8 17:23:06

;函数内容：

(defun listdel (lst k / i lst2)
(if (= lst nil) ;IF 1
(exits "函数listdel中LST为空。 ")
(progn ;p1
(if (/= (type lst) 'LIST)
(exits "函数listdel中参数LST不是表。")
)
(if (/= (type k) 'INT)
(exits "函数listdel中参数LST不是整数。")
)
(setq len (length lst))
(if (< k 1)
(exits "函数listdel中参数K值小于1，应为大于等于1 。")
)
(if (> k len)
(exits "函数listdel中参数K值大于LST表长度。")
)
(setq i (- len 1))
(setq lst2 nil)
(while (>= i (- k 0))
(progn
(setq lst2 (cons (nth i lst) lst2))
(setq i (- i 1))
)
)
;;; (setq lst2 (cons ent lst2))
(setq i (- k 2))
(while (>= i 0)
(progn
(setq lst2 (cons (nth i lst) lst2))
(setq i (- i 1))
)
)
(setq lst2 lst2)
) ;end p1
) ;end if1
)
;end listdel

(defun listdel (lst k / i lst2) 
 
  (if (= lst nil) ;IF 1 
    (exits "函数listdel中LST为空。 ") 
    (progn ;p1 
      (if (/= (type lst) 'LIST) 
        (exits "函数listdel中参数LST不是表。") 
      ) 
      (if (/= (type k) 'INT) 
        (exits "函数listdel中参数LST不是整数。") 
      ) 
      (setq len (length lst)) 
      (if (< k 1) 
        (exits "函数listdel中参数K值小于1，应为大于等于1 。") 
      ) 
      (if (> k len) 
        (exits "函数listdel中参数K值大于LST表长度。") 
      ) 
 
 
      (setq i (- len 1)) 
      (setq lst2 nil) 
      (while (>= i (- k 0)) 
        (progn 
          (setq lst2 (cons (nth i lst) lst2)) 
          (setq i (- i 1)) 
        ) 
      ) 
;;;      (setq lst2 (cons ent lst2)) 
      (setq i (- k 2)) 
      (while (>= i 0) 
        (progn 
          (setq lst2 (cons (nth i lst) lst2)) 
          (setq i (- i 1)) 
        ) 
      ) 
      (setq lst2 lst2) 
    ) ;end p1 
  ) ;end if1 
) 
 ;end listdel

highflybird · 发表于 2009-2-25 00:55:13

(defun remove-n (n lst / a b)
(setq a lst)
(repeat n
(setq b (cons (car a) b))
(setq a (cdr a))
)
(setq a (cdr a))
(foreach i b
(setq a (cons i a))
)
a
)

很久没上这个网站了，我也来凑个热闹。
顺便说一句，只用改一句，这个函数就可以变成在n处插入一个元素。

(defun insert-n (n element lst / a b)
(setq a lst)
(repeat n
(setq b (cons (car a) b)
a (cdr a)
)
)
(setq a (cons element a))
(foreach i b
(setq a (cons i a))
)
a
)

taner · 发表于 2009-2-25 08:18:34

再加3個

(defun addnth1 (lst pos val / lst1 lst2 cnt nverts)
(setq cnt 0
lst1 '()
nverts (length lst)
)
(repeat pos
(setq lst1 (cons (nth cnt lst) lst1)
cnt (1+ cnt)
)
)
(setq lst1 (cons val lst1)
lst1 (reverse lst1)
cnt pos
)
(if (> nverts pos)
(progn
(setq lst2 '())
(repeat (- nverts pos)
(setq lst2 (cons (nth cnt lst) lst2)
cnt (1+ cnt)
)
)
(setq lst2 (reverse lst2)
lst1 (append
lst1
lst2
)
)
)
)
lst1
)
(defun addnth2 (lst pos new / lst2)
(setq pos (1+ pos))
(mapcar
'(lambda (x)
(if (zerop (setq pos (1- pos)))
(setq lst2 (cons new lst2)
lst2 (cons x lst2)
)
(setq lst2 (cons x lst2))
)
)
lst
)
(reverse lst2)
)
(defun addnth3 (lst pos new / n)
(setq n -1)
(apply
'append
(mapcar
(function (lambda (x)
(if (= (setq n (1+ n))
pos
)
(list new x)
(list x)
)
)
)
lst
)
)
)

(defun addnth1 (lst pos val / lst1 lst2 cnt nverts) 
  (setq cnt 0 
        lst1 '() 
        nverts (length lst) 
  ) 
  (repeat pos 
    (setq lst1 (cons (nth cnt lst) lst1) 
          cnt (1+ cnt) 
    ) 
  ) 
  (setq lst1 (cons val lst1) 
        lst1 (reverse lst1) 
        cnt pos 
  ) 
  (if (> nverts pos) 
    (progn 
      (setq lst2 '()) 
      (repeat (- nverts pos) 
        (setq lst2 (cons (nth cnt lst) lst2) 
              cnt (1+ cnt) 
        ) 
      ) 
      (setq lst2 (reverse lst2) 
            lst1 (append 
                   lst1 
                   lst2 
                 ) 
      ) 
    ) 
  ) 
  lst1 
) 
(defun addnth2 (lst pos new / lst2) 
  (setq pos (1+ pos)) 
  (mapcar 
    '(lambda (x) 
       (if (zerop (setq pos (1- pos))) 
         (setq lst2 (cons new lst2) 
               lst2 (cons x lst2) 
         ) 
         (setq lst2 (cons x lst2)) 
       ) 
     ) 
    lst 
  ) 
  (reverse lst2) 
) 
(defun addnth3 (lst pos new / n) 
  (setq n -1) 
  (apply 
    'append 
    (mapcar 
      (function (lambda (x) 
                  (if (= (setq n (1+ n)) 
                         pos 
                      ) 
                    (list new x) 
                    (list x) 
                  ) 
                ) 
      ) 
      lst 
    ) 
  ) 
)

將上面的改一下

(defun addnth4 (lst n element / a b)
(setq a lst)
(repeat n
(setq b (cons (car a) b)
a (cdr a)
)
)
(setq a (cons element a))
(foreach i b
(setq a (cons i a))
)
)
[/FONT]

測試

$ lst
(9 8 7 6 5 4 3 2 1 0)
_$ (benchmark '((addnth1 lst 5 "a") (addnth2 lst 5 "a")
(addnth3 lst 5 "a")
(addnth4 lst 5 "a")
)
)
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
(ADDNTH4 LST 5 "a").....1047 / 1.45 <fastest>
(ADDNTH1 LST 5 "a").....1125 / 1.35
(ADDNTH2 LST 5 "a").....1172 / 1.29
(ADDNTH3 LST 5 "a").....1516 / 1.00 <slowest>
_$

复制代码

yjch · 发表于 2013-6-12 13:46:27

大侠们太厉害了，值得学习

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

[群策群力] 移除列表的第n项,看看有多少条路！

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

评分

相关帖子

Re: [分享]：移除列表的第n项,看看有多少条路！

浏览过的版块