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

[Mirko]

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).
>
> (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'
> and returned in a list ...
>
> `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)
>           (if present
>               (setf (gethash tag hash)
>                     (apply function (gethash tag hash) values))
>               (setf (gethash tag hash) values)))))
>     (let (result)
>       (dohash (key value hash)
>         (push (list key value) result))
>       result)))
>
> Comments, improvements?  I am looking for a general purpose function
> like reduce that I
> can apply in various situations.
>
> Thanks,
>
> Mirko

Correction: the previous code used a non-portable clisp macro
`dohash' (looks nice, doesn't it?)

Here is the version with maphash:

(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)
		    (apply function (gethash tag hash) values))
	      (setf (gethash tag hash) values)))))
    (let (result)
      (maphash #'(lambda(key value)
		   (push (list key value) result))
	       hash)
      result)))

Mirko