How to produce bandlines using ggplot2? - r

Stephen Few has recently introduced Bandlines which are an extension to Edward Tufte’s Sparklines. Is there an easy way to produce these kinds of plots using ggplot2?

Since this was introduced this month, I doubt there is already an implementation. But the concept seems simple enough that you can make one fairly easily. Here is a very simple implementation using base graphics (I'm not an expert of ggplot2).
bandline<-function(x, low.col, high.col, axis=TRUE){
l <- max(unlist(lapply(x, length)), na.r=TRUE)
r <- range(unlist(x), na.rm=TRUE)
par(mfcol=c(length(x), 1))
for(i in 1:length(x)){
y <- boxplot.stats(x[[i]])
ifelse(i==1, par(mar=c(0,3,3,3)),
ifelse(i==length(x), par(mar=c(3,3,0,3)),
par(mar=c(0,3,0,3))))
plot(NA, axes=F, bty="n", xlim=c(1,l), ylim=r, xaxs="i")
rect(1,y$stats[2], l, y$stats[1], col="grey80", border=NA)
rect(1,y$stats[4], l, y$stats[2], col="grey60", border=NA)
rect(1,y$stats[5], l, y$stats[4], col="grey40", border=NA)
abline(h=y$stats[3],col="white", lwd=2)
lines(seq_along(x[[i]]), x[[i]])
zhigh <- zlow <- x[[i]]
zhigh[zhigh<=y$stats[5]]<-NA
zlow[zlow>=y$stats[1]]<-NA
points(seq_along(x[[i]]), zlow, bg=low.col, pch=21,cex=2)
points(seq_along(x[[i]]), zhigh, bg=high.col, pch=21, cex=2)
if(axis==TRUE){
axis(2, at=pretty(x[[i]]), las=2)
ifelse(i==1, axis(3, at=seq_len(l)),
ifelse(i==length(x),axis(1, at=seq_len(l)),""))
}
mtext(names(x)[i], side=4, srt=270, line=1)
}
}
And here is an example:
set.seed(1)
dat<-list(a=rnorm(100), b=rnorm(100), c=rnorm(100), d=rnorm(100))
bandline(dat, "black", "white", axis=FALSE)

Related

Is there anyway of adding latex commands to the labs in scatter3D in r?

I am looking for a way to write latex commands such as $\nu$ and $S_t$ to the labs of a scatter3D() from the package plot3D.
No.
On regular plots you can usually get by with expression() and plotmath, eg:
x <- seq(-4*pi, 4*pi, by=pi/100)
y.sinc <- sin(pi*x)/(pi*x)
y.sinc[is.na(y.sinc)] <- 1
plot(x, y.sinc, type="l", col="blue", xaxt="n", ylab="")
mtext(expression(sinc[pi] == frac(sin*(pi*x), pi*x)), line=0)
s <- seq(-4*pi, 4*pi, by=pi)
lab <- expression(-4*pi, -3*pi, -2*pi, -pi, 0, pi, 2*pi, 3*pi, 4*pi)
axis(1, at=s, labels=lab)
But rgl, which plot3D is based on, does not support plotmath.

Plotting multiple plots - rescaling of axes

I found, that axes were rescaled during multiple plotting using par(new=T) parameter.
An example to demonstrate this:
a <- seq(1,10, by = 0.25)
b <- sin(a)
c <- sin(2*a)+1
d <- sin(0.5*a)+2
df <- data.frame(a,b,c,d)
plot(df$a, df$b, type="l")
par(new=T)
plot(df$a, df$c, type="l", col="blue")
par(new=T)
plot(df$a, df$d, type="l", col="red")
This is the result.
Instead of real scales, I have a transformed curves.
And this is the real result:
I used parameters axes=F, xlab="", ylab="" and did not see this "rescaling".
I find it very dangerous, that it is so easy to transform the data during plotting if you do not control y-limits.
Are there better ways to control y-limits than looking for min and max values in all plotted data to avoid this "rescaling" effect?
I have several quite big files and each of them gives only one line from 10 in one plot and I have several plots on one page to compare my data.
The code for the last "correct" image:
plot(df$a, df$b, type="l", ylim=c(-1.5,3.5))
par(new=T)
plot(df$a, df$c, type="l", ylim=c(-1.5,3.5), col="blue", axes=F, xlab="", ylab="")
par(new=T)
plot(df$a, df$d, type="l", ylim=c(-1.5,3.5), col="red", axes=F, xlab="", ylab="")
#Create an empty plot with enough xlim and ylim to accomodate all data
plot(1, 1, xlim = range(df[,1]), ylim = range(df[,-1]), type = "n", ann = FALSE)
#Draw the three lines
lines(df$a, df$b)
lines(df$a, df$c, col="blue")
lines(df$a, df$d, col="red")

Arrange points and lines in an r plot legend

Is it possible to rearrange the legend of the following plot
plot(1,1, type="n")
legend("topleft", c("1", "2"), col=c("darkblue", "darkred"), pch = 1, bty = "n", horiz = T, lwd=1.25, cex=1.8)
to look like this ("point-line-point" pattern)?
Usually, if you want this level of control over plot elements, you'll have to do it manually with primitives (points(), lines()/segments(), text(), etc.) and careful calculations from the plot parameters (e.g. par('usr')). It's not easy. Here's an example of how this could be done:
point.line.point <- function(x1,y1,x2=x1,y2=y1,...) {
points(c(x1,x2),c(y1,y2),...);
segments(x1,y1,x2,y2,...);
};
legend.plp <- function(x,y,labels,col,linewidth=diff(par('usr')[1:2])/10,textgap=diff(par('usr')[1:2])/20,...) {
comb <- cbind(labels,col);
xc <- x;
for (i in seq_len(nrow(comb))) {
x2 <- xc+linewidth;
point.line.point(xc,y,x2,col=comb[i,'col'],...);
text(x2+textgap,y,comb[i,'labels'],...);
xc <- x2+textgap*1.5+strwidth(comb[i,'labels']);
};
};
plot(1,1,type="n");
legend.plp(par('usr')[1]+diff(par('usr')[1:2])/20,par('usr')[4]-diff(par('usr')[3:4])/20,1:2,c('darkblue','darkred'),font=2,cex=1.5);
Here is an alternative solution that is the opposite of elegant. It involves embedding a couple of plots (one per legend), and a great deal of manual manipulation (to set the 'legends' where you want them to be):
library(Hmisc)
data(mtcars)
#plots the one in blue
plot(mtcars$cyl, type="o", col="darkblue")
#plots the one in red
lines(mtcars$carb, type="o", col="darkred")
#name the legends
text(6.5,7, "Cyl", font=2)
text(14,7, "Carb", font=2)
#add the subplots, it's actually a normal plot wrapped around the subplot with the x and y positions
subplot(plot(c(1,0),c(1,1), xlab=NA, ylab=NA, xaxt="n", yaxt="n", col="darkblue", type="o", axes=FALSE), 3, 7)
subplot(plot(c(1,0),c(1,1), xlab=NA, ylab=NA, xaxt="n", yaxt="n", col="darkred", type="o", axes=FALSE), 10, 7)
That yields the following plot:

Kernel density scatter plot in R

I saw a beautiful plot and I'd like to recreate it. Here's an example showing what I've got so far:
# kernel density scatterplot
library(RColorBrewer)
library(MASS)
greyscale <- rev(brewer.pal(4, "Greys"))
x <- rnorm(20000, mean=5, sd=4.5); x <- x[x>0]
y <- x + rnorm(length(x), mean=.2, sd=.4)
z <- kde2d(x, y, n=100)
plot(x, y, pch=".", col="hotpink")
contour(z, drawlabels=FALSE, nlevels=4, col=greyscale, add=T)
abline(c(0,1), lty=1, lwd=2)
abline(lm(y~x), lty=2, lwd=2)
I'm struggling to fill the contours with colour. Is this a job for smoothScatter or another package? I suspect it might be down to my use of kde2d and, if so, can someone please explain this function or link me to a good tutorial?
Many thanks!
P.S. the final image should be greyscale
Seems like you want a filled contour rather than jus a contour. Perhaps
library(RColorBrewer)
library(MASS)
greyscale <-brewer.pal(5, "Greys")
x <- rnorm(20000, mean=5, sd=4.5); x <- x[x>0]
y <- x + rnorm(length(x), mean=.2, sd=.4)
z <- kde2d(x, y, n=100)
filled.contour(z, nlevels=4, col=greyscale, plot.axes = {
axis(1); axis(2)
#points(x, y, pch=".", col="hotpink")
abline(c(0,1), lty=1, lwd=2)
abline(lm(y~x), lty=2, lwd=2)
})
which gives

plotting SPX vs. VIX using quantmod in R

I just got introduced to quantmod, and looked at examples here
http://www.r-chart.com/2010/06/stock-analysis-using-r.html
I tried the following code,
getSymbols(c("^GSPC","^VIX"))
head(as.xts(merge(GSPC,VIX)))
chartSeries(c(GSPC, VIX), subset='last 3 months')
but the graph was completely out-of-scale, so I hope some of the experts on this forum can show me how to plot this correctly.
Try this:
chart_Series(GSPC)
add_Series(OHLC(VIX)+1000,on=1)
You need to use OHLC to remove the volume from VIX, since it's always zero and seems to hose up the automatic ylim calculation. I also added 1000 to make the levels of the two series to be a bit closer together.
Here is an example that does not use chartSeries.
ind <- function(x) {
# Divide each column by the first non-NA value
# (There may already be a function to do that.)
coredata(x) <- t(t(coredata(x)) / apply(coredata(x),2,function(u){ c(u[!is.na(u)&u!=0],NA)[1] }))
x
}
x <- cbind( Ad(GSPC), Ad(VIX) )
x <- x["2011-11::"]
# Using base graphics
matplot(
index(x), coredata(ind(x)),
xlab="", ylab="", main="",
type="l", lty=1, lwd=3, axes=FALSE
)
abline(h=1, lty=3, col="lightgrey")
axis(2, las=1)
axis.Date(1, index(x))
box()
legend( "topleft", gsub("\\..*", "", names(x)), lty=1, lwd=3, col=1:2 )
# If you prefer ggplot2
library(ggplot2)
library(reshape2)
d <- data.frame( date = index(x), coredata(ind(x)) )
names(d) <- gsub("\\..*", "", names(d))
d <- melt(d, id.vars="date")
ggplot(d, aes(date, value, color=variable)) + geom_line(size=2)

Resources