Path: ...!2.eu.feeder.erje.net!feeder.erje.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: Any way to collect all the values of a hash table more concisely ?
Date: Mon, 19 Aug 2024 05:58:38 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 56
Message-ID: <v9umuc$2osfp$1@dont-email.me>
References: <v69qu1$3f6ps$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Mon, 19 Aug 2024 07:58:39 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="e424c484fd84d3ea93231443f92efc4c";
	logging-data="2912761"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/H5UOAp1WpcGelCrv74TLQ"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:1K8gUPqapEK/22CfYS+ajRgh17U=
Bytes: 2816

B. Pym wrote:

> > > So this new version works as intended: 
> > 
> > > (defun cluster-by (fn list &aux (clusters (make-hash-table)) (result nil)) 
> > >     (mapcar #'(lambda (x) (push x (gethash (funcall fn x) clusters))) list) 
> > >     (maphash  #'(lambda (key value) (push value result)) clusters) 
> > >     (sort result #'< :key #'(lambda (x) (length (car x))))) 
> > 
> > Um, sorry: 
> > 
> > (defun cluster-by (fn list &aux (clusters (make-hash-table)) (result nil)) 
> >      (mapcar #'(lambda (x) (push x (gethash (funcall fn x) clusters))) list) 
> >      (maphash  #'(lambda (key value) (push value result)) clusters) 
> >      (sort result #'< :key #'(lambda (x) (funcall fn (car x))))) 
> >                                           ^^^^^^^^^^

Testing:

(cluster-by #'length '("a" "b" "abc" "bc" "a" "abcd" "e" "fg"))
  ===>
(("e" "a" "b" "a") ("fg" "bc") ("abc") ("abcd"))

The items are grouped by "length" and then sorted
by "length".


newLISP

(define (group-by func lst    , (alist '()) result)
  (dolist (x lst) (ainc! alist (func x) x cons '()))
  (set 'result (sort alist (fn (a b) (< (first a) (first b)))))
  (map last result))

(group-by length '("a" "b" "abc" "bc" "a" "abcd" "e" "fg"))
  ===>
(("e" "a" "b" "a") ("fg" "bc") ("abc") ("abcd"))
 
Given:

(macro (ainc! Alist Key Value Function Deflt)
  (local (E-Message Val Func Def)
    (setq Func Function)
    (if (true? Func)
      (setq Val Value)
      (begin (setq Func +) (setq Val (or Value 1))))
    (setq Def Deflt)
    (if (= nil Def) (setq Def 0))
    (unless  
      (catch
        (setf (assoc Key Alist)
          (list ($it 0) (Func Val ($it 1))))
        'E-Message)
      (if (starts-with E-Message "ERR: no reference")
        (setf Alist (cons (list Key (Func Val Def)) Alist))
        (throw-error E-Message)))))