Last active
August 29, 2015 14:23
-
-
Save ronrest/a214839e35561d86ab68 to your computer and use it in GitHub Desktop.
Week Number since some arbitrary start date
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # TODO: add an option that makes use of lubridate's quarter(date) if no value is | |
| # entered for the *since* argument. | |
| #=============================================================================== | |
| # WEEK_SINCE | |
| #=============================================================================== | |
| #' @title week_since | |
| #' @description calculates what week number some input date is, counting from | |
| #' some specified starting date (eg the Start of Financial Year) | |
| #' @details You can specify any start date you want by using the | |
| #' *since* argument. | |
| #' | |
| #' You can either feed it a date specified as a string, or as one of | |
| #' the common date objects such as POSIXct, POSIXlt, or Date. | |
| #' | |
| #' By default, dates entered as strings are interpreted using the | |
| #' following date format: "%Y_%m_%d", which processes dates such as | |
| #' "2015_12_31". If you are using a different date format, then specify | |
| #' how it is formatted using the *dateFormat* argument. See for | |
| #' instance http://www.statmethods.net/input/dates.html for details | |
| #' on how the date formatting symbols are be used. | |
| #' | |
| #' You can also specify if you want the week number to be based on the | |
| #' n'th Monday to Sunday grouping since the start date(ISO 8601 system) | |
| #' or if you want week number defined as the number of complete 7 day | |
| #' cycles. This choice is handled by the *type* argument. See the | |
| #' Arguments list section to see how this is set. | |
| #' | |
| #' @note week_since() Curently only accepts single values for the *date* and | |
| #' *since* arguments. If you wish to process vectors of values then use | |
| #' something like: | |
| #' | |
| #' sapply(myDates, since="2015-07-01") | |
| #' | |
| #' @param date (string or Date object) Your date of interest. | |
| #' @param since (string or Date object) The date from which week 1 should start, | |
| #' eg, the start of the financial year. | |
| #' @param dateFormat (string) A format string that is passed on to the format | |
| #' argument in the as.Date() function in the base package. | |
| #' | |
| #' (DEFAULT is "%Y_%m_%d") | |
| #' @param type (string) Takes only one of the following two values: | |
| #' | |
| #' - "iso" - returns the n'th Monday to Sunday grouping since the | |
| #' start date(ISO 8601 system). | |
| #' - "7day" - returns the the number of complete 7 day cycles since | |
| #' the start date | |
| #' | |
| #' (DEFAULT is "iso") | |
| #' @author Ronny Restrepo | |
| #' @examples | |
| #' | |
| #' #Feed the function dates formatted as strings | |
| #' week_since("2015_07_06", since="2015_07_01") | |
| #' | |
| #' #Feed the function dates formatted as strings, using a different date Format | |
| #' week_since("07/06/2015", since="07/01/2015", dateFormat="%m/%d/%Y") | |
| #' | |
| #' #Feed the function Date Objects | |
| #' myDate = as.Date("20150706", format="%Y%m%d") | |
| #' start = as.Date("20150701", format="%Y%m%d") | |
| #' week_since(myDate, since=start) | |
| #' | |
| #' #Feed the function "POSIXct" or "POSIXt" Objects | |
| #' myDate = lubridate::ymd(20150706) | |
| #' start = lubridate::ymd(20150701) | |
| #' week_since(myDate, since=start) | |
| #' | |
| #' #Return the number of 7 day cycles begining from start date | |
| #' week_since("2015_07_06", since="2015_07_01", type="7day") | |
| #' | |
| #' @seealso lubridate::isoweek, lubridate::week | |
| #' @keywords date | |
| #' @import lubridate | |
| #' @export week_since | |
| #=============================================================================== | |
| week_since <- function(date, since, dateFormat="%Y_%m_%d", type="iso"){ | |
| # Assign More meaningful internal name | |
| sinceDate = since | |
| #--------------------------------------------------------------------------- | |
| # Only allow single values | |
| #--------------------------------------------------------------------------- | |
| # Currently, this function does not inspect and check assumptions for | |
| # elements within a vector, list, dataframe, matrix, etc, so disable the use | |
| # of these data structures and force the user to feed single values at a | |
| # time. | |
| # TODO: actually implement handling of vectors, lists, dataframes, etc. | |
| if ((length(date) > 1) | (!is.null(dim(date))) | | |
| (length(since) > 1) | (!is.null(dim(since)))){ | |
| stop("week_since() curently only accepts single values for the\n", | |
| " *date* and *since* arguments. If you wish to process vectors\n", | |
| " of values then use something like: \n", | |
| " sapply(myDates, since='2015-07-01')\n") | |
| } | |
| #--------------------------------------------------------------------------- | |
| # Catch Problems with date and since arguments | |
| #--------------------------------------------------------------------------- | |
| valid_date_types = c("character", "POSIXct", "POSIXlt", "Date") | |
| if (!any(class(date) %in% valid_date_types)){ | |
| stop("The *date* argument in the week_since() function must be \n", | |
| " either a string, a POSIXct, POSIXlt, or Date object, \n", | |
| " not a '", class(date), "' object.") | |
| } | |
| if (!any(class(sinceDate) %in% valid_date_types)){ | |
| stop("The *since* argument in the week_since() function must be \n", | |
| " either a string, a POSIXct, POSIXlt, or Date object, \n", | |
| " not a '", class(sinceDate), "' object.") | |
| } | |
| #--------------------------------------------------------------------------- | |
| # Catch Problems with the dateFormat Argument | |
| #--------------------------------------------------------------------------- | |
| if (!is.character(dateFormat)){ | |
| stop("The *dateFormat* argument in the week_since() function must \n", | |
| " be a string, not a '", class(dateFormat), "' object.") | |
| } | |
| if (dateFormat == ""){ | |
| stop("The *dateFormat* argument in the week_since() function must \n", | |
| " not be an empty string") | |
| } | |
| #--------------------------------------------------------------------------- | |
| # Convert from String to Date objects | |
| #--------------------------------------------------------------------------- | |
| if (is.character(date)){ | |
| # Your date of interest | |
| date = as.Date(date, dateFormat) | |
| } | |
| if (is.character(sinceDate)){ | |
| sinceDate = as.Date(sinceDate, dateFormat) | |
| } | |
| #--------------------------------------------------------------------------- | |
| # Catch Problems with Processing the Date | |
| #--------------------------------------------------------------------------- | |
| if (is.na(date)){ | |
| stop("The week_since() function had problems processing your *date* \n", | |
| " argument. Please double check that the *date* and *dateFormat*", | |
| "\n fields are properly formatted.") | |
| } | |
| if (is.na(sinceDate)){ | |
| stop("The week_since() function had problems processing your *since*\n", | |
| " argument. Please double check that the *since* and *dateFormat*", | |
| "\n fields are properly formatted.") | |
| } | |
| #--------------------------------------------------------------------------- | |
| # Return The Week Number | |
| #--------------------------------------------------------------------------- | |
| if (type == "iso"){ | |
| # Week number since sinceDate based on Monday to Sunday Calendar | |
| return(lubridate::isoweek(date) - lubridate::isoweek(sinceDate) + 1) | |
| } | |
| else if (type == "7day"){ | |
| # Number of complete 7 day periods since sinceDate | |
| return(lubridate::week(date) - lubridate::week(sinceDate) + 1) | |
| } | |
| #--------------------------------------------------------------------------- | |
| # Catch Incorrect value for type | |
| #--------------------------------------------------------------------------- | |
| else{ | |
| stop("Sorry, but the only legal values for the *type* argument in\n", | |
| " week_since() are 'iso' and '7day'") | |
| } | |
| } | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
SELF NOTE: add an option that makes use of lubridate's
quarter(date)if no value is entered for thesinceargument.