From Newsgroup: comp.lang.lisp

B. Pym wrote:

B. Pym wrote:

Kenny Tilton wrote:

(defun p2b (pairs &key ((:test test) #'eql))
"((A 1) (A 2) (B 2) (C 2) (C 3)) ==> ((A 1 2) (B 2) (C 2 3))"
(loop with bunch = nil
for (one two) in pairs
do (push two (cdr (or (assoc one bunch :test test)
(car (push (list one) bunch)))))
finally (return bunch)))

Testing:

(p2b '((A 1) (A 2) (B 2) (C 2) (C 3) (A 88)))
===>
((C 3 2) (B 2) (A 88 2 1))

Gauche Scheme

Let's use a collector that collects into an association-list.

(let ((a (malistbag)))
(for-each
(lambda(xs) (apply a `(,@xs ,cons ())))
'((A 1) (A 2) (B 2) (C 2) (C 3) (A 88)))
(a))

Given:

Another way.

(define (p2b pairs :optional (test equal?))
(define alist (map list (delete-duplicates (map car pairs))))
(define (proc k v) (push! (cdr (assoc k alist test)) v))
(dolist (e pairs) (apply proc e))
alist)

--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

Kenny Tilton wrote:

(defun p2b (pairs &key ((:test test) #'eql))
"((A 1) (A 2) (B 2) (C 2) (C 3)) ==> ((A 1 2) (B 2) (C 2 3))"
(loop with bunch = nil
for (one two) in pairs
do (push two (cdr (or (assoc one bunch :test test)
(car (push (list one) bunch)))))
finally (return bunch)))

Testing:

(p2b '((A 1) (A 2) (B 2) (C 2) (C 3) (A 88)))
===>
((C 3 2) (B 2) (A 88 2 1))


Gauche Scheme

Let's use a collector that collects into an association-list.

(let ((a (malistbag)))
(for-each
(lambda(xs) (apply a `(,@xs ,cons ())))
'((A 1) (A 2) (B 2) (C 2) (C 3) (A 88)))
(a))

Given:

;; Non-destructive.
(define (update-alist alist k v :optional (func #f) (default 0))
(define (alter-entry e)
(if func
(let ((new-v (func v (if e (cdr e) default))))
(cons k new-v))
(cons k v)))
(let go ((the-list alist) (seen '()))
(cond ((null? the-list) (cons (alter-entry #f) seen))
((equal? k (caar the-list))
(append (cons (alter-entry (car the-list)) seen)
(cdr the-list)))
(#t (go (cdr the-list) (cons (car the-list) seen))))))

(define (malistbag)
(let ((bag '()))
(case-lambda
[() bag]
[(k) (let ((e (assoc k bag))) (and e (cdr e)))]
[(k val) (set! bag (update-alist bag k val))]
[(k val func) (set! bag (update-alist bag k val func))]
[(k val func def) (set! bag (update-alist bag k val func def))])))



--- Synchronet 3.21d-Linux NewsLink 1.2