R/SF.Time.Key_Function.R

Defines functions SF.Time.Key

SF.Time.Key <- function(df = ds, x, start = '2015-12-03', end = Sys.Date(), end_of_week = 'Sunday') {
  require(lubridate)
  require(tidyverse)
  d <- seq(as_date(start), as_date(end), by = 'days')
  Time_Key <- as_tibble(d) %>% rename('Date' = 'value')
  Time_Key$Month <- substr(Time_Key$Date, 1, 7)
  Time_Key$Weekday <- weekdays(Time_Key$Date)
  
  #----- Month and Day numbers
  Time_Key <- Time_Key %>%
    full_join(
      bind_cols(Month = unique(Time_Key$Month), Month_No = seq_along(unique(Time_Key$Month))), by = 'Month'
    ) %>%
    full_join(
      bind_cols(Date = unique(Time_Key$Date), Day_No = seq_along(unique(Time_Key$Date))), by = 'Date'
    )
  
  #----- Week numbers
  Time_Key$Week_No <- 0
  
  End_Week_One <- Time_Key %>% 
    filter(Weekday == end_of_week) %>% 
    slice(1); End_Week_One <- End_Week_One$Day_No
  
  t <- seq.int(Time_Key$Day_No[End_Week_One], Time_Key$Day_No[nrow(Time_Key)], by = 7)
  
  #-- Week 1
  Time_Key <- Time_Key %>% 
    mutate(
      Week_No = ifelse(Day_No <= End_Week_One, 1, Week_No)
    )
  
  #-- Rest of the weeks
  for (i in 2:length(t)) {
    Time_Key$Week_No[Time_Key$Day_No > t[i-1] & Time_Key$Day_No <= t[i]] <- seq_along(t)[i]
  }
  
  #-- Latest Week
  Time_Key <- Time_Key %>% 
    mutate(
      Week_No = ifelse(Week_No == 0, max(Week_No)+1, Week_No)
    )
  
  #----- Bring Together
  Time_Key <- Time_Key %>% 
    group_by(Week_No) %>% 
    mutate(Min = min(Date), Max = max(Date)) %>% 
    mutate(Week_Date = paste(Min, '-', Max)) %>% 
    rename(Day = 'Date') %>% 
    select(Day, Day_No, Week_No, Week_Date, Month, Month_No)
  
  if (is.null(df)) {
    Time_Key %>% as_tibble()
  } else {
    #-- Join to data
    df <- as.data.frame(df)
    df$Day <- as_date(df[,x])
    
    df <- df %>%
      left_join(Time_Key, by = 'Day') %>% 
      as_tibble()
  }
  
}
Ehsan-F/R-Mixtape documentation built on June 24, 2020, 12:22 a.m.