Skip to content

Useful helper functions? #283

@omuelle

Description

@omuelle

I have a few helper functions in the kofbts and kofbarometer package I use on a regular basis. I'm trying to find a place for them. Would they fit in tstools?

#' Returns Date object given year and month. The day is set to 1.
ymDate <- function(year, month)
{
  as.Date(paste0(year, "-", month, "-1"))
}

dateToTime <- function(date)
{
  data.table::year(date) + (data.table::month(date) - 1)/12
}

timeToDate <- function(time)
{
  time <- round(time, 3)
  ymDate(floor(time), round((time - floor(time)) / (1/12)) + 1)
}

startTime <- function(ts)
{
  time(ts)[1]
}

endTime <- function(ts)
{
  time(ts)[length(ts)]
}

startDate <- function(ts)
{
  timeToDate(startTime(ts))
}

endDate <- function(ts)
{
  timeToDate(endTime(ts))
}

frequencyDate <- function(date, frequency)
{
  ymDate(year(date), (ceiling(month(date) / (12/frequency)) - 1) * (12/frequency) + 1)
}

toMonthlySeries <- function(x, fill_last_quarter = F)
{
  vals <- unlist(lapply(as.vector(x), function(val) c(val, NA, NA)))
  if(!fill_last_quarter) {
    vals <- vals[1:(length(vals)-2)]
  }
  ts(vals, start = startTime(x), frequency = 12)
}

#' Add a number of months to a given date. Return NA if the resulting Date does not exist,
#' for example if the day is the 31th and the new month doesn't have 31 days. "months" can
#' be negative.
#' 
#' @param date   Date or character representing a Date.
#' @param months integer, number of months to add, can be negative.
#' @return       Date with months added to date
#' @export
addMonths <- function(date, months) 
{
  m <- data.table::month(date)-1+months
  add_this <- m%%12+1
  
  d_str <- paste0(data.table::year(date)+m%/%12, "-",
                  ifelse(nchar(add_this) == 1, paste0("0", add_this), add_this), "-",
                  data.table::mday(date))
  
  tryCatch({as.Date(d_str)}, error = function(e) NA)
}

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions