Как упростить несколько циклов for в один цикл или функцию в R

Я пытаюсь объединить несколько циклов for в один цикл или функцию. Каждый цикл оценивает, присутствует ли человек на защищенном сайте, и на основе этого присваивает номер (числа представляют сайты) на каждом временном шаге. После этого результаты для каждого временного шага сохраняются в матрице и позже используются в другом анализе. Проблема, с которой я сталкиваюсь, заключается в том, что я повторяю один и тот же цикл несколько раз для оценки различных сценариев (10%, 50%, 100% защищенных сайтов). Поскольку мне нужно хранить свои результаты для каждого сценария, я не могу придумать лучшего способа упростить это до одного цикла или функции. Любые идеи или предложения будут оценены. Это очень маленькое и упрощенное представление о проблеме. Я хотел бы сохранить структуру цикла, поскольку мой исходный цикл использует несколько операторов if. Единственное, что меняется, — это доля защищенных сайтов.

N<-10 # number of sites
sites<-factor(seq(from=1,to=N))

sites10<-as.factor(sample(sites,N*1))     
sites5<-as.factor(sample(sites,N*0.5)) 
sites1<-as.factor(sample(sites,N*0.1)) 

steps<-10
P.stay<-0.9

# storing results

result<-matrix(0,nrow=steps) 
time.step<-seq(1,steps)
time.step<-data.frame(time.step)
time.step$event<-0

j<-numeric(steps)
j[1]<-sample(1:N,1)
time.step$event[1]<-j[1] 

for(i in 1:(steps-1)){

    if(j[i] %in% sites1){   

      if(rbinom(1,1,P.stay)==1){time.step$event[i+1]<-j[i+1]<-j[i]} else 

  time.step$event[i+1]<-0

  }

    time.step$event[i+1]<-j[i+1]<-sample(1:N,1)

}   

results.sites1<-as.factor(result)

###

result<-matrix(0,nrow=steps) 
time.step<-seq(1,steps)
time.step<-data.frame(time.step)
time.step$event<-0

j<-numeric(steps)
j[1]<-sample(1:N,1)
time.step$event[1]<-j[1] 

for(i in 1:(steps-1)){

  if(j[i] %in% sites5){   

    if(rbinom(1,1,P.stay)==1){time.step$event[i+1]<-j[i+1]<-j[i]} else 

      time.step$event[i+1]<-0

  }

  time.step$event[i+1]<-j[i+1]<-sample(1:N,1)

}   

results.sites5<-as.factor(result)

###

result<-matrix(0,nrow=steps) 
time.step<-seq(1,steps)
time.step<-data.frame(time.step)
time.step$event<-0

j<-numeric(steps)
j[1]<-sample(1:N,1)
time.step$event[1]<-j[1] 

for(i in 1:(steps-1)){

  if(j[i] %in% sites10){   

    if(rbinom(1,1,P.stay)==1){time.step$event[i+1]<-j[i+1]<-j[i]} else 

      time.step$event[i+1]<-0

  }

  time.step$event[i+1]<-j[i+1]<-sample(1:N,1)

}   

results.sites10<-as.factor(result)

#

results.sites1
results.sites5
results.sites10

r function for-loop simplify
person user1626688    schedule 01.06.2013    source источник

Ответы (1)


arrow_upward
2
arrow_downward

Вместо этого:

sites10<-as.factor(sample(sites,N*1))     
sites5<-as.factor(sample(sites,N*0.5)) 
sites1<-as.factor(sample(sites,N*0.1))

и запустив отдельные циклы для каждой из трех переменных, вы можете создать общий цикл и поместить его в функцию, а затем использовать одну из функций -apply, чтобы вызвать его с определенными параметрами. Например:

N<-10 # number of sites
sites<-factor(seq(from=1,to=N))
steps<-10
P.stay<-0.9

simulate.n.sites <- function(n) {
  n.sites <- sample(sites, n)

  result<-matrix(0,nrow=steps) 
  time.step<-seq(1,steps)
  time.step<-data.frame(time.step)
  time.step$event<-0

  j<-numeric(steps)
  j[1]<-sample(1:N,1)
  time.step$event[1]<-j[1] 

  for(i in 1:(steps-1)){

    if(j[i] %in% n.sites){ 

  ...etc...

  return(result)

}

results <- lapply(c(1, 5, 10), simulate.n.sites)

Теперь results будет списком с тремя матричными элементами.

Ключ в том, чтобы определить места, где вы повторяетесь, а затем преобразовать эти области в функции. Это не только более лаконично, но и легко расширяется в будущем. Хотите попробовать для 2 сайта? Поместите 2 в вектор, который вы передаете lapply.

Если вы не знакомы с семейством функций -apply, обязательно изучите их.

Я также подозреваю, что большая часть остального вашего кода может быть упрощена, но я думаю, что вы слишком усложнили его, чтобы я мог понять его. Например, вы определяете элемент time.step$event на основе условия, но затем перезаписываете этот элемент. Конечно, это не то, что делает фактический код?

person Peyton    schedule 01.06.2013
comment
Большое спасибо! Это было здорово и очень полезно! - person user1626688; 01.06.2013