Even More JGB Yield Charts with R lattice
[This article was first published on 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.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
See the last post for all the details. I just could not help creating a couple more.
Variations on 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 <- p2 + layer(panel.abline(h = pretty(jgb.melt$value), <br /> lty = 3))<br />p2<br />
![]() |
From TimelyPortfolio |
<br />jgb.xts.diff <- jgb.xts["2012::", ] - matrix(rep(jgb.xts["2012::", <br /> ][1, ], NROW(jgb.xts["2012::", ])), ncol = NCOL(jgb.xts), <br /> byrow = TRUE)<br />jgb.diff.melt <- xtsMelt(jgb.xts.diff)<br />jgb.diff.melt$date <- as.Date(jgb.diff.melt$date)<br />jgb.diff.melt$value <- as.numeric(jgb.diff.melt$value)<br />jgb.diff.melt$indexname <- factor(jgb.diff.melt$indexname, <br /> levels = colnames(jgb.xts))<br /><br />p4 <- xyplot(value ~ date | indexname, data = jgb.diff.melt, <br /> type = "h")<br /><br />update(p2, ylim = c(min(jgb.diff.melt$value), max(jgb.melt$value) + <br /> 0.5)) + p4<br />
![]() |
From TimelyPortfolio |
<br />update(p2, ylim = c(min(jgb.diff.melt$value), max(jgb.melt$value) + <br /> 0.5), par.settings = list(axis.line = list(col = "gray70"))) + <br /> update(p4, panel = function(x, y, col, ...) {<br /> # do color scale from red(negative) to<br /> # blue(positive)<br /> cc.palette <- colorRampPalette(c(brewer.pal("Reds", <br /> n = 9)[7], "white", brewer.pal("Blues", <br /> n = 9)[7]))<br /> cc.levpalette <- cc.palette(20)<br /> cc.levels <- level.colors(y, at = do.breaks(c(-0.3, <br /> 0.3), 20), col.regions = cc.levpalette)<br /> panel.xyplot(x = x, y = y, col = cc.levels, <br /> ...)<br /> })<br />
![]() |
From TimelyPortfolio |
<br /><br />p5 <- horizonplot(value ~ date | indexname, data = jgb.diff.melt, <br /> layout = c(1, length(unique(jgb.diff.melt$indexname))), <br /> scales = list(x = list(tck = c(1, 0))), xlab = NULL, <br /> ylab = NULL)<br /><br />p5<br />
![]() |
From TimelyPortfolio |
<br />update(p2, ylim = c(0, max(jgb.melt$value) + 0.5), <br /> panel = panel.xyplot) + p5 + update(p2, ylim = c(0, <br /> max(jgb.melt$value)))<br />
![]() |
From TimelyPortfolio |
Variations on 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(400/(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 />p3 <- 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 /><br /># make point rather than line<br />update(p3, type = "p")<br />
![]() |
From TimelyPortfolio |
<br /># make point with just most current curve as line<br />update(p3, type = "p") + xyplot(value ~ indexname, <br /> data = jgb.melt[which(jgb.melt$date == max(jgb.melt$date)), <br /> ], type = "l", col = brewer.pal("Blues", n = 9)[7])<br />
![]() |
From TimelyPortfolio |
Replicate Me with code at Gist
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.