两个表分组函数,求拍砖~~
求帮忙修改算法,提出更快更便捷的算法.;;; 测试命令:
;;; (tablist:group '(("a" 1 1) ("b" 1 1) ("c" 1 1) ("b" 2 1) ("b" 3 1) ("a" 2 2) ("a" 3 3) ("b" 4 2) ("c" 2 2) ("c" 3 1)) 1)
;;; ==>((("a" 1 1) ("a" 2 2) ("a" 3 3)) (("b" 1 1) ("b" 2 1) ("b" 3 1) ("b" 4 2)) (("c" 1 1) ("c" 2 2) ("c" 3 1)))
(defun tablist:group (lst fuzz / k l ll)
(setq k (caar lst)) ; 设定关键词
(while lst ; 循环取值
(setq l (vl-remove-if-not '(lambda (x)
(equal (car x) k fuzz)
) lst
) ; 以关键词查找出对应的元素表l
l (list l) ; 组合成一个小组
ll (append l ll) ; 小组添加到输出表
)
(setq lst (vl-remove-if '(lambda (x)
(equal (car x) k fuzz)
) lst
) ; 剔除后形成新表lst
k (caar lst) ; 设定新的关键词
)
) ; while循环结束
(reverse ll) ; 反串
)
;;; 测试命令:
;;; (tablist:group1 '(("a" 1 1) ("b" 1 1) ("c" 1 1) ("b" 2 1) ("b" 3 1) ("a" 2 2) ("a" 3 3) ("b" 4 2) ("c" 2 2) ("c" 3 1)) 1)
;;; ==>(("a" (1 1) (2 2) (3 3)) ("b" (1 1) (2 1) (3 1) (4 2)) ("c" (1 1) (2 2) (3 1)))
(defun tablist:group1 (lst fuzz / k l ll)
(setq k (caar lst)) ; 设定关键词
(while lst ; 循环取值
(setq l (vl-remove-if-not '(lambda (x)
(equal (car x) k fuzz)
) lst
) ; 以关键词查找出对应的元素表l
l (mapcar 'cdr l) ; 分别剔除首项
l (list (cons k l)) ; 组合成一个小组
ll (append l ll) ; 小组添加到输出表
)
(setq lst (vl-remove-if '(lambda (x)
(equal (car x) k fuzz)
) lst
) ; 剔除后形成新表lst
k (caar lst) ; 设定新的关键词
)
) ; while循环结束
(reverse ll) ; 反串
)
忘记发用法了,
(tablist:group1 lst fuzz)
参数说明:
lst 用于分组的双层表
fuzz 模糊系数
附个图试一试 菜卷鱼 发表于 2014-10-11 08:26 static/image/common/back.gif
附个图试一试
这个怎么附图啊，测试结果已经写出来了~ 最近才用到分组，过来学习学习 这个还不是最快的
;;[功能]分组1 (HH:Lst->Group lst) -> ((1 1 1) (2 2) (6) (5 5 5))
(defun HH:Lst->Group (lst / N NL SAME)
(while (setq n (car lst))
(setq lst (cdr lst))
(if (setq same (assoc n nl))
(setq nl (subst (cons n same) same nl))
(setq nl (cons (list n) nl))
)
)
)
页:
[1]