I've a function as follows:
V <- seq(50, 350, by = 1)
> VK
Voltage^0 Voltage^1 Voltage^2 Voltage^3
-1.014021e+01 9.319875e-02 -2.738749e-04 2.923875e-07
> plot(x = V, exp(exp(sapply(0:3, function(x) V^x) %*% VK)), type = "l"); grid()
Now I would like to do an inverse regression upon this certain function. I've seen Solving for the inverse of a function in R :
inverse = function (f, lower = -100, upper = 100) {
function (y) uniroot((function (x) f(x) - y), lower = lower, upper = upper)1
}
square_inverse = inverse(function (x) x^2, 0.1, 100)
square_inverse(4)
and I'm trying to adjust it to my purposes as follows:
certain_function <- function(x=V) { exp(exp(sapply(0:3, function(x) V^x) %*% VK)) }
inverse = function (f, lower = 50, upper = 350) {
function (y) uniroot((function (x) f(x) - y), lower = lower, upper = upper)[1]
}
inverse_regression = inverse(certain_function, 50, 350)
inverse_regression(2)
Unfortunately this yields:
Error in uniroot((function(x) f(x) - y), lower = lower, upper = upper) :
f() values at end points not of opposite sign In addition: Warning messages:
1: In if (is.na(f.lower)) stop("f.lower = f(lower) is NA") :
the condition has length > 1 and only the first element will be used
2: In if (is.na(f.upper)) stop("f.upper = f(upper) is NA") :
the condition has length > 1 and only the first element will be used
As far as I understood: The error means that there are more roots than only one (uniroot can only handle one root) but there shouldn't be more than one root since it's a strictly monotonically increasing function.
The warnings I do not understand..
edit: I'm trying to get behind it.. I removed both exponentials which yields the following plot:
and this still generates the following error:
> inverse_regression(0.1)
Error in uniroot((function(x) f(x) - y), lower = lower, upper = upper) :
f() values at end points not of opposite sign In addition: Warning messages:
1: In if (is.na(f.lower)) stop("f.lower = f(lower) is NA") :
the condition has length > 1 and only the first element will be used
2: In if (is.na(f.upper)) stop("f.upper = f(upper) is NA") :
the condition has length > 1 and only the first element will be used
Why is this? Obviously the curve has opposite signs at both end points.. I guess end points mean the points left and right to the root?
Probably the inverse regression did not work due to the definition of "certain_function". This is a matrix-vector product and the result is a vector again. Therefore I transformed this to a regular function function(x) exp(exp(sum(x^0*VK[1],x^1*VK[2],x^2*VK[3],x^3*VK[4])) and now it is working.
Hence, one should be aware of the bounds each time in general.
Related
Im trying to use DEoptim to find the global minimum of z in in -1 < x < 1 , -1 < y < 1, but im getting Error in FUN(newX[, i], ...) : argument "y" is missing, with no default and I dont know what im supposed to do for the mission "y"
install.packages("Rmpfr")
install.packages("DEoptim")
library(gmp)
library(Rmpfr)
library(parallel) # https://cran.r-project.org/web/packages/DEoptim/vignettes/DEoptim.pdf
library(DEoptim)
z = function(x,y) {
(exp(sin(60.0*x)) + sin(50.0*exp(y)) + sin(80.0*sin(x)) + sin(sin(70.0*y)) - sin(10.0*(x+y)) + (x*x+y*y)/4.0)
}
optimized_Minimum <- DEoptim(z, lower = c(-1,-1), upper = c(1,1),
control=list(storepopfrom=1, trace=FALSE))
# optimized_Minimum <- optim(z, lower = c(-1,-1), upper = c(1,1), method = "Brent")
DEoptim is not expecting you to pass it 2 separate arguments to your function (x and y), but you can still solve for multiple variables.
You need to pass in a vector rather than 2 separate variables with the DEoptim package, as with the optim function.
I tested this with the functions from the linked solution and it worked:
fxcalc <- function(s,t){(1-(1-(parametros$ap/xm)^(s))^t)*100}
suma <- function(s,t){(parametros$fx-fxcalc(s,t))^2}
func <- function(st){
s <- st[1]
t <- st[2]
sum(suma(s,t))
}
optimized_Minimum <- DEoptim(func, lower = c(-1,-1), upper = c(1,1),
control=list(storepopfrom=1, trace=FALSE))
summary(optimized_Minimum)
***** summary of DEoptim object *****
best member : 1 1
best value : 0
after : 200 generations
fn evaluated : 402 times
*************************************
I am trying to find global minimum (-5 <= (x,y) <= 5) using the function below. When I use optimize, getting "Error in T %*% x : non-conformable arguments". Am I doing to something wrong?
T = qr.Q(qr(matrix(c(1,2,3,4),nrow=2,ncol=2,byrow=T)))
fitness = function(x){
z = T%*%x+c(.5,.5);
s = 100*(z[1]^2-z[2])^2 + (z[1]-1)^2;
return(10*(s/4000-cos(s))+10)
}
optimize(fitness, c(-0.5, 0.5), upper = c(5,5), lower = c(-5,-5))
Error in T %*% x : non-conformable arguments
You are getting that error because you are using optimize() (good for 1D optimization problems) on a 2D optimization problem.
As indicated by Rui Barradas you should use optim() (which is used for multi-dimensional optimization problems).
The following works:
T = qr.Q(qr(matrix(c(1,2,3,4),nrow=2,ncol=2,byrow=TRUE)))
fitness = function(x){
z = T%*%x+c(.5,.5);
s = 100*(z[1]^2-z[2])^2 + (z[1]-1)^2;
return(10*(s/4000-cos(s))+10)
}
fitness.optim = optim(c(-0.5, 0.5), fitness)
where fitness.optim results in:
> fitness.optim
$par
[1] -0.4550863 0.5470252
$value
[1] 0.298451
$counts
function gradient
59 NA
$convergence
[1] 0
$message
NULL
So, the optimum (minimum) fitness value is found at x_opt = fitness.optim$par i.e. x_opt = c(-0.4550863, 0.5470252) achieving the value fitness.optim$value = 0.298451.
I wanted to set a small dataframe in order to plot myself some points of the incomplete elliptic integral of 1st kind for different values of amplitude phi and modulus k. The function to integrate is 1/sqrt(1 - (k*sin(x))^2) between 0 and phi.Here is the code I imagined:
v.phi <- seq(0, 2*pi, 1)
n.phi <- length(v.phi)
v.k <- seq(-1, +1, 0.5)
n.k <- length(v.k)
k <- rep(v.k, each = n.phi, times = 1)
phi <- rep(v.phi, each = 1, times = n.k)
df <- data.frame(k, phi)
func <- function(x, k) 1/sqrt(1 - (k*sin(x))^2)
df$area <- integrate(func,lower=0, upper=df$phi, k=df$k)
But this generates errors and I am obviously mistaking in constructing the new variable df$area... Could someone put me in the right way?
You can use mapply:
df$area <- mapply(function(phi,k){
integrate(func, lower=0, upper=phi, k=k)$value
}, df$phi, df$k)
However that generates an error because there are some values of k equal to 1 or -1, while the allowed values are -1 < k < 1. You can't evaluate this integral for k = +/- 1.
Note that there's a better way to evaluate this integral: the incomplete elliptic function of the first kind is implemented in the gsl package:
> integrate(func, lower=0, upper=6, k=0.5)$value
[1] 6.458877
> gsl::ellint_F(6, 0.5)
[1] 6.458877
As I said, this function is not defined for k=-1 or k=1:
> gsl::ellint_F(6, 1)
[1] NaN
> gsl::ellint_F(6, -1)
[1] NaN
> integrate(func, lower=0, upper=6, k=1)
Error in integrate(func, lower = 0, upper = 6, k = 1) :
non-finite function value
I would like to find the root of log(x) = x2 − 2 using uniroot in R
f <- function(x) (log(x)+2-x^2)
uniroot(f, lower=0, upper=100000000)$root
But this shows the error
Error in uniroot(f, lower = 0, upper = 1e+08) : f() values at end
points not of opposite sign
uniroot requires an interval where the function has opposite signs at the two endpoints (since it uses a variation of the bisection method). It isn't a bad idea to do a quick plot when you don't know about just where to look:
f <- function(x) (log(x)+2-x^2)
x <- seq(0.0,4,0.01)
y <- f(x)
plot(x,y,ylim = c(-1,1),type = "l")
abline(h=0)
This yields:
From this you can see that there are two roots, one between 0 and 1, and one between 1 and 2:
uniroot(f,interval = c(0,1))$root #returns 0.1379346
uniroot(f,interval = c(1,2))$root #returns 1.564445
I would like to integrate a following function named betalog
g <- function(x,a,b){
if (a < 0 | b < 0) stop()
temp <- (a-1)*log(x) + (b-1)*log(1-x)
return( exp(temp) )
}
betalog<- function(x,a,b)
{
temp <- g(x=x,a=a,b=b)* log(x/(1-x))
return( temp )
}
The function g is integrand of the beta function. In theory, betalog should be integrable over any [0,alpha] interval if 0 < alpha < 1, and a > 0, b >0.
However, I cannot numerically integrate betalog with very small a:
a <- 0.00001
b <- 1
alpha <- 0.5
integrate(betalog,a=a,b=b,lower=0,upper=alpha,subdivisions=1000000L)
Error in integrate(betalog, a = a, b = b, lower = 0, upper = alpha, subdivisions =
1000000L) :
non-finite function value
In fact, I cannot even compute the incomplete beta function using R integrate function when a is very small:
integrate(g,a=a,b=b,lower=0,upper=alpha,subdivisions=1000000L)
Error in integrate(g, a = a, b = b, lower = 0, upper = alpha, subdivisions = 1000000L) :
roundoff error is detected in the extrapolation table
Can anyone gives me tip to integrate such incomplete beta-like function in R?
> betalog(0, a, b)
[1] -Inf
Your function is singular at the lower bound. Recall that to compute an improper integral you must replace the singular bounds with dummy variables and take the limit from the correct side towards that bound. In particular,
> integrate(betalog,a=a,b=b,lower=0.000001,upper=alpha,subdivisions=10000000L)
-94.60292 with absolute error < 0.00014
> integrate(betalog,a=a,b=b,lower=.Machine$double.xmin * 1000,upper=alpha,subdivisions=10000
-244894.7 with absolute error < 10
> integrate(betalog,a=a,b=b,lower=.Machine$double.xmin,upper=alpha,subdivisions=10000000L)
Error in integrate(betalog, a = a, b = b, lower = .Machine$double.xmin, :
non-finite function value
I suspect that your integral diverges, but this might be tricky since even state-of-the-art symbolic algebra systems can't prove that:
http://www.wolframalpha.com/input/?i=Integral%28x%5E%280.00001+-1%29+ln%28x%2F%281-x%29%29%2C+x%2C0%2C+0.5%29
Whatever the case, R is not the correct tool for this problem.