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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
# $Id: binsearch.R 1295 2007-08-08 13:38:18Z warnes $
binsearch <- function(fun, range, ..., target=0,
lower=ceiling(min(range)),upper=floor(max(range)),
maxiter=100, showiter=FALSE)
{
# initialize
lo <- lower
hi <- upper
counter <- 0
val.lo <- fun(lo,...)
val.hi <- fun(hi,...)
# check whether function is increasing or decreasing, & set sign
# appropriately.
if( val.lo > val.hi )
sign <- -1
else
sign <- 1
# check if value is outside specified range
if(target * sign < val.lo * sign)
outside.range <- TRUE
else if(target * sign > val.hi * sign)
outside.range <- TRUE
else
outside.range <- FALSE
# iteratively move lo & high closer together until we run out of
# iterations, or they are adjacent, or they are identical
while(counter < maxiter && !outside.range )
{
counter <- counter+1
if(hi-lo<=1 || lo<lower || hi>upper) break;
center <- round((hi - lo)/2 + lo ,0 )
val <- fun(center, ...)
if(showiter)
{
cat("--------------\n")
cat("Iteration #", counter, "\n")
cat("lo=",lo,"\n")
cat("hi=",hi,"\n")
cat("center=",center,"\n")
cat("fun(lo)=",val.lo,"\n")
cat("fun(hi)=",val.hi,"\n")
cat("fun(center)=",val,"\n")
}
if( val==target )
{
val.lo <- val.hi <- val
lo <- hi <- center
break;
}
else if( sign*val < sign*target )
{
lo <- center
val.lo <- val
}
else #( val > target )
{
hi <- center
val.hi <- val
}
if(showiter)
{
cat("new lo=",lo,"\n")
cat("new hi=",hi,"\n")
cat("--------------\n")
}
}
# Create return value
retval <- list()
retval$call <- match.call()
retval$numiter <- counter
if( outside.range )
{
if(target * sign < val.lo * sign)
{
warning("Reached lower boundary")
retval$flag="Lower Boundary"
retval$where=lo
retval$value=val.lo
}
else #(target * sign > val.hi * sign)
{
warning("Reached upper boundary")
retval$flag="Upper Boundary"
retval$where=hi
retval$value=val.hi
}
}
else if( counter >= maxiter )
{
warning("Maximum number of iterations reached")
retval$flag="Maximum number of iterations reached"
retval$where=c(lo,hi)
retval$value=c(val.lo,val.hi)
}
else if( val.lo==target )
{
retval$flag="Found"
retval$where=lo
retval$value=val.lo
}
else if( val.hi==target )
{
retval$flag="Found"
retval$where=hi
retval$value=val.hi
}
else
{
retval$flag="Between Elements"
retval$where=c(lo, hi)
retval$value=c(val.lo, val.hi)
}
return(retval)
}
|
