Как я могу сделать это вложенным для l oop быстрее? - PullRequest
0 голосов
/ 23 февраля 2020
for (i in 1:nrow(surgeries_7)){ 
  count = 0 
  for (j in 1:nrow(visits_1)){ 
    count <- ifelse(surgeries_7$PatientProfileId[i]==visits_1$PatientProfileId[j] 
                      & visits_1$visit_date[j] > surgeries_7$surgery_date[i] &  
           visits_1$visit_date[j] <= surgeries_7$one_year_from_surgery[i],1,0) 
    surgeries_7$post_op_visits[i] <- surgeries_7$post_op_visits[i] + count 
  } 
  print(i) 
} 

Существует две таблицы: хирургии_7 одна: в ней два столбца, PatientProfileId (уникальный), и у нас есть дата операции для каждого соответствующего идентификатора профиля.

вторая таблица - таблица посещений, где у нас есть идентификатор профиля (есть несколько записей одного и того же идентификатора профиля) для разных посещений.

Мы пытаемся подсчитать количество посещений (записей для каждого идентификатора профиля) в таблице посещений после даты операции (присутствует в таблице хирургии_7), но в течение одного года после даты операции.

Дело в том, что код занимает слишком много времени для выполнения около 6 тыс. Строк. Есть ли способ сделать l oop быстрее?

Ответы [ 3 ]

0 голосов
/ 24 февраля 2020

Рассмотрите возможность избежать циклов и обработки с блочной обработкой, в частности merge, subset и aggregate. Ниже предполагается, что пациенты не имеют более одной операции в течение года, которая может пересчитать количество посещений.

# MERGE
merged_df <- merge(surgeries_7, visits_1, by = "PatientProfileId")

# SUBSET
sub_df <- subset(merged_df, visit_date > surgery_date & 
                            visit_date <= one_year_from_surgery)

# AGGREGATE ACROSS ALL PATIENT SURGERIES
agg_df <- aggregate(cbind(post_op_visits=visit_date) ~ PatientProfileId,
                    sub_df, FUN = length)

# AGGREGATE BY PATIENT AND SURGERY
agg_df <- aggregate(cbind(post_op_visits=visit_date) ~ PatientProfileId + surgery_date,
                    sub_df, FUN = length)

Если вам нужно добавить результат в качестве нового столбца, просто объедините агрегацию с исходным фреймом данных:

survery7 <- merge(surgery7, agg_df, by = c("PatientProfileId", "surgery_date"))
0 голосов
/ 24 февраля 2020

Опция, использующая неэквивалентное объединение в пакете data.table:

#calculate date one year after surgery
surgery_7[, oneyr := as.IDate(sapply(surgery_date, function(x) 
    seq(x, by="1 year", length.out=2L)[2L]))]

            #update by reference
surgery_7[, post_op_visits := 
    #non-equi join
    visits_1[.SD, on=.(PatientProfileId, visit_date>=surgery_date, visit_date<=oneyr),
        #for each row of surgery_7 find the number of rows from visits_1
        by=.EACHI, .N]$N]

output surgery_7:

   PatientProfileId surgery_date      oneyr post_op_visits
1:                1   2018-01-01 2019-01-01              2
2:                2   2019-01-01 2020-01-01              1

data:

library(data.table)
surgery_7 <- data.table(PatientProfileId=c(1,2), 
    surgery_date=as.IDate(c("2018-01-01", "2019-01-01")))
#   PatientProfileId surgery_date
#1:                1   2018-01-01
#2:                2   2019-01-01

visits_1 <- data.table(PatientProfileId=c(1,1,1,2,2),
    visit_date=as.IDate(c("2018-03-15","2018-09-15","2019-02-03","2019-06-30","2020-01-15")))
#    PatientProfileId visit_date
# 1:                1 2018-03-15
# 2:                1 2018-09-15
# 3:                1 2019-02-03
# 4:                2 2019-06-30
# 5:                2 2020-01-15
0 голосов
/ 23 февраля 2020

Я согласен с Jonathan V. Solórzano, попробуйте удалить функции из пакета dplyr.

Вот некоторые улучшения в вашем скрипте.

#Use data structures that consume lesser memory
library(data.table)

surgeries_7 <- data.table(surgeries_7)
visits_1 <- data.table(visits_1)

# vectorization and pre-allocation dramatically improves speed on large data.
# initialize output vector
post_op_visits <- numeric (nrow(surgeries_7))

for (i in 1:nrow(surgeries_7)){ 
count=0
  for (j in 1:nrow(visits_1)){ 
    count <- ifelse(surgeries_7$PatientProfileId[i]==visits_1$PatientProfileId[j] 
                    & visits_1$visit_date[j] > surgeries_7$surgery_date[i] &  
                    visits_1$visit_date[j] <= surgeries_7$one_year_from_surgery[i],1,0) 

    post_op_visits[i] <- surgeries_7$post_op_visits[i] + count 
  } 
  print(i) 
} 

# assign output outside loops
surgeries_7$post_op_visits <- post_op_visits

Вы также пытаетесь выполнить параллельную обработку вложенного l oop с помощью foreach + doParallel, если у вас есть многоядерный компьютер


#Use data structures that consume lesser memory
library(data.table)

surgeries_7 <- data.table(surgeries_7)
visits_1 <- data.table(visits_1)

# initialize output vector
post_op_visits <- numeric (nrow(surgeries_7))

library(foreach)
library(doParallel)

cl <- parallel::makeCluster(4) # for 4 cores machine
doParallel::registerDoParallel(cl)

post_op_visits <- foreach(i=1:nrow(surgeries_7), .combine='rbind') %dopar% { 
  foreach(j=1:nrow(visits_1), .combine='c') %do% {
    count <- ifelse(surgeries_7$PatientProfileId[i]==visits_1$PatientProfileId[j] 
                    & visits_1$visit_date[j] > surgeries_7$surgery_date[i] &  
                    visits_1$visit_date[j] <= surgeries_7$one_year_from_surgery[i],1,0) 

    surgeries_7$post_op_visits[i] + count
  } 
} 


# assign output outside loops
surgeries_7$post_op_visits <- post_op_visits

#close parallel backend
parallel::stopCluster(cl)

наилучшие пожелания - Ахмед Альхенди

...