From: pnorvig@norvig.Eng.Sun.COM (Peter Norvig - Sun BOS SunLabs)
Newsgroups: comp.lang.lisp
Subject: Re: #'reduce
Date: 6 Oct 92 18:39:32 GMT
Organization: Sun Microsystems Inc. - BDC
NNTP-Posting-Host: norvig.east.sun.com

In article <OLI.92Oct6124657@milan.ims.uni-stuttgart.de>,
oli@milan.ims.uni-stuttgart.de (Oliver Christ) wrote:
> this might be an annoying question, but why does
> 
>  (reduce #'max '("This" "is" "a" "test" ".") :key #'length)
> 
> result in a 'unknown keyword: :key' error both with Allegro CL 4.1 and
> Lucid 4.0 on a Sparc? 

Reduce *does* take a :key argument in dpANS Common Lisp (page 17-13),
and in CLtL2 page 398, but not on page 397, which may be why some vendors
have not implemented it.

It makes perfect sense to have a :key argument.  The meaning (and
efficiency in a good implementation) of Oliver's expression above
should be exactly the same as the proposed solution below:

(LET ((max 0))
    (DOLIST (elt '("This" "is" "a" "test" "."))
		(SETF max (MAX max (LENGTH elt))))
    max)

The vendors are perhaps excused because CLtL2 was ambiguous on this, but
any Lisp with ansi-cl or draft-ansi-cl in its *features* list must
implement :key for reduce.  If you don't get it in the next release from
your vendor, complain loudly.

In the meantime, the following implementation, taken from "Paradigms of
AI Programming", implements :key for reduce:

(proclaim '(inline reduce reduce*))

(defun reduce* (fn seq from-end start end key init init-p)
  (funcall (if (listp seq) #'reduce-list #'reduce-vect)
           fn seq from-end (or start 0) end key init init-p))

(defun reduce (function sequence &key from-end start end key
               (initial-value nil initial-value-p))
  (reduce* function sequence from-end start end
           key initial-value initial-value-p))

(defun reduce-vect (fn seq from-end start end key init init-p)
  (if (null end) (setf end (length seq)))
  (assert (<= 0 start end (length seq)) (start end)
          "Illegal subsequence of ~a --- :start ~d :end ~d"
          seq start end)
  (case (- end start)
    (1 (if init-p
           (funcall fn init (funcall-if key (aref seq start)))
           (funcall-if key (aref seq start))))
    (0 (if init-p init (funcall fn)))
    (t (if (not from-end)
           (let ((result
                   (if init-p
                       (funcall
                         fn init
                         (funcall-if key (aref seq start)))
                       (funcall
                         fn
                         (funcall-if key (aref seq start))
                         (funcall-if key (aref seq (+ start 1)))))))
             (loop for i from (+ start (if init-p 1 2))
                   to (- end 1)
                   do (setf result
                            (funcall
                              fn result
                              (funcall-if key (aref seq i)))))
             result)
           (let ((result
                   (if init-p
                       (funcall
                         fn
                         (funcall-if key (aref seq (- end 1)))
                         init)
                       (funcall
                         fn
                         (funcall-if key (aref seq (- end 2)))
                         (funcall-if key (aref seq (- end 1)))))))
             (loop for i from (- end (if init-p 2 3)) downto start
                   do (setf result
                            (funcall
                              fn
                              (funcall-if key (aref seq i))
                              result)))
             result)))))

(defun reduce-list (fn seq from-end start end key init init-p)
  (if (null end) (setf end (length seq)))
  (cond ((> start 0)
         (reduce-list fn (nthcdr start seq) from-end 0
                      (- end start) key init init-p))
        ((or (null seq) (eql start end))
         (if init-p init (funcall fn)))
        ((= (- end start) 1)
         (if init-p
             (funcall fn init (funcall-if key (first seq)))
             (funcall-if key (first seq))))
        (from-end
         (reduce-vect fn (coerce seq 'vector) t start end
                      key init init-p))
        ((null (rest seq))
         (if init-p
             (funcall fn init (funcall-if key (first seq)))
             (funcall-if key (first seq))))
        (t (let ((result
                   (if init-p
                       (funcall
                         fn init
                         (funcall-if key (pop seq)))
                       (funcall
                         fn
                         (funcall-if key (pop seq))
                         (funcall-if key (pop seq))))))
             (if end
                 (loop repeat (- end (if init-p 1 2)) while seq
                    do (setf result
                             (funcall
                               fn result
                               (funcall-if key (pop seq)))))
                 (loop while seq
                    do (setf result
                             (funcall
                               fn result
                               (funcall-if key (pop seq))))))
             result))))
Newsgroups: comp.lang.lisp