[LISP函数-表]：含有精度检查的 Member

eachy

2. 
   
3. ;;   以下函数来自网上的均保留原作者信息, 转贴请注明出处并保持信息的完整
   
4. ;; ! ***************************************************************************
   
5. ;; ! LI_memb
   
6. ;; ! ***************************************************************************
   
7. ;; ! Function : MEMB - member with equal's uncertainty check (diff: real number)
   
8. ;; ! Argument : 'ele'    - Element to check, if in list
   
9. ;; !            'Lst'    - List to be checked
   
10. ;; !            'diff'   - A fuzzy tolerance to check for equality
    
11. ;; ! Returns  : The list index (starting from 0) where the first occurance of
    
12. ;; !            'ele' is found else nil
    
13. ;; ! Update   : May 2, 2004
    
14. ;; ! e-mail   : [email]rakesh.rao@4d-technologies.com[/email]
    
15. ;; ! Web      : [url]www.4d-technologies.com[/url]
    
16. ;; ! ****************************************************************************
    
17. ;; 含有精度检查的 Member，返回 T or nil
    
18. (defun LI_memb (ele Lst diff / len cnt Found)
    
19.   (if (zerop Diff)
    
20.     (progn
    
21.       (setq Found (member ele Lst))
    
22.       (if Found
    
23.         (setq Found T)
    
24.       )
    
25.     )
    
26.     (progn
    
27.       (setq
    
28.         len   (length Lst)
    
29.         cnt   0
    
30.         Found nil
    
31.       )
    
32.       (while (and (< cnt len) (not Found))
    
33.         (if (equal ele (nth cnt Lst) diff)
    
34.           (setq Found T)
    
35.           (setq cnt (1+ cnt))
    
36.         )
    
37.       )
    
38.     )
    
39.   )
    
40.   (if Found
    
41.     cnt
    
42.     nil
    
43.   )
    
44. )

<br /> ;;   以下函数来自网上的均保留原作者信息, 转贴请注明出处并保持信息的完整<br /> ;; ! ***************************************************************************<br /> ;; ! LI_memb<br /> ;; ! ***************************************************************************<br /> ;; ! Function : MEMB - member with equal's uncertainty check (diff: real number)<br /> ;; ! Argument : 'ele'    - Element to check, if in list<br /> ;; !            'Lst'    - List to be checked<br /> ;; !            'diff'   - A fuzzy tolerance to check for equality <br /> ;; ! Returns  : The list index (starting from 0) where the first occurance of <br /> ;; !            'ele' is found else nil<br /> ;; ! Update   : May 2, 2004<br /> ;; ! e-mail   : [email]rakesh.rao@4d-technologies.com[/email]<br /> ;; ! Web      : [url]www.4d-technologies.com[/url]<br /> ;; ! ****************************************************************************<br /> ;; 含有精度检查的 Member，返回 T or nil<br /> (defun LI_memb (ele Lst diff / len cnt Found)<br />   (if (zerop Diff)<br />     (progn<br />       (setq Found (member ele Lst))<br />       (if Found<br />         (setq Found T)<br />       )<br />     )<br />     (progn<br />       (setq<br />         len   (length Lst)<br />         cnt   0<br />         Found nil<br />       )<br />       (while (and (< cnt len) (not Found))<br />         (if (equal ele (nth cnt Lst) diff)<br />           (setq Found T)<br />           (setq cnt (1+ cnt))<br />         )<br />       )<br />     )<br />   )<br />   (if Found<br />     cnt<br />     nil<br />   )<br /> )

雨箭风刀

补充一个原创的

2. 
   
3. ;|xmem ＝ 有精度的member  by 雨箭风刀.2006.5
   
4. 参数: a ＝ 要比较的元素（可以是表）
   
5.       lst ＝ 表
   
6.       f   ＝ 精度值
   
7. 返回: 表(截取第一个符合精度的及其后的元素) 或 nil.
   
8. 测试：
   
9. (setq a '(3.02 4.001) b nil lst '((1. 0.) nil(3.01 4.0)(1.0 0.1)nil(3.1 5.)))
   
10. (xmem a lst 0.1) -> ((3.01 4.0) (1.0 0.1) nil (3.1 5.0))
    
11. (xmem a lst 0.001) ->nil
    
12. (xmem b lst 0.1) ->(nil (3.01 4.0) (1.0 0.1) nil (3.1 5.0))
    
13. |;
    
14. (defun xmem (a lst f / k)
    
15.   (apply 'append (mapcar '(lambda(x)(if(or k (equal a x f))(setq k (list x)) nil))lst))
    
16. )
    

<br /> ;|xmem ＝ 有精度的member  by 雨箭风刀.2006.5<br /> 参数: a ＝ 要比较的元素（可以是表）<br />       lst ＝ 表<br />       f   ＝ 精度值<br /> 返回: 表(截取第一个符合精度的及其后的元素) 或 nil.<br /> 测试：<br /> (setq a '(3.02 4.001) b nil lst '((1. 0.) nil(3.01 4.0)(1.0 0.1)nil(3.1 5.)))<br /> (xmem a lst 0.1) -> ((3.01 4.0) (1.0 0.1) nil (3.1 5.0))<br /> (xmem a lst 0.001) ->nil<br /> (xmem b lst 0.1) ->(nil (3.01 4.0) (1.0 0.1) nil (3.1 5.0))<br /> |;<br /> (defun xmem (a lst f / k)<br />   (apply 'append (mapcar '(lambda(x)(if(or k (equal a x f))(setq k (list x)) nil))lst))<br /> )<br />

