将一天的一天一年的一天指定为一个月

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是第一周，> 15是第二周。例如：

- 15th Jan is Biweek 1, 
- 16-31 Jan is biweek 2, 
- 1-15 Feb is biweek 3 and 
- 16-28 Feb is biweek 4 and so on.

​

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

下面是我创建这两列的代码(在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年(闰年)，2月有29天(2月的最后一天是60，但我希望最后一天是59)，因此12月只有30天(12月开始为336，但应该从335开始)。我希望这是清楚的。我的解决方案解决了这个问题，但运行起来需要很多时间。

Answer 1

下面是一个使用lubridate提取器和弗兰克在评论中提到的替换函数的解决方案。关键是yday<-、mday()和month()，它们分别设置日期的年份、日期的日期、日期的日期，以及日期的月份。8秒的运行时间对我来说似乎是可以接受的，尽管我相信一些优化可能会降低这一点，尽管可能会失去一般性。

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

编辑:这里有一个明显更快的解决方案。您只需将DOY映射为单个年份的月份和两个星期，然后将left_join映射到主表。运行时间为0.36s，因为您不再需要重复创建日期。我们还不用使用case_when，因为join将处理丢失的日子。请看2000年的第59天是2月，第60天是3月。

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封装创建于2018-04-06 (v0.2.0)。

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，所以时间反映了这一点。