(Note: the most recent version, imageScale can be found in the sinkr package: https://github.com/marchtaylor/sinkr)
Below is an updated version of the image.scale function. In the old version, one had to constantly use additional arguments to suppress axes and their labels. The new version contains the additional arguments axis.pos (1, 2, 3, or 4) for defining the side of the axis, and add.axis (TRUE or FALSE), for defining whether the axis is plotted. Based on the position of the axis, the scale color levels are automatically drawn in a horizontal (axis.pos = 1[bottom] or 3[top]) or vertical (axis.pos = 2[left] or 4[right]) orientation. For the right plot above, the argument add.axis=FALSE so that additional control over axis ticks and labels could be added in an additional step with axis(). The function mtext() can be used to add additional labels to the scale.
The image.scale function:
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#This function creates a color scale for use with the image() | |
#function. Input parameters should be consistent with those | |
#used in the corresponding image plot. The "axis.pos" argument | |
#defines the side of the axis. The "add.axis" argument defines | |
#whether the axis is added (default: TRUE)or not (FALSE). | |
image.scale <- function(z, zlim, col = heat.colors(12), | |
breaks, axis.pos=1, add.axis=TRUE, ...){ | |
if(!missing(breaks)){ | |
if(length(breaks) != (length(col)+1)){stop("must have one more break than colour")} | |
} | |
if(missing(breaks) & !missing(zlim)){ | |
breaks <- seq(zlim[1], zlim[2], length.out=(length(col)+1)) | |
} | |
if(missing(breaks) & missing(zlim)){ | |
zlim <- range(z, na.rm=TRUE) | |
zlim[2] <- zlim[2]+c(zlim[2]-zlim[1])*(1E-3)#adds a bit to the range in both directions | |
zlim[1] <- zlim[1]-c(zlim[2]-zlim[1])*(1E-3) | |
breaks <- seq(zlim[1], zlim[2], length.out=(length(col)+1)) | |
} | |
poly <- vector(mode="list", length(col)) | |
for(i in seq(poly)){ | |
poly[[i]] <- c(breaks[i], breaks[i+1], breaks[i+1], breaks[i]) | |
} | |
if(axis.pos %in% c(1,3)){ylim<-c(0,1); xlim<-range(breaks)} | |
if(axis.pos %in% c(2,4)){ylim<-range(breaks); xlim<-c(0,1)} | |
plot(1,1,t="n",ylim=ylim, xlim=xlim, axes=FALSE, xlab="", ylab="", xaxs="i", yaxs="i", ...) | |
for(i in seq(poly)){ | |
if(axis.pos %in% c(1,3)){ | |
polygon(poly[[i]], c(0,0,1,1), col=col[i], border=NA) | |
} | |
if(axis.pos %in% c(2,4)){ | |
polygon(c(0,0,1,1), poly[[i]], col=col[i], border=NA) | |
} | |
} | |
box() | |
if(add.axis) {axis(axis.pos)} | |
} |
To reproduce the example:
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(devtools) | |
source_url('https://gist.github.com/menugget/7689145/raw/dac746aa322ca4160a5fe66c70fec16ebe26faf9/image.scale.2.r') | |
png("volcano_w_scale.png", width=7, height=4, units="in", res=200) | |
layout(matrix(c(1,2,3,0,4,0), nrow=2, ncol=3), widths=c(4,4,1), heights=c(4,1)) | |
layout.show(4) | |
#1st image | |
breaks <- seq(min(volcano), max(volcano),length.out=100) | |
par(mar=c(1,1,1,1)) | |
image(seq(dim(volcano)[1]), seq(dim(volcano)[2]), volcano, | |
col=pal.1(length(breaks)-1), breaks=breaks-1e-8, xaxt="n", yaxt="n", ylab="", xlab="") | |
#Add additional graphics | |
levs <- pretty(range(volcano), 5) | |
contour(seq(dim(volcano)[1]), seq(dim(volcano)[2]), volcano, levels=levs, add=TRUE) | |
#Add scale | |
par(mar=c(3,1,1,1)) | |
image.scale(volcano, col=pal.1(length(breaks)-1), breaks=breaks-1e-8,axis.pos=1) | |
abline(v=levs) | |
box() | |
#2nd image | |
breaks <- c(0,100, 150, 170, 190, 200) | |
par(mar=c(1,1,1,1)) | |
image(seq(dim(volcano)[1]), seq(dim(volcano)[2]), volcano, | |
col=pal.2(length(breaks)-1), breaks=breaks-1e-8, xaxt="n", yaxt="n", ylab="", xlab="") | |
#Add additional graphics | |
levs=breaks | |
contour(seq(dim(volcano)[1]), seq(dim(volcano)[2]), volcano, levels=levs, add=TRUE) | |
#Add scale | |
par(mar=c(1,1,1,3)) | |
image.scale(volcano, col=pal.2(length(breaks)-1), breaks=breaks-1e-8, axis.pos=4, add.axis=FALSE) | |
axis(4,at=breaks, las=2) | |
box() | |
abline(h=levs) | |
dev.off() | |
No comments:
Post a Comment