Более быстрые в вычислительном отношении альтернативы для вычисления новой переменной на основе нескольких столбцов из двух больших фреймов данных в R

У меня есть два набора данных, df1 и df2.

(1) df1 имеет около 7 миллионов строк и 57 столбцов. Столбцы, представляющие интерес в df1 для этого расчета, — «округ», «дата начала» и «дата окончания».

(2) df2 имеет около 12 миллионов строк и 12 столбцов. Столбцы, представляющие интерес в df2 для этого расчета, — «округ», «дата» и «мера».

Для каждой строки i в df1 мне нужно вычислить среднее значение всех df2$measure[j], которые удовлетворяют двум условиям:

(a) df2$date[j] находится между df1$start.date[i] и df1$end.date[i], и

(b) df2$county[j] соответствует df1$county[i]

Это среднее значение будет добавлено в качестве нового столбца в df1 для дальнейшего анализа.

Моя главная проблема — скорость вычислений.

Мой код работал с меньшими подмножествами данных, но при полномасштабном применении это занимало слишком много времени. Моя сессия параллельных вычислений (8 процессоров, 8 ГБ памяти) была ограничена 8 часами, и даже после 8 часов это еще не было сделано.

Я был бы очень признателен за ваши предложения о том, как сделать это быстрее, помимо использования более мощной компьютерной системы. Огромное спасибо заранее!

Ниже мой код:

# Create function to extract mean measure
mean.measure <- function(x,y,z) { # x = county; y = start date; z = end date
  ifelse(is.na(x) | is.na(y) | is.na(z), return(NA), 
     ifelse (y >= z, return("Start date >= end date"),
             ifelse (!(x %in% df2$county), return("Nonexistent county"),
                     ifelse(z > max(df2$date) | y < min(df2$date), return("Out of df2 date range"),
                            temp <- df2 %>%
                              filter(county == x & date >= y & date < z) %>% # filter out only the time range and county of interest
                              summarise(mean = mean(measure, na.rm=TRUE)) # ignore NA values for measure
                     )
             )
         )
    )
 return(temp$mean)
}


# Vectorize mean.measure()
v_mean.measure <- Vectorize(mean.measure)

# Calculate mean measure and add to df1
df1 <- df1 %>%
  mutate(mean.measure = v_mean.measure(county,start.date,end.date))

(1) Вы неправильно используете ifelse, никогда не следует пытаться return от них. Я не уверен, хотите ли вы немедленно выйти из функции, если any(.) из них являются NA (например), или если вы собираетесь присвоить NA этому значению. (2) «Никогда» не пытайтесь присвоить <- что-то внутри ifelse. Бывают случаи, когда он может работать, но почти наверняка не делает того, что вам нужно. (3) %>% трубы внутри ifelse - это новый уровень «не делай этого», не уверен, что видел это раньше :-). (4) Ваша функция принимает x, y и z, но вы нарушаете рамки, чтобы посмотреть на df2. Не хорошая практика.

r2evans 20.02.2023 21:24

(5) Размер ваших данных, безусловно, усложняет задачу; Я предполагаю, что неэквивалентное слияние/объединение (с использованием data.table, sqldf или нового dplyr::join_by приведет к взрывному использованию памяти, верно? Это может быть признаком того, что вам нужно переместить данные из памяти и просто работать в одном округе за раз. Существует несколько методов, которые могут работать, начиная от файлов стрелок-паркетов и заканчивая sqlite/duckdb и более крупными (не основанными на монолитных файлах) серверами баз данных. R может работать с «большими данными» (big air кавычки), но он полностью полагается на то, что они являются еще одним слоем, помогающим организовать данные, а не только R.

r2evans 20.02.2023 21:27
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
1
2
65
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Вот идея пошаговой обработки. Как правильно отмечает r2evans, не следует использовать объекты в среде R непосредственно в функции. Лучшей практикой является передача их в качестве параметров в вашей функции. Мне кажется, что вы можете предварительно обработать свои округа x, чтобы убедиться, что они существуют в df2, что устранит необходимость логических проверок в вашей функции. Вот очень простой игрушечный пример, который разбивает фрейм данных на возможные подмножества, а затем обрабатывает каждое подмножество с помощью оболочки lapply:

cars <- mtcars
n_cyls <- unique(cars$cyl)

my_function <- function(df_subset) {
      return(mean(df_subset$mpg))
}

means <- lapply(n_cyls, function(x) my_function(subset(cars, cars$cyl == x)))
means
[[1]]
[1] 19.74286

[[2]]
[1] 26.66364

[[3]]
[1] 15.1

Таким образом, в вашем случае вы должны сгенерировать уникальный вектор n_counties из df2, а затем передать каждое подмножество df2 по округам в качестве параметра вашей функции.

Спасибо за ваш вклад! Мне было интересно, не могли бы вы показать мне, как передать даты начала и окончания в функцию и использовать lapply, так как среднее значение показателя фактически за период, определенный в каждой строке i df1 с помощью df1$start.date[i] и df1$end.date[i], а не по всем строкам с интересующим округом. Простите меня за то, что я не объяснил это достаточно хорошо - дайте мне знать, и я могу попробовать еще раз!

Gef 21.02.2023 00:05

Например, если my_function выглядит следующим образом: mean.measure <- function(start.date,end.date,df2_subset) { return(mean(df2_subset$measure[df2_subset$date >= start.date & df2_subset$date < end. date,],na.rm=TRUE)) } Как мне поступить с этим для lapply и извлечь start.date и end.date из df1? Еще раз спасибо!

Gef 21.02.2023 00:12
Ответ принят как подходящий

Начните с сортировки df2 по county, затем по date. Затем добавьте столбец индекса (r в приведенном ниже коде) и столбец, содержащий совокупную сумму measure (cs ниже). Это позволит нам выполнить два быстрых data.table неэквивалентных соединения, чтобы получить начальную и конечную строки в df2, которые необходимо усреднить для каждой строки df1. Используйте эти индексы строк, чтобы получить разницу в совокупной сумме measure, а затем разделите на количество строк, составляющих эту разницу.

Используя некоторые фиктивные данные с 7 миллионами строк в df1 и 12 миллионами строк в df2, вычисление занимает всего несколько секунд.

library(data.table)

system.time(
  setDT(df1)[
    , `:=`(
      r1 = setorder(
        setDT(df2),
        county, date
      )[
        , `:=`(r = .I, cs = cumsum(measure))
      ][
        df1,
        r,
        on = .(county == county, date >= start.date),
        mult = "first"
      ],
      r2 = df2[
        df1,
        r,
        on = .(county == county, date < end.date),
        mult = "last"
      ]
    )
  ][
    , `:=`(
      mean.measure = (df2$cs[r2] - df2$cs[r1])/(r2 - r1 + 1L),
      r1 = NULL,
      r2 = NULL
    )
  ]
)
#>    user  system elapsed 
#>    5.28    0.31    2.66

Данные:

df1 <- data.frame(
  county = sample(LETTERS[1:25], 7e6, 1),
  start.date = sample(seq.Date(as.Date("2010-01-01"), as.Date("2020-12-31"), "days"), 7e6, 1)
)
df1$end.date <- df1$start.date + sample(1e3, 7e6, 1)
df2 <- data.frame(
  county = sample(LETTERS, 12e6, 1),
  date = sample(seq.Date(as.Date("2010-06-01"), as.Date("2020-07-31"), "days"), 12e6, 1),
  measure = runif (12e6)
)

Этот метод по ссылке является колдовством! Это работает так быстро. Большое вам спасибо за вашу помощь!

Gef 21.02.2023 22:17

Другие вопросы по теме