4d monte carlo integration R - r

How to integrate function using the Monte Carlo method
F(X[1],X[2],X[3],X[4])
Which depends on 4 variable by 4 dimensions?
I mean int_{0}^{1} int_{0}^{1} int_{0}^{1} int_{0}^{1} X[1]X[2]X[3]X[4] dX[1] dX[2] dX[3] dX[4]
UPD
function is
data1 = rnorm(100, 0, 1)
data2 = rnorm(100, 0.1, 0.5)
data3 = rnorm(100, 0.2, 0.8)
data4 = rnorm(100, 0.3, 0.9)
kernel1 = kdensity(data1,kernel = 'gaussian')
kernel2 = kdensity(data2,kernel = 'gaussian')
kernel3 = kdensity(data3,kernel = 'gaussian')
kernel4 = kdensity(data4,kernel = 'gaussian')
f <- function(X) {
return(X[1]*kernel1(X[1])*kernel2(X[2])*kernel3(X[3])*kernel4(X[4]))
}
and i want to integrate it
int_{0}^{1} int_{0}^{1} int_{0}^{1} int_{0}^{1} f dX[1] dX[2] dX[3] dX[4]

Due to your particular structure of integral expression, you can rewrite your nested integral into a product of integrals.
Thus, the solution below may be a example (with random seed set.seed(1)) for you:
g <- Vectorize(function(ker) {integrate(ker,0,1)}$value)
gE <- function(ker) {integrate(function(x) x*ker(x),0,1)}$value
res1 <- prod(c(gE(kernel1),g(c(kernel2,kernel3,kernel4))))
such that
> res1
[1] 0.01559343
Nested Integral: you need to rewrite your function f first, i.e.,
f <- function(x1,x2,x3,x4) {
return(x1*kernel1(x1)*kernel2(x2)*kernel3(x3)*kernel4(x4))
}
res2 <- integrate(Vectorize(function(x4)
integrate(Vectorize(function(x3,x4)
integrate(Vectorize(function(x2,x3,x4)
integrate(f,0,1,x2,x3,x4)$value),
0,
1,
x3,
x4)$value),
0,
1,
x4)$value),
0,
1)$value
such that
> res2
[1] 0.01559343

Related

Applying function to data.frame

I have a function with following which looks like
function(nsim = 10, maxN = 10000, mu = 0, sigma = 0.1, S0 = 100, endT = 1, K = 100){
nsim+maxN+mu+sigma+S0+endT+K
}
(The function here is just given for simplicity, the actual funtion is a simple Black Sholes pricing model)
Now, I have a data.frame:
df <- expand.grid(nsim = 10,
maxN = 10000,
mu = c(0.05, 0.10, 0.15),
sigma = c(0.2, 0.4, 0.6),
S0 = seq(80,120, by = 1),
endT = c(0.25, 0.50, 0.75),
K = 100,
sim = sprintf("Sim.%s", 1:10)
)
Which is just a collection of multiple values. Now the question is, how do I apply previous function to the data set to calculate a new column with values, but using the column values from each row as input?
You can add a column with mutate :
library(dplyr)
my_function <- function(nsim = 10, maxN = 10000, mu = 0, sigma = 0.1, S0 = 100, endT =
1, K = 100){
nsim+maxN+mu+sigma+S0+endT+K
}
df %>%
mutate(new_c = my_function(nsim, maxN, mu,sigma, S0, endT, K))
You can use mapply :
apply_fun <- function(nsim = 10, maxN = 10000, mu = 0, sigma = 0.1, S0 = 100, endT = 1, K = 100){
nsim+maxN+mu+sigma+S0+endT+K
}
df$price <- mapply(apply_fun, df$nsim, df$maxN, df$mu, df$sigma, df$S0, df$endT, df$K)
If you don't want to write each argument separately you can also use apply with do.call.
df$price <- apply(df[-ncol(df)], 1, function(x) do.call(apply_fun, as.list(x)))

R code for simulating stochastic asset price path

