本帖最后由 newer 于 2020-5-14 13:44 编辑
你试试带容差的, 怎么写效率更高些
 - (defun XD::List:Intersection-fuzz (l1 l2 fuzz)
- (vl-remove-if-not
- '(lambda (x)
- (setq aa (xd::list:member-if '(lambda(y)(equal x y fuzz)) l2))
- )
- l1
- )
- )
 - ;|
- 函数名称: xd::list:member-if
- 调用格式: (xd::list:member-if f list)
- 参数说明: f ---- 原子 或 函数
- l ---- 表
- 返回值: 表
- 函数简介: 支持函数的member
- 函数来源: 原创
- 函数作者: marting
- 适用版本: 不限
- 最后更新时间: 2018-12-09
- 备注: 如果参数是原子,如整数、实数,字符串等,同member
- 命令: !a
- (1 2 4.1 5 2 3)
- 命令: (xd::list:member-if \'(lambda(x)(equal x 4 1e-3)) a)
- (4.1 5 2 3)
- |;
- (defun xd::list:member-if (f l / ff r i $zz)
- (if (= (atom f) (setq r (member f l)))
- (progn (setq i -1)
- (setq ff '(lambda ($zz)
- (setq i (1+ i))
- (if (apply f (list $zz))
- (setq r $zz)
- )
- )
- )
- (if (vl-some ff l)
- (setq r (xd::list:n+ l i))
- )
- )
- )
- r
- )
 - ;|
- 函数名称: xd::list:car-member-if
- 调用格式: (xd::list:car-member-if f l)
- 参数说明: f ----- 原子 或 函数
- l ----- 表
- 返回值: 原子
- 函数简介: 支持函数的取member第一个元素
- 函数来源: 原创
- 函数作者: marting
- 适用版本: 不限
- 最后更新时间: 2018-12-09
- 备注: 命令: !a
- (1 2 3 4.021 5 6 7)
- 命令: (xd::list:member-if '(lambda(x)(equal x 4 1e-1)) a)
- (4.021 5 6 7)
- 命令: (xd::list:car-member-if '(lambda(x)(equal x 4 1e-1)) a)
- 4.021
- |;
- (defun xd::list:car-member-if (f l / ff r)
- (if (= (atom f) (setq r (car (member f l))))
- (progn (setq ff '(lambda ($zz)
- (if (apply f (list $zz))
- (setq r $zz)
- )
- )
- )
- (vl-some ff l)
- )
- )
- r
- )
 - (defun xd::list:position-fuzz (e l fuzz)
- (if (atom e)
- (vl-position e l)
- (vl-position
- (xd::list:car-member-if '(lambda (x) (equal e x fuzz)) l)
- l
- )
- )
- )
- ;|
- 函数名称: xd::list:assoc-fuzz
- 调用格式: (xd::list:assoc-fuzz e l fuzz)
- 参数说明: e ----- 查找项
- l ----- 关联表
- fuzz --- 容差(实数)
- 返回值: 表 或 nil
- 函数简介: 支持带容差的assoc
- 函数来源: 原创
- 函数作者:
- 适用版本: 不限
- 最后更新时间: 2018-12-09
- 备注: 命令: !a
- ((1.02 1 2) (2 3 4) (4.023 3 4) (5 6 4))
- 命令: (xd::list:assoc-fuzz 4 a 1e-1)
- (4.023 3 4)
- |;
- (defun xd::list:assoc-fuzz (e l fuzz)
- (xd::list:car-member-if '(lambda (x) (equal e (car x) fuzz)) l)
- )
|