Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Knut Olav Bøhmer
alexandria
Commits
34488223
Commit
34488223
authored
Apr 25, 2012
by
Nikodemus Siivola
Browse files
add EXTREMUM
From
http://www.cliki.net/EXTREMUM
A simple version built on top of REDUCE for now.
parent
daa08725
Changes
3
Hide whitespace changes
Inline
Side-by-side
package.lisp
View file @
34488223
...
...
@@ -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
...
...
sequences.lisp
View file @
34488223
...
...
@@ -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
)))))
tests.lisp
View file @
34488223
...
...
@@ -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
)
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment