Solving (determining) a function at a point in R - r

In my below R code, I was wondering how I could find out what is rh1 when y == 0.5?
Note that y uses atanh(rh1), which can be converted back to rh1 using tanh().
rh1 <- seq(-1, 0.1, by = 0.001)
y <- pnorm(-0.13, atanh(rh1), 0.2)
plot(rh1, y, type = "l")

Analytical solution
For a normal distribution X ~ N(mu, 0.2). We want to find mu, such that Pr (X < -0.13) = y.
Recall your previous question and my answer over there: Determine a normal distribution given its quantile information. Here we have something simpler, as there is only one unknown parameter and one piece of quantile information.
Again, we start by standardization:
Pr {X < -0.13} = y
=> Pr { [(X - mu) / 0.2] < [(-0.13 - mu) / 0.2] } = y
=> Pr { Z < [(-0.13 - mu) / 0.2] } = y # Z ~ N(0,1)
=> (-0.13 - mu) / 0.2 = qnorm (y)
=> mu = -0.13 - 0.2 * qnorm (y)
Now, let atanh(rh1) = mu => rh1 = tanh(mu), so in short, the analytical solution is:
tanh( -0.13 - 0.2 * qnorm (y) )
Numerical solution
It is a root finding problem. We first build the following function f, and we aim to find its root, i.e., the rh1 so that f(rh1) = 0.
f <- function (rh1, y) pnorm(-0.13, atanh(rh1), 0.2) - y
The simplest root finding method is bisection method, implemented by uniroot in R. I recommend you reading Uniroot solution in R for how we should work with it in general.
curve(f(x, 0.5), from = -1, to = 0.1); abline (h = 0, lty = 2)
We see there is a root between (-0.2, 0), so:
uniroot(f, c(-0.2, 0), y = 0.5)$root
# [1] -0.129243

Your function is monotonic so you can just create the inverse function.
rh1 <- seq(-1,.1,by=.001)
y <- pnorm(-.13,atanh(rh1),.2)
InverseFun = approxfun(y, rh1)
InverseFun(0.5)
[1] -0.1292726

Related

Error in uniroot while calculating XIRR in R

