```{r setup, eval=TRUE, echo=FALSE, warning=FALSE, message=FALSE} ## setwd(file.path(dbpath, "GitHub", "jekyll", "bowerth.github.io", "rmarkdown", "prismfp")) ## rmarkdown::render(file.path(dbpath, "GitHub", "jekyll", "bowerth.github.io", "rmarkdown", "prismfp", "prismfp_libor_3m_highcharts.Rmd")) ## file.copy(from=file.path(dbpath, "GitHub", "jekyll", "bowerth.github.io", "rmarkdown", "prismfp", "prismfp_libor_3m_highcharts.html"), to=file.path(dbpath, "GitHub", "jekyll", "bowerth.github.io", "_includes", "rmarkdown_fragment", "prismfp_libor_3m_highcharts.html"), overwrite=TRUE) ## browseURL(file.path("file:/", Sys.getenv("HOME"), "Dropbox", "GitHub", "jekyll", "bowerth.github.io", "rmarkdown", "prismfp_libor_3m.html")) ## library(dygraphs) library(highcharter) library(xts) library(plyr) library(dplyr) library(XML) library(rcdimple) ## install.packages("dyn") library(dyn) ## dateWindow <- c("2005-01-01", "2015-12-31") dateWindow <- 10 * 12 * 30 * 24 * 3600 * 1000 # ten years highchart_vignette <- function() { highchart() %>% hc_add_theme(hc_theme_darkunica()) } ``` ## Project Take the history of USD 3 month LIBOR https://www.quandl.com/data/FRED/USD3MTD156N-3-Month-London-Interbank-Offered-Rate-LIBOR-based-on-U-S-Dollar And history of 10 year Treasury yield curve rate from here http://www.treasury.gov/resource-center/data-chart-center/interest-rates/Pages/TextView.aspx?data=yieldYear&year=2015. 10 years of history is enough. Based on these data, build a data visualization, which displays the beta from a linear regression between these two series, by month and by year, and makes it easy to see when the value of beta was highest. We would like to see in your project: - The code which you used to extract the data from the above sources - The code which you used to create the visualization - The visualization itself. You can use any programming language and data visualization method you find appropriate for this task. Any creativity is welcome. ```{r retrieve_data_libor, eval=FALSE, echo=TRUE} ## https://www.quandl.com/data/FRED/USD3MTD156N-3-Month-London-Interbank-Offered-Rate-LIBOR-based-on-U-S-Dollar quandlurl2xts <- function(url) { data_list <- url %>% RCurl::getURL() %>% jsonlite::fromJSON() data_mat <- data_list[[1]][["data"]] data_df <- as.data.frame(data_mat) names(data_df) <- c("DATE", "LIBOR") data_df$LIBOR <- as.numeric(data_df$LIBOR) rownames(data_df) <- as.Date(as.character(data_df$DATE)) xts <- data_df %>% select(-DATE) %>% as.xts() return(xts) } url_usdliborqtr <- "https://www.quandl.com/api/v3/datasets/FRED/USD3MTD156N.json" usdliborqtr_xts <- quandlurl2xts(url_usdliborqtr) save(usdliborqtr_xts, file = "usdliborqtr_xts.rda") ``` ### 3-Month London Interbank Offered Rate (LIBOR), based on U.S. Dollar ```{r plot_data_libor, eval=TRUE, echo=TRUE} load("usdliborqtr_xts.rda") highchart_vignette() %>% hc_add_series_xts(usdliborqtr_xts, name = "USD LIBOR QTR") %>% hc_xAxis(list(range = dateWindow)) ``` ```{r retrieve_data_treasury, eval=FALSE, echo=TRUE} ## http://data.treasury.gov/feed.svc/DailyTreasuryYieldCurveRateData?$filter=year(NEW_DATE)%20ge%202005 ## https://github.com/mrbcuda/ustyc getYieldCurve <- function (year = NULL, month = NULL, base = "http://data.treasury.gov/feed.svc/DailyTreasuryYieldCurveRateData", allowParallel = FALSE) { location <- base yloc <- mloc <- doc <- NULL yloc <- if (is.null(year) == FALSE) paste("year(NEW_DATE)%20eq%20", year, sep = "") mloc <- if (is.null(month) == FALSE) paste("month(NEW_DATE)%20eq%20", month, sep = "") parameters <- "" if (is.null(yloc) == FALSE && is.null(mloc) == FALSE) { parameters = paste("?$filter=", mloc, "%20and%20", yloc, sep = "") } else { if (is.null(yloc) == FALSE) parameters = paste("?$filter=", yloc, sep = "") if (is.null(mloc) == FALSE) parameters = paste("?$filter=", mloc, sep = "") } ## doc <- xmlParse(paste(location, parameters, sep = "")) tt <- RCurl::getURL(paste(location, parameters, sep = "")) doc <- xmlParse(tt) if (is.null(doc)) { warning(paste("Could not parse the location", location)) return(NULL) } message("Download and parse complete. Converting to list...") x <- xmlToList(doc) message("List conversion complete. Converting to frame...") updated = x[[3]] x[1:4] <- NULL x[[length(x)]] <- NULL cy <- function(t, p) { if ("text" %in% names(p[[t]])) p[[t]]$text else NA } y <- ldply(x, function(e) { p <- e$content$properties q = sapply(names(p), cy, p) }, .id = "NEW_DATE", .parallel = allowParallel) y$NEW_DATE <- substring(y$NEW_DATE, 1, 10) y <- y[with(y, order(NEW_DATE)), ] dates <- y$NEW_DATE y <- data.frame(apply(y[, 3:14], 2, function(x) as.double(x))) rownames(y) <- dates message("Frame conversion complete.") rv <- list(updated = updated, df = y, month = month, year = year, query = location) class(rv) <- "ustyc" rv } yc <- getYieldCurve() yc_xts = xts(yc$df, order.by=as.Date(rownames(yc$df))) save(yc_xts, file = "yc_xts.rda") ``` ### Daily Treasury Yield Curve Rates ```{r plot_data_treasury, eval=TRUE, echo=TRUE} load("yc_xts.rda") x <- yc_xts %>% subset(select = "BC_10YEAR") highchart_vignette() %>% hc_add_series_xts(x, name = "BC_10YEAR") %>% hc_xAxis(list(range = dateWindow)) ``` ```{r regression_dyn, eval=TRUE, echo=TRUE} usdliborqtr_xts_use <- usdliborqtr_xts["2005/2015-01-01"] yc_xts_use <- yc_xts["2005/2015-01-01", "BC_10YEAR"] ## change time zone from "UTC" to "CET" yc_xts_use_df <- as.data.frame(yc_xts_use) rownames(yc_xts_use_df) <- as.Date(as.character(rownames(yc_xts_use_df)), tz = "CET") yc_xts_use_2 <- as.xts(yc_xts_use_df) data_xts <- merge.xts(usdliborqtr_xts_use, yc_xts_use_2) data_xts <- data_xts[!is.na(data_xts$LIBOR) & !is.na(data_xts$BC_10YEAR)] res_month <- apply.monthly(data_xts, function(x) coef(dyn$lm(x[,2] ~ x[,1]))[2]) names(res_month) <- "monthly_beta" res_year <- apply.yearly(data_xts, function(x) coef(dyn$lm(x[,2] ~ x[,1]))[2]) names(res_year) <- "yearly_beta" data_res <- merge(res_month, res_year) highchart_vignette() %>% hc_yAxis( list(title = list(text = "LIBOR"), align = "left", opposite = FALSE), list(title = list(text = "BC_10YEAR"), align = "right", opposite = TRUE)) %>% hc_add_series_xts(data_xts[,"LIBOR"], name = "LIBOR") %>% hc_add_series_xts(data_xts[,"BC_10YEAR"], name = "BC_10YEAR", yAxis = 1) data_res_df <- as.data.frame(data_res) data_res_df$date <- rownames(data_res_df) data_res_df$month <- format(as.Date(data_res_df$date), "%b-%y") data_res_df$year <- format(as.Date(data_res_df$date), "%Y") ## data_res_df$millisecond <- as.numeric(as.Date(data_res_df$date)) * 24 * 3600 * 1000 ## data_res_df$millisecond <- as.POSIXct(as.Date(data_res_df$date), origin = "1960-01-01", tz = "GMT") # in UTC highchart_vignette() %>% hc_add_series_labels_values(data_res_df$year, data_res_df$yearly_beta, name = "yearly beta", type = "column") highchart_vignette() %>% ## hc_add_series_labels_values(data_res_df$month, data_res_df$monthly_beta, hc_add_series_labels_values(data_res_df$millisecond, data_res_df$monthly_beta, name = "monthly beta", type = "column")## %>% ## hc_xAxis( ## list(title = "Date", ## type = "datetime", ## dateTimeLabelFormats = list( ## month = "%e. %b", ## year = "%b" ## ) ## ) ## ) ## head(data_res_df$month) ## head(data_res_df$date) ## Sys.time() ## as.POSIXct(head(data_res_df$date)) ## as.POSIXlt(head(data_res_df$date)) ## as.POSIXct(head(data_res_df$date), format="%m/%d/%Y %H:%M:%S") ## strptime("12/31/2014 6:42:52 PM", format="%m/%d/%Y %H:%M:%S",tz="UTC") ## as.POSIXct("12/31/2014 6:42:52 PM", format="%m/%d/%Y %H:%M:%S") ```