[LISP函数]：用ALISP重写VL-REMOVE等

taner

2. 
   
3.   [FONT=courier new]
   
4. ;;; ==================================================================
   
5. (defun txt-remove (x lst)
   
6.   (setq lst (txt-list-subtract lst (list x)))
   
7. )
   
8. ;;; ==================================================================
   
9. (defun th-remove-if (pred lst)
   
10.   (foreach x lst
    
11.     (if (apply
    
12.           pred
    
13.           (list x)
    
14.         )
    
15.       (setq lst (txt-list-subtract lst (list x)))
    
16.     )
    
17.   )
    
18.   lst
    
19. )
    
20. ;;; ==================================================================
    
21. (defun th-remove-if-not (pred lst)
    
22.   (foreach x lst
    
23.     (if (not (apply
    
24.                pred
    
25.                (list x)
    
26.              )
    
27.         )
    
28.       (setq lst (txt-list-subtract lst (list x)))
    
29.     )
    
30.   )
    
31.   lst
    
32. )
    
33. ;;; ==================================================================
    
34. ;;; 命令: (th-remove-if-not '(lambda(x)(> x 8)) lst)
    
35. ;;; (17 9)
    
36. ;;; 命令: (th-remove-if '(lambda(x)(> x 8)) lst)
    
37. ;;; (1 2 3 3 2 1 6 5 1 5 6 8 1 8 1 6 5 1 4 5 1)
    
38. ;;; 命令: (txt-remove 1 lst)
    
39. ;;; (2 3 3 2 6 5 5 6 17 8 9 8 6 5 4 5)
    
40. ;;; 命令: !lst
    
41. ;;; (1 2 3 3 2 1 6 5 1 5 6 17 8 1 9 8 1 6 5 1 4 5 1)
    
42. ;;; ==================================================================
    
43. (defun txt-list-subtract (lst1 lst2 / lst)
    
44.   (setq lst '())
    
45.   (if lst1
    
46.     (foreach tmp lst1
    
47.       (if (not (member tmp lst2))
    
48.         (setq lst (cons tmp lst))
    
49.       )
    
50.     )
    
51.   )
    
52.   (setq lst (reverse lst))
    
53.   lst
    
54. )
    
55. ;;; ==================================================================
    
56.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;; ==================================================================<br /> (defun txt-remove (x lst)<br />   (setq lst (txt-list-subtract lst (list x)))<br /> )<br /> ;;; ==================================================================<br /> (defun th-remove-if (pred lst)<br />   (foreach x lst<br />     (if (apply<br />           pred<br />           (list x)<br />         )<br />       (setq lst (txt-list-subtract lst (list x)))<br />     )<br />   )<br />   lst<br /> )<br /> ;;; ==================================================================<br /> (defun th-remove-if-not (pred lst)<br />   (foreach x lst<br />     (if (not (apply<br />                pred<br />                (list x)<br />              )<br />         )<br />       (setq lst (txt-list-subtract lst (list x)))<br />     )<br />   )<br />   lst<br /> )<br /> ;;; ==================================================================<br /> ;;; 命令: (th-remove-if-not '(lambda(x)(> x 8)) lst)<br /> ;;; (17 9)<br /> ;;; 命令: (th-remove-if '(lambda(x)(> x 8)) lst)<br /> ;;; (1 2 3 3 2 1 6 5 1 5 6 8 1 8 1 6 5 1 4 5 1)<br /> ;;; 命令: (txt-remove 1 lst)<br /> ;;; (2 3 3 2 6 5 5 6 17 8 9 8 6 5 4 5)<br /> ;;; 命令: !lst<br /> ;;; (1 2 3 3 2 1 6 5 1 5 6 17 8 1 9 8 1 6 5 1 4 5 1)<br /> ;;; ==================================================================<br /> (defun txt-list-subtract (lst1 lst2 / lst)<br />   (setq lst '())<br />   (if lst1<br />     (foreach tmp lst1<br />       (if (not (member tmp lst2))<br />         (setq lst (cons tmp lst))<br />       )<br />     )<br />   )<br />   (setq lst (reverse lst))<br />   lst<br /> )<br /> ;;; ==================================================================<br />   [/FONT]<br />

另外一种写法:

2. 
   
3.   [FONT=courier new]
   
4. ;;; ==================================================================
   
5. ;;; 命令: (th-remove-if '(lambda(x)(< x 5))lst)
   
6. ;;; (3 1 2 3 4 0 0 4 3 2 1 1 1)
   
7. ;;; 命令: (th-remove-if-not '(lambda(x)(< x 5))lst)
   
8. ;;; (12 5 6 7 8 9 9 8 7 6 5 5 6 6)
   
9. ;;; 命令: (th-remove 1 lst)
   
10. ;;; (12 3 2 3 4 5 6 7 8 9 0 0 9 8 7 6 5 4 3 2 5 6 6)
    
11. ;;; 命令: !lst
    
12. ;;; (12 3 1 2 3 4 5 6 7 8 9 0 0 9 8 7 6 5 4 3 2 1 1 1 5 6 6)
    
13. (defun th-remove (ele lst)
    
14.   (apply
    
15.     'append
    
16.     (mapcar
    
17.       (function (lambda (x)
    
18.                   (if (/= x ele)
    
19.                     (list x)
    
20.                   )
    
21.                 )
    
22.       )
    
23.       lst
    
24.     )
    
25.   )
    
26. )
    
27. (defun th-remove-if-not (pred lst)
    
28.   (apply
    
29.     'append
    
30.     (mapcar
    
31.       (function (lambda (x)
    
32.                   (if (apply
    
33.                         pred
    
34.                         (list x)
    
35.                       )
    
36.                     (list x)
    
37.                   )
    
38.                 )
    
39.       )
    
40.       lst
    
41.     )
    
42.   )
    
43. )
    
44. (defun th-remove-if(pred lst)
    
45.   (apply
    
46.     'append
    
47.     (mapcar
    
48.       (function (lambda (x)
    
49.                   (if (not (apply
    
50.                              pred
    
51.                              (list x)
    
52.                            )
    
53.                       )
    
54.                     (list x)
    
55.                   )
    
56.                 )
    
57.       )
    
58.       lst
    
59.     )
    
60.   )
    
61. )
    
62. ;;; ==================================================================
    
63. 
    
64.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;; ==================================================================<br /> ;;; 命令: (th-remove-if '(lambda(x)(< x 5))lst)<br /> ;;; (3 1 2 3 4 0 0 4 3 2 1 1 1)<br /> ;;; 命令: (th-remove-if-not '(lambda(x)(< x 5))lst)<br /> ;;; (12 5 6 7 8 9 9 8 7 6 5 5 6 6)<br /> ;;; 命令: (th-remove 1 lst)<br /> ;;; (12 3 2 3 4 5 6 7 8 9 0 0 9 8 7 6 5 4 3 2 5 6 6)<br /> ;;; 命令: !lst<br /> ;;; (12 3 1 2 3 4 5 6 7 8 9 0 0 9 8 7 6 5 4 3 2 1 1 1 5 6 6)<br /> (defun th-remove (ele lst)<br />   (apply<br />     'append<br />     (mapcar<br />       (function (lambda (x)<br />                   (if (/= x ele)<br />                     (list x)<br />                   )<br />                 )<br />       )<br />       lst<br />     )<br />   )<br /> )<br /> (defun th-remove-if-not (pred lst)<br />   (apply<br />     'append<br />     (mapcar<br />       (function (lambda (x)<br />                   (if (apply<br />                         pred<br />                         (list x)<br />                       )<br />                     (list x)<br />                   )<br />                 )<br />       )<br />       lst<br />     )<br />   )<br /> )<br /> (defun th-remove-if(pred lst)<br />   (apply<br />     'append<br />     (mapcar<br />       (function (lambda (x)<br />                   (if (not (apply<br />                              pred<br />                              (list x)<br />                            )<br />                       )<br />                     (list x)<br />                   )<br />                 )<br />       )<br />       lst<br />     )<br />   )<br /> )<br /> ;;; ==================================================================<br /> <br />   [/FONT]<br />

yjch

tanger 写得太好，学习