Efficient simulation of brownian motion with drift in R - r

Question

I want to efficiently simulate a brownian motion with drift d>0, where the direction of the drift changes, if some barriers b or -b are exceeded (no reflection, just change of drift direction!).
A for-loop is the simple way doing this
step<-0.1 #step size
sig<-1 #sign of drift
T<-10^4 #length of process
b<-300; d<-0.5#barrier and drift
W<-rep(NA,(T/step))
W[1]<-0
for (i in 2:(T/step))
{
if (W[i-1]>b) {sig<- -1} #change drift to -1
if (W[i-1]< -b) {sig<-1} #change drift to +1
W[i]<-W[i-1]+rnorm(1,d*sig*step,sqrt(step))
}
Of course this loop takes much time in R especially for small step size.
Therefore, I am interested in a more efficient solution maybe using vectorial operations or the apply()-command. (in case of a simple brownian motion I can use cumsum(rnorm()), is a similar solution possible here?)
Thanks a lot!!

Answer 1

You have a recursive calculation for W[i] and sig which also does a bit of logic at each step. There's probably not much you can do in R to reduce the execution times by a large factor but there are a couple of things that will reduce times by almost 50%. In particular rather than calling rnorm on each step, vectorize this calculation by calling rnorm once with mean=0 to compute num_step values and store the result. In each step of the loop, the value from this vector is added to the mean for that step. The logic determining the value of sig can also be simplified a bit. The code with timings for the posted approach and the new code are:
step<-0.1 #step size
T<-10^4 #length of process
b<-300; d<-0.5 #barrier and drift
print(system.time({
sig <- 1 #sign of drift
set.seed(123) # set seed
W<-rep(NA,(T/step))
W[1]<-0
for (i in 2:(T/step))
{
if (W[i-1]>b) {sig<- -1} #change drift to -1
if (W[i-1]< -b) {sig<-1} #change drift to +1
W[i]<-W[i-1]+rnorm(1,d*sig*step,sqrt(step))
}
}))
print(system.time({
sig <- 1 # reset value of sig
set.seed(123) # reset seed
num_steps <- trunc(T/step)
W1 <- numeric(num_steps)
ep <- rnorm(num_steps, 0, sqrt(step))
for (i in 2:num_steps) {
if(abs(W1[i-1]) > b) sig <- ifelse( W1[i-1] >b, -1, 1)
W1[i] <- W1[i-1]+d*sig*step +ep[i-1]
}
}))
The results of the two calculations, W and W1, should be identical.