tender138 发表于 昨天 15:09

麻烦各位大佬写个相同项累加并排序的程序

(setq Lst
         (list
         '("CT1" 3 0.93 0.986)
         '("CT1" 3 0.93 0.986)
         '("CT2" 3 1.008 1.065)
         '("CT1" 3 0.93 0.986)
         '("CT1" 3 0.93 0.986)
         '("CT2" 3 1.008 1.065)
         '("CT2" 3 1.008 1.065)
         '("CT2" 3 1.008 1.065)
         '("CT2" 3 1.008 1.065)
         '("CT2" 3 1.008 1.065)
         '("CJ1" 3 1.41 1.482)
         '("CJ3" 3 0.57 0.614)
         '("CJ1" 3 1.41 1.482)
         '("CJ3" 3 0.57 0.614)
         '("CJ2" 3 1.528 1.601)
         '("CJ4" 3 0.618 0.663)
         '("CJ1" 3 1.41 1.482)
         '("CJ3" 3 0.57 0.614)
         '("CJ1" 3 1.41 1.482)
         '("CJ3" 3 0.57 0.614)
         '("CJ2" 3 1.528 1.601)
         '("CJ4" 3 0.619 0.667)
         '("CJ4" 3 0.618 0.663)
         )
)
希望返回：((CJ1 3 5.64 5.928) (CJ2 3 3.056 3.202) (CJ3 3 2.28 2.456) (CJ4 3 1.236 1.326) (CT1 3 3.72 3.944) (CT2 3 6.048 6.39))
列表如上，麻烦各位大佬帮写个第1元素相同项累加第3、4元素，然后按第1元素排序的程序，非常谢谢！

tryhi 发表于 昨天 15:30

本帖最后由 tryhi 于 2025-4-29 15:32 编辑

写完之后编辑器死机了，还好我截图下来，这是完整代码，你抄一下吧，附件是try-num-lst-flhz函数


tender138 发表于 昨天 16:28

tryhi 发表于 2025-4-29 15:30
写完之后编辑器死机了，还好我截图下来，这是完整代码，你抄一下吧，附件是try-num-lst-flhz函数
(defun c:AA( / Lst a b)
(setq Lst
         (list
         '("CT1" 3 0.93 0.986)
         '("CT1" 3 0.93 0.986)
         '("CT2" 3 1.008 1.065)
         '("CT1" 3 0.93 0.986)
         '("CT1" 3 0.93 0.986)
         '("CT2" 3 1.008 1.065)
         '("CT2" 3 1.008 1.065)
         '("CT2" 3 1.008 1.065)
         '("CT2" 3 1.008 1.065)
         '("CT2" 3 1.008 1.065)
         '("CJ1" 3 1.41 1.482)
         '("CJ3" 3 0.57 0.614)
         '("CJ1" 3 1.41 1.482)
         '("CJ3" 3 0.57 0.614)
         '("CJ2" 3 1.528 1.601)
         '("CJ4" 3 0.618 0.663)
         '("CJ1" 3 1.41 1.482)
         '("CJ3" 3 0.57 0.614)
         '("CJ1" 3 1.41 1.482)
         '("CJ3" 3 0.57 0.614)
         '("CJ2" 3 1.528 1.601)
         '("CJ4" 3 0.619 0.667)
         '("CJ4" 3 0.618 0.663)
         )
)
(setq
    a (mapcar '(lambda(x) (reverse (cdr (reverse x)))) Lst)
    b (mapcar '(lambda(x) (list (car x) (cadr x) (last x))) Lst)
)
(setq
    a (try-num-lst-flhz a)
    b (try-num-lst-flhz b)
)
(vl-sort (mapcar '(lambda(a b) (append a (list (last b)))) a b) '(lambda(a b) (<(car a) (car b))))
)

(defun try-num-lst-flhz (lst / assocs head num)
(defun assocs (e lst) (mapcar 'cadr (vl-remove-if-not '(lambda(x) (equal e (car x))) lst)))
(setq lst (mapcar '(lambda(x) (list (reverse (cdr (reverse x))) (last x))) lst));把每个子项(a b c n)转换为((a b c)n)
(setq
    head (try-lst-move-same (mapcar 'car lst));表去重
    num (mapcar '(lambda(x) (apply '+ (assocs x lst))) head)
)
(mapcar 'append head (mapcar 'list num));重新合并
)

(defun try-lst-move-same (lst / s-car new)
(while lst
    (setq s-car (car lst))
    (if(vl-position s-car new)
      nil
      (setq new (cons s-car new))
    )
    (setq lst (cdr lst))
)
(setq new (reverse new))
new
)

夏生生 发表于 昨天 16:08

tender138 发表于 2025-4-29 15:29
谢谢！我太菜了，写不出一个完整的小程序

就是这三个函数一拼就行了
(defun tt(lst / a lst1 tmp)(while lst
(setq tmp(vl-remove-if-not '(lambda (x) (= (setq a (caar lst)) (car x)))
                              lst)
       lst1 (cons (list        a
                        (cadar tmp)
                        (apply '+ (mapcar 'caddr tmp))
                        (apply '+ (mapcar 'cadddr tmp)))
                  lst1)
       lst(vl-remove-if '(lambda (x) (= a (car x))) lst)))
(vl-sort lst1'(lambda(x y)(<(car x)(car y)))))

夏生生 发表于 昨天 15:25

vl-remove-if vl-remove-if -not vl-sort组合一下即可

tender138 发表于 昨天 15:29

夏生生 发表于 2025-4-29 15:25
vl-remove-if vl-remove-if -not vl-sort组合一下即可

谢谢！我太菜了，写不出一个完整的小程序

tender138 发表于 昨天 15:42

tryhi 发表于 2025-4-29 15:30
写完之后编辑器死机了，还好我截图下来，这是完整代码，你抄一下吧，附件是try-num-lst-flhz函数

非常感谢大师的热心帮忙，谢谢！！！:handshake

qwsss31 发表于 昨天 15:48

牛啤plus海哥牛啤哈~

tryhi 发表于 昨天 15:57

tender138 发表于 2025-4-29 15:42
非常感谢大师的热心帮忙，谢谢！！！

要不你把代码补齐发出来吧，方便后来人检索

tender138 发表于 昨天 16:26

本帖最后由 tender138 于 2025-4-29 16:27 编辑

夏生生 发表于 2025-4-29 16:08
就是这三个函数一拼就行了
非常感谢大师的热心帮忙，评分限制，明天再给你加分。谢谢！！！
页: [1] 2
查看完整版本: 麻烦各位大佬写个相同项累加并排序的程序