eachy

2. 
   
3. ;;equalmember ;
   
4. ;; ;
   
5. ;; check if "item" is in "lista" or not by equality test. with real number the ;
   
6. ;; standard fuction "member" not work correctly. ;
   
7. ;; ;
   
8. (defun equalmember (item lista fuzzy /)
   
9.   (apply 'or
   
10.          (mapcar '(lambda (x) (equal x item fuzzy)) lista)
    
11.   )
    
12. )

<br /> ;;equalmember ;<br /> ;; ;<br /> ;; check if "item" is in "lista" or not by equality test. with real number the ;<br /> ;; standard fuction "member" not work correctly. ;<br /> ;; ;<br /> (defun equalmember (item lista fuzzy /)<br />   (apply 'or<br />          (mapcar '(lambda (x) (equal x item fuzzy)) lista)<br />   )<br /> )

另外一种，如果 equal 等的元素比较靠前，下面的也许更好

2. 
   
3. (defun ybl-member (item lst diff / tf)
   
4.   (setq tf t)
   
5.   (while (and tf lst)
   
6.     (if        (equal item (setq n (car lst)) diff)
   
7.       (setq tf        nil
   
8.             lst        (cdr lst)
   
9.       )
   
10.       (setq lst (cdr lst))
    
11.     )
    
12.   )
    
13.   lst
    
14. )

<br /> (defun ybl-member (item lst diff / tf)<br />   (setq tf t)<br />   (while (and tf lst)<br />     (if        (equal item (setq n (car lst)) diff)<br />       (setq tf        nil<br />             lst        (cdr lst)<br />       )<br />       (setq lst (cdr lst))<br />     )<br />   )<br />   lst<br /> )

雨箭风刀

[php]
;| xmem = 含阈值的member --ok!----by 雨箭风刀.2006.6
格式: (xmem 元素 表 阈值)
测试:
(xmem 2.002 '(2.01 a "a" 2.0 3 0) 0.01) ->
(2.01 A "a" 2.0 3 0)
(xmem 2.002 '(a "a" 2.0 3 0) 0.01) ->(2.0 3 0)
(xmem 2.2 '(a "a" 2.0 3 0) 0.01) ->nil
|;
(defun xmem (a lst fz / lst2)
  (while (and (setq lst2 lst) (not(equal a (car lst) fz)))
    (setq lst(cdr lst))
  )
  lst2
)

[/php]

aeo

为什么只提供一个精度呢?
提供一个func比较好

2. 
   
3. (defun member0( func lst)
   
4.   (while (and lst  (not (apply func(list (car lst)))))
   
5.        (setq lst(cdr lst))
   
6.   )
   
7. )
   

<br /> (defun member0( func lst)<br />   (while (and lst  (not (apply func(list (car lst)))))<br />        (setq lst(cdr lst))<br />   )<br /> )<br />

命令: (MEMBER0 '(lambda(x)(equal x 5 1e-3)) '(2 3 4 5 6 ))
(5 6)

命令: (MEMBER0 '(lambda(x)(equal (car x) 5 1e-3)) '((2 3)(2 4)(5 3)(1 56)))
((5 3) (1 56))

命令: (MEMBER0 '(lambda(x)(equal (car x) 5 1e-3)) '((2 3)(2 4)(56 3)(1 56)))
nil

雨箭风刀

最初由 aeo 发布
[B]为什么只提供一个精度呢?
提供一个func比较好

2. 
   
3. (defun member0( func lst)
   
4.   (while (and lst  (not (apply func(list (car lst)))))
   
5.        (setq lst(cdr lst))
   
6.   )
   
7.   lst ;;这个是不可以省略的.
   
8. )
   

<br /> (defun member0( func lst)<br />   (while (and lst  (not (apply func(list (car lst)))))<br />        (setq lst(cdr lst))<br />   )<br />   lst ;;这个是不可以省略的.<br /> )<br />

命令: (MEMBER0 ... [/B]

加func自然可以，不过
(xmem     5  '(2 3 4 5 6 ) 1e-3)
(MEMBER0 '(lambda(x)(equal x 5 1e-3)) '(2 3 4 5 6 ))
哪个调用更简便呢？

本来这么写就是想省去写equal的语句，可好你又给加回来了。要加func，我宁可这样：
[php]
(defun xmemx (a lst func fz )
  (while (and lst (not(equal a ((eval func) (car lst)) fz)))
    (setq lst (cdr lst))
  ) lst ;;这个是不可以省略的.
)[/php]
(setq lst '(2 3 4 5 6 7))
(xmemx -5 lst '-  1e-3)
-> (5 6 7)
(xmemx 2 lst '(lambda(x)(/ x 2)) 1e-3)
-> (4 5 6 7)
(xmemx  5 '((2 3)(2 4)(5 3)(1 56)) 'car 1e-5)
->((5 3) (1 56))

aeo

最初由 雨箭风刀 发布
[B][QUOTE]最初由 aeo 发布
[B]为什么只提供一个精度呢?
提供一个func比较好

[code]
(defun member0( func lst)
  (while (and lst  (not (apply func(list (car lst)))))
       (setq lst(cdr lst))
... [/B]

其实我这么写,无非是说没必要写什么函数的
有"精度"要写一个,有"文字大小写"要写一个,还有很多机会会写
所以有了
vl-member-if (就是member0)
vl-member-if-not