More efficient loops thru unique values in R - r

Question

I am relatively new to R and all its wisdom and I am trying to be more efficient with my script. I am using a loop to simulate how an animal moves among different sites. The problem that I have is that when I increase the number of sites or change the initial parameters (based on fixed probability of moving or staying in the same site) then I end with a very complicated loop. If I have to run several different simulations with different parameters, I prefer a more efficient loop or function that could adjust to different situations. The first loop will fill a matrix according to the initial probabilities and the second loop will compared the cumulative probability matrix against a random number from a list of values (10 in this example) and will decide the fate of that individual (either stay or go to a new site)
Here is a simplification of my code:
N<-4 # number of sites
sites<-LETTERS[seq(from=1,to=N)]
p.stay<-0.45
p.move<-0.4
move<-matrix(c(0),nrow=N,ncol=N,dimnames=list(c(sites),c(sites)))
from<-array(0,c(N,N),dimnames=list(c(sites),c(sites)))
to<-array(0,c(N,N),dimnames=list(c(sites),c(sites)))
# Filling matrix with fixed probability #
for(from in 1:N){
for(to in 1:N){
if(from==to){move[from,to]<-p.stay} else {move[from,to]<-p.move/(N-1)}
}
}
move
cumsum.move<-cumsum(data.frame(move))
steps<-100
result<-as.character("") # for storing results
rand<-sample(random,steps,replace=TRUE)
time.step<-data.frame(rand)
colnames(time.step)<-c("time.step")
time.step$event<-""
to.r<-(rbind(sites))
j<-sample(1:N,1,replace=T) # first column to select (random number)
k<-sample(1:N,1,replace=T) # site selected after leaving and coming back
# Beginning of the longer loop #
for(i in 1:steps){
if (time.step$time.step[i]<cumsum.move[1,j]){time.step$event[i]<-to.r[1]} else
if (time.step$time.step[i]<cumsum.move[2,j]){time.step$event[i]<-to.r[2]} else
if (time.step$time.step[i]<cumsum.move[3,j]){time.step$event[i]<-to.r[3]} else
if (time.step$time.step[i]<cumsum.move[4,j]){time.step$event[i]<-to.r[4]} else
if (time.step$time.step[i]<(0.95)){time.step$event[i]<-NA} else
if (time.step$time.step[i]<1.0) break # break the loop
result[i]<-time.step$event[i]
j<-which(to.r==result[i])
if(length(j)==0){j<-k} # for individuals the leave and come back later
}
time.step
result
This loop is part of a bigger loop that will simulate and store the result after a series of simulations. Any ideas or comments on how I can improve the efficiency of this loop so that I can easily modify the number of sites or change the initial probability parameters without repeating or having to do major edits of the loop will be appreciated.

Answer 1

I'm not sure if I'm capturing the essence of your code, but this is faster than the for loops. This started having an advantage as soon as we start getting past a few thousand steps. I replace "random" with a sample of the uniform distribution (runif())
system.time(
time.step$event <- sapply(
time.step$time.step,
function(x) rownames(
cumsum.move[which(cumsum.move[,j] > x),])[[1]]
)
)
Here are my results # 10,000 steps. I'm working on a laptop so 100,000 with the for loop didn't compute in under 1 minute, but sapply did it in 14 seconds.
> system.time(
+ time.step$event <- sapply(
+ time.step$time.step,
+ function(x) rownames(
+ cumsum.move[which(cumsum.move[,j] > x),])[[1]]
+ )
+ )
user system elapsed
1.384 0.000 1.387
> head(time.step)
time.step event
1 0.2787642 C
2 0.3098240 C
3 0.9079045 D
4 0.9904031 D
5 0.3754330 C
6 0.6984415 C
> system.time(
+ for(i in 1:steps){
+ if (time.step$time.step[i]<cumsum.move[1,j]){time.step$event[i]<-to.r[1]} else
+ if (time.step$time.step[i]<cumsum.move[2,j]){time.step$event[i]<-to.r[2]} else
+ if (time.step$time.step[i]<cumsum.move[3,j]){time.step$event[i]<-to.r[3]} else
+ if (time.step$time.step[i]<cumsum.move[4,j]){time.step$event[i]<-to.r[4]}
+ result[i]<-time.step$event[i]
+ }
+ )
user system elapsed
3.137 0.000 3.143
> head(time.step)
time.step event
1 0.2787642 C
2 0.3098240 C
3 0.9079045 D
4 0.9904031 D
5 0.3754330 C
6 0.6984415 C