Consider the following model for the evolution of an asset's price:
This what I have done (in R). I could not find a function that randomly outputs +1 or -1, so I decided to adapt the inbuilt rbinom function.
## This code is in R
rm(list = ls())
library(dplyr)
library(dint)
library(magrittr)
library(stats)
path =
function(T, mu, sigma, p, x0) {
x = rep(NA, T)
x[1] = x0
for(i in 2:T){
z = if_else(rbinom(1,1,p) == 0, -1, 1)
x[i] = x[i-1] * exp(mu + sigma*z)
}
return(x)
}
## Just some testing
x_sim = path(T = 4, mu = 0, sigma = 0.01, p = 0.5, x0 = 100)
## Actual answer
Np = 10000
mc = matrix(nrow = 17, ncol = Np)
for(j in 1:Np){
mc[,j] = path(T = 17, mu = 0, sigma = 0.01, p = 0.5, x0 = 100)
}
test = mc[2:nrow(mc), ] >= 100
sum_test = colSums(test)
comp = sum(sum_test >= 1)/length(sum_test)
prob = 1 - comp
Does this make sense? Any help/tips/advice would be much appreciated. Thanks!
Staying close to your code, I came up with this. Intuitively, if you think about it, the probability should be rather low due to the parameters and I get a probability of about 6.7% which is roughly what I get if I run your code with the parameters from the assignment.
simpath <- function(t, mu, sigma, p, x0, seed){
# set seed
if(!missing(seed)){
set.seed(seed)
}
# set up matrix for storing the results
res <- matrix(c(1:t, rep(NA, t*2)), ncol = 3)
colnames(res) <- c('t', 'z_t', 'x_t')
res[, 'z_t'] <- sample(c(1, -1), size = t, prob = c(p, 1-p), replace = TRUE)
res[1, 3] <- x0
for(i in 2:t){
res[i, 3] <- res[i-1, 3] * exp(mu+sigma*res[i, 2])
}
return(res)
}
x_sim <- simpath(t = 4, mu = 0, sigma = 0.01, p = 0.5, x0 = 100, seed = 123)
x_sim2 <- simpath(t = 36, mu = 0, sigma = 0.03, p = 0.5, x0 = 100, seed = 123)
## Actual answer
Np <- 100000
mc <- matrix(nrow = 36, ncol = Np)
for (j in 1:Np){
mc[, j] <- simpath(t = 36, mu = 0, sigma = 0.03, p = 0.5, x0 = 100)[, 3]
}
test <- mc > 100
sum_test <- colSums(test)
comp = sum(sum_test == 0)/length(sum_test)
prob = comp
> prob
[1] 0.06759

Count with Varying Levels Parameters in R

