Commit 34488223 authored by Nikodemus Siivola's avatar Nikodemus Siivola

add EXTREMUM

  From http://www.cliki.net/EXTREMUM

  A simple version built on top of REDUCE for now.
parent daa08725
......@@ -107,17 +107,19 @@
#:emptyp
#:ends-with
#:ends-with-subseq
#:extremum
#:first-elt
#:last-elt
#:length=
#:map-combinations
#:map-derangements
#:map-permutations
#:no-extremum
#:proper-sequence
#:random-elt
#:removef
#:rotate
#:sequence-of-length-p
#:length=
#:shuffle
#:starts-with
#:starts-with-subseq
......
......@@ -484,3 +484,54 @@ if calling FUNCTION modifies either the derangement or SEQUENCE."
sequence)))
(declaim (notinline sequence-of-length-p))
(define-condition no-extremum (error)
()
(:report (lambda (condition stream)
(declare (ignore condition))
(format stream "Empty sequence in ~S." 'extremum))))
(defun extremum (sequence predicate &key key (start 0) end)
"Returns the element of SEQUENCE that would appear first if the subsequence
bounded by START and END was sorted using PREDICATE and KEY.
EXTREMUM determines the relationship between two elements of SEQUENCE by using
the PREDICATE function. PREDICATE should return true if and only if the first
argument is strictly less than the second one (in some appropriate sense). Two
arguments X and Y are considered to be equal if (FUNCALL PREDICATE X Y)
and (FUNCALL PREDICATE Y X) are both false.
The arguments to the PREDICATE function are computed from elements of SEQUENCE
using the KEY function, if supplied. If KEY is not supplied or is NIL, the
sequence element itself is used.
If SEQUENCE is empty, then the error NO-EXTREMUM is signalled. Invoking the
CONTINUE restart will cause extremum to return NIL."
(let* ((pred-fun (ensure-function predicate))
(key-fun (unless (or (not key) (eq key 'identity) (eq key #'identity))
(ensure-function key)))
(real-end (or end (length sequence))))
(cond ((> real-end start)
(if key-fun
(flet ((reduce-keys (a b)
(if (funcall pred-fun
(funcall key-fun a)
(funcall key-fun b))
a
b)))
(declare (dynamic-extent #'reduce-keys))
(reduce #'reduce-keys sequence :start start :end real-end))
(flet ((reduce-elts (a b)
(if (funcall pred-fun a b)
a
b)))
(declare (dynamic-extent #'reduce-elts))
(reduce #'reduce-elts sequence :start start :end real-end))))
((= real-end start)
(cerror "Return NIL instead." 'no-extremum))
(t
(error "Invalid bounding indexes for sequence of length ~S: ~S ~S, ~S ~S"
(length sequence)
:start start
:end end)))))
......@@ -1828,3 +1828,31 @@
t
t
t)
(deftest extremum.1
(let ((n 0))
(dotimes (i 10)
(let ((data (shuffle (coerce (iota 10000 :start i) 'vector)))
(ok t))
(unless (eql i (extremum data #'<))
(setf ok nil))
(unless (eql i (extremum (coerce data 'list) #'<))
(setf ok nil))
(unless (eql (+ 9999 i) (extremum data #'>))
(setf ok nil))
(unless (eql (+ 9999 i) (extremum (coerce data 'list) #'>))
(setf ok nil))
(when ok
(incf n))))
(when (eql 10 (extremum #(100 1 10 1000) #'> :start 1 :end 3))
(incf n))
(when (eql -1000 (extremum #(100 1 10 -1000) #'> :key 'abs))
(incf n))
(let ((err nil))
(handler-bind ((no-extremum (lambda (c)
(setf err c)
(continue c))))
(when (eq nil (extremum "" #'error))
(when err
(incf n))))))
13)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment