I'm currently working on an R code for a basic insurance risk process.
it is part of an assignment, and I'm struggling with 3 things -
The question is in the image attached here. Question
1) the time arrival is specified as a homogeneous Poisson process. I was wondering if the generation of E was right to address this.
2) I'm not sure how to include a summation in R
3) I'm also struggling with how to integrate the j effectively in the code? Am i using it the right way? I'm still new to R. my code seems wrong to me, i was just wondering if someone can point me in the right direction.
a = 10
n=100
t=0
l=10
for(t in 1:n){
E <- rexp(n,l)
if(t + E < t){
t= t + E
}else{
if(t + E >=t){
for(j in 1:t)
R = a + 5*t - sum(X[j])
}
}
}
Related
I've written an R script (sourced from here) simulating the path of a geometric Brownian motion of a stock price, and I need the simulation to run 1000 times such that I generate 1000 paths of the process Ut = Ste^-mu*t, by discretizing the law of motion derived from Ut which is the bottom line of the solution to the question posted here.
The process also has n = 252 steps and discretization step = 1/252, also risk of sigma = 0.4 and instantaneous drift mu, which I've treated as zero, although I'm not sure about this. I'm struggling to simulate 1000 paths of the process but am able to generate one single path, I'm unsure which variables I need to change or whether there's an issue in my for loop that's restricting me from generating all 1000 paths. Could it also be that the script is simulating each individual point for 252 realization instead of simulating the full process? If so, would this restrict me from generating all 1000 paths? Is it also possible that the array I'm generating defined as U hasn't being correctly generated by me? U[0] must equal 1 and so too must the first realization U(1) = 1. The code is below, I'm pretty stuck trying to figure this out so any help is appreciated.
#Simulating Geometric Brownian motion (GMB)
tau <- 1 #time to expiry
N <- 253 #number of sub intervals
dt <- tau/N #length of each time sub interval
time <- seq(from=0, to=N, by=dt) #time moments in which we simulate the process
length(time) #it should be N+1
mu <- 0 #GBM parameter 1
sigma <- 0.4 #GBM parameter 2
s0 <- 1 #GBM parameter 3
#simulate Geometric Brownian motion path
dwt <- rnorm(N, mean = 0, sd = 1) #standard normal sample of N elements
dW <- dwt*sqrt(dt) #Brownian motion increments
W <- c(0, cumsum(dW)) #Brownian motion at each time instant N+1 elements
#Define U Array and set initial values of U
U <- array(0, c(N,1)) #array of U
U[0] = 1
U[1] <- s0 #first element of U is s0. with the for loop we find the other N elements
for(i in 2:length(U)){
U[i] <- (U[1]*exp(mu - 0.5*sigma^2*i*dt + sigma*W[i-1]))*exp(-mu*i)
}
#Plot
plot(ts(U), main = expression(paste("Simulation of Ut")))
This questions is quite difficult to answer since there are a lot of unclear things, at least to me.
To begin with, length(time) is equal to 64010, not N + 1, which will be 254.
If I understand correctly, the brownian motion function returns the position in one dimension given a time. Hence, to calculate this position for each time the following can be enough:
s0*exp((mu - 0.5*sigma^2)*time + sigma*rnorm(length(time),0,time))
However, this calculates 64010 points, not 253. If you replicate it 1000 times, it gives 64010000 points, which is quite a lot.
> B <- 1000
> res <- replicate(B, {
+ s0*exp((mu - 0.5*sigma^2)*time + sigma*rnorm(length(time),0,time))
+ })
> length(res)
[1] 64010000
> dim(res)
[1] 64010 1000
I know I'm missing the second part, the one explained here, but I actually don't fully understand what you need there. If you can draw the formula maybe I can help you.
In general, avoid programming in R using for loops to iterate vectors. R is a vectorized language, and there is no need for that. If you want to run the same code B times, the replicate(B,{ your code }) function is your firend.
I have written an R code to solve the following equations jointly. These are closed-form solutions that require numerical procedure.
I further divided the numerator and denominator of (B) by N to get arithmetic means.
Here is my code:
y=cbind(Sta,Zta,Ste,Zte) # combine the variables
St=as.matrix(y[,c(1,3)])
Stm=c(mean(St[,1]), mean(St[,2])); # Arithmetic means of St's
Zt=as.matrix(y[,c(2,4)])
Ztm=c(mean(Zt[,1]), mean(Zt[,2])); # Arithmetic means of Zt's
theta=c(-20, -20); # starting values for thetas
tol=c(10^-4, 10^-4);
err=c(0,0);
epscon=-0.1
while (abs(err) > tol | phicon<0) {
### A
eps = ((mean(y[,2]^2))+mean(y[,4]^2))/(-mean(y[,1]*y[,2])+theta[1]*mean(y[,2])-mean(y[,3]*y[,4])+theta[2]*mean(y[,4]))
### B
thetan = Stm + (1/eps)*Ztm
err=thetan-theta
theta=thetan
epscon=1-eps
print(c(ebs,theta))
}
Iteration does not stop as the second condition of while loop is not met, the solution is a positive epsilon. I would like to get a negative epsilon. This, I guess requires a grid search or a range of starting values for the Thetas.
Can anyone please help code this process differently and more efficiently? Or help correct my code if there are flaws in it.
Thank you
If I am right, using linearity your equations have the form
ΘA = a + b / ε
ΘB = c + d / ε
1/ε = e ΘA + f ΘB + g
This is an easy 3x3 linear system.
I really hope you can help me with a problem I cant solve on my own.
I'm trying to program a basic urn model for a web app. I want to calculate the probabilities of specific random events according to different drawing methods in a model with 2 different colors.
The composition of the urn (red and black balls) is specified in a vector
a <-c(number_red, number_black)
The random event is specified in another vecotor, lets say
b<-c("red","red","black","red") or any other combination of red and black balls
Now want to calculate the probability of the event (vector b), when the balls are
1) replaced in the urn, and order does matter
2) NOT replaced in the urn, and order does matter
3) NOT replaced in the urn, and order doesn't matter
4) replaced in the urn, and order doesn't matter
I came up with several different ideas but none of them really worked...
At first I wrote fuctions in order to determine how many different combinations one can could draw in each of the scenarios.
stan = function(n,x) {return(n^x)}
perm = function(n, x) {return(factorial(n) / factorial(n-x))}
komb = function(n, x) {return(factorial(n) / (factorial(n-x)*factorial(x)))}
komb2 = function(n, x) {return(factorial(n+x-1) / (factorial(n-1)*factorial(x)))}
But then I didnt really know how to apply them in order to calculate the final probabilities.
I also experimented with for loops in order to emulate a tree diagram, but it became too complex for me. For example:
c <- c(number_red/(number_red+number_black), number_red/(number_red+number_black))
b <- c("red","black","red")
b[b=="red"]<-1
[b=="black"]<-2
b<-as.numeric(b)
vec<-NULL
for (i in b){
vec<-c(vec, c[i])}
prod(vec)
A solution like that gives correct results for problem #1, but i dont really know how to apply it to the other problems since I would have to find a way to alter vector c according to the composition of vector b each time I run the loop.
Of course I have experimented with different ideas, but none of them really seems to work. I would be very thankful if someone could help me with my problem.
Best,
Henry
Is this correct?
a <- c(red = 5, black = 5)
b <- c("red","red","black","red")
# (1)
prod((a/sum(a))[b])
# (2)
p <- c()
n <- a
for(i in b){
p <- c(n[i] / sum(n), p)
n[i] <- n[i] - 1
}
prod(p)
# (3)
komb <- function(n, x) {
return(factorial(n) / (factorial(n-x)*factorial(x)))
}
n <- table(b)
prod(sapply(names(n), function(i){
komb(a[i], n[i])
})) / komb(sum(a), sum(n))
# (4)
# I think it is the same as (1) as each sample is independent;
i am trying to build a recursive function in R,
H(x,t) = \sum\limits_{d=0}^{x} (Pr(D=d)*(h*(x-d)+H(x-d,t-1)))
+ \sum\limits_{d=x+1}^{\infty} (Pr(D=d)*(p(*d-x)+ H(0,t-1)))
Where h,p are some constants, D ~ Po(l) and H(x,0) = 0, the are code i have done so far, gives an obvious error, but i can't see the fix. The code
p<- 1000 # Unit penalty cost for lost sales
h<- 10 # Unit inventory holding cost pr. time unit
l<- 5 # Mean of D
H <- function(x,t){
if(t==0)(return(0))
fp <- 0
sp <- 0
for(d in 0:x){
fp <- fp + dpois(x=d,l)*(h*(x-d)+H(x-d,t-1))
}
for(d in x+1:Inf){
sp <- sp + dpois(x=d,l)*(p*(d-x)+H(0,t-1))
}
return(fp+sp)
}
When i run this, the error is
Error in 1:Inf : result would be too long a vector
Which, seems obvious, so the question is, can anyone point me in the direction to redefine the problem, so i can get R to bring me a solution?
Thanks in advance.
Going from x+1:Inf won't work. Since you're using poisson's pdf, you can just add a upper bound (why? think about the shape of the pdf and how small the values are at the right tail):
for(d in x+1:100)
which when ran for H(20,2) gives
[1] 252.806
when you increase it to
for(d in x+1:500)
then H(20,2) also gives
[1] 252.806
I have a functional like this :
(LaTex formula: $v[y]=\int_0^2 (y'^2+23yy'+12y^2+3ye^{2t})dt$)
with given start and end conditions y(0)=-1, y(2)=18.
How can I find extreme values of this functional in R? I realize how it can be done for example in Excel but didn't find appropriate solution in R.
Before trying to solve such a task in a numerical setting, it might be better to lean back and think about it for a moment.
This is a problem typically treated in the mathematical discipline of "variational calculus". A necessary condition for a function y(t) to be an extremum of the functional (ie. the integral) is the so-called Euler-Lagrange equation, see
Calculus of Variations at Wolfram Mathworld.
Applying it to f(t, y, y') as the integrand in your request, I get (please check, I can easily have made a mistake)
y'' - 12*y + 3/2*exp(2*t) = 0
You can go now and find a symbolic solution for this differential equation (with the help of a textbook, or some CAS), or solve it numerically with the help of an R package such as 'deSolve'.
PS: Solving this as an optimization problem based on discretization is possible, but may lead you on a long and stony road. I remember solving the "brachistochrone problem" to a satisfactory accuracy only by applying several hundred variables (not in R).
Here is a numerical solution in R. First the functional:
f<-function(y,t=head(seq(0,2,len=length(y)),-1)){
len<-length(y)-1
dy<-diff(y)*len/2
y0<-(head(y,-1)+y[-1])/2
2*sum(dy^2+23*y0*dy+12*y0^2+3*y0*exp(2*t))/len
}
Now the function that does the actual optimization. The best results I got were using the BFGS optimization method, and parametrizing using dy rather than y:
findMinY<-function(points=100, ## number of points of evaluation
boundary=c(-1,18), ## boundary values
y0=NULL, ## optional initial value
method="Nelder-Mead", ## optimization method
dff=T) ## if TRUE, optimizes based on dy rather than y
{
t<-head(seq(0,2,len=points),-1)
if(is.null(y0) || length(y0)!=points)
y0<-seq(boundary[1],boundary[2],len=points)
if(dff)
y0<-diff(y0)
else
y0<-y0[-1]
y0<-head(y0,-1)
ff<-function(z){
if(dff)
y<-c(cumsum(c(boundary[1],z)),boundary[2])
else
y<-c(boundary[1],z,boundary[2])
f(y,t)
}
res<-optim(y0,ff,control=list(maxit=1e9),method=method)
cat("Iterations:",res$counts,"\n")
ymin<-res$par
if(dff)
c(cumsum(c(boundary[1],ymin)),boundary[2])
else
c(boundary[1],ymin,boundary[2])
}
With 500 points of evaluation, it only takes a few seconds with BFGS:
> system.time(yy<-findMinY(500,method="BFGS"))
Iterations: 90 18
user system elapsed
2.696 0.000 2.703
The resulting function looks like this:
plot(seq(0,2,len=length(yy)),yy,type='l')
And now a solution that numerically integrates the Euler equation.
As #HansWerner pointed out, this problem boils down to applying the Euler-Lagrange equation to the integrand in OP's question, and then solving that differential equation, either analytically or numerically. In this case the relevant ODE is
y'' - 12*y = 3/2*exp(2*t)
subject to:
y(0) = -1
y(2) = 18
So this is a boundary value problem, best approached using bvpcol(...) in package bvpSolve.
library(bvpSolve)
F <- function(t, y.in, pars){
dy <- y.in[2]
d2y <- 12*y.in[1] + 1.5*exp(2*t)
return(list(c(dy,d2y)))
}
init <- c(-1,NA)
end <- c(18,NA)
t <- seq(0, 2, by = 0.01)
sol <- bvpcol(yini = init, yend = end, x = t, func = F)
y = function(t){ # analytic solution...
b <- sqrt(12)
a <- 1.5/(4-b*b)
u <- exp(2*b)
C1 <- ((18*u + 1) - a*(exp(4)*u-1))/(u*u - 1)
C2 <- -1 - a - C1
return(a*exp(2*t) + C1*exp(b*t) + C2*exp(-b*t))
}
par(mfrow=c(1,2))
plot(t,y(t), type="l", xlim=c(0,2),ylim=c(-1,18), col="red", main="Analytical Solution")
plot(sol[,1],sol[,2], type="l", xlim=c(0,2),ylim=c(-1,18), xlab="t", ylab="y(t)", main="Numerical Solution")
It turns out that in this very simple example, there is an analytical solution:
y(t) = a * exp(2*t) + C1 * exp(sqrt(12)*t) + C2 * exp(-sqrt(12)*t)
where a = -3/16 and C1 and C2 are determined to satisfy the boundary conditions. As the plots show, the numerical and analytic solution agree completely, and also agree with the solution provided by #mrip