Rocksolid Light

News from da outaworlds

mail  files  register  groups  login

Message-ID:  

An avocado-tone refrigerator would look good on your resume.


comp / comp.lang.lisp / Re: Accumulating in hash-table

SubjectAuthor
* Accumulating in hash-tableB. Pym
`- Re: Accumulating in hash-tableKaz Kylheku

1
Subject: Accumulating in hash-table
From: B. Pym
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Mon, 22 Jul 2024 19:47 UTC
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Nobody447095@here-nor-there.org (B. Pym)
Newsgroups: comp.lang.lisp
Subject: Accumulating in hash-table
Date: Mon, 22 Jul 2024 19:47:49 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 41
Message-ID: <v7md14$pr7r$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Mon, 22 Jul 2024 21:47:50 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="e396b2dbc7de6c10992283c407241561";
logging-data="847099"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX19mD0KLhPkqsq0VBnpMtqIA"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:PILd6cyRqttNCVAJl89dWQZE13o=
View all headers

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

Subject: Re: Accumulating in hash-table
From: Kaz Kylheku
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Tue, 23 Jul 2024 01:14 UTC
References: 1
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: 643-408-1753@kylheku.com (Kaz Kylheku)
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: <v7md14$pr7r$1@dont-email.me>
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=
View all headers

On 2024-07-22, B. Pym <Nobody447095@here-nor-there.org> 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

1

rocksolid light 0.9.8
clearnet tor