I want R to count how many times my simulated ARIMA data conform to ARIMA(1,0,0) which I have achieved with:
library(forecast)
library(forecast)
cnt <- 0
num <- 60
phi <- 0.8
for(i in 1:10) {
epselon <- rnorm(num, mean=0, sd=1)
ar1 <- arima.sim(n = num, model=list(ar=phi, order = c(1, 0, 0)),
sd=1)
ar2 <- auto.arima(ar1)
if(all(arimaorder(ar2) == c(1, 0, 0))) cnt <- cnt + 1}
cnt
The above is just for a single case when sd=1, n=60, and ar=0.8.
I want a case when I have varying levels of N <- c(15, 20), SD <- c(1, 2) ^ 2, and phi = c(0.8, 0.9) for sample size, standard diviation and AR parameter respectively.
I have traid this:
library(forecast)
N <- c(15, 20)
SD <- c(1, 2) ^ 2
phi = c(0.8, 0.9)
## generate all combos
all_combos <- expand.grid(N = N, SD = SD, phi = phi)
epselon = function(n) rnorm(n, mean = 0, sd = SD)
## create function
fx_arima <- function(n, SD, phi) {
cnt <- 0
num <- 60
phi <- 0.8
for(i in 1:10) {
epselon <- rnorm(num, mean=0, sd=1)
ar1 <- arima.sim(n = num, model=list(ar=phi, order = c(1, 0, 0)), sd=1)
ar2 <- auto.arima(ar1)
if(all(arimaorder(ar2) == c(1, 0, 0))) cnt <- cnt + 1}
cnt
}
## find arima for all combos using Map
set.seed(123L)
res = Map(fx_arima, all_combos[["N"]], all_combos[["SD"]],
all_combos[["phi"]])
## or a little bit more work:
set.seed(123L)
res2 = by(all_combos, all_combos["N"],
function(DF) {
res = mapply(fx_arima, DF[["N"]], DF[["SD"]], DF[["phi"]])
colnames(res) = paste("SD", DF[["SD"]], "phi", DF[["phi"]], sep = "_")
res
})
res2
## write to csv
Map(function(file, DF) write.csv(DF, paste0("N_", file, ".csv")),
names(res2), res2)
which I mirror from arima.sim() function with varying: sample sizes, phi values and sd values and R Count How Many Time auto.arima() Confirmarima.sim() to be True
I got this error message
Error in `colnames<-`(`*tmp*`, value = c("SD_1_phi_0.2", "SD_4_phi_0.2", : attempt to set 'colnames' on an object with less than two dimensions
Traceback:
How can I solve this such that will have my result to show in varying form suuch that first row will be the label while the second row will be the count itself. The result will in two sheets; the first will be for 'N=15' and the second will be for 'N=20'.
If I understood your problem correctly, the error comes from function colnames because your function does not return a "pure" matrix-like object. If, instead, you use the function names in your last chunk of code as follows:
res2 = by(all_combos, all_combos["N"],
function(DF) {
res = mapply(fx_arima, DF[["N"]], DF[["SD"]], DF[["phi"]])
names(res) = paste("SD", DF[["SD"]], "phi", DF[["phi"]], sep = "_")
return(res)
})
res2
You will get:
> res2
N: 15
SD_1_phi_0.8 SD_4_phi_0.8 SD_1_phi_0.9 SD_4_phi_0.9
1 3 7 5
---------------------------------------------------------------------------
N: 20
SD_1_phi_0.8 SD_4_phi_0.8 SD_1_phi_0.9 SD_4_phi_0.9
3 4 5 2
With elements accessible by name and index:
> res2$`15`["SD_1_phi_0.8"]
SD_1_phi_0.8
1
> res2$`15`[1]
SD_1_phi_0.8
1

Diffusion-reaction model using reactran in R

I am trying to implement a reaction-diffusion PDE using reacTran in the deSolve package. However, the time-dependent reaction term is not working. Any suggestions on how to implement this would be greatly appreciated!
library(ReacTran)
library(deSolve)
N <- 1000
xgrid <- setup.grid.1D(x.up = 0, x.down = 10, N = N)
x <- xgrid$x.mid
D.coeff <- 1
k <- 1
Diffusion <- function (t, Y, parms){
tran <- tran.1D(C = Y, C.up = 0, C.down = 0, D = D.coeff, dx = xgrid)-k*t
reac <- -kt
return(list(tran$dC+reac))
}
# Set initial conditions as gaussian distribution
C0 <- 10 #Initial concentration (mg/L)
X0 <- 5 #Location of initial concentration (m)
sig <- .2 #Spread of Gaussian distribution
C <- rep(0,N) #matrix
Yini <- C+C0*exp(-((x-X0)/sig)^2)
parms1 <- list(D=D.coeff, k=k)
times <- seq(from = 0, to = 5, by = 0.01)
print(system.time(
out <- ode.1D(y = Yini, times = times, func = Diffusion,
parms = parms1, dimens = N)))

R: extract parameter estmates from object of class 'mle'

I was wondering how one extracts the estimated parameters stored in an R object of class mle-class.
Here is an example:
x <- matrix(rnorm(300), ncol = 3)
x[x > 1] <- 1
require(tmvtnorm)
fit1 <- mle.tmvnorm(X = x, lower = rep(-Inf, 3), upper = rep(1, 3))
Now, fit1 is an object of class:
class(fit1)
[1] "mle"
attr(,"package")
[1] "stats4
"
fit1 itself gives me:
fit1
Call:
mle(minuslogl = function (mu_1 = 0, mu_2 = 0, mu_3 = 0, sigma_1.1 = 1,
sigma_1.2 = 0, sigma_1.3 = 0, sigma_2.2 = 1, sigma_2.3 = 0,
sigma_3.3 = 1)
{
nf <- names(formals())
theta <- sapply(nf, function(x) {
eval(parse(text = x))
})
mean <- theta[1:n]
if (cholesky) {
L <- inv_vech(theta[-(1:n)])
L[lower.tri(L, diag = FALSE)] <- 0
sigma <- t(L) %*% L
}
else {
sigma <- inv_vech(theta[-(1:n)])
}
if (det(sigma) <= 0 || any(diag(sigma) < 0)) {
return(.Machine$integer.max)
}
f <- -(sum(dmvnorm(X, mean, sigma, log = TRUE)) - nrow(X) *
log(pmvnorm(lower = lower, upper = upper, mean = mean,
sigma = sigma)))
if (is.infinite(f) || is.na(f)) {
return(.Machine$integer.max)
}
f
}, start = as.list(c(0, 0, 0, 1, 0, 0, 1, 0, 1)), method = "BFGS",
fixed = list())
Coefficients:
mu_1 mu_2 mu_3 sigma_1.1 sigma_1.2 sigma_1.3
0.64218198 1.51720543 0.97047201 1.73395947 -0.03889188 0.14627774
sigma_2.2 sigma_2.3 sigma_3.3
2.18020597 0.38822509 1.49854600
My question is: how do I extract these coefficients from the object fit1?
Thanks again for your time, and for your help in answering this question!
coef is a generic function which extracts model coefficients from objects returned by modeling functions. coefficients is an alias for it.
Usage
coef(object, ...)
coefficients(object, ...)
So, fit1#coef should work.
https://stat.ethz.ch/R-manual/R-devel/library/stats/html/coef.html
Sorry for this silly question: I will keep it just in case someone ends up looking.
fit1#coef
mu_1 mu_2 mu_3 sigma_1.1 sigma_1.2 sigma_1.3
0.64218198 1.51720543 0.97047201 1.73395947 -0.03889188 0.14627774
sigma_2.2 sigma_2.3 sigma_3.3
2.18020597 0.38822509 1.49854600
solves the query. Duh!

Resources