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
120
121
|
# Get the location/size of the current viewport in inches on the device
currentViewportLoc <- function() {
# Get the current viewport transformation
# This transforms from inches in the current viewport to
# inches on the device
transform <- current.transform()
# Convert the current viewport's location to inches ...
width <- convertWidth(unit(1, "npc"), "inches", valueOnly=TRUE)
height <- convertHeight(unit(1, "npc"), "inches", valueOnly=TRUE)
# ... then to inches on the device
bottomleft <- c(0, 0, 1) %*% transform
left <- bottomleft[1]/bottomleft[3]
bottom <- bottomleft[2]/bottomleft[3]
topright <- c(width, height, 1) %*% transform
right <- topright[1]/topright[3]
top <- topright[2]/topright[3]
list(left=left, bottom=bottom, right=right, top=top)
}
# Prolific use of round(..., digits=4) because lots of the time
# calculated values will be intended to be the same, but will
# differ by tiny amounts due to rounding error. In particular,
# we are keen to avoid getting tiny negative values for par()
# settings. digits=4 because with the values we are dealing with
# two decimal places is plenty of precision.
# Check that a viewport location is within base outer margin setting
badOMI <- function(cvp, omi, din) {
round(cvp$left - omi[2], digits=4) < 0 ||
round(cvp$bottom - omi[1], digits=4) < 0 ||
round(cvp$right - (din[1] - omi[4]), digits=4) > 0 ||
round(cvp$top - (din[2] - omi[3]), digits=4) > 0
}
# Check that a viewport location is within base figure region setting
badFIG <- function(cvp, fig, omi, din) {
width <- din[1] - omi[2] - omi[4]
height <- din[2] - omi[1] - omi[3]
round(cvp$left - (omi[2] + fig[1]*width), digits=4) < 0 ||
round(cvp$bottom - (omi[1] + fig[3]*height), digits=4) < 0||
round(cvp$right - (omi[2] + fig[2]*width), digits=4) > 0 ||
round(cvp$top - (omi[1] + fig[4]*height), digits=4) > 0
}
# Return par(omi) settings that correspond to the current
# grid viewport
gridOMI <- function() {
# First get the current viewport locn/size
cvp <- currentViewportLoc()
# return outer margin values
din <- par("din")
# Do a round to avoid rounding error
omi <- round(c(cvp$bottom, cvp$left,
din[2] - cvp$top, din[1] - cvp$right), digits=4)
omi
}
# Return par(fig) settings that correspond to the current
# grid viewport
gridFIG <- function() {
# First get the current viewport locn/size
cvp <- currentViewportLoc()
# Get the current base outer margins (in inches)
din <- par("din")
omi <- par("omi")
# Throw an error if the curent viewport is outside the
# current outer margins (implies fig values outside [0, 1] range)
if (badOMI(cvp, omi, din))
stop("Outer margins too large and/or viewport too large")
# par(fig) is proportions within the inner region
# par(fig) is c(x1, x2, y1, y2)
width <- din[1] - omi[2] - omi[4]
height <- din[2] - omi[1] - omi[3]
# Do a round to avoid rounding error
fig <- round(c((cvp$left - omi[1])/width,
(cvp$right - omi[1])/width,
(cvp$bottom - omi[2])/height,
(cvp$top - omi[2])/height), digits=4)
fig
}
# Return par(plt) settings that correspond to the current
# grid viewport
gridPLT <- function() {
# First get the current viewport locn/size
cvp <- currentViewportLoc()
# Get the current base outer margins (in inches)
# and the current base figure region (as a proportion of the inner region)
din <- par("din")
omi <- par("omi")
fig <- par("fig")
# Throw an error if the curent viewport is outside the
# current figure region (implies plt values outside [0, 1] range)
if (badFIG(cvp, fig, omi, din))
stop("Figure region too small and/or viewport too large")
# par(plt) is proportions within the figure region
# par(plt) is c(x1, x2, y1, y2)
innerwidth <- din[1] - omi[2] - omi[4]
innerheight <- din[2] - omi[1] - omi[3]
width <- innerwidth*(fig[2] - fig[1])
height <- innerheight*(fig[4] - fig[3])
left <- omi[2] + innerwidth*fig[1]
bottom <- omi[1] + innerheight*fig[3]
# Do a round to avoid rounding error
plt <- round(c((cvp$left - left)/width,
(cvp$right - left)/width,
(cvp$bottom - bottom)/height,
(cvp$top - bottom)/height), digits=4)
plt
}
# Return some gpar settings that can be used to set par() graphical
# parameters
gridPAR <- function() {
gpars <- get.gpar()
# FIXME: Need to add font specifications too
gpars <- list(col=gpars$col,
lwd=gpars$lwd,
lty=gpars$lty)
}
|
