[cl-utilities-devel] making EXTREMUM return multiple values -- and request for a function EXTREMA.

[Tobias C. Rittweiler]

Hi Peter,

I'd like to suggest making EXTREMUM return all /equivalent/ extrema as
multiple values, such that for instance:
 
  CL-USER> (extremum '((A . 3) (B . 1) (C . 2) (D . 1)) #'< :key #'cdr)
  (D . 1)
  (B . 1)

My more restrictive (featurewise) version based on parts of your code
but that I hacked together to fit my particular needs (no :start, :end
keywords, only works for lists), looks like this:

  ;;; Inspired by www.cliki.net/EXTREMUM), but this function returns
  ;;; all extrema of sequence (if being equal) as multiple values.
  (defun extremum (sequence predicate &key (key #'identity))
    (let* ((smallest-elements (list (first sequence)))
           (smallest-key (funcall key (first smallest-elements))))
      (map nil
           #'(lambda (x)
               (let ((x-key (funcall key x)))
                 (cond ((funcall predicate x-key smallest-key)
                        (setq smallest-elements (list x))
                        (setq smallest-key x-key))
                       ;; both elements are considered equal if the predicate
                       ;; returns false for (PRED A B) and (PRED B A)
                       ((not (funcall predicate smallest-key x-key))
                        (push x smallest-elements)))))
           (rest sequence))
      (apply #'values smallest-elements)))

Similiarly, I'd like to suggest a new function EXTREMA which returns the
N "topmost" extrema:

  CL-USER> (extrema 1 '(3 1 2 1) #'>)
  (3)
  CL-USER> (extrema 2 '(3 1 2 1) #'>)
  (3 2)
  CL-USER> (extrema 2 '(3 1 2 1) #'<)
  (1 1)
     
  CL-USER> (extrema 1 '((A . 3) (B . 1) (C . 2) (D . 1)) #'> :key #'cdr)
  ((A . 3))
  CL-USER> (extrema 2 '((A . 3) (B . 1) (C . 2) (D . 1)) #'< :key #'cdr)
  ((D . 1) (B . 1))

My version -- which can almost certainly be written many times
simpler -- is:

  (defun push-rotate-chop (item array &key (start 0) (end (length array)))
    (loop
       with saved-item = item
       for i from start to (1- end)
       do (rotatef saved-item (aref array i))))

  ; CL-USER> (let ((array (make-array 5 :initial-contents '(1 2 3 4 5))))
  ;            (push-rotate-chop 'a array) array)
  ; #(A 1 2 3 4)

  ; CL-USER> (let ((array (make-array 5 :initial-contents '(1 2 3 4 5))))
  ;            (push-rotate-chop 'a array :start 1 :end 4) array)
  ; #(1 A 2 3 5)

  (defun extrema (n list predicate &key (key #'identity))
    (let ((smallest-elements (make-array n))
          (smallest-keys (make-array n))
          (real-length 1))
      (flet ((free-slot-p (x) (not x)))
        (setf (aref smallest-elements 0) (first list)
              (aref smallest-keys 0) (funcall key (first list)))    
        (map nil
             #'(lambda (x)
                 (let ((x-key (funcall key x)))
                   (loop
                      for key-idx from 0
                      for key across smallest-keys do
                      (when (or (free-slot-p key)
                                (funcall predicate x-key key)        ; x-key < key
                                (not (funcall predicate key x-key))) ; x-key = key
                        (when (< real-length n) (incf real-length))
                        (push-rotate-chop x-key smallest-keys
                                          :start key-idx :end real-length)
                        (push-rotate-chop x smallest-elements
                                          :start key-idx :end real-length)
                        (loop-finish)))))
             (rest list))
        (coerce (subseq smallest-elements 0 real-length) 'list))))


Well, you'll hopefully get inspired. :-)


-t