[LISP函数]：嵌套表添加、删除

netbee

2. 
   
3. ;;;_添加至表中的第index项后
   
4. ;;index:'(0 5 3 1)表层
   
5. ;;new:表或项 '(1 2 3 "d")或"f"
   
6. ;;lst:可为多层表:'((a (()a()...)...)...)
   
7. (setq NBTV_AllFunsLIST (cons "NBTF_Lst_Addnth" NBTV_AllFunsLIST))
   
8. (DEFUN NBTF_Lst_Addnth (index new lst / n re olditem newitem leftlst rightlst fun_substlst fun_sublst)
   
9.   (defun fun_sublst (index_begin index_end lst / n re item)
   
10.     (setq n 0)
    
11.     (if (= -1 index_begin)
    
12.       ;;(setq index_begin (length lst))
    
13.       (setq index_begin 0)
    
14.     ) ;_ 结束if
    
15.     (if (= -2 index_end)
    
16.       (setq index_end (length lst))
    
17.     ) ;_ 结束if
    
18.     (foreach item lst
    
19.       (if (and (>= n index_begin) (<= n index_end))
    
20.         (setq re (append re (list item)))
    
21.       ) ;_ 结束if
    
22.       (setq n (1+ n))
    
23.     ) ;_ 结束foreach
    
24.     re
    
25.   ) ;_ 结束defun
    
26. 
    
27.   (defun fun_substlst (index lst / n olditem newitem)
    
28.     (setq n (car index))
    
29.     (if (setq olditem (nth n lst))
    
30.       (progn
    
31.         (if (and(cdr index)(listp olditem))
    
32.           (setq newitem (fun_substlst (cdr index) olditem)
    
33.                 lst     (subst newitem olditem lst)
    
34.           ) ;_ 结束setq
    
35.           (setq leftlst  (fun_sublst 0 (1- n) lst)
    
36.                 rightlst (fun_sublst n -2 lst)
    
37.                 lst      (append leftlst (list new) rightlst)
    
38.           ) ;_ 结束setq
    
39.         ) ;_ 结束if
    
40.       ) ;_ 结束progn
    
41.       (setq lst (append lst (list new)))
    
42.     ) ;_ 结束if
    
43.     lst
    
44.   ) ;_ 结束defun
    
45.   ;;---------------
    
46.   (setq n (car index))
    
47.   (if (setq olditem (nth n lst))
    
48.     (progn
    
49.       (if (and(cdr index)(listp olditem))
    
50.         (setq newitem (fun_substlst (cdr index) olditem)
    
51.               lst     (subst newitem olditem lst)
    
52.         ) ;_ 结束setq
    
53.         (setq leftlst  (fun_sublst 0 (1- n) lst)
    
54.               rightlst (fun_sublst n -2 lst)
    
55.               lst      (append leftlst (list new) rightlst)
    
56.         ) ;_ 结束setq
    
57.       ) ;_ 结束if
    
58.     ) ;_ 结束progn
    
59.     (setq lst (append lst (list new)))
    
60.   ) ;_ 结束if
    
61.   lst
    
62. ) ;_ 结束DEFUN
    
63. 
    
64. _$ (setq l1 '((6 8)5 6 ("a" "c"("第三层" "adf"))))
    
65. ((6 8) 5 6 ("a" "c" ("第三层" "adf")))
    
66. _$ (NBTF_Lst_Addnth '(0 1) "a" l1)
    
67. ((6 "a" 8) 5 6 ("a" "c" ("第三层" "adf")))
    
68. _$ (NBTF_Lst_Addnth '(0) "a" l1)
    
69. ("a" (6 8) 5 6 ("a" "c" ("第三层" "adf")))
    
70. _$ (NBTF_Lst_Addnth '(1) "a" l1)
    
71. ((6 8) "a" 5 6 ("a" "c" ("第三层" "adf")))
    
72. _$ (NBTF_Lst_Addnth '(3 2 1) "a" l1)
    
73. ((6 8) 5 6 ("a" "c" ("第三层" "a" "adf")))
    
74. _$
    
75. 
    
76. ;;;_删除表中的第index项
    
77. ;;index:'(0 5 3 1)表层
    
78. ;;new:表或项 '(1 2 3 "d")"
    
79. ;;lst:可为多层表:'((a (()a()...)...)...)
    
80. (setq NBTV_AllFunsLIST (cons "NBTF_Lst_Delnth" NBTV_AllFunsLIST))
    
81. (DEFUN NBTF_Lst_Delnth (index  lst / n re olditem newitem leftlst rightlst fun_substlst fun_sublst)
    
82.   (defun fun_sublst (index_begin index_end lst / n re item)
    
83.     (setq n 0)
    
84.     (if (= -1 index_begin)
    
85.       ;;(setq index_begin (length lst))
    
86.       (setq index_begin 0)
    
87.     ) ;_ 结束if
    
88.     (if (= -2 index_end)
    
89.       (setq index_end (length lst))
    
90.     ) ;_ 结束if
    
91.     (foreach item lst
    
92.       (if (and (>= n index_begin) (<= n index_end))
    
93.         (setq re (append re (list item)))
    
94.       ) ;_ 结束if
    
95.       (setq n (1+ n))
    
96.     ) ;_ 结束foreach
    
97.     re
    
98.   ) ;_ 结束defun
    
99.   (defun fun_substlst (index lst / n olditem newitem)
    
100.     (setq n (car index))
     
101.     (if(and lst(listp lst)(setq olditem (nth n lst)))
     
102.       (progn
     
103.         (if (and(cdr index)(listp olditem))
     
104.           (setq newitem (fun_substlst (cdr index) olditem)
     
105.                 lst     (subst newitem olditem lst)
     
106.           ) ;_ 结束setq
     
107.           (setq leftlst  (fun_sublst 0 (1- n) lst)
     
108.                 rightlst (fun_sublst (1+ n) -2 lst)
     
109.                 lst      (append leftlst rightlst)
     
110.           ) ;_ 结束setq
     
111.         ) ;_ 结束if
     
112.       ) ;_ 结束progn
     
113.     ) ;_ 结束if
     
114.     lst
     
115.   ) ;_ 结束defun
     
116.   ;;---------------
     
117.   (setq n (car index))
     
118.   (if (and lst(listp lst)(setq olditem (nth n lst)))
     
119.     (progn
     
120.       (if (and(cdr index)
     
121.        (listp olditem)
     
122.        )
     
123.         (setq newitem (fun_substlst (cdr index) olditem)
     
124.               lst     (subst newitem olditem lst)
     
125.         ) ;_ 结束setq
     
126.         (setq leftlst  (fun_sublst 0 (1- n) lst)
     
127.               rightlst (fun_sublst (1+ n) -2 lst)
     
128.               lst      (append leftlst rightlst)
     
129.         ) ;_ 结束setq
     
130.       ) ;_ 结束if
     
131.     ) ;_ 结束progn
     
132.   ) ;_ 结束if
     
133.   lst
     
134. ) ;_ 结束DEFUN
     
135. _$ l1
     
136. ((6 8) 5 6 ("a" "c" ("第三层" "adf")))
     
137. _$ (NBTF_Lst_Delnth '(0) l1)
     
138. (5 6 ("a" "c" ("第三层" "adf")))
     
139. _$ (NBTF_Lst_Delnth '(0 1) l1)
     
140. ((6) 5 6 ("a" "c" ("第三层" "adf")))
     
141. _$ (NBTF_Lst_Delnth '(3 2 0) l1)
     
142. ((6 8) 5 6 ("a" "c" ("adf")))
     
143. _$
     

<br /> ;;;_添加至表中的第index项后<br /> ;;index:'(0 5 3 1)表层<br /> ;;new:表或项 '(1 2 3 "d")或"f"<br /> ;;lst:可为多层表:'((a (()a()...)...)...)<br /> (setq NBTV_AllFunsLIST (cons "NBTF_Lst_Addnth" NBTV_AllFunsLIST))<br /> (DEFUN NBTF_Lst_Addnth (index new lst / n re olditem newitem leftlst rightlst fun_substlst fun_sublst)<br />   (defun fun_sublst (index_begin index_end lst / n re item)<br />     (setq n 0)<br />     (if (= -1 index_begin)<br />       ;;(setq index_begin (length lst))<br />       (setq index_begin 0)<br />     ) ;_ 结束if<br />     (if (= -2 index_end)<br />       (setq index_end (length lst))<br />     ) ;_ 结束if<br />     (foreach item lst<br />       (if (and (>= n index_begin) (<= n index_end))<br />         (setq re (append re (list item)))<br />       ) ;_ 结束if<br />       (setq n (1+ n))<br />     ) ;_ 结束foreach<br />     re<br />   ) ;_ 结束defun<br /> <br />   (defun fun_substlst (index lst / n olditem newitem)<br />     (setq n (car index))<br />     (if (setq olditem (nth n lst))<br />       (progn<br />         (if (and(cdr index)(listp olditem))<br />           (setq newitem (fun_substlst (cdr index) olditem)<br />                 lst     (subst newitem olditem lst)<br />           ) ;_ 结束setq<br />           (setq leftlst  (fun_sublst 0 (1- n) lst)<br />                 rightlst (fun_sublst n -2 lst)<br />                 lst      (append leftlst (list new) rightlst)<br />           ) ;_ 结束setq<br />         ) ;_ 结束if<br />       ) ;_ 结束progn<br />       (setq lst (append lst (list new)))<br />     ) ;_ 结束if<br />     lst<br />   ) ;_ 结束defun<br />   ;;---------------<br />   (setq n (car index))<br />   (if (setq olditem (nth n lst))<br />     (progn<br />       (if (and(cdr index)(listp olditem))<br />         (setq newitem (fun_substlst (cdr index) olditem)<br />               lst     (subst newitem olditem lst)<br />         ) ;_ 结束setq<br />         (setq leftlst  (fun_sublst 0 (1- n) lst)<br />               rightlst (fun_sublst n -2 lst)<br />               lst      (append leftlst (list new) rightlst)<br />         ) ;_ 结束setq<br />       ) ;_ 结束if<br />     ) ;_ 结束progn<br />     (setq lst (append lst (list new)))<br />   ) ;_ 结束if<br />   lst<br /> ) ;_ 结束DEFUN<br /> <br /> _$ (setq l1 '((6 8)5 6 ("a" "c"("第三层" "adf"))))<br /> ((6 8) 5 6 ("a" "c" ("第三层" "adf")))<br /> _$ (NBTF_Lst_Addnth '(0 1) "a" l1)<br /> ((6 "a" 8) 5 6 ("a" "c" ("第三层" "adf")))<br /> _$ (NBTF_Lst_Addnth '(0) "a" l1)<br /> ("a" (6 8) 5 6 ("a" "c" ("第三层" "adf")))<br /> _$ (NBTF_Lst_Addnth '(1) "a" l1)<br /> ((6 8) "a" 5 6 ("a" "c" ("第三层" "adf")))<br /> _$ (NBTF_Lst_Addnth '(3 2 1) "a" l1)<br /> ((6 8) 5 6 ("a" "c" ("第三层" "a" "adf")))<br /> _$ <br /> <br /> ;;;_删除表中的第index项<br /> ;;index:'(0 5 3 1)表层<br /> ;;new:表或项 '(1 2 3 "d")"<br /> ;;lst:可为多层表:'((a (()a()...)...)...)<br /> (setq NBTV_AllFunsLIST (cons "NBTF_Lst_Delnth" NBTV_AllFunsLIST))<br /> (DEFUN NBTF_Lst_Delnth (index  lst / n re olditem newitem leftlst rightlst fun_substlst fun_sublst)<br />   (defun fun_sublst (index_begin index_end lst / n re item)<br />     (setq n 0)<br />     (if (= -1 index_begin)<br />       ;;(setq index_begin (length lst))<br />       (setq index_begin 0)<br />     ) ;_ 结束if<br />     (if (= -2 index_end)<br />       (setq index_end (length lst))<br />     ) ;_ 结束if<br />     (foreach item lst<br />       (if (and (>= n index_begin) (<= n index_end))<br />         (setq re (append re (list item)))<br />       ) ;_ 结束if<br />       (setq n (1+ n))<br />     ) ;_ 结束foreach<br />     re<br />   ) ;_ 结束defun<br />   (defun fun_substlst (index lst / n olditem newitem)<br />     (setq n (car index))<br />     (if(and lst(listp lst)(setq olditem (nth n lst)))<br />       (progn<br />         (if (and(cdr index)(listp olditem))<br />           (setq newitem (fun_substlst (cdr index) olditem)<br />                 lst     (subst newitem olditem lst)<br />           ) ;_ 结束setq<br />           (setq leftlst  (fun_sublst 0 (1- n) lst)<br />                 rightlst (fun_sublst (1+ n) -2 lst)<br />                 lst      (append leftlst rightlst)<br />           ) ;_ 结束setq<br />         ) ;_ 结束if<br />       ) ;_ 结束progn<br />     ) ;_ 结束if<br />     lst<br />   ) ;_ 结束defun<br />   ;;---------------<br />   (setq n (car index))<br />   (if (and lst(listp lst)(setq olditem (nth n lst)))<br />     (progn<br />       (if (and(cdr index)<br />        (listp olditem)<br />        )<br />         (setq newitem (fun_substlst (cdr index) olditem)<br />               lst     (subst newitem olditem lst)<br />         ) ;_ 结束setq<br />         (setq leftlst  (fun_sublst 0 (1- n) lst)<br />               rightlst (fun_sublst (1+ n) -2 lst)<br />               lst      (append leftlst rightlst)<br />         ) ;_ 结束setq<br />       ) ;_ 结束if<br />     ) ;_ 结束progn<br />   ) ;_ 结束if<br />   lst<br /> ) ;_ 结束DEFUN<br /> _$ l1<br /> ((6 8) 5 6 ("a" "c" ("第三层" "adf")))<br /> _$ (NBTF_Lst_Delnth '(0) l1)<br /> (5 6 ("a" "c" ("第三层" "adf")))<br /> _$ (NBTF_Lst_Delnth '(0 1) l1)<br /> ((6) 5 6 ("a" "c" ("第三层" "adf")))<br /> _$ (NBTF_Lst_Delnth '(3 2 0) l1)<br /> ((6 8) 5 6 ("a" "c" ("adf")))<br /> _$<br />