dendrogram grouped currency plot

currencyplot.r

require(quantmod)
require(fAssets)

#get asian currency data from the FED FRED data series
getSymbols("DEXKOUS",src="FRED") #load Korea
getSymbols("DEXMAUS",src="FRED") #load Malaysia
getSymbols("DEXSIUS",src="FRED") #load Singapore
getSymbols("DEXTAUS",src="FRED") #load Taiwan
getSymbols("DEXCHUS",src="FRED") #load China
getSymbols("DEXJPUS",src="FRED") #load Japan
getSymbols("DEXTHUS",src="FRED") #load Thailand
getSymbols("DEXBZUS",src="FRED") #load Brazil
getSymbols("DEXMXUS",src="FRED") #load Mexico
getSymbols("DEXINUS",src="FRED") #load India
getSymbols("DTWEXO",src="FRED") #load US Dollar Other Trading Partners
getSymbols("DTWEXB",src="FRED") #load US Dollar Broad

currencies<-merge(DEXKOUS,DEXMAUS,DEXSIUS,DEXTAUS,DEXCHUS,DEXJPUS,DEXTHUS,DEXBZUS,DEXMXUS,DEXINUS,DTWEXO,DTWEXB)
currencies<-na.omit(currencies)
currencies<-currencies/lag(currencies)-1


# try to do http://stackoverflow.com/questions/9747426/how-can-i-produce-plots-like-this


# Sample data 
n <- NROW(currencies)
k <- NCOL(currencies)
d <- as.matrix(na.omit(currencies))
x <- apply(d+1,2,cumprod)
t <- assetsDendrogramPlot(as.timeSeries(currencies))
r <- t$hclust

# Plot 
op <- par(mar=c(0,0,0,0),oma=c(0,2,0,0)) 
# set up plot area for the dendrogram
plot(NA,ylim=c(.5,k+.5), xlim=c(0,4),axes=FALSE) 
# Dendogram. See ?hclust for details. 
xc <- yc <- rep(NA,k) 
o <- 1:k 
o[r$order] <- 1:k 
#separate into 4 groups for color classification
groups  <-  cutree(r, k=4)[r$order]
# loop through each to generate the dendrogram
# go from innermost to outermost
for(i in 1:(k-1)) { 
  a <- r$merge[i,1] 
  x1 <- if( a<0 ) o[-a] else xc[a] 
  y1 <- if( a<0 ) 0 else yc[a] 
  b <- r$merge[i,2] 
  x2 <- if( b<0 ) o[-b] else xc[b] 
  y2 <- if( b<0 ) 0 else yc[b] 
  #do the lines for the dendrogram
  lines(  
    3+c(y1,i,i,y2)/k, 
    c(x1,x1,x2,x2), 
    lwd=k-i,
    col=groups[colnames(d)[abs(a)]]
  ) 
  xc[i] <- (x1+x2)/2 
  yc[i] <- i 
} 
# Time series 
axis(2,1:k,colnames(d)[r$order],las=0, cex.axis=0.6, line=-1, lwd=0, lwd.ticks=1) 


u <- par()$usr 
for(i in 1:k) { 
  f <- c(0,3,i-.5,i+.5) 
  f <- c(  
    (f[1]-u[1])/(u[2]-u[1]),  
    (f[2]-u[1])/(u[2]-u[1]),  
    (f[3]-u[3])/(u[4]-u[3]),  
    (f[4]-u[3])/(u[4]-u[3]) 
  ) 
  par(new=TRUE,fig=f) 
  plot(x[,r$order[i]],axes=FALSE,xlab="",ylab="",main="",type="l",col=groups[i],lwd=2) 
  box() 
} 
par(op)