Here's my crossword-puzzle for the day:
# A sample monotonous discontinuous function with a single root
# (vectorized)
F <- function(x) {
return((as.numeric(x >= 0.112233445566778899) * 2) - 1)
}
discRoot <- function(xL, xR, F, k = 10) {
# Return the interval containing a single root of the monotonous
# increasing function F() in the range [xL, xR] to k-digits
# accuracy.
myK <- 1
while (myK <= k) {
x <- seq(xL, xR, length.out = 11) # ten intervals
y <- F(x) # evaluate F
i <- min(which(y >= 0)) # find index of first positive y
xR <- x[i] # make this the right bound
xL <- x[max((i - 1), 1)] # left bound, but prevent xL < 1
myK <- myK + 1 # increase resolution
}
return(c(xL, xR))
}
R > print(discRoot(0, 1, F), digits = 22)
[1] 0.1122334455000000147384 0.1122334456000000091347
R > print(discRoot(0, 1, F, k = 5), digits = 22)
[1] 0.1122300000000000103073 0.1122400000000000064304
R > print(discRoot(0, 1, F, k = 15), digits = 22)
[1] 0.1122334455667780145349 0.1122334455667790137356
R > print(discRoot(0, 1, F, k = 22), digits = 22)
[1] 0.1122334455667788888356 0.1122334455667789027133
R > print(discRoot(0, 1, F, k = 30), digits = 22)
[1] 0.1122334455667788888356 0.1122334455667789027133
Try it on your own function
Cheers,
B.
> On Apr 10, 2017, at 1:53 PM, li li <hannah....@gmail.com> wrote:
>
> Here are the codes again. I made an error in the previous email.
> Thanks very much.
>
>
> ##points of discontinuity
> pts <- seq(0,1,by=0.2)
> n <- length(pts)
>
>
> ##g is the step function
> g <- function(x){
> val <- numeric(n)
> for (i in 1:(n-1)){val[i] <- pts[i]*((x>=pts[i])&&(pts[i+1])>x)}
> val[n] <- pts[n]*(x>=pts[n])
> sum(val)}
> ##f is the piecewise function
> f <- function(x){x+g(x)-1}
>
> ##values of f at the discontinuity points
> z <- pts
> for (i in 1:n){z[i]<- f(pts[i])}
>
> ##find the root
>
> if(any(z==0)=="TRUE") {
> res <- pts[which(z==0)]
> } else {
> l <- pts[max(which(z<0))]
> r <- pts[min(which(z>0))]
> res <- uniroot(f, c(l,r))$root
> }
>
> ##check the root
>
> f(res)
>
>
> 2017-04-10 13:41 GMT-04:00 li li <hannah....@gmail.com>:
> Hi Burt and all,
> Thanks so much for your reply.
> Here is an example.
> Consider the points (0, 0.2, 0.4, 0.6, 0.8,1) and denote them as c_1, ...,
> c_5.
> The piecewise function is defined as f(x)=x+g(x)-1, x >=0, where
> g is a step function defined as follows:
>
> <image.png>
>
> Below is the code to find inf{x | f(x) >=0} according to your suggestion.
> If there is any suggestion to make the code simpler, please let me know.
> Thanks so much for your help.
> Hannah
>
>
>
>
> ##points of discontinuity
> pts <- seq(0,1,by=0.2)
> n <- length(pts)
>
>
> ##g is the step function
> g <- function(x){
> val <- numeric(n)
> for (i in 1:(n-1)){val[i] <- pts[i]*((x>=pts[i])&&(pts[i+1])>x)}
> val[n] <- pts[n]*(x>=pts[n])
> sum(val)}
> ##f is the piecewise function
> f <- function(x){x+g(x)-1}
>
> ##values of f at the discontinuity points
> z <- pts
> for (i in 1:n){z[i]<- f(pts[i])}
>
> ##find the root
>
> if(any(z==0)=="TRUE") {
> res <- pts[max(which(z==0))]
> } else {
> l <- pts[max(which(z<0))]
> r <- pts[min(which(z>0))]
> res <- uniroot(f, c(l,r))$root
> }
>
> ##check the root
>
> f(res)
>
> Hanna
>
>
______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
