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

Question

Я пытаюсь объединить несколько циклов для петель в один цикл или функцию. Каждый цикл оценивает, присутствует ли человек на защищаемом сайте и на основании этого назначается число (числа представляют сайты) на каждом временном шаге. После этого результаты для каждого временного шага хранятся в матрице, а затем используются в другом анализе. Проблема, которую я испытываю, заключается в том, что я повторяю один и тот же цикл несколько раз, чтобы оценить различные сценарии (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 

Answer 1

Вместо того, чтобы сделать это:

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.

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

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