1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
#'
#' utiloptim.R
#'
#' Utilities for optimization
#'
#' $Revision: 1.4 $ $Date: 2021/10/03 08:17:51 $
#'
optimizeWithTrace <- local({
tracer <- function(x, ..., .TheFunction, .Enviro) {
y <- .TheFunction(x, ...)
xx <- get("xx", envir=.Enviro)
yy <- get("yy", envir=.Enviro)
assign("xx", c(xx, as.numeric(x)), envir=.Enviro)
assign("yy", c(yy, y), envir=.Enviro)
return(y)
}
optimizeWithTrace <- function(f, interval, ...,
lower = min(interval), upper = max(interval)) {
e <- new.env()
assign("xx", numeric(0), envir=e)
assign("yy", numeric(0), envir=e)
result <- optimize(tracer, lower=lower, upper=upper,
..., .TheFunction=f, .Enviro=e)
result$x <- get("xx", envir=e)
result$y <- get("yy", envir=e)
rm(e)
return(result)
}
optimizeWithTrace
})
which.min.fair <- function(x) {
a <- min(x, na.rm=TRUE)
i <- which(x == a)
if(length(i) > 1)
i <- sample(i, 1)
return(i)
}
which.max.fair <- function(x) {
a <- max(x, na.rm=TRUE)
i <- which(x == a)
if(length(i) > 1)
i <- sample(i, 1)
return(i)
}
|
