[分享]：兩表的並集、交集和差集等表处理函数

taner

1.兩表的並集:LI-UNION
[PHP]
;; ! ****************************************************************************
;; ! LI_Union
;; ! ****************************************************************************
;; ! Function : Performs a union of two lists
;; ! Arguments:
;; !            'Lst1' - First List
;; !            'Lst2' - Second List
;; ! Action   : Returns a list which contains all of Lst1 plus any elements in
;; !            not contained in Lst1
;; !            Duplicate elements will be added as many times as they occur in
;; !            second list
;; ! Updated  : December 23, 1998
;; ! e-mail   : rakesh.rao@4d-technologies.com
;; ! Web      : www.4d-technologies.com
;; ! ****************************************************************************

(defun LI-Union( Lst1 Lst2 / Lst tmp )
(setq Lst '())
(foreach tmp Lst2
        (if (not (member tmp Lst1))
                (setq Lst (cons tmp Lst))
        )
)
(setq
        Lst (reverse Lst)
        Lst (append Lst1 Lst)
)
Lst
)
[/PHP]

還差以下兩個,有興趣的,跟!
2.兩表的差集:LI-DIFF
3.兩表的交集:LI-INTER

xyp1964

2. [FONT=courier new]
   
3. ;;;两表的并集
   
4. (defun LSTUNION        (Lst1 Lst2 / Lst tmp)
   
5.   (append Lst1 lst2)
   
6. )
   
7. 
   
8. ;;;两表的交集
   
9. (defun LSTINTER        (Lst1 Lst2 / Lst tmp lst11 lst22)
   
10.   (foreach tmp Lst2
    
11.     (if        (member tmp Lst1)
    
12.       (setq Lst22 (cons tmp Lst22))
    
13.     )
    
14.   )
    
15.   (foreach tmp Lst1
    
16.     (if        (member tmp Lst2)
    
17.       (setq Lst11 (cons tmp Lst11))
    
18.     )
    
19.   )
    
20.   (setq        Lst (append (reverse Lst11) (reverse Lst22))
    
21.         lst (LstDelSame lst)
    
22.   )
    
23.   Lst
    
24. )
    
25. 
    
26. ;;;两表的差集
    
27. (defun LSTDIFF (Lst1 Lst2 / Lst tmp lst11 lst22)
    
28.   (foreach tmp Lst2
    
29.     (if        (not (member tmp Lst1))
    
30.       (setq Lst22 (cons tmp Lst22))
    
31.     )
    
32.   )
    
33.   (foreach tmp Lst1
    
34.     (if        (not (member tmp Lst2))
    
35.       (setq Lst11 (cons tmp Lst11))
    
36.     )
    
37.   )
    
38.   (setq        Lst (append (reverse Lst11) (reverse Lst22))
    
39.         lst (LstDelSame lst)
    
40.   )
    
41.   Lst
    
42. )
    
43. 
    
44. ;;;删除列表中的相同元素(保留一个)并返回新表
    
45. (defun LstDelSame (lst / x nl)
    
46.   (foreach x lst
    
47.     (if        (not (member x nl))
    
48.       (setq nl (cons x nl))
    
49.     )
    
50.   )
    
51.   (reverse nl)
    
52. )
    
53. [/FONT]

[FONT=courier new]<br /> ;;;两表的并集<br /> (defun LSTUNION        (Lst1 Lst2 / Lst tmp)<br />   (append Lst1 lst2)<br /> )<br /> <br /> ;;;两表的交集<br /> (defun LSTINTER        (Lst1 Lst2 / Lst tmp lst11 lst22)<br />   (foreach tmp Lst2<br />     (if        (member tmp Lst1)<br />       (setq Lst22 (cons tmp Lst22))<br />     )<br />   )<br />   (foreach tmp Lst1<br />     (if        (member tmp Lst2)<br />       (setq Lst11 (cons tmp Lst11))<br />     )<br />   )<br />   (setq        Lst (append (reverse Lst11) (reverse Lst22))<br />         lst (LstDelSame lst)<br />   )<br />   Lst<br /> )<br /> <br /> ;;;两表的差集<br /> (defun LSTDIFF (Lst1 Lst2 / Lst tmp lst11 lst22)<br />   (foreach tmp Lst2<br />     (if        (not (member tmp Lst1))<br />       (setq Lst22 (cons tmp Lst22))<br />     )<br />   )<br />   (foreach tmp Lst1<br />     (if        (not (member tmp Lst2))<br />       (setq Lst11 (cons tmp Lst11))<br />     )<br />   )<br />   (setq        Lst (append (reverse Lst11) (reverse Lst22))<br />         lst (LstDelSame lst)<br />   )<br />   Lst<br /> )<br /> <br /> ;;;删除列表中的相同元素(保留一个)并返回新表<br /> (defun LstDelSame (lst / x nl)<br />   (foreach x lst<br />     (if        (not (member x nl))<br />       (setq nl (cons x nl))<br />     )<br />   )<br />   (reverse nl)<br /> )<br /> [/FONT]

测试：
[php]
;;(LSTUNION '(f a b gg b c c d f) '(a e f gg c h d))→(F A B GG B C C D F A E F GG C H D)
;;(LSTINTER '(f a b gg b c c d f) '(a e f gg c h d))→(F A GG C D)
;;(LSTDIFF '(f a b gg b c c d f) '(a e f gg c h d))→(B E H)
[/php]

taner

版主真是牛b,五體投地!請大家收集所有的表處理函數,看看有多少好東西.

http://www.xdcad.net/forum/showthread.php?s=&threadid=452095
以上鏈接內容:
1.去除表的最後一個元素.
2.將表的第N項移去.
3.在表的第n項位置增加一元素.

4.从列表中移去指定的元素.(摘自明經)
[PHP](defun i:listremoveatom (delatom lstin)
  (apply
    'append
    (subst
      nil
      (list delatom)
      (mapcar
        'list
        lstin
      )
    )
  )
)
[/PHP]
另一種:
[PHP](defun LI_RemLst( itm lst / nlst elem len )
(setq nlst '())
(foreach elem lst
        (if (not (equal elem itm))
                (setq nlst (append nlst (list elem)))
        )
)
nlst
)[/PHP]
測試:
(setq q (list 1 1 1 2 3 4 5 6 7 8 9 9 9 9))
(i:listremoveatom 1 q)
(2 3 4 5 6 7 8 9 9 9 9)
(i:listremoveatom 9 q)
(1 1 1 2 3 4 5 6 7 8)
(i:listremoveatom 8 q)
(1 1 1 2 3 4 5 6 7 9 9 9 9)
(LI_REMLST 3 (list 1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1))
(1 2 4 5 6 7 8 9 9 8 7 6 5 4 2 1)


5.结合两个列表以创建一个点对列表 (摘自明經)
[PHP](defun listunion (lst1 lst2)
  (mapcar 'cons lst1 lst2)
)[/PHP]
測試:
(listunion '("One" "Two" "Three") '(1 2 3))
(("One" . 1) ("Two" . 2) ("Three" . 3))
(listunion '("One" "Two" "Three") '(1 2 ))
(("One" . 1) ("Two" . 2))
(listunion '("One" "Two")'(1 2 3))
(("One" . 1) ("Two" . 2))

6.删除列表中的相同元素(保留一个)并返回新表
[PHP](defun LstDelSame( Lst / Lst1 tmp )
(setq Lst1 '())
(foreach tmp Lst
        (if (not (member tmp Lst1))
                (setq Lst1 (cons tmp Lst1))
        )
)
(reverse Lst1)
)[/PHP]

[PHP](defun LstDelSame (lst / x nl)
  (mapcar
    '(lambda (x)
       (if (not (member x nl))
         (setq nl (cons x nl))
       )
     )
    lst
  )
  (reverse nl)
)[/PHP]
7.替換指定位置的元素.
[PHP];; ! ***************************************************************************
;; ! LI_RepList
;; ! ***************************************************************************
;; ! Function : Replaces a member of the list at the specified position
;; ! Argument : 'Lst'    - The list to operate on.
;; !            'Pos'    - Postion in list after which the new element is to be
;; !                       replaced (starts with 1).
;; !            'Val'    - The new value of the list member
;; ! Returns  : The updated list, if 'pos' is greater than the length of the
;; !            list, the function returns nil
;; ! Update   : October 13, 1998
;; ! e-mail   : rakesh.rao@4d-technologies.com
;; ! Web      : www.4d-technologies.com
;; ! ****************************************************************************

(defun LI_RepList (Lst Pos Val / Lst1 Lst2 cnt len )
(setq
        cnt 0
        len (length Lst)
        Lst1 '()
)

(if (and (> Pos 0) (<= Pos len))
(progn
        (repeat (1- Pos)
                (setq
                        Lst1 (cons (nth cnt Lst) Lst1)
                        cnt (1+ cnt)
                )
        )

        (setq
                Lst1 (cons Val Lst1)
                Lst1 (reverse Lst1)
                cnt Pos
        )

        (if (> len cnt)
        (progn
                (setq Lst2 '())
                (repeat (- len cnt)
                        (setq
                                Lst2 (cons (nth cnt Lst) Lst2)
                                cnt (1+ cnt)
                        )
                )
                (setq
                        Lst2 (reverse Lst2)
                        Lst1 (append Lst1 Lst2)
                )
        ))
))
Lst1
)
[/PHP]
8.N位開始,M 長度的子表.
[PHP](defun LI_SubList ( Lst Start len / _len n m _Lst)
(if (minusp len)
        (setq len (1+(length lst)))
)

(setq
        _len (length Lst)
        n (min (- Start 1) _len)        ; Starting Index
        m (min (+ n len) _len)                ; Ending Index
        _Lst '()
)

(while (< n m)
        (setq
                _Lst (cons (nth n Lst) _Lst)
                n (1+ n)
        )
)
(reverse _Lst)
)
[/PHP]
測試:
命令: !q
(1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1)
命令: (LI_SUBLIST q 1 8)
(1 2 3 4 5 6 7 8)
命令: (LI_SUBLIST q 1 -1)
(1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1)
命令: (LI_SUBLIST q 1 0)
nil

9.差集(覺得XYP版主的不對)
[PHP](defun LI_Subtract( Lst1 Lst2 / Lst )
(setq Lst '())
(if Lst1
(progn
        (foreach tmp Lst1
                (if (not (member tmp Lst2))
                        (setq Lst (cons tmp Lst))
                )
        )
))
(setq Lst (reverse Lst))
Lst
)
[/PHP]
測試:
命令: !q (1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1)
命令: !w(5 6 9 8 7 10 45)
命令: (LI_SUBTRACT w q)
(10 45)
命令: (LI_SUBTRACT q w)
(1 2 3 4 4 3 2 1)
命令: (lstdiff q w)
(1 2 3 4 10 45)
命令: (lstdiff w q)
(10 45 1 2 3 4)

10.交集的另一種(覺得XYP版主的更合理).
[PHP](defun LI_Intersect( Lst1 Lst2 / Lst tmp )
(setq Lst '())
(if (or Lst1 Lst2)
(progn
        (foreach tmp Lst1
                (if (member tmp Lst2)
                        (setq Lst (cons tmp Lst))
                )
        )
))
(setq Lst (reverse Lst))
Lst
)
[/PHP]
測試:
命令: !q (1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1)
命令: !w(5 6 9 8 7 10 45)
命令: (LI_INTERSECT q w)
(5 6 7 8 9 9 8 7 6 5)
命令: (LI_INTERSECT w q)
(5 6 9 8 7)
命令: (lstinter q w)
(5 6 7 8 9)
命令: (lstinter w q)
(5 6 9 8 7)

舟自横

移除列表的第N项
[PHP]
(defun hy_remove_nth(lst n / i )
(setq j -1)
(vl-remove-if '(lambda(x)(= n(setq j(1+ j)))) lst)
)
[/PHP]
清除列表相同的项目
[PHP]
(defun hy_erasedouble(nlist preci / needlist);;;preci 带精度控制
  (setq needlist nlist)
  (foreach item nlist (setq needlist (append (list item)
                                             (vl-remove-if '(lambda(x) (equal item x preci)
                                                              )
                                               needlist)))
    )
  (reverse needlist))
[/PHP]

snoopychen

我感觉stdlib里面的表函数就挺齐全的，反正现在一般临时想到的都能在里面找到相应函数

taner

最初由 snoopychen 发布
[B]我感觉stdlib里面的表函数就挺齐全的，反正现在一般临时想到的都能在里面找到相应函数 [/B]

沒發現STDLIB裏有多少表處理函數啊?列幾個出來看看?

查了一下,確實挺全的.參考以下鏈接:
http://www.xdcad.net/forum/showt ... 2337952#post2337952

http://www.xdcad.net/forum/showt ... 2418851#post2418851

tctabc

各位高手可以说明一下
表的运用吗?
thank!

taner

1.判断点表是否共线.
链接:   http://www.xdcad.net/forum/showthread.php?s=&threadid=471571
2.1,点集中XminYmin(X优先于Y)
2.2,点集中XmaxYmax(X优先于Y)
2.3,点集中YminXmin(Y优先于X)
2.4,点集中YmaxXmax(Y优先于X)
链接:  http://www.xdcad.net/forum/showthread.php?s=&threadid=463109

xyz518mm

最初由 taner 发布
[B]1.判断点表是否共线.
链接:   http://www.xdcad.net/forum/showthread.php?s=&threadid=471571
2.1,点集中XminYmin(X优先于Y)
2.2,点集中XmaxYmax(X优先于Y)
2.3,点集中YminXmin(Y优先于X)
2.4,点?.. [/B]

不错的文章
但可以来各范例介绍一下运用吗
谢谢

taner

最初由 xyz518mm 发布
[B][QUOTE]最初由 taner 发布
[B]1.判断点表是否共线.
链接:   http://www.xdcad.net/forum/showthread.php?s=&threadid=471571
2.1,点集中XminYmin(X优先于Y)
2.2,点集中XmaxYmax(X优先于Y)
2... [/B]

1.部份函数有测试的范例,看看测试结果应该知道用法.
2.请自行测试,自己亲自测试比别人介绍更有效.

aeo

2. 
   
3. ;;;两表的差集
   
4. (defun LST-LST(lst1 lst2)
   
5.   (vl-remove-if '(lambda(x)(member x lst2)) lst1)
   
6. )
   
7. ;;;交集
   
8. (defun LSTxLST(lst1 lst2)
   
9.   (vl-remove-if-not '(lambda(x)(member x lst2)) lst1)
   
10. )
    
11. ;;;并集
    
12. (defun LST+LST(lst1 lst2)
    
13. (append lst1 (LST-LST lst2 lst1))
    
14. )
    

<br /> ;;;两表的差集<br /> (defun LST-LST(lst1 lst2)<br />   (vl-remove-if '(lambda(x)(member x lst2)) lst1)<br /> )<br /> ;;;交集<br /> (defun LSTxLST(lst1 lst2)<br />   (vl-remove-if-not '(lambda(x)(member x lst2)) lst1)<br /> )<br /> ;;;并集<br /> (defun LST+LST(lst1 lst2)<br /> (append lst1 (LST-LST lst2 lst1))<br /> )<br />

其实没必要写函数

jx2008

楼上的代码都很精彩，多谢了

flowerson

好东西！但('1 2 3 4 5  '1 2 4 6 7 ' 1 3 4 5 6 )和( '1 2  3 4 5  '1 2 4 6 7) 不可以剩下('1 3 4 5 6)！要是可以实现这个功能就好了！