Path: nntp.eternal-september.org!news.eternal-september.org!eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: How to improve my summarizing code
Date: Mon, 30 Jun 2025 02:59:24 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 67
Message-ID: <103suib$1v1l7$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Mon, 30 Jun 2025 04:59:25 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="b316bafb1ab57d3a7e95c5e7f34e7f34";
	logging-data="2066087"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX18eWLDDHzHqxmts39F5v4e6"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:k0yhYWnq+fDT1NmwOOgmkRhplwQ=

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