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

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函数

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

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
就是这三个函数一拼就行了

非常感谢大师的热心帮忙，评分限制，明天再给你加分。谢谢！！！

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

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

本帖子中包含更多资源

评分

评分

浏览过的版块