[R] Finding Infimum in R

[Boris Steipe]

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.hlx at 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.hlx at 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
> 
>