1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
|
addtable2plot<-function(x,y=NULL,table,lwd=par("lwd"),bty="n",
bg=par("bg"),cex=1,xjust=0,yjust=1,xpad=0.1,ypad=0.5,box.col=par("fg"),
text.col=par("fg"),display.colnames=TRUE,display.rownames=FALSE,
hlines=FALSE,vlines=FALSE,title=NULL) {
# make sure that there is a graphics device open
if(dev.cur() == 1)
stop("Cannot add table unless a graphics device is open")
# check for an xy.coords structure
if(is.null(y)) {
if(is.character(x)) {
tablepos<-get.tablepos(x)
x<-tablepos$x
y<-tablepos$y
xjust<-tablepos$xjust
yjust<-tablepos$yjust
}
else {
if(is.null(x$y)) stop("both x and y coordinates must be given")
y<-x$y
x<-x$x
}
}
droptop<-ifelse(any(c("topleft","top","topright") %in% x),1,0)
tabdim<-dim(table)
if(tabdim[1] == 1) hlines<-FALSE
if(tabdim[2] == 1) vlines<-FALSE
# cat(tabdim,vlines,hlines,"\n")
if(is.null(dim(bg))) bg<-matrix(bg,nrow=tabdim[1],ncol=tabdim[2])
column.names<-colnames(table)
if(is.null(column.names) && display.colnames)
column.names<-1:tabdim[2]
row.names<-rownames(table)
if(is.null(row.names) && display.rownames)
row.names<-1:tabdim[1]
if(par("xlog")) x<-log10(x)
cellwidth<-rep(0,tabdim[2])
# assume that the column names will be at least as wide as the entries
if(display.colnames) {
for(column in 1:tabdim[2])
cellwidth[column]<-max(strwidth(c(column.names[column],
format(table[,column])),cex=cex))*(1+xpad)
nvcells<-tabdim[1]+1
}
else {
nvcells<-tabdim[1]
for(column in 1:tabdim[2])
cellwidth[column]<-max(strwidth(format(table[,column]),cex=cex))*(1+xpad)
}
if(display.rownames) {
nhcells<-tabdim[2]+1
rowname.width<-max(strwidth(row.names,cex=cex))*(1+xpad)
}
else {
nhcells<-tabdim[2]
rowname.width<-0
}
# cat(cellwidth,"\n")
if(par("ylog")) y<-log10(y)
cellheight<-
max(strheight(c(column.names,row.names,as.vector(unlist(table))),
cex=cex))*(1+ypad)
if(!is.null(title) & droptop) y<-y-cellheight
ytop<-y+yjust*nvcells*cellheight
# adjust for logarithmic plotting and allow the table to extend beyond the plot
oldpar<-par(xlog=FALSE,ylog=FALSE,xpd=TRUE)
if(display.colnames) {
xleft<-x+display.rownames*rowname.width-xjust*(sum(cellwidth)+rowname.width)
for(column in 1:tabdim[2]) {
text(xleft+cellwidth[column]*0.5,
ytop-0.5*cellheight,column.names[column],cex=cex,col=text.col)
xleft<-xleft+cellwidth[column]
}
}
for(row in 1:tabdim[1]) {
# start at the left edge of the table
xleft<-x-xjust*(sum(cellwidth)+rowname.width)
if(display.rownames) {
text(xleft+0.5*rowname.width,
ytop-(row+display.colnames-0.5)*cellheight,
row.names[row],cex=cex,col=text.col)
xleft<-xleft+rowname.width
}
for(column in 1:tabdim[2]) {
rect(xleft,ytop-(row+display.colnames-1)*cellheight,
xleft+cellwidth[column],ytop-(row+display.colnames)*cellheight,
col=bg[row,column],border=bg[row,column])
text(xleft+0.5*cellwidth[column],
ytop-(row+display.colnames-0.5)*cellheight,
table[row,column],cex=cex,col=text.col)
xleft<-xleft+cellwidth[column]
}
}
if(vlines) {
xleft<-x+display.rownames*rowname.width-xjust*(sum(cellwidth)+rowname.width)
segments(xleft+cumsum(cellwidth[-tabdim[2]]),
ytop-display.colnames*cellheight,
xleft+cumsum(cellwidth[-tabdim[2]]),
ytop-(display.colnames+tabdim[1])*cellheight)
}
if(hlines) {
xleft<-x+display.rownames*rowname.width-xjust*(sum(cellwidth)+rowname.width)
segments(xleft,
ytop-display.colnames*cellheight-cumsum(rep(cellheight,tabdim[1]-1)),
xleft+sum(cellwidth),
ytop-display.colnames*cellheight-cumsum(rep(cellheight,tabdim[1]-1)))
}
if(!is.null(title)) {
xleft<-x-xjust*(sum(cellwidth)+rowname.width)
text(xleft+(rowname.width+sum(cellwidth))/2,ytop+cellheight/2,title,
cex=cex,col=text.col)
}
if(bty == "o") {
xleft<-x+display.rownames*rowname.width-xjust*(sum(cellwidth)+rowname.width)
rect(xleft,ytop-(tabdim[1]+display.colnames)*cellheight,
xleft+sum(cellwidth),ytop-display.colnames*cellheight)
}
par(oldpar)
}
|