将一年中的一天分配给一个月

Question

样本数据

    df <- data.frame(ID1 = rep(1:1000, each= 5*365), year = rep(rep(2000:2004, each = 365), times = 1000), 
             day = rep(1:365, times = 1000*5), 
             x= runif(365*1000*5))

此数据包含一列day，它是一年中的某一天。我需要生成两列：

• 月份列：月份的一列（当天属于哪个月份）

• 双周栏：一天属于哪个双周。一年有24个双周。一个月内所有天数 15 是第二个双周。 例如

  • 1 月 15 日是双周 1，
  • 1 月 16 日至 31 日是第 2 周，
  • 2 月 1 日至 15 日是第 3 周和
  • 2 月 16 日至 28 日是第 4 周，以此类推。

为简单起见，我假设所有年份都是非闰年。

这是我拥有的创建两列的代码（在 RS 的帮助下）。

  # create a vector of days for each month

  months <- list(1:31, 32:59, 60:90, 91:120, 121:151, 152:181, 182:212, 213:243, 244:273, 274:304, 305:334, 335:365)

  library(dplyr)


  ptm <- proc.time()
  df <- df %>% mutate(month =  sapply(day, function(x) which(sapply(months, function(y) x %in% y))), # this assigns each day to a month
                           date = as.Date(paste0(year,'-',format(strptime(paste0('1981-',day), '%Y-%j'), '%m-%d'))), # this creates a vector of dates for a non-leap year
                           twowk = month*2 - (as.numeric(format(date, "%d")) <= 15)) %>% # this describes which biweek each day falls into
                 dplyr::select(-date) 
  proc.time() - ptm

  user  system elapsed 
  121.71    0.31  122.43 

我的问题是运行此脚本所需的时间，我正在寻找相对更快的解决方案

编辑：为了清楚起见，我假设所有年份都必须有 365 天。在下面的答案之一中，对于 2000 年（闰年），二月有 29 天（二月的最后一天是 60，但我希望最后一天是 59），因此十二月只有 30 天（十二月从 336 开始虽然它应该以 335 开头）。我希望这很清楚。我的解决方案解决了这个问题，但需要大量时间才能运行。

Answer 1

这是使用lubridate 提取器和替换函数的解决方案，如Frank in a comment 所述。关键是yday<-、mday()和month()，分别设置日期的年日、获取日期的月日、获取日期的月份。 8 秒的运行时间对我来说似乎是可以接受的，尽管我确信一些优化可以减少它，尽管可能会失去一般性。

还要注意使用 case_when 以确保闰年 2 月 29 日之后的天数正确。

编辑：这是一个明显更快的解决方案。您可以将 DOY 映射到一年的月份和双周，然后将 left_join 映射到主表。 0.36s 运行时间，因为您不再需要重复创建日期。我们还绕过了必须使用case_when，因为加入会处理缺失的日子。请参阅要求，2000 年的第 59 天是二月，而第 60 天是三月。

library(tidyverse)
library(lubridate)
#> 
#> Attaching package: 'lubridate'
#> The following object is masked from 'package:base':
#> 
#>     date
tbl <- tibble(
  ID1 = rep(1:1000, each= 5*365),
  year = rep(rep(2000:2004, each = 365), times = 1000),
  day = rep(1:365, times = 1000*5),
  x= runif(365*1000*5)
)

tictoc::tic("")
doys <- tibble(
  day = rep(1:365),
  date = seq.Date(ymd("2001-1-1"), ymd("2001-12-31"), by = 1),
  month = month(date),
  biweek = case_when(
    mday(date) <= 15 ~ (month * 2) - 1,
    mday(date) > 15  ~ month * 2
  )
)
tbl_out2 <- left_join(tbl, select(doys, -date), by = "day")
tictoc::toc()
#> : 0.36 sec elapsed
tbl_out2
#> # A tibble: 1,825,000 x 6
#>      ID1  year   day     x month biweek
#>    <int> <int> <int> <dbl> <dbl>  <dbl>
#>  1     1  2000     1 0.331    1.     1.
#>  2     1  2000     2 0.284    1.     1.
#>  3     1  2000     3 0.627    1.     1.
#>  4     1  2000     4 0.762    1.     1.
#>  5     1  2000     5 0.460    1.     1.
#>  6     1  2000     6 0.500    1.     1.
#>  7     1  2000     7 0.340    1.     1.
#>  8     1  2000     8 0.952    1.     1.
#>  9     1  2000     9 0.663    1.     1.
#> 10     1  2000    10 0.385    1.     1.
#> # ... with 1,824,990 more rows
tbl_out2[55:65, ]
#> # A tibble: 11 x 6
#>      ID1  year   day     x month biweek
#>    <int> <int> <int> <dbl> <dbl>  <dbl>
#>  1     1  2000    55 0.127    2.     4.
#>  2     1  2000    56 0.779    2.     4.
#>  3     1  2000    57 0.625    2.     4.
#>  4     1  2000    58 0.245    2.     4.
#>  5     1  2000    59 0.640    2.     4.
#>  6     1  2000    60 0.423    3.     5.
#>  7     1  2000    61 0.439    3.     5.
#>  8     1  2000    62 0.105    3.     5.
#>  9     1  2000    63 0.218    3.     5.
#> 10     1  2000    64 0.668    3.     5.
#> 11     1  2000    65 0.589    3.     5.

由reprex package (v0.2.0) 于 2018 年 4 月 6 日创建。

Answer 2

您可以通过首先定义日期，减少日期调用中的冗余，然后从日期中提取月份来加快这一速度。

    ptm <- proc.time()
    df <- df %>% mutate(
      date = as.Date(paste0(year, "-", day), format = "%Y-%j"), # this creates a vector of dates 
      month = as.numeric(format(date, "%m")), # extract month
      twowk = month*2 - (as.numeric(format(date, "%d")) <= 15)) %>% # this describes which biweek each day falls into
      dplyr::select(-date) 
    proc.time() - ptm

#   user  system elapsed 
#  18.58    0.13   18.75 

与问题中的原始版本

#   user  system elapsed 
# 117.67    0.15  118.45 

Answer 3

过滤一年。我认为它解决了您描述的飞跃问题，除非我不清楚您在说什么。在我下面的结果中，2 月的最后一天在 df 中是 59，但这只是因为天是 0 索引。

df2000 <- filter(df, year == "2000")
ptm <- proc.time()
df2000 <- df2000 %>% mutate(
  day = day - 1, # dates are 0 indexed
  date = as.Date(day, origin = "2000-01-01"),
  month = as.numeric(as.POSIXlt(date, format = "%Y-%m-%d")$mon + 1),
  bis = month * 2  - (as.numeric(format(date, "%d")) <= 15)
  )
proc.time() - ptm

user  system elapsed 
0.8     0.0     0.8

一年是整个df的0.2，所以时间反映了这一点。