У меня есть два набора данных, 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))
(5) Размер ваших данных, безусловно, усложняет задачу; Я предполагаю, что неэквивалентное слияние/объединение (с использованием data.table, sqldf или нового dplyr::join_by приведет к взрывному использованию памяти, верно? Это может быть признаком того, что вам нужно переместить данные из памяти и просто работать в одном округе за раз. Существует несколько методов, которые могут работать, начиная от файлов стрелок-паркетов и заканчивая sqlite/duckdb и более крупными (не основанными на монолитных файлах) серверами баз данных. R может работать с «большими данными» (big air кавычки), но он полностью полагается на то, что они являются еще одним слоем, помогающим организовать данные, а не только R.
Вот идея пошаговой обработки. Как правильно отмечает 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], а не по всем строкам с интересующим округом. Простите меня за то, что я не объяснил это достаточно хорошо - дайте мне знать, и я могу попробовать еще раз!
Начните с сортировки 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)
)
Этот метод по ссылке является колдовством! Это работает так быстро. Большое вам спасибо за вашу помощь!
(1) Вы неправильно используете ifelse, никогда не следует пытаться return от них. Я не уверен, хотите ли вы немедленно выйти из функции, если any(.) из них являются NA (например), или если вы собираетесь присвоить NA этому значению. (2) «Никогда» не пытайтесь присвоить <- что-то внутри ifelse. Бывают случаи, когда он может работать, но почти наверняка не делает того, что вам нужно. (3) %>% трубы внутри ifelse - это новый уровень «не делай этого», не уверен, что видел это раньше :-). (4) Ваша функция принимает x, y и z, но вы нарушаете рамки, чтобы посмотреть на df2. Не хорошая практика.