I'm trying to translate the following double integral in R.
n <- 1
InnerFunc <- function(x, y) {f(y - x)*g(x)}
InnerIntegral <- Vectorize(function(y) {integrate(InnerFunc, -Inf, Inf)$value})
integrate(InnerIntegral, n, Inf)
I tried to find inspiration from another question but I'm getting mixed up in the arguments. Thanks for the help.
Thanks G5W for referring me to this post:
Numerical Triple Integration in R
I think I am able to answer my own question now.
n <- 1
integrate(Vectorize(function(y) {
integrate(Vectorize(function(x) {f(y - x)*g(x)}), -Inf, Inf)$value }), n, Inf)
I tested the syntax with
f <- function(x) {x^2}
g <- function(x) {sin(x)}
integrate(Vectorize(function(y) {
integrate(Vectorize(function(x) {f(y-x)*g(y)}), 0, 1)$value }), 0, pi)
Which gives 3.394678 as in https://www.wolframalpha.com/input/?i=integrate+(y-x)%5E2+sin+y+dx+dy,+x%3D0+to+1,+y%3D0+to+pi
Related
I apologise if this is a duplicate; I've read answers to similar questions to no avail.
I'm trying to integrate under a curve, given a specific formula (below) for said integration.
As a toy example, here's some data:
Antia_Model <- function(t,y,p1){
r <- p1[1]; k <- p1[2]; p <- p1[3]; o <- p1[4]
P <- y[1]; I <- y[2]
dP = r*P - k*P*I
dI = p*I*(P/(P + o))
list(c(dP,dI))
}
r <- 0.25; k <- 0.01; p <- 1; o <- 1000 # Note that r can range btw 0.1 and 10 in this model
parms <- c(r, k, p, o)
P0 <- 1; I0 <- 1
N0 <- c(P0, I0)
TT <- seq(0.1, 50, 0.1)
results <- lsoda(N0, TT, Antia_Model, parms, verbose = FALSE)
P <- results[,2]; I <- results[,3]
As I understand it, I should be able to use the auc() function from the MESS package (can I just use the integrate() function? Unclear...), which should look something like this:
auc(P, TT, from = x1, to = x2, type = "spline")
Though I don't really understand how to use the "from" and "to" arguments, or how to incorporate "u" from the original integration formula...
Using the integrate() function seems more intuitive, but if I try:
u <- 1
integrand <- function(P) {u*P}
q <- integrate(integrand, lower = 0, upper = Inf)
I get this error:
# Error in integrate(integrand, lower = 0, upper = Inf) :
# the integral is probably divergent
As you can tell, I'm pretty lost, so any help would be greatly appreciated! Thank you so much! :)
integrand is technically acceptable but right now, it's the identity function f(x) = x. The area under it from [0, inf) is infinite, i.e. divergent.
From the documentation of integrate the first argument is:
an R function taking a numeric first argument and returning a numeric vector of the same length. Returning a non-finite element will generate an error.
If instead you use a pulse function:
pulse <- function(x) {ifelse(x < 5 & x >= 0, 1, 0)}
integrate(pulse, lower = 0, upper = Inf)
#> 5 with absolute error < 8.5e-05
I want to integrate a function which looks like
f <- function(x) 1.96 * sqrt(t(c(1,x)) %*% m %*% c(1,x))
where m is
m <- matrix(c(3.855, -0.206, -0.206, 0.01), nrow = 2, ncol = 2, byrow = T)
Since the matrix multiplication inside my function produces a scalar, for any value of x, this is just a one-dimensional integration for f(x). How can I solve this smoothly?
Simply with integrate and Vectorize:
integrate(Vectorize(f), lower = 0, upper = 1)
Here is another option without Vectorize (but I believe the approach by #Stéphane Laurent is more space-efficient)
> ff <- function(x) 1.96 * sqrt(diag(t(rbind(1, x)) %*% m %*% rbind(1, x)))
> integrate(ff, lower = 0, upper = 1)
3.745299 with absolute error < 4.2e-14
where ff is already a vectorized function since it is constructed using rbind + diag to accept vector argument.
library(pbivnorm)
rho <- 0.5
f1 <- function(x, y) {
pbivnorm(log(x)-10, log(y)-10, rho)*(exp(-(log(x)-10)^2/2)/(sqrt(2*pi)*x))*(exp(-(log(y)-10)^2/2)/(sqrt(2*pi)*y))
}
integration1 <- round(integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f1(x,y), 0, Inf, rel.tol = 1e-12)$value
})
}, 0, Inf, rel.tol = 1e-12)$value, 10)
This integration should be around 0.3, but R gives 0. Could anyone point out the problem? What is the best function for integral in R? Many thanks.
Package cubature can solve the problem giving the expected result. The function must be rewritten as a one argument function, and the values for x and y set in the function body.
library(cubature)
f2 <- function(X) {
x <- X[1]
y <- X[2]
pbivnorm(log(x)-10, log(y)-10, rho)*(exp(-(log(x)-10)^2/2)/(sqrt(2*pi)*x))*(exp(-(log(y)-10)^2/2)/(sqrt(2*pi)*y))
}
hcubature(f2, c(0, 0), c(Inf, Inf))
#$integral
#[1] 0.2902153
#
#$error
#[1] 2.863613e-06
#
#$functionEvaluations
#[1] 7599
#
#$returnCode
#[1] 0
Edit.
Following the OP's second comment, here is the integral computed with hcubature
f3 <- function(x) {
pnorm(log(x)-10.2)*(exp(-(log(x)-10)^2/2)/(sqrt(2*pi)*x))
}
hcubature(f3, lowerLimit = 0, upperLimit = Inf, tol = 1e-12)$integral
#[1] 0.4437685
I have a question concerning the computation of a double integral in R. Maybe it is not the best software package to try numerical integration, but we are heavily relying on its stochastic optimisation packages (the function to be optimised is very non-trivial, with lots of local minima), so we cannot switch to MATLAB or other packages.
The problem is the following: it takes a whale of a time to compute the double integral using nested integrate functions, and several times more (!) using the hcubature approach from the cubature package. I tried the first solution from this answer (using hcubature from the cubature package), but it made the timing even worse; besides that, infinite integration limits are not supported, and the integration chokes for (-100, 100) interval already. With the second solution (quad2d from pracma package), the timing is great, but the computation result is way off!
The single integral is computed quite quickly (e.g., if the double integrals are commented out, it takes only 0.2 seconds to compute the value of the function, which is tolerable).
Here is a heavily simplified version of the function for the MWE (just to illustrate the point of integration).
library(cubature)
library(pracma)
# Generate some artificial data to try this function on
set.seed(100)
n <- 200
r <- rnorm(n, 0.0004, 0.01)
# Log-likelihood function accepts 3 parameters:
# [1] shape of positive shocks, [2] shape of negative shocks, [3] DoF of Student's distribution for jumps
parm <- c(6, 7, 10)
LL <- function(parm, cub = "default") {
shapes <- parm[1:2]
studdof <- parm[3]
# For simplification, generate some dynamic series
set.seed(101)
sigmaeps <- rgamma(n, shape=shapes[1], rate=1000)
sigmaeta <- rgamma(n, shape=shapes[2], rate=1000)
lambdas <- rgamma(n, shape=10, rate=80)+1
probs <- sapply(lambdas, function(x) dpois(0:2, lambda=x))
probs <- sweep(probs, 2, colSums(probs), FUN="/") # Normalising the probabilities
# Reserving memory for 3 series of density
fw0 <- rep(NA, n)
fw1 <- rep(NA, n)
fw2 <- rep(NA, n)
for (t in 2:n) {
integ0 <- function(e) { # First integrand for 0 jumps
1/sigmaeta[t] * dgamma(-(r[t]-sigmaeps[t]*e)/sigmaeta[t], shape=shapes[2]) * # Density of negative shocks
dgamma(e, shape=shapes[1]) # Density of positive shocks
}
integ1 <- function(e, g) { # Double integrand for 1 jump
1/sigmaeta[t] * dgamma(-(r[t]-sigmaeps[t]*e-1*g)/sigmaeta[t], shape=shapes[2]) * # Density of negative shocks
dgamma(e, shape=shapes[1]) * # Density of positive shocks
dt(g, df = studdof)/1 # Density of jump intensity
}
integ2 <- function(e, g) { # Double integrand for 2 jumps
1/sigmaeta[t] * dgamma(-(r[t]-sigmaeps[t]*e-2*g)/sigmaeta[t], shape=shapes[2]) * # Density of negative shocks
dgamma(e, shape=shapes[1]) * # Density of positive shocks
dt(g, df = studdof)/2 # Density of jump intensity
}
# Wrappers for cubature because they need vector inputs
wrapper1 <- function(x) integ1(x[1], x[2])
wrapper2 <- function(x) integ2(x[1], x[2])
# Single integral that is not a problem
fw0[t] <- integrate(integ0, 0, Inf)$value
if (cub=="cubature") {
# 2D CUBATURE FROM cubature PACKAGE
fw1[t] <- hcubature(wrapper1, c(0, -20), c(20, 20))$integral
fw2[t] <- hcubature(wrapper2, c(0, -20), c(20, 20))$integral
} else if (cub=="prac2d") {
# 2D CUBATURE FROM pracma PACKAGE
fw1[t] <- quad2d(integ1, 0, 100, -100, 100)
fw2[t] <- quad2d(integ2, 0, 100, -100, 100)
} else if (cub=="default") {
# DOUBLE INTEGRALS FROM BUILT-IN INTEGRATE
fw1[t] <- integrate(function(g) { sapply(g, function(g) { integrate(function(e) integ1(e, g), 0, Inf)$value }) }, -Inf, Inf)$value
fw2[t] <- integrate(function(g) { sapply(g, function(g) { integrate(function(e) integ2(e, g), 0, Inf)$value }) }, -Inf, Inf)$value
}
if (!t%%10) print(t)
}
fw <- fw0*probs[1, ] + fw1*probs[2, ] + fw2*probs[3, ]
fw <- log(fw[2:n])
fw[is.nan(fw)] <- -Inf
slfw <- sum(fw)
print(paste0("Point: ", paste(formatC(parm, 4, format="e", digits=3), collapse=" "), ", LL: ", round(slfw, 2)))
return(slfw)
}
system.time(LL(parm, cub="default"))
# 13 seconds
# "Point: 6.000e+00 7.000e+00 1.000e+01, LL: 247.78"
system.time(LL(parm, cub="cubature"))
# 29 seconds, the result is slightly off
# "Point: 6.000e+00 7.000e+00 1.000e+01, LL: 241.7"
system.time(LL(parm, cub="prac2d"))
# 0.5 seconds, the result is way off
# "Point: 6.000e+00 7.000e+00 1.000e+01, LL: 223.25"
(Ideally, integ1(e, g) and integ2(e, g) should be integrated over [0, Inf) w.r.t. e and over (-Inf, Inf) w.r.t. g.)
Parallelisation is done at a higher level (i.e., the stochastic optimiser is computing the values of this likelihood function in parallel), so it is essential that this function run as quickly as possible on a single core.
Is there any way to speed up the computation of this double integral?
Here is a wrapper for hcubature which I use to allow infinite limits:
hcubature.inf <- function() {
cl <- match.call()
cl[[1L]] <- quote(cubature::hcubature)
if(all(is.finite(c(lowerLimit,upperLimit)))) return(eval.parent(cl))
# convert limits to new coordinates to incorporate infinities
cl[['upperLimit']] <- atan(upperLimit)
cl[['lowerLimit']] <- atan(lowerLimit)
# wrap the function with the coordinate transformation
# update argument to hcubature with our function
f <- match.fun(f)
cl[['f']] <- if(!vectorInterface)
function(x, ...) f(tan(x), ...) / prod(cos(x))^2
else
function(x, ...) f(tan(x), ...) / rep(apply(cos(x), 2, prod)^2, each=fDim)
eval.parent(cl)
}
formals(hcubature.inf) <- formals(cubature::hcubature)
Then you should vectorize the integrands:
vwrapper1 <- function(x) as.matrix(integ1(x[1,], x[2,]))
vwrapper2 <- function(x) as.matrix(integ2(x[1,], x[2,]))
And integrate:
if (cub=="cubature.inf") {
fw1[t] <- hcubature.inf(vwrapper1, c(0, -Inf), c(Inf, Inf), vectorInterface=TRUE)$integral
fw2[t] <- hcubature.inf(vwrapper2, c(0, -Inf), c(Inf, Inf), vectorInterface=TRUE)$integral
} else if (cub=="cubature") {
...
You get a value of 242.83 in about half the time of your default method.
After searching in the forum, I did not find similar questions. If I missed it, please let me know. I would really appreciate.
I need to generate N (can be 10000 or more) sample points from gamma distribution wth given shape and scale parameters and lower/upper bound in R.
I know how to do it by "for loop" but, it is not efficient.
library(distr)
get_sample_gamma(shape, scale, lb, ub)
{
v <- rgamma(n = 10000, shape, scale)
# check the elements of v to be located [lb, ub]
# if not in the range, count the number of points in the range as M
# generate the remaining N - M points until all N points are got.
}
This is not efficient.
Any more efficient solutions would be apprecaited.
See R Programs for Truncated Distributions by Saralees Nadarajah and Samuel Kotz.
Using their code on page 4:
qtrunc <- function(p, spec, a = -Inf, b = Inf, ...) {
tt <- p
G <- get(paste("p", spec, sep = ""), mode = "function")
Gin <- get(paste("q", spec, sep = ""), mode = "function")
tt <- Gin(G(a, ...) + p*(G(b, ...) - G(a, ...)), ...)
return(tt)
}
rtrunc <- function(n, spec, a = -Inf, b = Inf, ...) {
x <- u <- runif(n, min = 0, max = 1)
x <- qtrunc(u, spec, a = a, b = b,...)
return(x)
}
Now v <- rtrunc(10000, "gamma", lb, ub, shape=shape, scale=scale) should do the job.