#------------------------------------------------------------------------------#
# File: utilities.R
#
# Description: This file contains basic functions that will be used throughout
# HLW.
#------------------------------------------------------------------------------#
shiftQuarter <- function(original.start,shift){
#################################################################
# This function takes in a (year,quarter) date in time series format
# and a shift number, and returns the (year,quarter) date corresponding
# to the shift. Positive values of shift produce leads and negative values
# of shift produce lags.
# For example, entering 2014q1 with a shift of -1 would return 2013q4.
# Entering 2014q1 with a shift of 1 would return 2014q2.
# In each case, the first argument of the function must be entered as
# a two-element vector, where the first element corresponds to the year
# and the second element corresponds to the quarter.
# For example, Q12014 must be entered as "c(2014,1)".
################################################################
# Leads (positive values of shift)
if (shift > 0) {
new.start = c(0,0)
sum = original.start[2] + shift
# Get the year value
if (sum <= 4) {
new.start[1] = original.start[1]
}
else {
new.start[1] = original.start[1] + ceiling(sum/4) - 1
}
# Get the quarter value
if (sum %% 4 > 0) {
new.start[2] = sum %% 4
}
else {
new.start[2] = sum %% 4 + 4
}
}
# Lags (negative values of shift)
else {
new.start = c(0,0)
diff = original.start[2] - abs(shift)
# Get the year value
if (diff > 0) {
new.start[1] = original.start[1]
}
else {
new.start[1] = original.start[1] - (1 + floor(abs(diff)/4))
}
# Get the quarter value
if (diff %% 4 > 0) {
new.start[2] = diff %% 4
}
else {
new.start[2] = diff %% 4 + 4
}
}
return(new.start)}
shiftMonth <- function(original.start,shift){
#################################################################
# This function takes in a (year,month) date in time series format
# and a shift number, and returns the (year,month) date corresponding
# to the shift. Positive values of shift produce leads and negative values
# of shift produce lags.
# For example, entering 2014m1 with a shift of -1 would return 2013m12.
# Entering 2014m1 with a shift of 1 would return 2014m2.
# In each case, the first argument of the function must be entered as
# a two-element vector, where the first element corresponds to the year
# and the second element corresponds to the month.
# This function is analogous to shiftQuarter().
################################################################
# Leads (positive values of shift)
if (shift > 0) {
new.start = c(0,0)
sum = original.start[2] + shift
# Get the year value
if (sum <= 12) {
new.start[1] = original.start[1]
}
else {
new.start[1] = original.start[1] + ceiling(sum/12) - 1
}
# Get the month value
if (sum %% 12 > 0) {
new.start[2] = sum %% 12
}
else {
new.start[2] = sum %% 12 + 12
}
}
# Lags (negative values of shift)
else {
new.start = c(0,0)
diff = original.start[2] - abs(shift)
# Get the year value
if (diff > 0) {
new.start[1] = original.start[1]
}
else {
new.start[1] = original.start[1] - (1 + floor(abs(diff)/12))
}
# Get the month value
if (diff %% 12 > 0) {
new.start[2] = diff %% 12
}
else {
new.start[2] = diff %% 12 + 12
}
}
return(new.start)}
getFRED <- function(url, freq = "Quarterly") {
##########################################################################################
# This function downloads data from FRED. It returns quarterly data.
# User must provide the FRED url.
###########################################################################################
FREDraw <- readLines(url)
# download.file(url, destfile = paste0('FREDtemp.txt'))
#
# txt.file.name <- paste0(folder,substr(url, regexpr('[a-zA-z0-9]*.txt',url),1000))
# if (!file.exists(txt.file.name)){
# # Download the data from FRED
# download.file(url, destfile = paste0(folder,'FREDtemp.txt'))
# system(paste0('wget --no-check-certificate "', url, '"'))
# system(paste('mv',substr(url, regexpr('[a-zA-z0-9]*.txt',url),1000),txt.file.name))
# }
# FREDraw <- readLines(txt.file.name)
# Frequency
freq.FRED <- gsub(' ', '',substr(FREDraw[which(regexpr('Frequency', FREDraw)==1)],
(nchar('Frequency')+2),100))
# Where does the data start
datastart = which(gsub(' ', '',FREDraw)=='DATEVALUE') - 2
#data <- read.table('FREDtemp.txt', skip = datastart, header = TRUE)
data <- FREDraw
data <- read.table(textConnection(data), skip = datastart, header = TRUE)
# get starting date
first.year <- as.numeric(format(as.Date(data$DATE[1]),'%Y'))
first.month <- as.numeric(format(as.Date(data$DATE[1]),'%m'))
# Adjust frequency
if (freq.FRED == 'Quarterly'){
first.q <- (first.month-1)/3 + 1
data.tis <- tis(data$VALUE, start = c(first.year, first.q), tif = 'quarterly')
} else if (freq.FRED == 'Monthly') {
data.tis <- tis(data$VALUE, start = c(first.year, first.month), tif = 'monthly')
}
# Convert frequency
if (freq.FRED == 'Monthly' & freq == 'Quarterly') {
data.tis <- convert(data.tis, tif = 'quarterly', method = 'constant', observed. = 'averaged')
}
return(data.tis)
}
splice <- function(s1, s2, splice.date, freq) {
##########################################################################################
# This function splices two series, with the series s2 beginning at splice.date
# and extended back using the growth rate at the splice.date times series s1
# The freq argument accepts two values - 'quarterly' and 'monthly' -
# but it could be modified to take more.
##########################################################################################
t <- splice.date #renaming for convenience
if (freq == "quarterly" | freq == "Quarterly") {
t.minus.1 <- shiftQuarter(t,-1)
}
else if (freq == "monthly" | freq == "Monthly") {
t.minus.1 <- shiftMonth(t,-1)
}
else { stop("You must enter 'quarterly' or 'monthly' for freq.") }
ratio <- as.numeric(window(s2,start = t, end = t)/
window(s1,start = t, end = t))
return(mergeSeries(ratio*window(s1,end = t.minus.1),window(s2, start = t)))
}
gradient <- function(f, x, delta = x * 0 + 1.0e-5) {
##########################################################################################
# This function computes the gradient of a function f given a vector input x.
##########################################################################################
g <- x * 0
for (i in 1:length(x)) {
x1 <- x
x1[i] <- x1[i] + delta[i]
f1 <- f(x1)
x2 <- x
x2[i] <- x2[i] - delta[i]
f2 <- f(x2)
g[i] <- (f1 - f2) / delta[i] / 2
}
return(g)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.