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
|
subplot <- function(fun, x, y=NULL, size=c(1,1), vadj=0.5, hadj=0.5,
inset=c(0,0), type=c('plt','fig'), pars=NULL){
# old.par <- par(no.readonly=TRUE)
type <- match.arg(type)
old.par <- par( c(type, 'usr', names(pars) ) )
on.exit(par(old.par))
if(missing(x)) x <- locator(2)
if(is.character(x)) {
if(length(inset) == 1) inset <- rep(inset,2)
x.char <- x
tmp <- par('usr')
x <- (tmp[1]+tmp[2])/2
y <- (tmp[3]+tmp[4])/2
if( length(grep('left',x.char, ignore.case=TRUE))) {
x <- tmp[1] + inset[1]*(tmp[2]-tmp[1])
if(missing(hadj)) hadj <- 0
}
if( length(grep('right',x.char, ignore.case=TRUE))) {
x <- tmp[2] - inset[1]*(tmp[2]-tmp[1])
if(missing(hadj)) hadj <- 1
}
if( length(grep('top',x.char, ignore.case=TRUE))) {
y <- tmp[4] - inset[2]*(tmp[4]-tmp[3])
if(missing(vadj)) vadj <- 1
}
if( length(grep('bottom',x.char, ignore.case=TRUE))) {
y <- tmp[3] + inset[2]*(tmp[4]-tmp[3])
if(missing(vadj)) vadj <- 0
}
}
xy <- xy.coords(x,y)
if(length(xy$x) != 2){
pin <- par('pin')
# tmp <- cnvrt.coords(xy$x[1],xy$y[1],'usr')$plt
tmpx <- grconvertX( xy$x[1], to='npc' )
tmpy <- grconvertY( xy$y[1], to='npc' )
x <- c( tmpx - hadj*size[1]/pin[1],
tmpx + (1-hadj)*size[1]/pin[1] )
y <- c( tmpy - vadj*size[2]/pin[2],
tmpy + (1-vadj)*size[2]/pin[2] )
# xy <- cnvrt.coords(x,y,'plt')$fig
xyx <- grconvertX(x, from='npc', to='nfc')
xyy <- grconvertY(y, from='npc', to='nfc')
} else {
# xy <- cnvrt.coords(xy,,'usr')$fig
xyx <- grconvertX(x, to='nfc')
xyy <- grconvertY(y, to='nfc')
}
par(pars)
if(type=='fig'){
xyx <- grconvertX(xyx, from='nfc', to='ndc')
xyy <- grconvertY(xyy, from='nfc', to='ndc')
par(fig=c(xyx,xyy), new=TRUE)
} else {
par(plt=c(xyx,xyy), new=TRUE)
}
fun
tmp.par <- par(no.readonly=TRUE)
return(invisible(tmp.par))
}
|
