Избавиться от вложенных (ненужных?) For-циклов - PullRequest
0 голосов
/ 17 января 2019

Я опытный в Фортране, но довольно новый в R. В Фортране я привык вкладывать несколько циклов do, но я думаю, что есть лучшие методы в R. Некоторые ответы на вопросы были получены с применением apply, но я Я не уверен, что это правильный путь для меня.

Я хочу сделать поправку на смещение для данных моей модели. Я знаю, что для этого существуют пакеты, но я бы предпочел написать это сам. У меня есть два data.frames, первый содержит мои данные модели:

library(dplyr)
x <- round(runif(34698,0,20), 2)
df_a <- data.frame(date=as.Date(0:34697, origin="2006-01-01"),x)
df_a <- setNames(df_a, c("date","daily"))
df_a <- separate(df_a, date, into = c("year", "month", "day"), sep="-")

Второй фрейм данных содержит наблюдаемые и смоделированные исторические месячные средние значения:

df_b <- data.frame(month=seq(01,12,by=1),obs=seq(1.1,12.1,by=1),model=seq(2.2,13.2,by=1))
df_b$month <- ifelse(nchar(df_b$month)!=2,paste0("0",df_b$month),df_b$month)

С помощью следующего кода я исправляю данные моего первого data.frame, используя средства каждого месяца второго data.frame. Код работает нормально, но я думаю, что это не R-стиль его кодирования. Особенно мне понадобится еще больше циклов for, потому что у меня есть несколько выходов модели, и для каждой модели у меня есть два разных сценария.

system.time(
  for(i in 1:12){
    for (j in 1:nrow(df_a)) {
      if(df_b$month[i]==df_a$month[j]){
        df_a$daily[j] <- df_a$daily[j]+(df_b$obs[i]-df_b$model[i])
      }
    }
  }
)

Я был бы очень признателен всем, кто мог бы показать мне, как "улучшить" мой стиль кодирования в R.

1 Ответ

0 голосов
/ 17 января 2019

Лучшим вариантом было бы сделать left_join и mutate для создания нового столбца

library(dplyr)
df_a1 <- df_a %>% 
            left_join(df_b) %>% 
            mutate(daily = daily + obs + model)

Тесты

system.time(df_a %>% 
              left_join(df_b) %>%
              mutate(daily = daily + obs + model))  
#   user  system elapsed 
#  0.201   0.011   0.213 

Кроме того, как @parfait упомянул в комментариях, версия base R с merge будет

system.time( within(merge(df_a, df_b, by="month", all.x=TRUE), {
              daily <- daily + obs + model}))
#   user  system elapsed 
#  0.260   0.015   0.275 

Или с data.table

library(data.table)
system.time(setDT(df_a)[df_b, daily := daily + obs + model, on = .(month)])
#   user  system elapsed 
#  0.198   0.011   0.208 

и петля ОП for

system.time(
   for(i in 1:12){
     for (j in 1:nrow(df_a)) {
       if(df_b$month[i]==df_a$month[j]){
         df_a$daily[j] <- df_a$daily[j]+(df_b$obs[i]-df_b$model[i])
       }
     }
   }
 )
#   user  system elapsed 
#  9.661   2.741  12.306 
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...