表归类问题

黄翔

请问表


(
( 0 "w1-w2" DN300 30.0 25)
( 1 "w3-w4" DN300 20.0 30)
( 2 "w1-w2" DN300 30.0 11)
( 3 "w4-w5" DN300 10.0  2)
( 4 "w3-w4" DN300 20.0  3)
( 5 "w1-w2" DN300 30.0 5)
)
按照第二项归类
得到

(
  (
  ( 0 "w1-w2" DN300 30.0 25)
  ( 2 "w1-w2" DN300 30.0 11)
  ( 5 "w1-w2" DN300 30.0 5)
)
(
( 1 "w3-w4" DN300 20.0 30)
( 4 "w3-w4" DN300 20.0  3)
)
  ( 3 "w4-w5" DN300 10.0  2)
)

xtjd

(setq lst '(
               ( 0 "w1-w2" DN300 30.0 25)
               ( 1 "w3-w4" DN300 20.0 30)
               ( 2 "w1-w2" DN300 30.0 11)
               ( 3 "w4-w5" DN300 10.0  2)
               ( 4 "w3-w4" DN300 20.0  3)
               ( 5 "w1-w2" DN300 30.0 5)
              )
)
(setq n2(mapcar 'cadr lst)n2x nil)
(while(setq n2x(cons(car n2)n2x)n2(vl-remove(car n2)(cdr n2))))
(mapcar '(lambda(n)(vl-remove-if-not '(lambda(x)(=(cadr x)n))lst))(reverse n2x))

liuhe

http://bbs.mjtd.com/thread-190896-1-1.html

(SETQ LST '(
            (0 "w1-w2" DN300 30.0 25)
            (1 "w3-w4" DN300 20.0 30)
            (2 "w1-w2" DN300 30.0 11)
            (3 "w4-w5" DN300 10.0 2)
            (4 "w3-w4" DN300 20.0 3)
            (5 "w1-w2" DN300 30.0 5)
           )
)
(defun lh:func (a b  fuzzx fuzzy / name1 name2)

  (eq (cadr a)(cadr b) )
)
(setq lst(LH:FINDFRIENDS   lst lh:func  0  0))

LH:FINDFRIENDS函数见我的帖子

你可以测试一下

vitalgg

1. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   
2. 
   
3. (setq lst '(
   
4.             ( 0 "w1-w2" DN300 30.0 25)
   
5.             ( 1 "w3-w4" DN300 20.0 30)
   
6.             ( 2 "w1-w2" DN300 30.0 11)
   
7.             ( 3 "w4-w5" DN300 10.0  2)
   
8.             ( 4 "w3-w4" DN300 20.0  3)
   
9.             ( 5 "w1-w2" DN300 30.0 5)
   
10.             ))
    
11. 
    
12. (setq lst (list:sort lst '(lambda(x y)(< (cadr x)(cadr y)))))
    
13. (setq lst (list:group-by  lst '(lambda(x y)(eq (cadr x)(cadr y)))))

(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br /> <br /> (setq lst '(<br />             ( 0 "w1-w2" DN300 30.0 25)<br />             ( 1 "w3-w4" DN300 20.0 30)<br />             ( 2 "w1-w2" DN300 30.0 11)<br />             ( 3 "w4-w5" DN300 10.0  2)<br />             ( 4 "w3-w4" DN300 20.0  3)<br />             ( 5 "w1-w2" DN300 30.0 5)<br />             ))<br /> <br /> (setq lst (list:sort lst '(lambda(x y)(< (cadr x)(cadr y)))))<br /> (setq lst (list:group-by  lst '(lambda(x y)(eq (cadr x)(cadr y)))))

运行结果

1. 命令:
   
2. 命令: (load "test/group")
   
3. (((0 "w1-w2" DN300 30.0 25) (2 "w1-w2" DN300 30.0 11) (5 "w1-w2" DN300 30.0 5)) ((1 "w3-w4" DN300 20.0 30) (4 "w3-w4" DN300 20.0 3)) ((3 "w4-w5" DN300 10.0 2)))

命令:<br /> 命令: (load "test/group")<br /> (((0 "w1-w2" DN300 30.0 25) (2 "w1-w2" DN300 30.0 11) (5 "w1-w2" DN300 30.0 5)) ((1 "w3-w4" DN300 20.0 30) (4 "w3-w4" DN300 20.0 3)) ((3 "w4-w5" DN300 10.0 2)))

查询相关函数：

黄翔

谢谢!               

黄翔

(list:sort '((1 2 3 1 9)(1 2 3 1 8))   '(lambda(x y)(<  (nth 4 x)(nth 4 y)))) 出错.有bug

vitalgg

黄翔 发表于 2024-10-10 21:29
(list:sort '((1 2 3 1 9)(1 2 3 1 8))   '(lambda(x y)(<  (nth 4 x)(nth 4 y)))) 出错.有bug

感谢提示，已更正。