Path: ...!news.misty.com!2.eu.feeder.erje.net!feeder.erje.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail From: Kaz Kylheku <643-408-1753@kylheku.com> Newsgroups: comp.lang.lisp Subject: Re: Accumulating in hash-table Date: Tue, 23 Jul 2024 01:14:45 -0000 (UTC) Organization: A noiseless patient Spider Lines: 114 Message-ID: <20240722155524.793@kylheku.com> References: Injection-Date: Tue, 23 Jul 2024 03:14:45 +0200 (CEST) Injection-Info: dont-email.me; posting-host="2e723cea1cdfb5e1d326eb8834436c3e"; logging-data="950529"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX18BRpV+AOCeRLUDa9pP+hxbFVAVO7SuoxU=" User-Agent: slrn/pre1.0.4-9 (Linux) Cancel-Lock: sha1:s/7Y+GJys9E5NNbfqD9Uivh7gJI= Bytes: 4997 On 2024-07-22, B. Pym wrote: >> (defun distribution1 (items values test) >> (let ((table (make-hash-table :test test))) >> (loop for item in items >> for value in values >> do (incf (gethash item table 0) value)) >> (let ((items-list nil)) >> (maphash (lambda (item sum-value) >> (push (cons item sum-value) items-list)) >> table) >> (sort items-list #'> :key #'cdr)))) >> >> An example call: >> >> CL-USER 58 > (distribution1 '("a" "b" "c" "b" "a" "f" "e" "g" >> "h" "k" "z" "k" "r" "u" "f") >> '(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9) >> #'equal) >> (("k" . 25) ("f" . 17) ("a" . 15) ("b" . 12) ("h" . 9) ("c" . 8) >> ("g" . 7) ("u" . 7) ("r" . 5) ("e" . 3) ("z" . 3)) > > Gauche Scheme > > (define (distribution1 items values test) > (let1 table (make-hash-table test) > (for-each > (^(item value) > (hash-table-update! table item (cut + value <>) 0)) > items > values) > (sort (hash-table->alist table) > cdr))) > > (distribution1 '("a" "b" "c" "b" "a" "f" "e" "g" > "h" "k" "z" "k" "r" "u" "f") > '(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9) > 'equal?) > > ===> > (("k" . 25) ("f" . 17) ("a" . 15) ("b" . 12) ("h" . 9) ("c" . 8) ("g" . 7) > ("u" . 7) ("r" . 5) ("z" . 3) ("e" . 3)) This is the TXR Lisp interactive listener of TXR 294. Quit with :quit or Ctrl-D on an empty line. Ctrl-X ? for cheatsheet. I'm not addicted to procrastination. I can start any time I want to! 1> (defun distrib (items values) (let ((h (hash))) (each ((i items) (v values)) (inc [h i 0] v)) [sort (hash-alist h) : car])) distrib 2> (distrib '("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f") '(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9)) (("a" . 15) ("b" . 12) ("c" . 8) ("e" . 3) ("f" . 17) ("g" . 7) ("h" . 9) ("k" . 25) ("r" . 5) ("u" . 7) ("z" . 3)) Look how much the better code looks when you don't have silly things like a for-each that takes a lambda, and having to call a function with a functional argument to update a hash cell. Also, when you make equal hash tables default, most of the time it's the right default. You can skip the test arguments and whatnot. Names like "hash-table->alist" make my eyes bleed. Oops, I sorted on the wrong thing. 1> (defun distrib (items values) (let ((h (hash))) (each ((i items) (v values)) (inc [h i 0] v)) [sort (hash-alist h) > cdr])) distrib 2> (distrib '("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f") '(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9)) (("k" . 25) ("f" . 17) ("a" . 15) ("b" . 12) ("h" . 9) ("c" . 8) ("u" . 7) ("g" . 7) ("r" . 5) ("z" . 3) ("e" . 3)) Using group-reduce: 1> (defun distrib (items values) (flow [group-reduce (hash) car [mapf + use cdr] [mapcar cons items values] 0] hash-alist (sort @1 > cdr))) distrib 2> (distrib '("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f") '(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9)) (("k" . 25) ("f" . 17) ("a" . 15) ("b" . 12) ("h" . 9) ("c" . 8) ("u" . 7) ("g" . 7) ("r" . 5) ("z" . 3) ("e" . 3)) Using group-reduce on the keys, using pop to get the values, so we don't cons up list of pairs up-front: 3> (defun distrib (items values) (flow [group-reduce (hash) identity [mapf + use (ret (pop values))] items 0] hash-alist (sort @1 > cdr))) distrib 4> (distrib '("a" "b" "c" "b" "a" "f" "e" "g" "h" "k" "z" "k" "r" "u" "f") '(1 5 8 7 14 8 3 7 9 4 3 21 5 7 9)) (("k" . 25) ("f" . 17) ("a" . 15) ("b" . 12) ("h" . 9) ("c" . 8) ("u" . 7) ("g" . 7) ("r" . 5) ("z" . 3) ("e" . 3)) -- TXR Programming Language: http://nongnu.org/txr Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal Mastodon: @Kazinator@mstdn.ca