[原创]从列表中移去指定的元素（一个不留，支持任意嵌套表）

jxphklibin

从列表中移去指定的元素（一个不留，支持任意嵌套表）

2. ;;; ============================================================================;;
3. ;;; 函数名：         ;;
4. ;;; RemoveItem         ;;
5. ;;; 从列表中移去指定的元素（一个不留，支持任意嵌套表）    ;;
6. ;;; 参数：         ;;
7. ;;; 要从列表中移去的元素和一个列表      ;;
8. ;;; 示例：         ;;
9. ;;; (RemoveItem nil (list 121 nil (list "abc" nil "dde" nil 111) "aaa" nil 999));;
10. ;;; -> (121 ("abc" "dde" 111) "aaa" 999)     ;;
11. ;;; By 木子CAD工具 小李子  2009-3-30      ;;
12. ;;; ============================================================================;;
13. (defun RemoveItem (item lst / x tmplst)
14.   (foreach x (vl-remove item lst)
15.     (if (listp x)
16.       (setq tmplst (append (list (RemoveItem item x)) tmplst))
17.       (setq tmplst (append (list x) tmplst))
18.     )
19.   )
20.   (reverse tmplst)
21. )

;;; ============================================================================;; ;;; 函数名：         ;; ;;; RemoveItem         ;; ;;; 从列表中移去指定的元素（一个不留，支持任意嵌套表）    ;; ;;; 参数：         ;; ;;; 要从列表中移去的元素和一个列表      ;; ;;; 示例：         ;; ;;; (RemoveItem nil (list 121 nil (list "abc" nil "dde" nil 111) "aaa" nil 999));; ;;; -> (121 ("abc" "dde" 111) "aaa" 999)     ;; ;;; By 木子CAD<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a> 小李子  2009-3-30      ;; ;;; ============================================================================;; (defun RemoveItem (item lst / x tmplst)   (foreach x (vl-remove item lst)     (if (listp x)       (setq tmplst (append (list (RemoveItem item x)) tmplst))       (setq tmplst (append (list x) tmplst))     )   )   (reverse tmplst) )

还可以改为这样：

2. ;;; ============================================================================;;
3. ;;; 函数名：         ;;
4. ;;; RemoveItem         ;;
5. ;;; 从列表中移去指定的元素（一个不留，支持任意嵌套表）    ;;
6. ;;; 参数：         ;;
7. ;;; 要从列表中移去的元素和一个列表      ;;
8. ;;; 示例：         ;;
9. ;;; (RemoveItem nil (list 121 nil (list "abc" nil "dde" nil 111) "aaa" nil 999));;
10. ;;; -> (121 ("abc" "dde" 111) "aaa" 999)     ;;
11. ;;; By 木子CAD工具 小李子  2009-3-30      ;;
12. ;;; ============================================================================;;
13. (defun RemoveItem (item lst / x tmplst)
14.   (foreach x (vl-remove item lst)
15.     (if (listp x)
16.       (setq tmplst (cons (RemoveItem item x) tmplst))
17.       (setq tmplst (cons x tmplst))
18.     )
19.   )
20.   (reverse tmplst)
21. )

;;; ============================================================================;; ;;; 函数名：         ;; ;;; RemoveItem         ;; ;;; 从列表中移去指定的元素（一个不留，支持任意嵌套表）    ;; ;;; 参数：         ;; ;;; 要从列表中移去的元素和一个列表      ;; ;;; 示例：         ;; ;;; (RemoveItem nil (list 121 nil (list "abc" nil "dde" nil 111) "aaa" nil 999));; ;;; -> (121 ("abc" "dde" 111) "aaa" 999)     ;; ;;; By 木子CAD工具 小李子  2009-3-30      ;; ;;; ============================================================================;; (defun RemoveItem (item lst / x tmplst)   (foreach x (vl-remove item lst)     (if (listp x)       (setq tmplst (cons (RemoveItem item x) tmplst))       (setq tmplst (cons x tmplst))     )   )   (reverse tmplst) )

