From Newsgroup: comp.lang.lisp

Wade Humeniuk wrote:

Yeah, but I do not worry about it, much, at the beginning. Here
is another, it seems easier to think in the morning

(defun summarize (list)
(let ((summary nil))
(map nil (lambda (elt)
(let ((sum (find (first elt) summary :test #'eql :key #'first)))
(if sum
(incf (second sum) (second elt))
(push elt summary))))
list)
summary))

and its loop version

(defun summarize (list)
(loop with summary = nil
for elt in list
for sum = (find (first elt) summary :test #'eql :key #'first)
if sum do (incf (second sum) (second elt))
else do (push elt summary)
finally (return summary)))

CL-USER 2 > (summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
((B 111) (A 4) (C 7))

Gauche Scheme

Using a collector that collects into an association list.

(define (summarize alist)
(let1 a (malistbag)
(for-each
(lambda (xs) (apply a `(,@xs ,+)))
alist)
(a)))

(summarize '((c 7) (a 1) (a 3) (b 1) (b 10) (b 100)))
===>
((b . 111) (c . 7) (a . 4))

Given:

;; Non-destructive.
(define (update-alist alist k v :optional (func #f) (default 0))
(define (alter-entry e)
(if func
(let ((new-v (func v (if e (cdr e) default))))
(cons k new-v))
(cons k v)))
(let go ((the-list alist) (seen '()))
(cond ((null? the-list) (cons (alter-entry #f) seen))
((equal? k (caar the-list))
(append (cons (alter-entry (car the-list)) seen)
(cdr the-list)))
(#t (go (cdr the-list) (cons (car the-list) seen))))))

(define (malistbag)
(let ((bag '()))
(case-lambda
[() bag]
[(k) (let ((e (assoc k bag))) (and e (cdr e)))]
[(k val) (set! bag (update-alist bag k val))]
[(k val func) (set! bag (update-alist bag k val func))]
[(k val func def) (set! bag (update-alist bag k val func def))])))
--- Synchronet 3.21d-Linux NewsLink 1.2