reduce-tagged (was Re: toy list processing problem: collect similar terms)

[Mirko]

On Sep 27, 11:40 am, Mirko <mirko.vuko... at gmail.com> wrote:
> On Sep 27, 11:18 am, Mirko <mirko.vuko... at gmail.com> wrote:
>
>
>
> > On Sep 26, 12:05 am, Xah Lee <xah... at gmail.com> wrote:
>
> > I am hijacking the following post and driving it to Cuba (the Monthy
> > Python fans will know what I refer to).  I want to create a `reduce'-
> > like function that can handle similar problems.
>
> > Xah said:
>
> > > here's a interesting toy list processing problem.
>
> > > I have a list of lists, where each sublist is labelled by
> > > a number. I need to collect together the contents of all sublists
> > > sharing
> > > the same label. So if I have the list
>
> > > ((0 a b) (1 c d) (2 e f) (3 g h) (1 i j) (2 k l) (4 m n) (2 o p) (4 q
> > > r) (5 s t))
>
> > > where the first element of each sublist is the label, I need to
> > > produce:
>
> > > output:
> > > ((a b) (c d i j) (e f k l o p) (g h) (m n q r) (s t))
>
> > > stuffed deleted.
>
> > Here is my Common Lisp (and I only care about Common Lisp answers)
> > attempt to create a `reduce'-like function to handle this kind of a
> > problem (you will see that I am still struggling with the code and the
> > documentation).
>
> ... faulty code deleted

Aaand one more fix (apply -> funcall)  (This version at least produces
a close
facsimile of the desired output)

(defun reduce-tagged (function sequence &key
		 (key-tag #'first)
		 (key-datum #'rest))
  "Use a binary operation, `function' to combine a sequence of tagged
elements.  like-tagged elements are `reduce'd according to `function'

`sequence' is a sequence of tagged elements.  reduce-m will reduce
like-tagged-elements.

If `key-tag' is supplied it is used to extract the element tag.  If
`key-tag' is not supplied, the function `first' is used.

If `key-datum' is supplied, it is used to extract the element datum.
If `key-datum' is not supplied, the function `rest' is used.

"
  (let ((hash (make-hash-table)))
    (dolist (datum sequence)
      (let ((tag (funcall key-tag datum))
	    (values (funcall key-datum datum)))
	(multiple-value-bind (it present)
	    (gethash tag hash)
	  (declare (ignore it))
	  (if present
	      (setf (gethash tag hash)
		    (funcall function (gethash tag hash) values))
	      (setf (gethash tag hash) values)))))
    (let (result)
      (maphash #'(lambda(key value)
		   (push (list key value) result))
	       hash)
      result)))