(xl-remove rlst lst fz) = 排除表中重复项及属于排除列表中的项,支持精度

梦断江南 · 发表于 2013-6-20 00:13:36

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;; (xl-remove)(xl-eq)(xl-mem)(xl-rem)(xl-rems)
;| (xl-remove rlst lst fz) = 排除表中重复项及属于排除列表中的项,支持精度－－－－－－－－梁雄啸.2004.4
参数: rlst为要排除的列表.fz=精度.
关联: (xl-pts1 pts fuzz) = 点表去除重复点；(本函数更通用!)
例: (交点表处理－过滤重复点和与曲线首尾相同的点.返回新的点表.)
(setq rlst (list (vlax-curve-getstartpoint curobj) (vlax-curve-getendpoint curobj)))
(setq nlst (xl-remove rlst lst 0.01)) ;lst为已经求得的点表.
|;
(defun xl-remove ( rlst lst fz / nlst)
(mapcar '(lambda (x)
(if (not(or (xl-mem x nlst fz) (xl-mem x rlst fz)));; xl-mem
(setq nlst (append nlst (list x)))
)) lst)
)
;|比较两个表lst1 ,lst2 是否相等，支持精度. 效果同equal.
例: (xl-eq '(3.01 2.9 2) '(3.02 2.82 2) 0.1) -> T;
(xl-eq '(3.01 2.9 2) '(3.02 2.82 2) 0.01) -> nil.
|;
(defun xl-eq (lst1 lst2 fz / i)
(equal lst1 lst2 fz)
)
;|判断点元素是否在点表内.支持精度
例: (xl-mem '(3.01 2.9 2) '((3.01 2.82 2) (1 1 2)(3 2.01 0)) 0.1) -> T
(xl-mem '(3.01 2.9 2) '((3.01 2.82 2) (1 1 2)(3 2.01 0)) 0.01) -> nil
(equal "a" "a" 1);->T
(equal '(0.1 "a") '(0.2 "a") 1);->T
(equal '(0.1 "a") '(0.2 "a") 0.01);->nil
|;
(defun xl-mem (lst xlst fz / )
(apply 'or (mapcar '(lambda (x) (equal x lst fz)) xlst))
)
;;/////////////////////////////////////////////////////////////////;;
;;------------------------简单函数---------------------------------;;
;| (xl-rem at lst ) = 表剔除元素;-------------lxx.2004.1
;提示; 用mapcar每元素做list，用append 对nil忽略的特性.
!!!等同于: (vl-remove element-to-remove list)
(xl-rem "a" '(58 3 (a . 8) "a" 4.5)) -> (58 3 (A . 8) 4.5)
|;
(defun xl-rem (at lst) ;at=atom
(apply 'append (subst nil (list at) (mapcar 'list lst)))
)
;| (xl-rems atlst lst ) = 表剔除多个元素;-------------lxx.2004.1
;提示; 用mapcar每元素做list，用append 对nil忽略的特性.
(xl-rems '("a" 58) '(58 3 (a . 8) "a" 4.5)) -> (3 (A . 8) 4.5)
|;
(defun xl-rems (atlst lst) ;at=atom
(foreach n atlst (setq lst (apply 'append (subst nil (list n) (mapcar 'list lst)))))
)

;; (xl-remove)(xl-eq)(xl-mem)(xl-rem)(xl-rems) 
;| (xl-remove rlst lst fz) = 排除表中重复项及属于排除列表中的项,支持精度－－－－－－－－梁雄啸.2004.4 
参数: rlst为要排除的列表.fz=精度. 
关联: (xl-pts1 pts fuzz) = 点表去除重复点；(本函数更通用!) 
例: (交点表处理－过滤重复点和与曲线首尾相同的点.返回新的点表.) 
  (setq rlst (list (vlax-curve-getstartpoint curobj) (vlax-curve-getendpoint curobj))) 
  (setq nlst (xl-remove rlst lst  0.01)) ;lst为已经求得的点表. 
|; 
(defun xl-remove ( rlst lst fz / nlst) 
  (mapcar '(lambda (x) 
       (if (not(or (xl-mem x nlst fz) (xl-mem x rlst fz)));; xl-mem 
           (setq nlst (append nlst (list x))) 
       )) lst) 
) 
;|比较两个表lst1 ,lst2 是否相等，支持精度. 效果同equal. 
例: (xl-eq '(3.01 2.9 2) '(3.02 2.82 2) 0.1) -> T; 
    (xl-eq '(3.01 2.9 2) '(3.02 2.82 2) 0.01) -> nil. 
|; 
(defun xl-eq (lst1 lst2 fz / i) 
  (equal lst1 lst2 fz) 
) 
;|判断点元素是否在点表内.支持精度 
例: (xl-mem '(3.01 2.9 2) '((3.01 2.82 2) (1 1 2)(3 2.01 0)) 0.1) -> T 
    (xl-mem '(3.01 2.9 2) '((3.01 2.82 2) (1 1 2)(3 2.01 0)) 0.01) -> nil 
    (equal "a" "a" 1);->T 
    (equal '(0.1 "a") '(0.2 "a") 1);->T 
    (equal '(0.1 "a") '(0.2 "a") 0.01);->nil 
