回复 第17楼 的 hemao:corrplot包中有的,函数如下:
<br />
colorlegend <- function(colbar, labels, at=NULL, xlim=c(0,1), ylim=c(0,1),<br />
vertical=TRUE, ratio.colbar = 0.4, lim.segment = NULL, align=c("c","l","r"),<br />
addlabels=TRUE, ...)<br />
{<br />
### begin colorlegend function<br />
### last modified 2010-5-26, 11:49, changsha, china<br />
if(is.null(at)&addlabels)<br />
at <- seq(0L,1L,length=length(labels))<br />
if(is.null(lim.segment))<br />
lim.segment <- ratio.colbar + c(0, ratio.colbar/5)<br />
if(any(at<0L)|any(at>1L))<br />
stop("at should be between 0 and 1")<br />
if(any(lim.segment<0L)|any(lim.segment>1L))<br />
stop("lim.segment should be between 0 and 1")<br />
align <- match.arg(align)<br />
xgap <- diff(xlim)<br />
ygap <- diff(ylim)<br />
len <- length(colbar)<br />
rat1 <- ratio.colbar<br />
rat2 <- lim.segment</p>
<p>if(vertical){<br />
at <- at*ygap + ylim[1]<br />
yyy <- seq(ylim[1], ylim[2], length=len+1)<br />
rect(rep(xlim[1], len), yyy[1:len],<br />
rep(xlim[1] +xgap*rat1, len), yyy[-1], col = colbar, border = colbar)<br />
rect(xlim[1], ylim[1], xlim[1] +xgap*rat1, ylim[2], border="black")<br />
pos.xlabel <- rep(xlim[1] + xgap*max(rat2, rat1), length(at))<br />
segments(xlim[1]+ xgap*rat2[1], at,<br />
xlim[1]+ xgap*rat2[2], at)<br />
if(addlabels){<br />
if(align=="l") text(x=pos.xlabel, y=at, labels=labels, pos = 4, ...)<br />
if(align=="c") text((pos.xlabel+xlim[2])/2, y=at, labels=labels, ...)<br />
if(align=="r") text(x=xlim[2], y=at, labels=labels, pos = 2, ...)<br />
}<br />
}</p>
<p>if(!vertical){<br />
at <- at*xgap + xlim[1]<br />
xxx <- seq(xlim[1], xlim[2], length=len+1)<br />
rect(xxx[1:len], rep(ylim[2] - rat1*ygap, len),<br />
xxx[-1], rep(ylim[2], len), col = colbar, border = colbar)<br />
rect(xlim[1], ylim[2] - rat1*ygap, xlim[2], ylim[2], border="black")<br />
pos.ylabel <- rep(ylim[2] - ygap*max(rat2, rat1), length(at))<br />
segments(at , ylim[2] - ygap*rat2[1],<br />
at, ylim[2] - ygap*rat2[2])<br />
if(addlabels){<br />
if(align=="l") text(at, pos.ylabel, labels, pos = 1, ...)<br />
if(align=="c") text(at, (pos.ylabel+ylim[1])/2, labels=labels, ...)<br />
if(align=="r") text(at, ylim[1], labels=labels, pos = 2, ...)<br />
}<br />
} </p>
<p>} ### end colorlegend<br />
</p>