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

(use gauche.sequence) ;; group-sequence

(define (summarize alist)
(map
(lambda(xs) (list (caar xs) (fold + 0 (map cadr xs))))
(group-sequence alist :key car)))

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


Another way:

(use srfi-1) ;; list-index

(define (index x xs) (list-index (cut equal? x <>) xs))

(define (summarize alist)
(let1 keys (delete-duplicates (map car alist) )
(map
cons
keys
(apply map
+
(map
(lambda(kv)
(let1 v (make-vector (length keys) 0)
(vector-set! v (index (car kv) keys) (cadr kv))
(vector->list v)))
alist)))))

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

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On 6/23/2024, B. Pym wrote:

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

(use gauche.sequence) ;; group-sequence

(define (summarize alist)
(map
(lambda(xs) (list (caar xs) (fold + 0 (map cadr xs))))
(group-sequence alist :key car)))

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

Another way:

(use srfi-1) ;; list-index

(define (index x xs) (list-index (cut equal? x <>) xs))

(define (summarize alist)
(let1 keys (delete-duplicates (map car alist) )
(map
cons
keys
(apply map
+
(map
(lambda(kv)
(let1 v (make-vector (length keys) 0)
(vector-set! v (index (car kv) keys) (cadr kv))
(vector->list v)))
alist)))))

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

Another way:

(define (summarize alist)
(delete-duplicates
(fold
(lambda (kv accum)
(let* ((k (car kv))
(v (cdr kv))
(n (assoc-ref accum k 0)))
(cons (cons k (+ n v)) accum)))
'()
alist)
(lambda(a b)(equal? (car a)(car b)))))

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

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On 6/23/2024, B. Pym wrote:

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

(use gauche.sequence) ;; group-sequence

(define (summarize alist)
(map
(lambda(xs) (list (caar xs) (fold + 0 (map cadr xs))))
(group-sequence alist :key car)))

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

Another way:

(use util.match)

(define (summarize assoclist)
(define tree (make-tree-map))
(for-each
(match-lambda
[(key val) (tree-map-update! tree key (cut + <> val) 0)])
assoclist)
(tree-map->alist tree))

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

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On 6/23/2024, B. Pym wrote:

(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))

(define (summarize alist)
(let1 keys (delete-duplicates (map car alist))
(map
(lambda(k)
(list k
(apply +
(filter-map
(lambda(x) (and (equal? k (car x)) (cadr x)))
alist))))
keys)))

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

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

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))])))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)