|; 
(defun xl-mem (lst xlst fz / ) 
  (apply 'or (mapcar '(lambda (x) (equal x lst fz)) xlst)) 
) 
;;/////////////////////////////////////////////////////////////////;; 
;;------------------------简单函数---------------------------------;; 
;| (xl-rem at lst ) = 表剔除元素;-------------lxx.2004.1 
;提示; 用mapcar每元素做list，用append 对nil忽略的特性. 
       !!!等同于: (vl-remove  element-to-remove  list) 
 (xl-rem "a" '(58 3 (a . 8) "a" 4.5)) -> (58 3 (A . 8) 4.5) 
|; 
(defun xl-rem (at lst) ;at=atom 
  (apply 'append (subst nil (list at) (mapcar 'list lst))) 
) 
 
;| (xl-rems atlst lst ) = 表剔除多个元素;-------------lxx.2004.1 
;提示; 用mapcar每元素做list，用append 对nil忽略的特性. 
 (xl-rems '("a" 58) '(58 3 (a . 8) "a" 4.5)) -> (3 (A . 8) 4.5) 
|; 
(defun xl-rems (atlst lst) ;at=atom 
  (foreach n atlst (setq lst (apply 'append (subst nil (list n) (mapcar 'list lst))))) 
)

wowan1314 · 发表于 2013-6-20 13:53:43

简约而不简单！

redcat2012 · 发表于 2013-11-18 03:32:57

本帖最后由 redcat2012 于 2013-11-18 21:02 编辑

{:soso_e100:}借宝地发一个比较简洁的算法{:soso__3110130392203091378_3:}

;;删除表中元素(可用于循环表)
(defun removen (n lst)
(mapcar '(lambda (x)
(if (= (type x) 'list)
(removen n x)
x
) ;_ 结束if
) ;_ 结束lambda
(vl-remove n lst)
) ;_ 结束mapcar
) ;_ 结束defun
;;替换表中元素(可用于循环表)
;;newitem-新元素
;;olditem-被替换元素
;;lst-需要处理的表
(defun substn (newitem olditem lst)
(mapcar '(lambda (n)
(cond ((equal n olditem)
newitem
)
((= (type n) 'list)
(substn newitem olditem n)
)
(t n)
) ;_ 结束cond
) ;_ 结束lambda
lst
) ;_ 结束mapcar
) ;_ 结束defun

redcat2012 · 发表于 2013-11-18 20:11:41

本帖最后由 redcat2012 于 2013-11-18 20:16 编辑

redcat2012 发表于 2013-11-18 03:32
借宝地发一个比较简洁的算法

{:soso__3419049825043533360_4:}再来一个更加给力的算法

;|删除表中元素(可用于循环表)
_$ (REMOVEN@ 1 '(1 2 3(1(1)(1)(1))))
(2 3)
_$ (REMOVEN@ 1 '(1 2 3(1(1)(1 12)(1))))
(2 3 ((12)))
_$ (REMOVEN@ 1 '(1 2 3(1 12(1 2)(1 21)(1 2((1 22)1 22)2))))
(2 3 (12 (2) (21) (2 ((22) 22) 2)))
|;
(defun removen@ (n lst)
(mapcar '(lambda (x)
(if (= (type x) 'list)
(removen@ n x)
x
) ;_ 结束if
) ;_ 结束lambda
(vl-remove-if
'(lambda (a)
(if (or (equal n a)
(and (= (type a) 'list)
(= (removen@ n a) nil)
) ;_ 结束and
) ;_ 结束or
t
) ;_ 结束if
) ;_ 结束lambda
lst
) ;_ 结束vl-remove-if
) ;_ 结束mapcar
) ;_ 结束defun

st788796 · 发表于 2013-11-18 20:21:27

redcat2012 发表于 2013-11-18 20:11
再来一个更加给力的算法

快绕晕了，bluecat 呢

守仁格竹GM · 发表于 2013-11-20 21:50:29

就效率而言，简洁未必效率高

dyjwyqz5221 · 发表于 2018-5-11 16:02:27

发的都是好东西，值得借鉴，很有价值！赞赞赞

dyjwyqz5221 · 发表于 2018-5-11 16:05:22

再此，顺便说一句，排序函数是好，但是效率并不高。我一个程序里，用了3次排序，排序的时间就用了2.5s，后来我不用排序了，用了（ssget “wp” pts fillerter）的方法，速度明显加快了，整个程序用时不过1s。

Lisphk · 发表于 2018-11-10 14:16:37

dyjwyqz5221 发表于 2018-5-11 16:05
再此，顺便说一句，排序函数是好，但是效率并不高。我一个程序里，用了3次排序，排序的时间就用了2.5s，后 ...

看什么场合用了，有些场合是必须要排序，再进行处理的，提高效率
SSGET受限于必须要显示在屏幕内

账号		自动登录	找回密码
密码			立即注册

[选择集] (xl-remove rlst lst fz) = 排除表中重复项及属于排除列表中的项,支持精度

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

相关帖子

点评

评分

点评

点评