关于表分组的两个函数

st788796 · 发表于 2013-11-18 16:20:03

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

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

×

;;适用元素为 STR REAL INT 的分组
(defun List:Group1 (lst fuzz / tf ll)
(if (= (type (car lst)) 'INT)
(setq lst (mapcar 'float lst)
tf t
)
)
(setq lst (vl-sort lst '<)
ll (list (list (car lst)))
)
(while (setq lst (cdr lst))
(if (equal (car lst) (last (car ll)) fuzz)
(setq ll (cons (cons (car lst) (car ll)) (cdr ll)))
(setq ll (cons (list (car lst)) ll))
)
)
(if tf
(mapcar '(lambda (x) (mapcar 'fix x)) ll)
ll
)
)
;;适用原素为 LIST 的分组
(defun List:Group2 (lst fuzz / ll l)
(setq ll (list (list (car lst))))
(while (setq lst (cdr lst))
(if (setq l (vl-member-if
'(lambda (x) (equal (car x) (car lst) fuzz))
ll
)
)
(setq ll (subst (append (car l) (list (car lst)))
(car l)
ll
)
)
(setq ll (cons (list (car lst)) ll))
)
)
ll
)

;;适用元素为 STR REAL INT 的分组 
(defun List:Group1 (lst fuzz / tf ll) 
  (if (= (type (car lst)) 'INT) 
    (setq lst (mapcar 'float lst) 
          tf  t 
    ) 
  ) 
  (setq        lst (vl-sort lst '<) 
        ll  (list (list (car lst))) 
  ) 
  (while (setq lst (cdr lst)) 
    (if        (equal (car lst) (last (car ll)) fuzz) 
      (setq ll (cons (cons (car lst) (car ll)) (cdr ll))) 
      (setq ll (cons (list (car lst)) ll)) 
    ) 
  ) 
  (if tf 
    (mapcar '(lambda (x) (mapcar 'fix x)) ll) 
    ll 
  ) 
) 
;;适用原素为 LIST 的分组 
(defun List:Group2 (lst fuzz / ll l) 
  (setq ll (list (list (car lst)))) 
  (while (setq lst (cdr lst)) 
    (if        (setq l        (vl-member-if 
                  '(lambda (x) (equal (car x) (car lst) fuzz)) 
                  ll 
                ) 
        ) 
      (setq ll (subst (append (car l) (list (car lst))) 
                      (car l) 
                      ll 
               ) 
      ) 
      (setq ll (cons (list (car lst)) ll)) 
    ) 
  ) 
  ll 
)

/db_自贡黄明儒_ · 发表于 2013-11-18 16:24:52

要有应用示例，就好理解一些。
也就是说，输入什么，输出什么

st788796 · 发表于 2013-11-18 16:31:11

/db_自贡黄明儒_ 发表于 2013-11-18 16:24
要有应用示例，就好理解一些。
也就是说，输入什么，输出什么

第一个应用可能多些，比如统计某个字的数量
或者分别统计块的数量

434939575 · 发表于 2014-3-21 20:34:04

在大师这里学：mapcar的妙用。今天建了一个下载目录。感谢！

77077 · 发表于 2014-9-27 09:55:39

有bug
(setq ll (("图层5" 31916.6) ("图层5" 39767.8) ("图层4" 31916.6) ("图层4" 39767.8) ("图层2" 31916.6) ("图层2" 39767.8) ("图层2" 31916.6) ("图层1" 39767.8) ("图层5" 31916.6) ("图层5" 39767.8) ("图层4" 31916.6) ("图层3" 39767.8) ("图层3" 31916.6) ("图层3" 39767.8) ("图层1" 31916.6) ("图层1" 39767.8)))

(List:Group2 ll 0)

==>
((("图层1" 31916.6)) (("图层3" 31916.6)) (("图层3" 39767.8) ("图层3" 39767.8))
(("图层1" 39767.8) ("图层1" 39767.8)) (("图层2" 39767.8)) (("图层2" 31916.6)
("图层2" 31916.6)) (("图层4" 39767.8)) (("图层4" 31916.6) ("图层4" 31916.6))
(("图层5" 39767.8) ("图层5" 39767.8)) (("图层5" 31916.6) ("图层5" 31916.6)))

77077 · 发表于 2014-9-27 10:14:31

;针对以上lst做适当调整
(defun List:Group2 (lst fuzz / ll l)
(setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))));分组之前先排序
(setq ll (list (list (car lst))))
(while (setq lst (cdr lst))
(if (setq l (vl-member-if
'(lambda (x) (equal (car x) (car lst) fuzz))
ll
)
)
(setq ll (subst (append (car l) (list (car lst)))
(car l)
ll
)
)
(setq ll (cons (list (car lst)) ll))
)
)
ll
)

st788796 · 发表于 2014-9-27 10:15:12

77077 发表于 2014-9-27 09:55
有bug
(setq ll (("图层5" 31916.6) ("图层5" 39767.8) ("图层4" 31916.6) ("图层4" 39767.8) ("图层2" 31 ...

使用 xd::list:groupbyindex

Free-Lancer · 发表于 2014-9-27 10:29:33

77077 发表于 2014-9-27 10:14

_$ (xd::list:groupbyindex ll 0)
(("图层5" 39767.8 31916.6 39767.8 31916.6) ("图层4" 31916.6 39767.8 31916.6) ("图层3" 39767.8 31916.6 39767.8) ("图层2" 31916.6 39767.8 31916.6) ("图层1" 39767.8 31916.6 39767.8))

77077 · 发表于 2014-9-27 10:36:05

嘿嘿，学习嘛，就是一个完善程序的过程。xd::list:groupbyindex是经过测试暂时没发现bug的了
这里是讨论下这么完善楼主这个~

csharp · 发表于 2014-9-27 12:37:04

77077 发表于 2014-9-27 10:36
嘿嘿，学习嘛，就是一个完善程序的过程。xd::list:groupbyindex是经过测试暂时没发现bug的了
这里是讨论下 ...

支持下这种学习精神

xvjiex · 发表于 2021-7-7 00:04:41

感谢分享关于表分组的两个函数。

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

[每日一码] 关于表分组的两个函数

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

评分

点评

点评

点评