Быстрые манипуляции с датами в R - PullRequest
Новая
       5

Быстрые манипуляции с датами в R

0 голосов
/ 14 марта 2019

У меня есть около 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. Функция в стороне работает так:

  1. если new_day отличается от NA, день даты изменится на новый
  2. , если new_day отличается от NA, это будет сдвигать месяцы на одну дату позади.

Я открыт для любого решения, которое увеличит скорость независимо от использования пакетов (если они в CRAN).

EDIT

Итак, основываясь на комментариях, я сократил пример для списка из 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 для этого значения.

Ответы [ 2 ]

0 голосов
/ 15 марта 2019

В дополнение к решению Maurits, если вы хотите еще больше увеличить скорость вычислений, вы можете рассмотреть возможность использования нескольких ядер с 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')
)
0 голосов
/ 15 марта 2019

Вот решение 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 })
...