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
|
tab.title<-function(label,text.col=par("fg"),tab.col=par("bg"),
border=par("fg"),lwd=par("lwd"),cex=1.5,pad.mult=1.6,radius=0) {
plotin<-par("pin")
marin<-par("mai")
plim<-par("usr")
xmult<-(plim[2]-plim[1])/(plim[4]-plim[3])*plotin[2]/plotin[1]
plim[3]<-plim[4]
plim[4]<-plim[3]+((plim[2]-plim[1])/xmult)*marin[3]/plotin[2]
oldcex<-par("cex")
par(cex=cex)
tabtop<-plim[3]+strheight(label)*pad.mult
oldxlog<-par("xlog")
oldylog<-par("ylog")
par(xlog=FALSE,ylog=FALSE)
if(radius == 0) {
tabx<-c(plim[1],plim[1],plim[2],plim[2])
taby<-c(plim[3],tabtop,tabtop,plim[3])
}
else {
xradius<-radius*(tabtop-plim[3])*xmult
xcurve1<-xradius*cos(seq(0,pi/2,length.out=20))
xcurve2<-xradius*cos(seq(pi/2,pi,length.out=20))
tabx<-c(plim[2],
(plim[2]-xradius)+xcurve1,
(plim[1]+xradius)+xcurve2,
plim[1])
yradius<-radius*(tabtop-plim[3])
ycurve1<-yradius*sin(seq(0,pi/2,length.out=20))
ycurve2<-yradius*sin(seq(pi/2,pi,length.out=20))
taby<-c(plim[3],
tabtop-yradius+ycurve1,
tabtop-yradius+ycurve2,
plim[3])
}
par(xpd=TRUE)
polygon(tabx,taby,border=border,col=tab.col,lwd=lwd)
text((plim[1]+plim[2])/2,(plim[3]+tabtop)/2,label,
col=text.col)
par(xpd=FALSE,xlog=oldxlog,ylog=oldylog,cex=oldcex)
}
|
