Написание векторизованной функции с lubridate :: month () для получения финансового года - PullRequest
Новая
       7

Написание векторизованной функции с lubridate :: month () для получения финансового года

1 голос
/ 05 февраля 2020

Я пишу функцию, чтобы взять дату и вывести (30 июня) месяц финансового года, где июль - это месяц 1 финансового года, август - 2, а июнь - 12.

Например, учитывая два года дат, я ожидаю, что вывод этих данных будет c(1:12, 1:12): 

data.frame(perf_dt = seq.Date(from = as.Date("2019-07-01"),
                              to   = as.Date("2021-06-01"),
                              by   = "month"))

Моя текущая функция такова. Он включает в себя logi c, чтобы дополнительно разрешить вывод меток. 

FY_mo <- function(date, label = F, abbrev = F) {
  a <- (5 + (lubridate::month(date) %% 12)) + 1
  CY_num = lubridate::month(date)
  ifelse(!label, a,
          ifelse(abbrev,
                  month.abb[CY_num],
                  month.name[CY_num]))
}

Это работает, когда я передаю отдельные даты. Например, этот тест из testthat проходит: 

test_that("FY_mo works on indiv input dates", {
  expect_equal(7, FY_mo(as.Date("2020-01-01")))
  expect_equal("January", FY_mo(as.Date("2020-01-01"), label = TRUE))
  expect_equal("Jan", FY_mo(as.Date("2020-01-01"), label = TRUE, abbrev = TRUE))
})

Но он не работает, когда я передаю ему вектор. Код ниже выводит все «13». 

data.frame(perf_dt = seq.Date(from = as.Date("2019-07-01"),
                                             to =   as.Date("2021-06-01"),
                                             by = "month")) %>%
                 dplyr::mutate(FY_mo = FY_mo(perf_dt)) %>%
                 dplyr::pull(FY_mo)
#[1] 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13

Где моя ошибка? Есть ли лучший способ структурировать функцию для получения правильного вывода для векторов?

1 Ответ

3 голосов
/ 05 февраля 2020

Это не ошибка как таковая, но поскольку мы используем ifelse для проверки здесь условия, а ifelse возвращает вектор такой же длины, как и test. Поскольку наша test имеет длину 1 (length(!label)), она возвращает только 1-е значение и перезапускает его. Здесь, поскольку у нас есть единственное условие для проверки, мы можем использовать if / else вместо ifelse, что позволит избежать этой проблемы. 

FY_mo <- function(date, label = F, abbrev = F) {
  a <- match(lubridate::month(date), c(7:12, 1:6))
  CY_num = lubridate::month(date)
  if(!label) a
  else if (abbrev) month.abb[CY_num]
       else month.name[CY_num]       
}

data.frame(perf_dt = seq.Date(from = as.Date("2019-07-01"),
                              to =   as.Date("2021-06-01"),
                              by = "month")) %>%
  dplyr::mutate(FY_mo = FY_mo(perf_dt)) %>%
  dplyr::pull(FY_mo)

#[1] 1  2  3  4  5  6  7  8  9 10 11 12  1  2  3  4  5  6  7  8  9 10 11 12
...