R: проблема времени выполнения, цикл, два больших кадра данных, эффективность - PullRequest
0 голосов
/ 30 апреля 2018

Я работаю над анализом общественного транспорта. У меня есть два больших фрейма данных, df: "links" и df: "incl_1stop". Первый содержит необработанные данные, 100000 объектов - все существующие линии / границы одной станции-станции (от А до В), в т.ч. время прибытия и отъезда Вторая содержит все возможные комбинации «одна остановка-передача» (от A до B к C), которые я создал с помощью цикла.

Теперь я хотел бы создать все возможные "комбинации двух остановок", связав ABC df: "incl_1stop" со всеми "подходящими" obs в df: "link" условно на C в df: "incl_1stop" == A в df: «ссылка» и некоторые другие ограничения (см. Ниже).

Я пробовал следующий цикл:

two_stop <- data.frame(stringsAsFactors = FALSE)
mtt <-5
total_travel_time <- 240

for(i in 1:length(incl_1stop$ID)){#all one stop paths
  for(j in 1:length(links$ID)){#all existing direct links
   if(incl_1stop$dest[i]==links$orig[j] & !is.na(incl_1stop$dest[i]) &!is.na(links$orig[j])){#destination one-stop path = origin link
    if((links$dep_minute[j] - incl_1stop$arr_minute[i]) >= mtt & !is.na(links$dep_minute[j]) &!is.na(incl_1stop$arr_minute[i])){#minimum transit time 
     if((links$arr_minute[j] - incl_1stop$dep_minute[i]) <= total_travel_time & !is.na(links$arr_minute[j]) &!is.na(incl_1stop$dep_minute[i])){#max travel time
      if(links$dest[j]!=incl_1stop$orig[i]& !is.na(links$dest[j])& !is.na(incl_1stop$orig[i])){#loop first origin
       if(links$dest[j]!=incl_1stop$dest[i]& !is.na(links$dest[j])& !is.na(incl_1stop$dest[i])){#loop second origin

          two_stop[k,1]<-incl_1stop$orig[i]#first node/origin
          two_stop[k,2]<-incl_1stop$dest[i]#second node
          two_stop[k,3]<-incl_1stop$dest2[i]#thrird node
          two_stop[k,4]<-incl_1stop$dep_minute[i]#depature time first node
          two_stop[k,5]<-incl_1stop$arr_minute2[i]#arrival time endpoint third node
          two_stop[k,6]<-incl_1stop_$prov2[i]#provider last path element

          two_stop[k,7]<-incl_1stop$ID1[i]#ID first edge
          two_stop[k,8]<-incl_1stop$ID2[i]#ID second edge

          two_stop[k,9]<-links$ID3[j]#ID additional/third edge
          two_stop[k,10]<-links$dep_minute[j]#depature time third element
          two_stop[k,11]<-links$dest[j]#destination third element/fourth node
          two_stop[k,12]<-paste0(incl_1stop$path[i],"_",links$dest[j]) #travel path
          two_stop[k,13]<-(links$arr_minute[j]-incl_1stop$dep_minute[i])#total travel time first node-fourth node
          k <- k+1 
        }
      }
    } 
  }
}
}
}

Однако этот цикл требует буквально дней, чтобы пройти через фреймы и получить результаты. Я предполагаю, что код не очень эффективен. У вас есть рекомендации, как значительно ускорить процедуру?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...