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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
## adapted from the Lattice book by Deepayan Sarkar
xscale.components.logpower <- function(lim, ...) {
ans <- xscale.components.default(lim, ...)
ans$bottom$labels$labels <- parse(text = ans$bottom$labels$labels)
ans
}
yscale.components.logpower <- function(lim, ...) {
ans <- yscale.components.default(lim, ...)
ans$left$labels$labels <- parse(text = ans$left$labels$labels)
ans
}
xscale.components.fractions <- function(lim, logsc = FALSE, ...) {
ans <- xscale.components.default(lim, logsc = logsc, ...)
## get 'at' in data coordinates
if (identical(logsc, TRUE)) logsc <- 10
if (identical(logsc, "e")) logsc <- exp(1)
at <- ans$bottom$labels$at
if (!identical(logsc, FALSE))
at <- logsc ^ at
ans$bottom$labels$labels <- MASS::fractions(at)
ans
}
yscale.components.fractions <- function(lim, logsc = FALSE, ...) {
ans <- yscale.components.default(lim, logsc = logsc, ...)
## get 'at' in data coordinates
if (identical(logsc, TRUE)) logsc <- 10
if (identical(logsc, "e")) logsc <- exp(1)
at <- ans$left$labels$at
if (!identical(logsc, FALSE))
at <- logsc ^ at
ans$left$labels$labels <- MASS::fractions(at)
ans
}
logTicks <- function (lim, loc = c(1, 5)) {
ii <- floor(log10(range(lim))) + c(-1, 2)
main <- 10^(ii[1]:ii[2])
r <- as.numeric(outer(loc, main, "*"))
r[lim[1] <= r & r <= lim[2]]
}
xscale.components.log10ticks <- function(lim, logsc = FALSE, at = NULL, ...) {
ans <- xscale.components.default(lim = lim, logsc = logsc, at = at, ...)
if (is.null(at)) return(ans)
if (identical(logsc, FALSE)) return(ans)
logbase <- logsc
if (identical(logbase, TRUE)) logbase <- 10
if (identical(logbase, "e")) logbase <- exp(1)
tick.at <- logTicks(logbase^lim, loc = 1:9)
tick.at.major <- logTicks(logbase^lim, loc = 1)
major <- tick.at %in% tick.at.major
ans$bottom$ticks$at <- log(tick.at, logbase)
ans$bottom$ticks$tck <- ifelse(major, 1, 0.5)
ans$bottom$labels$at <- log(tick.at, logbase)
ans$bottom$labels$labels <- as.character(tick.at)
ans$bottom$labels$labels[!major] <- ""
ans$bottom$labels$check.overlap <- FALSE
ans
}
yscale.components.log10ticks <- function(lim, logsc = FALSE, at = NULL, ...) {
ans <- yscale.components.default(lim = lim, logsc = logsc, at = at, ...)
if (is.null(at)) return(ans)
if (identical(logsc, FALSE)) return(ans)
logbase <- logsc
if (identical(logbase, TRUE)) logbase <- 10
if (identical(logbase, "e")) logbase <- exp(1)
tick.at <- logTicks(logbase^lim, loc = 1:9)
tick.at.major <- logTicks(logbase^lim, loc = 1)
major <- tick.at %in% tick.at.major
ans$left$ticks$at <- log(tick.at, logbase)
ans$left$ticks$tck <- ifelse(major, 1, 0.5)
ans$left$labels$at <- log(tick.at, logbase)
ans$left$labels$labels <- as.character(tick.at)
ans$left$labels$labels[!major] <- ""
ans$left$labels$check.overlap <- FALSE
ans
}
xscale.components.log10.3 <- function(lim, logsc = FALSE, at = NULL, ...) {
ans <- xscale.components.default(lim = lim, logsc = logsc, at = at, ...)
if (is.null(at)) return(ans)
if (identical(logsc, FALSE)) return(ans)
logbase <- logsc
if (identical(logbase, TRUE)) logbase <- 10
if (identical(logbase, "e")) logbase <- exp(1)
tick.at <- logTicks(logbase^lim, loc = c(1, 3))
ans$bottom$ticks$at <- log(tick.at, logbase)
ans$bottom$labels$at <- log(tick.at, logbase)
ans$bottom$labels$labels <- as.character(tick.at)
ans
}
yscale.components.log10.3 <- function(lim, logsc = FALSE, at = NULL, ...) {
ans <- yscale.components.default(lim = lim, logsc = logsc, at = at, ...)
if (is.null(at)) return(ans)
if (identical(logsc, FALSE)) return(ans)
logbase <- logsc
if (identical(logbase, TRUE)) logbase <- 10
if (identical(logbase, "e")) logbase <- exp(1)
tick.at <- logTicks(logbase^lim, loc = c(1, 3))
ans$left$ticks$at <- log(tick.at, logbase)
ans$left$labels$at <- log(tick.at, logbase)
ans$left$labels$labels <- as.character(tick.at)
ans
}
## major + minor ticks (e.g. for date/time axes):
xscale.components.subticks <-
function(lim, ..., n = 5, n2 = n * 5, min.n2 = n + 5)
{
ans <- xscale.components.default(lim = lim, ..., n = n)
ans2 <- xscale.components.default(lim = lim, ..., n = n2, min.n = min.n2)
ticks <- ans$bottom$ticks$at
ticks2 <- ans2$bottom$ticks$at
ticks2 <- ticks2[!(ticks2 %in% ticks)]
ans$bottom$ticks$at <- c(ticks, ticks2)
ans$bottom$ticks$tck <- c(rep(1, length(ticks)),
rep(0.5, length(ticks2)))
ans$bottom$labels$at <- ans$bottom$ticks$at
ans$bottom$labels$labels <- c(ans$bottom$labels$labels,
rep(" ", length(ticks2)))
ans$bottom$labels$check.overlap <- FALSE
ans
}
yscale.components.subticks <-
function(lim, ..., n = 5, n2 = n * 5, min.n2 = n + 5)
{
ans <- yscale.components.default(lim = lim, ..., n = n)
ans2 <- yscale.components.default(lim = lim, ..., n = n2, min.n = min.n2)
ticks <- ans$left$ticks$at
ticks2 <- ans2$left$ticks$at
ticks2 <- ticks2[!(ticks2 %in% ticks)]
ans$left$ticks$at <- c(ticks, ticks2)
ans$left$ticks$tck <- c(rep(1, length(ticks)),
rep(0.5, length(ticks2)))
ans$left$labels$at <- ans$left$ticks$at
ans$left$labels$labels <- c(ans$left$labels$labels,
rep(" ", length(ticks2)))
ans$left$labels$check.overlap <- FALSE
ans
}
|