I'm trying to write the density of a mixture Gaussian distribution to an arbitrary power, b, in R. Currently, I have two methods that works, but I prefer if I could avoid a for loop.
dnorm_mix_tempered_unnorm <- function(x, w, m, s, b) {
value <- 0
for (i in 1:length(w)) {value <- value + w[i]*dnorm(x, mean = m[i], sd = s[i])}
value <- value^(b)
return(value)
}
Alternatively, I can vectorise this to avoid the for loop:
dnorm_mix_tempered_unnorm <- function(x, w, m, s, b) {
return(sum(w*dnorm(x, mean = m, sd = s))^b)
}
Both of these give the same result, but the second is more efficient since it is vectorised. But I need to next normalise this so that the density integrates to 1, I do this by using:
dnorm_mix_tempered <- function(x, weights, means, sds, beta) {
norm_constant <- integrate(function(x) dnorm_mix_tempered_unnorm(x, w = weights,
m = means, s = sds, b = 1/beta), lower = -Inf,
upper = Inf)$value
value <- dnorm_mix_tempered_unnorm(x, w = weights, m = means, s = sds, b = 1/beta)
/ norm_constant
return(value)
}
If I define dnorm_mix_tempered_unnorm with for loops, this works with no problem, and I can use curve() to plot the density. But if I define dnorm_mix_tempered_unnorm by using vectorisation, then I get the following error:
Error in integrate(function(x) dnorm_mix_tempered_unnorm(x, w = weights, :
evaluation of function gave a result of wrong length
Does anyone know what is going on when I am vectorising instead and trying to integrate?
Thanks in advance,
R.
A possible option is
dnorm_mix_tempered_unnorm <- function(x, w, m, s, b) {
return(rowSums(mapply(dnorm, mean = m, sd = m, MoreArgs = list(x = x)))^b)
}
But I think it is quite similar to your first proposal.
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 have the next function:
f <- function(x,y,z,w) {dpois(x, lambda = w*cos(y-z) ) }
I want to construct a function g(y,z,w) defined by the integral of f with respect to x. I can do it when I have two variables, the code is for example, something like this
margin <- function(y) { sapply(y, function(y) { integrate(function(x) f(x,y), llimx, ulimx)$value }) }
But I don't know how to do that for more than two variables.
Maybe you can try the code below
f <- Vectorize(function(x,y,z,w) dpois(x, w*cos(y-z)),"x")
g <- function(y,z,w) integrate(f, lower = 0, upper =Inf, y, z, w)
So, I have these functions:
funk1 <- function(a,x,l,r) {
x^2*exp(-(l*(1-exp(-r*a))/r))}
funk2 <- function(x,l,r) {
sapply(x, function (s) {
integrate(funk1, lower = 0, upper = s, x=s, l=l, r=r)$value })}
which are used to explain the data y in,
z <- data.frame(ts = 1:100,
y = funk2(1:100, l = 1, r = 1) + rpois(100, 1:100))
I wish to use optim to maximise the likelihood, so I defined a likelihood function:
LL_funk <- function(l,r) {
n=nrow(z)
R = sum((funk2(ts,l,r) - y)^2)
logl = -((n/2)*log(R))
return(-logl)
}
and I tried to fit using optim
fit <- optim(par=c(0.5,0.5), fn= LL_funk, method="Nelder-Mead")
But I get an error:
Error in integrate(funk1, lower = 0, upper = s, x = s, l = l, r = r) :
a limit is missing
I am not sure why? I could run nls fitting funk2(x,l,r) to y
nls(y ~ funk2(ts,l,r), data = z, start = list(l = 0.5, r = 0.5))
That means funk2 is working. I guess its the problem with LL function that I have designed, which I cant figure out!! Please Help!
Yup! There were two problems with your function. This worked for me:
LL_funk <- function(params) {
n=nrow(z)
l = params[1]
r = params[2]
R = sum((funk2(z$ts,l,r) - z$y)^2)
logl = -((n/2)*log(R))
return(-logl)
}
Previous issues:
LL_funk only takes 1 argument, which is the vector of parameters.
In LHS of the assignment of R, ts and y were not actually referring to columns in your dataset.
I would like to compute an integral where the integrand is a function of the solution of an ODE.
In order to solve the integral, R needs to solve an ODE for each value the integration algorithm uses. This is what I have done so far:
require(deSolve)
# Function to be passed to zvode in order to solve the ODE
ODESR <- function(t, state, parameters) {
with(as.list(c(state, parameters)),{
dPSI <- -kappa*PSI+0.5*sigma^2*PSI^2
dPHI <- kappa*theta*PSI
return(list(c(dPSI, dPHI)))
})
}
# For a given value of p this code should return the solution of the integral
pdfSRP <- function (p) {
integrand <- function (u) {
state <- c(PSI = u*1i, PHI = 0)
out <- as.complex(zvode(y = state, times = times, parms = parameters, fun = ODESR)[2, 2:3])
Re(exp(out[2] + out[1]*x)*exp(-u*1i*p))
}
integrate(f = integrand, lower = -Inf, upper = Inf)$value/(2*pi)
}
For the following given values:
parameters <- c(kappa = 1, theta = 0.035, sigma = 0.05)
times <- c(0,1)
x <- 0.1
running:
pdfSRP(p = 2)
produces the following error:
Error in eval(expr, envir, enclos) : object 'PSI' not found
I just cannot figure out why. I'm quite sure it is due to a syntax error, because running:
integrand <- function (u) {
state <- c(PSI = u*1i, PHI = 0)
out <- as.complex(zvode(y = state, times = times, parms = parameters, fun = ODESR)[2, 2:3])
Re(exp(out[2] + out[1]*x)*exp(-u*1i*p))
}
with p <- 2 and (for example) u <- 3 works.
Can you help me spot the mistake?
It seems to be a vectorization problem in the integrand input u. If I understand correctly, PSI should be a number for each calculation and not a vector of numbers (which will give a dimensional problem between PSI and PHI. Hence
integrand <- Vectorize(integrand)
should resolve your issue. From ?integrate:
f must accept a vector of inputs and produce a vector of function evaluations at those points.
However, this leads to a different error.
pdfSRP(p = 2)
## Error in integrate(f = integrand, lower = -Inf, upper = Inf) :
## the integral is probably divergent
If we plot the integrand, we may spot the divergence problem
p <- 2
par(mfrow = c(1,2))
curve(integrand,-1e3,1e3,n = 100)
curve(integrand,-1e3,1e3,n = 1e3)
Assuming the integrand converges sufficiently fast to zero in both tails, the divergence of the integral could be a result from numerical imprecision. We can increase precision by increasing the number of subintervals for the integral, which does give a result - I suppose, as expected by heuristically looking at the plot.
pdfSRP <- function (p) {
int <- integrate(f = integrand, lower = -Inf, upper = Inf,
subdivisions = 1e3)
int$value/(2*pi)
}
## [1] 2.482281e-06
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.