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)

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)