Reproducible example:
v <- c(-400000.0,-200000.0, 660636.7)
d <- c("2021-10-27","2022-12-23","2023-01-04")
d1 <- as.Date(d, format="%Y-%m-%d")
tvm::xirr(v, d1) # gives the error below
Error in uniroot(xnpv, interval = interval, cf = cf, d = d, tau = tau, :
f.lower = f(lower) is NA
Excel XIRR returns 0.125 which seems correct.
The uniroot documentation says "Either interval or both lower and upper must be specified", and I'm not sure if tvm::xirr does so. I guess it does because it works well for many other sets of data.
Anyway, I could get it to work correctly in this case by providing a lower and upper (now that I know the answer via Excel) with some trial and error as below. But I'm not sure if my bounds will always hold.
> tvm::xirr(v, d1, f.lower = -0.2, f.upper=0.5)
[1] 10
> tvm::xirr(v, d1, f.lower = -0.2, f.upper=5)
[1] -1
> tvm::xirr(v, d1, lower = -0.99, upper=0.99)
[1] 0.1244512
Is this a bug or limitation of tvm::xirr or am I missing something?
Let us go down the rabbit hole. Firstly, let us read the source code for tvm::xirr:
xirr = function (cf, d, tau = NULL, comp_freq = 1, interval = c(-1, 10), ...)
{
uniroot(xnpv, interval = interval, cf = cf, d = d, tau = tau,
comp_freq = comp_freq, extendInt = "yes", ...)$root
}
Xirr calls uniroot to identify at what cf the function xnpv is equal to zero in the interval c(-1, 10). Default parameter values are tau = NULL and comp_freq = 1. Secondly, let us see the source code for xnpv:
xnpv = function (i, cf, d, tau = NULL, comp_freq = 1)
{
if (is.null(tau))
tau <- as.integer(d - d[1])/365
delta <- if (comp_freq == 0) {
1/(1 + i * tau)
}
else if (comp_freq == Inf) {
exp(-tau * i)
}
else {
1/((1 + i/comp_freq)^(tau * comp_freq))
}
sum(cf * delta)
}
We can visualize xnpv and its root as follows:
library(tvm)
v = c(-400000.0,-200000.0, 660636.7)
d = c("2021-10-27","2022-12-23","2023-01-04")
d1 = as.Date(d, format="%Y-%m-%d")
x = seq(-0.8, 10, 0.01)
y = sapply(x, function(x) xnpv(i = x, cf = v, d = d1, tau = as.integer(d1 - d1[1])/365))
plot(x, y, type = 'l', ylab = "xnpv", xlab = "cf"); abline(h = 0, lty = 2); abline(v = 0.1244512, lty = 2)
As you can see, for comp_freq = 1, the factor 1/(1 + i/comp_freq) (in the definition of delta) has a vertical asymptote at i = -1 for exponents different than 0 (0^0 = 1 in R). Moreover, for i < -1, this expression is undefined in R (negative number raised to decimal powers equals NaN in R).
To solve this issue, assuming comp_freq different than 0 or +Inf, you can call xirr as follows:
offset = 0.001; comp_freq = 1
tvm::xirr(v, d1, lower = -comp_freq+offset, upper = 10, comp_freq = comp_freq, tol = 1e-7) # I also changed the numerical tolerance for increased accuracy.
This assumes that cf <= 10. Finally, given that comp_freq = 1 is the default value, xirr always fails under default settings (thus: this function has not been thoroughly tested by its developer(s)).
I'm the package creator.
In this case, the uniroot algo tries to move past the i=-1 point, and fails. You can easily guide it with the lower bound as the OP has done. I could have set up a default lower bound >= 0 to deal with this, but due to the existence of negative interest rates, I decided to not to do it. A possible solution would be to set a lower bound > -1 in the case that the compounding frequency is not 0 (simple interest) or inf (continuous compounding) and that the function call doesn't include explicit bounds.
Thanks for the report.

Plotting incomplete elliptic integral of 1st kind

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

Monte Carlo integration using importance sampling given a proposal function

Given a Laplace Distribution proposal:
g(x) = 1/2*e^(-|x|)
and sample size n = 1000, I want to Conduct the Monte Carlo (MC) integration for estimating θ:
via importance sampling. Eventually I want to calculate the mean and standard deviation of this MC estimate in R once I get there.
Edit (arrived late after the answer below)
This is what I have for my R code so far:
library(VGAM)
n = 1000
x = rexp(n,0.5)
hx = mean(2*exp(-sqrt(x))*(sin(x))^2)
gx = rlaplace(n, location = 0, scale = 1)
Now we can write a simple R function to sample from Laplace distribution:
## `n` is sample size
rlaplace <- function (n) {
u <- runif(n, 0, 1)
ifelse(u < 0.5, log(2 * u), -log(2* (1 - u)))
}
Also write a function for density of Laplace distribution:
g <- function (x) ifelse(x < 0, 0.5 * exp(x), 0.5 * exp(-x))
Now, your integrand is:
f <- function (x) {
ifelse(x > 0, exp(-sqrt(x) - 0.5 * x) * sin(x) ^ 2, 0)
}
Now we estimate the integral using 1000 samples (set.seed for reproducibility):
set.seed(0)
x <- rlaplace(1000)
mean(f(x) / g(x))
# [1] 0.2648853
Also compare with numerical integration using quadrature:
integrate(f, lower = 0, upper = Inf)
# 0.2617744 with absolute error < 1.6e-05

How to create a distribution function in R?

Given the following function:
f(x) = (1/2*pi)(1/(1+x^2/4))
How do I identify it's distribution and write this distribution function in R?
So this is your function right now (hopefully you know how to write an R function; if not, check writing your own function):
f <- function (x) (pi / 2) * (1 / (1 + 0.25 * x ^ 2))
f is defined on (-Inf, Inf) so integration on this range gives an indefinite integral. Fortunately, it approaches to Inf at the speed of x ^ (-2), so the integral is well defined, and can be computed:
C <- integrate(f, -Inf, Inf)
# 9.869604 with absolute error < 1e-09
C <- C$value ## extract integral value
# [1] 9.869604
Then you want to normalize f, as we know that a probability density should integrate to 1:
f <- function (x) (pi / 2) * (1 / (1 + 0.25 * x ^ 2)) / C
You can draw its density by:
curve(f, from = -10, to = 10)
Now that I have the probably distribution function I was wondering how to create a random sample of say n = 1000 using this new distribution function?
An off-topic question, but OK to answer without your making a new thread. Useful as it turns out subtle.
Compare
set.seed(0); range(simf(1000, 1e-2))
#[1] -56.37246 63.21080
set.seed(0); range(simf(1000, 1e-3))
#[1] -275.3465 595.3771
set.seed(0); range(simf(1000, 1e-4))
#[1] -450.0979 3758.2528
set.seed(0); range(simf(1000, 1e-5))
#[1] -480.5991 8017.3802
So I think e = 1e-2 is reasonable. We could draw samples, make a (scaled) histogram and overlay density curve:
set.seed(0); x <- simf(1000)
hist(x, prob = TRUE, breaks = 50, ylim = c(0, 0.16))
curve(f, add = TRUE, col = 2, lwd = 2, n = 201)

Solving double (n-tuple) multivariate integrals in R

I would like to write a code to solve this kind of equations:
For that I wrote the code below, however it does not solve the problem. Do you have any ideas about the possibility to solve this kind of integrals in R?
t_0 = 15
mu = 0.1
lambda = 0.8
f = function(x1,x2) exp(mu*(x1+x2))*dexp(log(lambda)*(x1+x2))
f_comp = function(x2) f(x1,x2)
f_1 = function(x1) {integrate(f_comp,upper = t_0, lower = x1)}
result = integrate(f = f_1, lower = 0, upper = t_0)$value
--------- edit:
Given the answer below, I adapt the code to my example, but I still think is not the correct one, at least the value 0 for the integral does not make sense.
integrate(function(x1) {
sapply(x1, function(x1){
integrate(function(x2) exp(mu*(x1+x2))*dexp(log(lambda)*(x1+x2)), lower = x1, upper = t_0)$value
})
}, 0, t_0)
by the way, I would like to buid a general procedure for that (that is why I just not calculate the integral by hand). That is not only double integrals, but also n-tuples integrals, so I need a general procedure for this kind of calculations.
Make a picture of the domain of integration. This is a simplex (a triangle) with vertices (0,0), (0,t0), (t0,t0). To evaluate an integral on a simplex, the SimplicialCubature package is the way to go.
t0 = 15
mu = 0.1
lambda = 0.8
library(SimplicialCubature)
f <- function(xy){
x <- xy[1]; y <- xy[2]
exp(-mu*(x+y)) * (1-exp(-lambda*(x+y)))
}
S <- cbind(c(0,0), c(0,t0), c(t0,t0))
adaptIntegrateSimplex(f, S)$integral
# 29.55906
integrate(function(x1) {
sapply(x1, function(x1){
integrate(function(x2) exp(-mu*(x1+x2))*(1-exp(-lambda*(x1+x2))), lower = x1,
upper = t0)$value
})
}, 0, t0)$value
# 29.55906

Resources