Быстрая работа с датами в R
У меня есть около 34000 векторов дат, которые мне нужно изменить день и переместить месяц. Я пробовал это с помощью цикла и функции mapply, но это очень медленно.
Это пример того, что у меня есть:
library(lubridate)
list_dates = replicate(34000,seq(as.Date("2019-03-14"),length.out = 208,by = "months"),simplify = F)
new_day = round(runif (34000,1,30))
new_day[sample(1:34000,10000)] = NA
new_dates = mapply(FUN = function(dates,day_change){
day(dates) = ifelse(is.na(rep(day_change,length(dates))),day(dates),rep(day_change,length(dates)))
dates = as.Date(ifelse(is.na(rep(day_change,length(dates))),dates,dates%m-%months(1)),origin = "1970-01-01")
return(dates)
},dates = list_dates,day_change = as.list(new_day),SIMPLIFY = F)
Переменная new_dates должна содержать список исходных дат, перемещаемых соответственно переменной new_day. Функция в стороне работает следующим образом:
- если
new_dayотличается от NA, он изменит день даты на новый - если
new_dayотличается от NA, он переместит месяцы дат на один назад.
Я открыт для любого решения, которое увеличит скорость независимо от использования пакетов (если они есть в CRAN).
РЕДАКТИРОВАТЬ
Поэтому, основываясь на комментариях, я сократил пример для списка из 2 векторов дат, каждый из которых содержит 2 даты, и создал ручной вектор новых дней:
list_dates = replicate(2,seq(as.Date("2019-03-14"),length.out = 2,by = "months"),simplify = F)
new_day = c(9,NA)
Это исходный ввод (переменная list_dates):
[[1]]
[1] "2019-03-14" "2019-04-14"
[[2]]
[1] "2019-03-14" "2019-04-14"
и ожидаемый результат функции mapply:
[[1]]
[1] "2019-02-09" "2019-03-09"
[[2]]
[1] "2019-03-14" "2019-04-14"
Как вы можете видеть, первый вектор дат был изменен на 9-й день, и каждая дата отставала на один месяц. Второй вектор дат не изменился, потому что new_dates равно NA для этого значения.
В дополнение к комментарию Ронака, пожалуйста, используйте фиксированное случайное начальное число, чтобы обеспечить воспроизводимость выборочных данных и ожидаемого результата. Я также не уверен, что вы подразумеваете под «это переместит месяцы дат на один позади».. Вы хотите сказать, что new_month = old_month - 1 для всех дат элемента list_dates?
Существует некоторая двусмысленность относительно того, хотите ли вы использовать функцию day из lubridate или индексировать аргумент day, который вы передаете mapply. Если последнее, то вы должны использовать квадратные скобки []. В любом случае избегайте называть свою переменную так же, как функции, которые вы собираетесь использовать.
Я обновил вопрос, чтобы он был минимальным. @Rohit спасибо за комментарий об аргументе дня, который был ошибкой, которую я допустил из исходной функции, уже измените ее.
Ответы 2
Вот решение lubridate
library(lubridate)
mapply(
function(x, y) { if (!is.na(y)) {
day(x) <- y;
month(x) <- month(x) - 1
}
return(x) },
list_dates, new_day, SIMPLIFY = F)
#[[1]]
#[1] "2019-02-09" "2019-03-09"
#
#[[2]]
#[1] "2019-03-14" "2019-04-14"
Или с помощью purrr
library(purrr)
library(lubridate)
map2(list_dates, new_day, function(x, y) {
if (!is.na(y)) {
day(x) <- y
month(x) <- month(x) - 1
}
x })
Спасибо, но я сравниваю вашу функцию и мою с двумя датами длиной 208 в microbenchmark, и исходная функция mi немного быстрее.
@AlejandroAndrade Понятно; Я добавил вариант purrr, не уверен, как это соотносится с microbenchmark сравнением. PS: отрицательный голос здесь на самом деле не оправдан и, откровенно говоря, является несколько ошибочным ответом на общую концепцию респондентов SO, дающих бесплатные советы; решение воспроизводит ожидаемый результат.
Новая функция работает быстрее. Что касается отрицательного ответа, ваш первоначальный ответ был в основном той же функцией, но вместо ifelse вы использовали if, и это было медленнее, что не было предполагаемым результатом вопроса (у меня уже была функция, которая делала это быстрее). Я знаю, что это бесплатный совет, и спасибо за него, но меня также проголосовали за законный вопрос. Результат остается довольно медленным, но я думаю, вы не пробовали его с более чем 100 датами.
В дополнение к решению Маурица, если вы хотите еще больше увеличить скорость вычислений, вы можете рассмотреть возможность использования нескольких ядер с doParallel
library(data.table)
library(doParallel)
registerDoParallel(3)
df <- data.table(new_day,list_dates)
mlply(df,
function(new_day,list_dates){
list_dates <- list_dates[[1]]
if (!is.na(new_day)){
day(list_dates) <- new_day
list_dates <- list_dates %m-% months(1)
}
return(list_dates)
}, .parallel = T, .paropts = list(.packages='lubridate')
)
Я не могу распараллелить эту функцию, потому что я уже запускаю более крупную функцию, которая вызывает эту функцию с помощью foreach
Можете ли вы сократить ввод до 10 дат и показать, что вы пытаетесь сделать вместе с ожидаемым результатом?