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)
}
|
