x<-matrix(rnorm(1024),nrow=32)
# simulate a correlation matrix with values -0.5 to 0.5
x<-rescale(x,c(-0.5,0.5))
# add a column with the extreme values (-1,1) to calculate
# the colors, then drop the extra column in the result
cellcol<-color.scale(cbind(x,c(-1,rep(1,31))),c(0,1),0,c(1,0))[,1:32]
color2D.matplot(x,cellcolors=cellcol,main="Blue to red correlations")
# do the legend call separately to get the full range
color.legend(0,-4,10,-3,legend=c(-1,-0.5,0,0.5,1),
rect.col=color.scale(c(-1,-0.5,0,0.5,1),c(0,1),0,c(1,0)),align="rb")
x<-matrix(rnorm(100),nrow=10)
# generate colors that show negative values in red to brown
# and positive in blue-green to green
cellcol<-matrix(rep("#000000",100),nrow=10)
cellcol[x<0]<-color.scale(x[x<0],c(1,0.8),c(0,0.8),0)
cellcol[x>0]<-color.scale(x[x>0],0,c(0.8,1),c(0.8,0))
# now do hexagons without borders
color2D.matplot(x,cellcolors=cellcol,xlab="Columns",ylab="Rows",
do.hex=TRUE,main="2D matrix plot (hexagons)",border=NA)
# for this one, we have to do the color legend separately
# because of the two part color scaling
legval<-seq(min(x),max(x),length.out=6)
legcol<-rep("#000000",6)
legcol[legval<0]<-color.scale(legval[legval<0],c(1,0.8),c(0,0.8),0)
legcol[legval>0]<-color.scale(legval[legval>0],0,c(0.8,1),c(0.8,0))
color.legend(0,-1.8,3,-1.4,round(c(min(x),0,max(x)),1),rect.col=legcol)
# do a color only association plot
xt<-table(sample(1:10,100,TRUE),sample(1:10,100,TRUE))
observed<-xt[,rev(1:dim(xt)[2])]
expected<-outer(rowSums(observed),colSums(observed),"*")/sum(xt)
deviates<-(observed-expected)/sqrt(expected)
cellcol<-matrix(rep("#000000",100),nrow=10)
cellcol[deviates<0]<-
color.scale(deviates[deviates<0],c(1,0.8),c(0,0.5),0)
cellcol[deviates>0]<-
color.scale(deviates[deviates>0],0,c(0.7,0.8),c(0.5,0))
color2D.matplot(x=round(deviates,2),cellcolors=cellcol,
show.values=TRUE,main="Association plot")
# Hinton diagram
border.col<-color.scale(x,extremes=2:3)
color2D.matplot(x,extremes=c(2,3),main="Hinton diagram (green +, red -)",
Hinton=TRUE,border=border.col)
# waffle plot of percentages with two contributing elements
waffle.col<-fill.corner(c(rep("red",18),rep("blue",45)),10,10)
color2D.matplot(matrix(1:100,nrow=10),cellcolors=waffle.col,yrev=FALSE,
border="lightgray",xlab="",ylab="",main="Waffle plot",axes=FALSE)
# coarse density plot of the iris petal data
spnames<-unique(iris$Species)
spcols<-c("red","green","blue")
matmax<-list()
cindx<-1
for(isp in spnames) {
petal_mat<-makeDensityMatrix(iris[iris$Species == isp,"Petal.Length"],
iris[iris$Species == isp,"Petal.Width"],
nx=20,ny=20,xlim=c(1,7),ylim=c(0,2.5),geocoord=FALSE)
# center the maximum markers in the cells
matmax[[cindx]]<-lapply(find_max_cell(petal_mat),"-",0.5)
if(isp == "setosa")
color2D.matplot(petal_mat,main="Iris petal length by petal width",
xlab="Petal length (cm)",ylab="Petal width (cm)",axes=FALSE,
cellcolors=color.scale(petal_mat,extremes=spcols[cindx],alpha=c(0,1)),
border=NA,yrev=FALSE)
else
color2D.matplot(petal_mat,border=NA,yrev=FALSE,add=TRUE,
cellcolors=color.scale(petal_mat,extremes=spcols[cindx],alpha=c(0,1)))
cindx<-cindx+1
}
axis(1,at=seq(0,20,by=3.33),labels=1:7)
axis(2,at=seq(0,20,length.out=4),labels=seq(1,2.5,by=0.5))
legend(1,6,paste0(spnames,"(",1:3,")"),fill=c("red","green","blue"))
for(cindx in 1:3)
text(matmax[[cindx]],as.character(cindx),col="white",cex=1.5)
Run the code above in your browser using DataLab