;|
(RemoveItem "" (list 121 "" (list "abc" "" "dde" "" 111) "aaa" "" 999 000))
-> (121 ("abc" "dde" 111) "aaa" 999 0)
(RemoveItem "" (list 121 "" (list "abc" "" "dde" "" 111) "aaa" "" 999 000
    (list 88 "" 9090 "" "" "AAA" "BBB" ""
          (list "ccc" "" "DDD" ""123)
    )
     )
)
-> (121 ("abc" "dde" 111) "aaa" 999 0 (88 9090 "AAA" "BBB" ("ccc" "DDD" 123)))
|;

dinosaurhxe

不错，支持一下！

caoyin

还可以这样

(defun RemoveItem (item lst)
  (mapcar '(lambda (x) (if (vl-consp x) (RemoveItem item x) x))
          (vl-remove item lst)
  )
)

jxphklibin

在这个函数中用 atom 、listp 和 vl-consp 有何区别？

2. (defun RemoveItem (item lst)
3.   (mapcar '(lambda (x) (if (listp x) (RemoveItem item x) x))
4.           (vl-remove item lst)
5.   )
6. )

(defun RemoveItem (item lst)   (mapcar '(lambda (x) (if (listp x) (RemoveItem item x) x))           (vl-remove item lst)   ) )

3. (defun RemoveItem (item lst)
4.   (mapcar '(lambda (x) (if (atom x) x (RemoveItem item x)))
5.           (vl-remove item lst)
6.   )
7. )

(defun RemoveItem (item lst)   (mapcar '(lambda (x) (if (atom x) x (RemoveItem item x)))           (vl-remove item lst)   ) )

caoyin

(vl-consp nil)-->nil

(listp nil)-->T

(vl-consp lst) = (and lst (listp lst))

(atom nil)-->T

(atom '(1 2))-->nil

用vl-consp，当参数为nil时省去了下一级的运算

atom 个人习惯，我一般用的比较少

jxphklibin

请教caoyin:

_$ (list 1245 "" "add" '(1 "" 2 nil "" 3 5 "" nil 6 "" 8 . 9))
(1245 "" "add" (1 "" 2 nil "" 3 5 "" nil 6 "" 8 . 9))
如何删除点对表中的 "" nil ？

单个点对表，以及潜逃在其他表中的点对表

_$ (removeitem "" (list 1245 "" "add" '(1 "" 2 nil "" 3 5 "" nil 6 "" 8 . 9)))
; 错误: 列表错误: 9

caoyin

点对是特殊的表，作你说的运算意义不大，如果一定要写出程序楼主应该写的出

(vl-list-length '(1 . 2))->nil

;;判断表 x 是否是点对表

(and (vl-consp x) (not (vl-list-length x)))

jxphklibin

Caoyin：

我已经试过了，问题的根源是出在 vl-remove 上，虽然这个条件 (and (vl-consp x) (not (vl-list-length x)))可以用，但是到了这里 (vl-remove item lst)
，就被杀掉了，我已经通过其他方法解决了这个难题，不能用 vl-remove这个函数了。caoyin 如果不相信，可以亲自试一下！

jxphklibin

下面是我的解决方法：有两种，但从速度比较上来看，第二种最好

3. ;; 速度非常慢，超级慢，支持嵌套表（任意），支持表中含有点对表
4. (defun nest-remove-if (fun lst / a )
5.     (cond
6.         ((apply fun (list lst)) nil)
7.         ((atom lst) lst)
8.         ((apply fun (list (setq a (car lst)))) (nest-remove-if fun (cdr lst)))
9.         ((cons (nest-remove-if fun a) (nest-remove-if fun (cdr lst))))
10.     )
11. )
12. ;; 速度快，比 nest-remove-if 快多了，支持嵌套表（任意），支持表中含有点对表
13. (defun RemoveItem (pattern mylist / string index newlist)
14.   (setq string (vl-prin1-to-string myList)
15. pattern (vl-prin1-to-string pattern)
16.   )
17.   (while (setq index (vl-string-search pattern string 0))
18.     (setq string (vl-string-subst "" pattern string))
19.   )
20.   (read string)
21.   ;;(setq NewList (read string))
22. )
25. ;; 测试效率
26. (defun c:test ( / lst t0)
27.   (setq lst (list 121 "" nil
28.     (list "abc" "" (list 777 888 '("aaa" 8888 nil "" 999 . 9) 999) "dde" "" 111)
29.     "aaa" "" 999 000
30.     (list 88 "" 9090 "" "" "AAA" "BBB" ""
31.    (list "ccc" "" "DDD" "" 123 '( 222 "" nil 333 . 66666))
32.     )
33.     "" 55555555 nil "TTTTTT" '(44444 nil 585858 "" . 6666) "PPPPPPPP" "" nil "" "fffff" "" nil ""
34.       )
35.   )
36.   
37.   (setq t0 (getvar "TDUSRTIMER"))
38.   (repeat 1000
39.     (nest-remove-if '(lambda (x) (member x '("" nil))) lst)
40.   )
41.   (princ "\n用时")
42.   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
43.   (princ "秒")
44.   
45.   (setq t0 (getvar "TDUSRTIMER"))
46.   (repeat 1000
47.     (RemoveItem "" lst)
48.     (RemoveItem nil lst)
49.     ;;(foreach x '("" nil) (setq lst (RemoveItem x lst)))
50.   )
51.   (princ "\n用时")
52.   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
53.   (princ "秒")
54.   
55.   (princ)
56. )

;; 速度非常慢，超级慢，支持嵌套表（任意），支持表中含有点对表 (defun nest-remove-if (fun lst / a )     (cond         ((apply fun (list lst)) nil)         ((atom lst) lst)         ((apply fun (list (setq a (car lst)))) (nest-remove-if fun (cdr lst)))         ((cons (nest-remove-if fun a) (nest-remove-if fun (cdr lst))))     ) ) ;; 速度快，比 nest-remove-if 快多了，支持嵌套表（任意），支持表中含有点对表 (defun RemoveItem (pattern mylist / string index newlist)   (setq string (vl-prin1-to-string myList) pattern (vl-prin1-to-string pattern)   )   (while (setq index (vl-string-search pattern string 0))     (setq string (vl-string-subst "" pattern string))   )   (read string)   ;;(setq NewList (read string)) ) ;; 测试效率 (defun c:test ( / lst t0)   (setq lst (list 121 "" nil     (list "abc" "" (list 777 888 '("aaa" 8888 nil "" 999 . 9) 999) "dde" "" 111)     "aaa" "" 999 000     (list 88 "" 9090 "" "" "AAA" "BBB" ""    (list "ccc" "" "DDD" "" 123 '( 222 "" nil 333 . 66666))     )     "" 55555555 nil "TTTTTT" '(44444 nil 585858 "" . 6666) "PPPPPPPP" "" nil "" "fffff" "" nil ""       )   )      (setq t0 (getvar "TDUSRTIMER"))   (repeat 1000     (nest-remove-if '(lambda (x) (member x '("" nil))) lst)   )   (princ "\n用时")   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))   (princ "秒")      (setq t0 (getvar "TDUSRTIMER"))   (repeat 1000     (RemoveItem "" lst)     (RemoveItem nil lst)     ;;(foreach x '("" nil) (setq lst (RemoveItem x lst)))   )   (princ "\n用时")   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))   (princ "秒")      (princ) )

;|
_$ (c:test)
用时8.375秒
用时0.344秒
_$ (c:test)
用时8.219秒
用时0.359秒
_$
|;

caoyin

提醒：用 vl-prin1-to-string 是不能处理包含REAL的LIST

(setq A pi)

(setq B (RemoveItem nil (list 1 nil A)))

(/= A (cadr B))--->T