День года для каждого дня в данном месяце - PullRequest
1 голос
/ 06 ноября 2019

Я хотел бы иметь функцию month2doty() в R, которая, если ей присвоено число, представляющее месяц (например, 2 для февраля), возвращает вектор, содержащий день года длякаждый день в этом месяце (поэтому 32, 33, 34, …, 59 за февраль):

> month2doty(2)
 [1] 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59

В моем мире не существует високосных лет. Ниже приведен один из возможных ответов, но я уверен, что есть лучшие решения?

Ответы [ 2 ]

1 голос
/ 06 ноября 2019

Вот еще один способ сделать это в базе R. Мы создаем последовательность из 2-х длин между началом месяца и следующим месяцем, а затем производим все даты между ними. Мы используем %j в format для отображения дня года для этих дат.

month2doty <- function(x) {

  days <- seq(as.Date(paste0(format(Sys.Date(), "%Y"), "-", x, "-01")), 
                       by = "1 month", length.out = 2)
  as.integer(format(seq(days[1], days[2] - 1, by = "day"), "%j"))
}

month2doty(2)
# [1] 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 
#     54 55 56 57 58 59

month2doty(12)
# [1] 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 
#     354 355 356 357 358 359 360 361 362 363 364 365

Или другой вариант, использующий seq только один раз и days_in_month из lubridate

library(lubridate)

month2doty <- function(x) {
   days <- as.Date(paste0(format(Sys.Date(), "%Y"), "-", x, "-01")) 
   as.integer(format(seq(days, days + days_in_month(x) - 1, by = "day"), "%j"))
}

Если мы не хотим по-разному относиться к високосным годам, мы можем жестко закодировать год (как в OP)

month2doty <- function(x) {
  days <- seq(as.Date(paste0("2015-", x, "-01")), by = "1 month", length.out = 2)
  as.integer(format(seq(days[1], days[2] - 1, by = "day"), "%j"))
}

и

month2doty <- function(x) {
   days <- as.Date(paste0("2015-", x, "-01")) 
   as.integer(format(seq(days, days + days_in_month(x) - 1, by = "day"), "%j"))
}
0 голосов
/ 06 ноября 2019

Мое текущее решение этой проблемы - несколько неуклюжая конструкция справочной таблицы при каждом вызове функции:

month2doty <- function(mon=1){
  require(lubridate)
  alldays <- seq(from=ymd("2015-01-01"), length.out=365, by="days")
  lookuptable <- data.frame(month=month(alldays), day=day(alldays), doty=yday(alldays) )
  monthdata <- subset(lookuptable, lookuptable$month==mon)
  return(monthdata$doty)
}

month2doty(2)

Она так прекрасно работает, но мне интересно, есть ли более чистое решение, которое я 'м здесь не хватает.

...