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
|
squishplot <- function(xlim,ylim,asp=1, newplot=TRUE){
if(length(xlim) < 2) stop('xlim must be a vector of length 2')
if(length(ylim) < 2) stop('ylim must be a vector of length 2')
if(newplot) plot.new()
tmp <- par(c('plt','pin','xaxs','yaxs'))
if( tmp$xaxs == 'i' ){ # not extended axis range
xlim <- range(xlim, na.rm=TRUE)
} else { # extended range
tmp.r <- diff(range(xlim, na.rm=TRUE))
xlim <- range(xlim, na.rm=TRUE) + c(-1,1)*0.04*tmp.r
}
if( tmp$yaxs == 'i' ){ # not extended axis range
ylim <- range(ylim, na.rm=TRUE)
} else { # extended range
tmp.r <- diff(range(ylim, na.rm=TRUE))
ylim <- range(ylim, na.rm=TRUE) + c(-1,1)*0.04*tmp.r
}
tmp2 <- (ylim[2]-ylim[1])/(xlim[2]-xlim[1])
tmp.y <- tmp$pin[1] * tmp2 * asp
if(tmp.y < tmp$pin[2]){ # squish vertically
par(pin=c(tmp$pin[1], tmp.y))
par(plt=c(tmp$plt[1:2], par('plt')[3:4]))
} else { # squish horizontally
tmp.x <- tmp$pin[2]/tmp2/asp
par(pin=c(tmp.x, tmp$pin[2]))
par(plt=c(par('plt')[1:2], tmp$plt[3:4]))
}
return(invisible(tmp['plt']))
}
|
