1. Forum
  2. Usenet
  3. COMP.LANG.LISP

  • Re: Any way to collect all the values of a hash table more concisely ?

    From B. Pym@21:1/5 to All on Fri Jul 5 22:09:09 2024
    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)))))
    ^^^^^^^^^^

    "lambda" is a macro that expands to (function (lambda ...)).
    So instead of
    #'(lambda
    he ought to use
    (lambda

    The poster prefers #'lambda because he prefers ugliness.

    Common Lisp is used by those who want code to be as
    hideous as possible.

    Gauche Scheme

    (define (cluster-by fn lst)
    (let ((clusters (make-hash-table 'equal?)))
    (dolist (k lst)
    (hash-table-push! clusters (fn k) k))
    (hash-table-values clusters)))

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

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From B. Pym@21:1/5 to Leandro Rios on Fri Aug 16 09:17:30 2024
    Leandro Rios wrote:

    Leandro Rios escribi�:

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

    newLISP

    (macro (aalt! Alist Key Func Default)
    (if (assoc Key Alist)
    (setf (assoc Key Alist) (list ($it 0) (Func ($it 1))))
    (push (list Key (Func Default)) Alist)))

    (macro (apush! Alist Key Val)
    (aalt! Alist Key (curry cons Val) '()))

    (define (group-by func lst (alist '()))
    (dolist (x lst) (apush! alist (func x) x))
    alist)

    (group-by length '("a" "b" "abc" "bc" "a" "abcd" "e" "fg"))
    ===>
    ((4 ("abcd")) (2 ("fg" "bc")) (3 ("abc")) (1 ("e" "a" "b" "a")))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From B. Pym@21:1/5 to B. Pym on Mon Aug 19 05:58:38 2024
    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)))))

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