How can I find out the minimum value that can be returned by a function with infinite domain in R?
f <- function(x) { x^2-1 }
print(minVal(f)) # -1
f <- function(x) { x^2+1 }
print(minVal(f)) # 1
So far I've tried optimize, but it requires a finite interval:
minVal <- function(f) {
optimize(f, c(-100, 100))
}
Have you tried the nlm function?
nlm(function(x) x^2 -1, p = 1E3)
$minimum
[1] -1
$estimate
[1] -2.499974e-10
$gradient
[1] 9.995338e-07
$code
[1] 1
$iterations
[1] 1
p is a starting value for minimization that is required.
As well as nlm, you could try
optim(fn=function(x) x^2 -1, par = 1, method="BFGS")
This happens to work with a starting value of 1 or 1000 (although numerical accuracy can almost never be guaranteed for general nonlinear minimization).
This will work even better if you specify the gradient explicitly:
optim(fn=function(x) x^2 -1, gr=function(x) 2*x, par = 1, method="BFGS")
Based on some quick experiment, this seems to give the correct answer for starting values between -10^7 and 10^7.
Related
I am using a simple polynomial to fit a curve.
poly <- function(a, b, c, x) a * x^2 + b * x + c
I'd like to find the value of x that results in the maximum value of the curve. Currently I create a grid with a range of x from 20000 to 50000, run the function for each row, then use max() on the result. It works, but I have a lot of groups and it creates a big dataframe every time I do it. It is very clunky and I feel like there must be a better way.
Some typical coefficients are:
a <- -0.000000179
b <- 0.011153167
c <- 9.896420781
If you rearrange your function so the variable you want to maximize is first and you set the default values like so:
poly <- function(x, a, b, c) a * x^2 + b * x + c
formals(poly)$a <- -0.000000179
formals(poly)$b <- 0.011153167
formals(poly)$c <- 9.896420781
Then you can use the optimize function to maximize over your interval:
optimize(poly, c(20000, 50000), maximum = T)
$`maximum`
[1] 31154.1
$objective
[1] 183.6298
Where $maximum is the x value at which the maximum occurs and $objective is the height.
If a is negative, maximum of parabola a * x^2 + b * x + c is reached at -b/(2*a) :
a<0
#[1] TRUE
-b/(2*a)
#[1] 31154.1
You could use optim. I think the other solutions answered in this thread are more appealing, but I'll write this up for completeness:
a <- -0.000000179
b <- 0.011153167
c <- 9.896420781
o <- optim(
par=list(x=0),
fn=function(x){ -poly(a,b,c,x=x) },
method="Brent",
lower=-50e3, upper=50e3
)
Output:
> o
$par
[1] 31154.1
$value
[1] -183.6298
$counts
function gradient
NA NA
$convergence
[1] 0
$message
NULL
I have a function f(x) with a free constant S. Once I integrate the function f(x) from 0 to infinity I would like to approximate what value of S makes the integral equal 1.
a <-0.3 #alpha
b <- 2.5 #beta
d <-0.7 #delta
g <-1.1 #gamma
#defining the function, note S is free (which causes an error, pasted below)
integrand <- function(x) {b*g/d*exp(-g*x)*(1-exp(-d* x))*exp(-a*b*S/d*(1-exp(-d*x)))}
#defining the integral equation I would like to solve for S
intfun<- function(S) {integrate(integrand,lower=0,upper=Inf)-1}
#trying to find the root of function
uniroot(intfun, lower = 0, upper = 1)
I also tried:
uniroot(integrate(integrand,lower=0,upper=Inf)-1, lower = 0, upper = 1)
Error given:
Error in f(x, ...) : object 'S' not found
The S value I am looking for is near 0.564029.
You should change your function:
a <-0.3 #alpha
b <- 2.5 #beta
d <-0.7 #delta
g <-1.1 #gamma
#defining the function, note S is free (which causes an error, pasted below)
integrand <- function(x, S) {b*g/d*exp(-g*x)*(1-exp(-d* x))*exp(-a*b*S/d*(1-exp(-d*x)))}
#defining the integral equation I would like to solve for S
intfun<- function(S) {
integrate(function(x)integrand(x, S),lower=0,upper=Inf)[[1]]-1
}
uniroot(intfun,c(-1,1))
$root
[1] 0.564041
$f.root
[1] -6.961327e-06
$iter
[1] 6
$init.it
[1] NA
$estim.prec
[1] 6.103516e-05
I'd like to minimize several differences. For one difference, this seems straight forward:
target1 <- 1.887
data <- seq(0,1, by=.001)
#Step 1
somefunction <- function(dat, target1, X){
#some random function...
t <- sum(dat)
y <- t * X
#minimize this difference
diff <- target1-y
return(diff)
}
V1 <- optimize(f = somefunction,
interval = c(0,1),
dat=data,
target1=target,
maximum = T)
V1$maximum
6.610696e-05
#--> This value for `X` should minimize the difference...
V1$maximum * sum(data)
#0.03308653
#--> as close to zero we get
Now, I'd like to minimize several differences in one step relying on optim but this does not work properly:
#Step 2
set.seed(1)
data2 <- data.frame(dat1=seq(0,1, by=.01),
dat2=runif(101),
dat3=runif(101))
somefunction_general <- function(dat, target1, target2, target3, X){
#some random function...
y <- sum(dat[,1]) * X[1]
y1 <- sum(dat[,2]) * X[2]
y2 <- sum(dat[,3]) * X[3]
#minimize these differences...
diff1 <- target1-y
diff2 <- target2-y1
diff3 <- target3-y2
#almost certain that this is wrong...
vtr <- sum(abs(diff1), abs(diff2), abs(diff3))
return(vtr)
}
V2 <- optim(par=c(1,1,1),
fn = somefunction_general,
dat=data2,
target1=1.8,
target2=2,
target3=4,
control = list(fnscale = -1))
sum(data2[,1])
[1] 50.5
sum(data2[,2])
[1] 44.27654
sum(data2[,3])
[1] 51.73668
V2$par[1]*sum(data2[,1])
#[1] 1.469199e+45
V2$par[2]*sum(data2[,2])
#[1] 1.128977e+45
V2$par[3]*sum(data2[,3])
[1] 2.923681e+45
Looks like there's some disagreement between the first function and the second? In the first function, you're returning target1-sum(dat)*X and then trying to find the maximum over X values in [0, 1].
But since you're returning the raw difference and not the absolute value, you're actually just maximizing -sum(dat)*X, or, equivalently, minimizing sum(dat)*X. Since the dat is constant, naturally the optimize function is going to return the smallest value on the interval each time (0 in the example).
For the first function, I think what you want to do is return the absolute value of the difference and then find the minimum and not the maximum. The fix for the second function, somefunction_general, is even simpler, since you're already returning sum(abs(diff1), abs(diff2), abs(diff3)): just make sure the minimum is returned by getting rid of control = list(fnscale = -1)
V2 <- optim(par=c(1,1,1),
fn = somefunction_general,
dat=data2,
target1=1.8,
target2=2,
target3=4)
V2$par
[1] 0.03564358 0.03837754 0.07748929
You should write a function such that whether there is one parameter or more, optim should work on it:
somefunction_general <- function(X, dat, target){
dat <- as.matrix(dat)
y <- colSums(dat) * X
sum((target-y)^2) # Often use the MSE
}
let us test this
data2 <- data.frame(dat1=seq(0,1, by=.01),
dat2=runif(101),
dat3=runif(101))
data <- seq(0,1, by=.001)
(a <-optim(0,somefunction_general,dat = data,target = 1.887,method = "BFGS"))
$par
[1] 0.00377023
$value
[1] 3.64651e-28
$counts
function gradient
25 3
$convergence
[1] 0
$message
NULL
We can not that the function value is zero. thus the parameter a$par is what we want. check this out
a$par*sum(data)
[1] 1.887
We can also have 3 parameters 1 target eg:
(b<-optim(c(0,0,0),somefunction_general,dat = data2,target = 1.887))
$par
[1] 0.03736837 0.04262253 0.03647203
$value
[1] 4.579334e-08
$counts
function gradient
100 NA
$convergence
[1] 0
$message
NULL
b$par*colSums(data2)
dat1 dat2 dat3
1.887103 1.887178 1.886942
Each almost got to the target of 1.887. note that this is similar to running the first one 3 times.
lastly:
(d<-optim(c(0,0,0),somefunction_general,dat = data2,target = c(1.8, 2, 4)))
$par
[1] 0.03564672 0.04516916 0.07730660
$value
[1] 2.004725e-07
$counts
function gradient
88 NA
$convergence
[1] 0
$message
NULL
the target was achieved:
d$par*colSums(data2)
dat1 dat2 dat3
1.800160 1.999934 3.999587
This one function can work on n dimensions. please use the method BFGS unless it does not converge.
What if there is one parameter with three targets? well this is quite difficult. Unless there is such a parameter, then it wont converge.
suppose we say the parameter is 0.01, what is the target?
colSums(data2)*0.01
dat1 dat2 dat3
0.5050000 0.4427654 0.5173668
Okay, suppose we were given this target, can we get the 0.01 back?
(e<-optim(10,somefunction_general,dat = data2,target = c(0.505, 0.4427654, 0.5173668),method = "BFGS"))
$par
[1] 0.01
$value
[1] 7.485697e-16
$counts
function gradient
12 3
$convergence
[1] 0
$message
NULL
Huh, we were able to converge. this is because there was a parameter that could take us there. note that i did change the starting point to 10.
my question is "Find the maximum of the function myfun = - (sin(x)-3)^2 + 1 ,on the interval (0,5), and please answer x=? and f(x)= ?"
there is my code in R：
f <- function(x) { return((-1*sin(x)-3)^2+1 }
result <- uniroot(f,c(0,5),extendInt = "yes"
result$root
result$f.root
but the console is ：
Error in uniroot(f, c(0, 5), extendInt = "yes") :
no sign change found in 1000 iterations
what's wrong with my code
Thanks a lot
optimize is the standard function for finding a max or min of a 1-dimensional function. uniroot is used for finding a root (0) of the function, not max or min values.
optimize(f, interval = c(0, 5), maximum = TRUE)
$maximum
[1] 1.570796
$objective
[1] 17
See ?optimize for examples and details.
(Note: I added a ) to the f in your question to avoid syntax errors.)
The base R function being used in the question is wrong. From the documentation:
uniroot
The function uniroot searches the interval from lower to upper for a
root (i.e., zero) of the function f with respect to its first
argument.
optimize
The function optimize searches the interval from lower to upper for
a minimum or maximum of the function f with respect to its first
argument.
Code
f <- function(x) { (-1*sin(x) - 3)^2 + 1 }
m <- optimize(f, c(0, 5), maximum = TRUE)
m
#$maximum
#[1] 1.570796
#
#$objective
#[1] 17
curve(f, 0, 5)
points(m$maximum, m$objective, pch = 16, col = "red")
Also, the function f is identical to
g <- function(x) { (sin(x) + 3)^2 + 1 }
For you purpose, you should use optim() or optimize(), instead of uniroot(), i.e.:
Given f <- function(x) -(sin(x)-3)^2+1 (the objective function in you code is not the one as you described at the beginning of your post), you will get the result via
optim(0,f,method = "L-BFGS-B",lower = 0,upper = 5,control = list(fnscale = -1))
> optim(0,f,method = "L-BFGS-B",lower = 0,upper = 5,control = list(fnscale = -1))
$par
[1] 1.570796
$value
[1] -3
$counts
function gradient
7 7
$convergence
[1] 0
$message
[1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
or
optimize(f, interval = c(0, 5), maximum = TRUE)
> optimize(f, interval = c(0, 5), maximum = TRUE)
$maximum
[1] 1.570796
$objective
[1] -3
I would like to compute the triple integral of a function of three variables f(x,y,z) in R. I'm using the package cubature and the function adaptIntegrate(). The integrand is equal to 1 only in a certain domain (x<y<z, 0 otherwise) which I don't know how to specify. I'm trying 2 different implementations of the function, but none of them work:
#First implementation
fxyz <- function(w) {
x <- w[1]
y <- w[2]
z <- w[3]
x*y*z*(x < y)&(y < z)
}
#Second implementation
fxyz <- function(w) {
x <- w[1]
y <- w[2]
z <- w[3]
if(x<y&y<z)
out<-1
else
out<-0
out
}
#Computation of integral
library(cubature)
lower <- rep(0,3)
upper <- rep(1, 3)
adaptIntegrate(f=fxyz, lowerLimit=lower, upperLimit=upper, fDim = 3)
Any idea on how to specify the domain correctly?
I don't know about the cubature package, but you can do this by repeated application of base R's integrate function for one-dimensional integration.
f.xyz <- function(x, y, z) ifelse(x < y & y < z, 1, 0)
f.yz <- Vectorize(function(y, z) integrate(f.xyz, 0, 1, y=y, z=z)$value,
vectorize.args="y")
f.z <- Vectorize(function(z) integrate(f.yz, 0, 1, z=z)$value,
vectorize.args="z")
integrate(f.z, 0, 1)
# 0.1666632 with absolute error < 9.7e-05
You'll probably want to play with the control arguments to set the numeric tolerances; small errors in the inner integration can turn into big ones on the outside.
In your first function the return value is wrong. It should be as.numeric(x<=y)*as.numeric(y<=z). In your second function you should also use <= instead of <, otherwise `adapIntegrate won't work correctly. You also need to specify a maximum number of evaluations. Try this
library(cubature)
lower <- rep(0,3)
upper <- rep(1,3)
# First implementation (modified)
fxyz <- function(w) {
x <- w[1]
y <- w[2]
z <- w[3]
as.numeric(x <= y)*as.numeric(y <= z)
}
adaptIntegrate(f=fxyz,lowerLimit=lower,upperLimit=upper,doChecking=TRUE,
maxEval=2000000,absError=10e-5,tol=1e-5)
#$integral
#[1] 0.1664146
#$error
#[1] 0.0001851699
#$functionEvaluations
#[1] 2000031
#$returnCode
#[1] 0
The domain 0 <= x <= y <= z <= 1 is the "canonical" simplex. To integrate over a simplex, use the SimplicialCubature package.
library(SimplicialCubature)
f <- function(x) 1
S <- CanonicalSimplex(3)
> adaptIntegrateSimplex(function(x) 1, S)
$integral
[1] 0.1666667
$estAbsError
[1] 1.666667e-13
$functionEvaluations
[1] 55
$returnCode
[1] 0
$message
[1] "OK"
Note that integrating the constant function f(x)=1 over the simplex simply gives the volume of the simplex, which is 1/6. The integration is useless for this example.
> SimplexVolume(S)
[1] 0.1666667