su内的数字总和

MJLM · 发表于 2022-7-5 23:22:21

我写了一个例程，让我把我画的一堆线中的数对放在一起。列表是这样的

((40 3.0) (40 4.0) (50 1.0) (50 3.0) (65 3.0) (65 5.0) (80 3.0) (80 10.0) (100
10.0) (100 6.0) (100 5.0))

我需要对该列表中所有子列表的所有第二个数字进行总和。我的目标是键入以下内容：

40 7
50 4
65 8
80 13
100 21

我认为apply或lambda命令在这里会帮助我，但我就是找不到方法。任何帮助都将不胜感激。

MSasu · 发表于 2022-7-5 23:32:33

不确定是否可以用MAPCAR实现这一点。

copy

(setq listTemp '())
(foreach subList '((40 3.0) (40 4.0) (50 1.0) (50 3.0) (65 3.0) (65 5.0) (80 3.0) (80 10.0) (100 10.0) (100 6.0) (100 5.0))
(if (setq listExists (assoc (setq idList (car subList)) listTemp))
 (setq listTemp (subst (list idList (+ (cadr listExists) (cadr subList)))
                       listExists
                       listTemp))
 (setq listTemp (append listTemp
                        (list subList)))
)
)

顺便问一下，我可以建议您考虑使用点对而不是列表吗？

copy

(setq listTemp '())
(foreach subList '((40 . 3.0) (40 . 4.0) (50 . 1.0) (50 . 3.0) (65 . 3.0) (65 . 5.0) (80 . 3.0) (80 . 10.0) (100 . 10.0) (100 . 6.0) (100 . 5.0))
(if (setq listExists (assoc (setq idList (car subList)) listTemp))
 (setq listTemp (subst (cons idList (+ (cdr listExists) (cdr subList)))
                       listExists
                       listTemp))
 (setq listTemp (append listTemp
                        (list subList)))
)
)

Tharwat · 发表于 2022-7-5 23:38:01

使用点对是列表的最佳选择。

这是我对mapcar和lambda的修改。

copy


(setq l '((40 . 3.0)
         (40 . 4.0)
         (50 . 1.0)
         (50 . 3.0)
         (65 . 3.0)
         (65 . 5.0)
         (80 . 3.0)
         (80 . 10.0)
         (100 . 10.0)
         (100 . 6.0)
         (100 . 5.0)
        )
)
(mapcar '(lambda (u)
          (if (setq a (assoc (car u) lst))
            (setq lst (subst (cons (car u) (+ (cdr a) (cdr u))) a lst))
            (setq lst (cons (cons (car u) (cdr u)) lst))
          )
        )
       (reverse l)
)

MJLM · 发表于 2022-7-5 23:41:20

我用了你的密码。谢谢你和塔瓦的帮助。似乎我需要详细阐述一下，以了解它是如何工作的。

MSasu · 发表于 2022-7-5 23:48:37

不客气！我在代码中添加了一些注释，以帮助您理解它：

copy

[color=blue];initiate a new, empty list to store result sets (key + sum)[/color]
(setq listTemp '())
[color=blue];parse the items of input list (pairs of key and value)[/color]
(foreach subList '((40 . 3.0) (40 . 4.0) (50 . 1.0) (50 . 3.0) (65 . 3.0) (65 . 5.0) (80 . 3.0) (80 . 10.0) (100 . 10.0) (100 . 6.0) (100 . 5.0)) 
[color=blue] ;test if an element with current key was already treated (is stored in results list)[/color]
(if (setq listExists (assoc (setq idList (car subList)) listTemp))
[color=blue]  ;if yes, then summate current value to stored sum and replace the existing set (key + sum)[/color]
 (setq listTemp (subst (cons idList (+ (cdr listExists) (cdr subList)))
                       listExists
                       listTemp))
[color=blue]  ;if not, then create a new set (key + sum) in results list[/color]
 (setq listTemp (append listTemp
                        (list subList)))
)
)

David Bethel · 发表于 2022-7-5 23:53:35

类似地-可能：

copy


[b][color=BLACK]([/color][/b]defun c:sumlist [b][color=FUCHSIA]([/color][/b]/ d fl[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]foreach p '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]40 3.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]40 4.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]50 1.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]50 3.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]65 3.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]65 5.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]80 3.0[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]80 10.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]100 10.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]100 6.0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]100 5.0[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  [b][color=NAVY]([/color][/b]setq fl [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]setq d [b][color=BLUE]([/color][/b]assoc [b][color=RED]([/color][/b]car p[b][color=RED])[/color][/b] fl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]subst [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]car p[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]+ [b][color=PURPLE]([/color][/b]cadr d[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]cadr p[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] d fl[b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]cons p fl[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]prin1 fl[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-大卫

BIGAL · 发表于 2022-7-5 23:57:15

我在别处发布的另一种方法是在循环中两次使用第n个函数

copy

(setq x 0)
(repeat (length list)
(setq ans (+  (nth 1 (nth x list)) ans)) ; get double values then get 2nd value which is postion 1 as list starts at 0
(setq x (+ x 1))
)

ymg3 · 发表于 2022-7-6 00:02:28

注意，Tharwat的代码也可以按原样在列表中使用
稍加修改。

copy


(defun test ( / a lst)
  (setq l '((40  3.0)
            (40  4.0)
            (50  1.0)
            (50  3.0)
            (65  3.0)
            (65  5.0)
            (80  3.0)
            (80  10.0)
            (100  10.0)
            (100  6.0)
            (100  5.0)
           )
  )
  (mapcar '(lambda (u)
             (if (setq a (assoc (car u) lst))
               (setq lst (subst (cons (car u) (+ (cdr a) [color="red"](cadr u)[/color])) a lst))
               (setq lst (cons (cons (car u) [color="red"](cadr u)[/color]) lst))
             )
           )
          (reverse l)
  )
 lst
)

然而，返回列表将是一个虚线列表：

copy

((40 . 7.0) (50 . 4.0) (65 . 8.0) (80 . 13.0) (100 . 21.0))

Tharwat · 发表于 2022-7-6 00:10:40

还有一个变种。

copy


(setq l '((40 . 3.0) (40 . 4.0) (50 . 1.0) (50 . 3.0) (65 . 3.0) (65 . 5.0) (80 . 3.0) (80 . 10.0) (100 . 10.0) (100 . 6.0) (100 . 5.0) ))
(mapcar '(lambda (u)
          (if (not (member (car u) lst))
            (setq lst (cons (car u) lst))
          )
        )
       l
)
(foreach x lst
 (setq sums
        (cons
          (cons
            x
            (apply
              '+
              (mapcar 'cdr
                      (vl-remove-if-not '(lambda (u) (eq (car u) x)) l)
              )
            )
          )
          sums
        )
 )
)

pBe · 发表于 2022-7-6 00:12:08

copy


(defun addsub (lst / a b c d)
 (while (setq a (car lst))
 (setq b (cdr lst))
   (while (setq c (assoc (Car a) b))
     (setq a (cons (car a) (+ (cdr a) (cdr c)))
    b (vl-remove c b)))
   (setq d   (cons a d)
  lst b))
 (reverse d)
)

递归

copy


(defun _addsub (lst d / a b c d)
 (if lst
   (progn
     (setq a (car lst)
    b (cdr lst)
     )
     (while (setq c (assoc (Car a) b))
(setq a        (cons (car a) (+ (cdr a) (cdr c)))
      b        (vl-remove c b)
)
     )
     (setq d (cons a d))
     (_addsub b d)
   )
   (reverse d)
 )
)

[编程交流] su内的数字总和

发表回复

精选推荐