将日期中的日期指定为一个月

Question

Sample data

    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))

This data contains a column day which is the day of the year. I need to produce two columns:

• Month column: a column of month (which month does the day belong)

• Biweek column: which biweek does a day belong to. There are 24 biweek in a year. All days <= 15 in a month is the first biweek and > 15 is second biweek. For eg

  • 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.

For sake of simplicity, I am assuming all the years are non-leap years.

Here's the code I have (with help from RS as well) that creates the two columns.

  # 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 

My issue is that of the time it takes to run this script and I am looking for a solution that is relatively faster

EDIT: To be clear, I have assumed all years must have 365 days. In one of the answers below, for the year 2000 (a leap year), Feb has 29 days (last day of Feb is 60 but I want the last day to be 59) and therefore Dec has only 30 days (Dec start with 336 though it should start with 335). I hope this is clear. My solution addresses this issue but takes lot of time to run.

Answer 1

Here is a solution using lubridate extractors and replacement functions as mentioned by Frank in a comment . The key ones are yday<- , mday() and month() , which respectively set the day of year of a date, get the day of month of a date, and get the month of a date. 8 sec running time seems pretty acceptable to me, though I'm sure some optimising could shave that down though there might be a loss of generality.

Note also the use of case_when to ensure the correct numbering of days after Feb 29 on a leap year.

EDIT: Here is a significantly faster solution. You can just get the mapping of DOYs to months and biweeks for a single year, and then left_join to the main table. 0.36s running time, since you no longer have to repetitively create the date. We also bypass having to use case_when , since the join will take care of the missing days. See that Day 59 of year 2000 is February and Day 60 is March, as requested.

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.

Created on 2018-04-06 by the reprex package (v0.2.0).

Answer 2

You can speed this up almost an order of magnitude by defining date first, reducing redundancy in the date call, and then extracting month from date.

    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 

Versus original version in the question

#   user  system elapsed 
# 117.67    0.15  118.45 

Answer 3

Filtered for one year. I think it solves the leap issue you described, unless I'm not clear on what you're saying. Last day of Feb is 59 in the df in my result below, but only because day is 0 indexed.

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

One year is 0.2 of the whole df, so times reflect that.