# Japan – JGB Yields–More Lattice Charts

[This article was first published on

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

**Timely Portfolio**, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

This blog is littered with posts about Japan. In one sentence, I think Japan presents opportunity and is a very interesting real-time test of much of my macro thinking. Proper visualization is absolutely essential for me to understand all of the dynamics. The R packages lattice and the new rCharts give me the power to see. I thought some of my recent lattice charts might help or interest some folks.

### Get and Transform the Data

# get Japan yield data from the Ministry of<br /># Finance Japan data goes back to 1974<br /><br />require(xts)<br /># require(clickme)<br />require(latticeExtra)<br /><br />url <- "http://www.mof.go.jp/english/jgbs/reference/interest_rate/"<br />filenames <- paste("jgbcme", c("", "_2010", "_2000-2009", <br /> "_1990-1999", "_1980-1989", "_1974-1979"), ".csv", <br /> sep = "")<br /><br /># load all data and combine into one jgb<br /># data.frame<br />jgb <- read.csv(paste(url, filenames[1], sep = ""), <br /> stringsAsFactors = FALSE)<br />for (i in 2:length(filenames)) {<br /> jgb <- rbind(jgb, read.csv(paste(url, "/historical/", <br /> filenames[i], sep = ""), stringsAsFactors = FALSE))<br />}<br /><br /># now clean up the jgb data.frame to make a jgb<br /># xts<br />jgb.xts <- as.xts(data.matrix(jgb[, 2:NCOL(jgb)]), <br /> order.by = as.Date(jgb[, 1]))<br />colnames(jgb.xts) <- paste0(gsub("X", "JGB", colnames(jgb.xts)), <br /> "Y")<br /><br /># get Yen from the Fed<br /># getSymbols('DEXJPUS',src='FRED')<br /><br />xtsMelt <- function(data) {<br /> require(reshape2)<br /><br /> # translate xts to time series to json with date<br /> # and data for this behavior will be more generic<br /> # than the original data will not be transformed,<br /> # so template.rmd will be changed to reflect<br /><br /><br /> # convert to data frame<br /> data.df <- data.frame(cbind(format(index(data), <br /> "%Y-%m-%d"), coredata(data)))<br /> colnames(data.df)[1] = "date"<br /> data.melt <- melt(data.df, id.vars = 1, stringsAsFactors = FALSE)<br /> colnames(data.melt) <- c("date", "indexname", "value")<br /> # remove periods from indexnames to prevent<br /> # javascript confusion these . usually come from<br /> # spaces in the colnames when melted<br /> data.melt[, "indexname"] <- apply(matrix(data.melt[, <br /> "indexname"]), 2, gsub, pattern = "[.]", replacement = "")<br /> return(data.melt)<br /> # return(df2json(na.omit(data.melt)))<br /><br />}<br /><br />jgb.melt <- xtsMelt(jgb.xts["2012::", ])<br />jgb.melt$date <- as.Date(jgb.melt$date)<br />jgb.melt$value <- as.numeric(jgb.melt$value)<br />jgb.melt$indexname <- factor(jgb.melt$indexname, levels = colnames(jgb.xts))<br />

### Favorite Plot – Time Series Line of JGB Yields by Maturity

p2 <- xyplot(value ~ date | indexname, data = jgb.melt, <br /> type = "l", layout = c(length(unique(jgb.melt$indexname)), <br /> 1), panel = function(x, y, ...) {<br /> panel.abline(h = c(min(y), max(y)))<br /> panel.xyplot(x = x, y = y, ...)<br /> panel.text(x = x[length(x)/2], y = max(y), <br /> labels = levels(jgb.melt$indexname)[panel.number()], <br /> cex = 0.7, pos = 3)<br /> }, scales = list(x = list(tck = c(1, 0), alternating = 1), <br /> y = list(tck = c(1, 0), lwd = c(0, 1))), strip = FALSE, <br /> par.settings = list(axis.line = list(col = 0)), <br /> xlab = NULL, ylab = "Yield", main = "JGB Yields by Maturity Since Jan 2012")<br />p2 + layer(panel.abline(h = pretty(jgb.melt$value), <br /> lty = 3))<br />

From TimelyPortfolio |

### Good Chart but Not a Favorite

As you can tell, I did not spend a lot of time formatting this one.

p1 <- xyplot(value ~ date | indexname, data = jgb.melt, <br /> type = "l")<br />p1<br />

From TimelyPortfolio |

### Another Favorite – Yield Curve Evolution with Opacity Color Scale

# add alpha to colors<br />addalpha <- function(alpha = 180, cols) {<br /> rgbcomp <- col2rgb(cols)<br /> rgbcomp[4] <- alpha<br /> return(rgb(rgbcomp[1], rgbcomp[2], rgbcomp[3], <br /> rgbcomp[4], maxColorValue = 255))<br />}<br /><br />p3 <- xyplot(value ~ indexname, group = date, data = jgb.melt, <br /> type = "l", lwd = 2, col = sapply(255/(as.numeric(Sys.Date() - <br /> jgb.melt$date) + 1), FUN = addalpha, cols = brewer.pal("Blues", <br /> n = 9)[7]), main = "JGB Yield Curve Evolution Since Jan 2012")<br /><br />update(asTheEconomist(p3), scales = list(x = list(cex = 0.7))) + <br /> layer(panel.text(x = length(levels(jgb.melt$indexname)), <br /> y = 0.15, label = "source: Japanese Ministry of Finance", <br /> col = "gray70", font = 3, cex = 0.8, adj = 1))<br />

From TimelyPortfolio |

### Replicate Me

To

**leave a comment**for the author, please follow the link and comment on their blog:**Timely Portfolio**.R-bloggers.com offers

**daily e-mail updates**about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.