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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
# Panel object.
#
# A panel figures out how data is positioned within a panel of a plot,
# coordinates information from scales, facets and coords. Eventually all
# state will move out of facets and coords, and live only in panels and
# stats, simplifying these data structures to become strategies.
#
# Information about a panel is built up progressively over time, which
# is why the initial object is empty to start with.
new_panel <- function() {
structure(list(), class = "panel")
}
# Learn the layout of panels within a plot.
#
# This is determined by the facet, which returns a data frame, than
# when joined to the data to be plotted tells us which panel it should
# appear in, where that panel appears in the grid, and what scales it
# uses.
#
# As well as the layout info, this function also adds empty lists in which
# to house the x and y scales.
#
# @param the panel object to train
# @param the facetting specification
# @param data a list of data frames (one for each layer), and one for the plot
# @param plot_data the default data frame
# @return an updated panel object
train_layout <- function(panel, facet, data, plot_data) {
layout <- facet_train_layout(facet, c(list(plot_data), data))
panel$layout <- layout
panel$shrink <- facet$shrink
panel
}
# Map data to find out where it belongs in the plot.
#
# Layout map ensures that all layer data has extra copies of data for margins
# and missing facetting variables, and has a PANEL variable that tells that
# so it know what panel it belongs to. This is a change from the previous
# design which added facetting variables directly to the data frame and
# caused problems when they had names of aesthetics (like colour or group).
#
# @param panel a trained panel object
# @param the facetting specification
# @param data list of data frames (one for each layer)
# @param plot_data default plot data frame
map_layout <- function(panel, facet, data, plot_data) {
lapply(data, function(data) {
if (is.waive(data)) data <- plot_data
facet_map_layout(facet, data, panel$layout)
})
}
# Train position scales with data
#
# If panel-specific scales are not already present, will clone from
# the scales provided in the parameter
#
# @param panel the panel object to train
# @param data a list of data frames (one for each layer)
# @param x_scale x scale for the plot
# @param y_scale y scale for the plot
train_position <- function(panel, data, x_scale, y_scale) {
# Initialise scales if needed, and possible.
layout <- panel$layout
if (is.null(panel$x_scales) && !is.null(x_scale)) {
panel$x_scales <- rlply(max(layout$SCALE_X), scale_clone(x_scale))
}
if (is.null(panel$y_scales) && !is.null(y_scale)) {
panel$y_scales <- rlply(max(layout$SCALE_Y), scale_clone(y_scale))
}
# loop over each layer, training x and y scales in turn
for(layer_data in data) {
match_id <- match(layer_data$PANEL, layout$PANEL)
if (!is.null(x_scale)) {
x_vars <- intersect(x_scale$aesthetics, names(layer_data))
SCALE_X <- layout$SCALE_X[match_id]
scale_apply(layer_data, x_vars, scale_train, SCALE_X, panel$x_scales)
}
if (!is.null(y_scale)) {
y_vars <- intersect(y_scale$aesthetics, names(layer_data))
SCALE_Y <- layout$SCALE_Y[match_id]
scale_apply(layer_data, y_vars, scale_train, SCALE_Y, panel$y_scales)
}
}
panel
}
reset_scales <- function(panel) {
if (!panel$shrink) return()
l_ply(panel$x_scales, scale_reset)
l_ply(panel$y_scales, scale_reset)
}
# Map data with scales.
#
# This operation must be idempotent because it is applied twice: both before
# and after statistical transformation.
#
# @param data a list of data frames (one for each layer)
map_position <- function(panel, data, x_scale, y_scale) {
layout <- panel$layout
lapply(data, function(layer_data) {
match_id <- match(layer_data$PANEL, layout$PANEL)
# Loop through each variable, mapping across each scale, then joining
# back together
x_vars <- intersect(x_scale$aesthetics, names(layer_data))
names(x_vars) <- x_vars
SCALE_X <- layout$SCALE_X[match_id]
new_x <- scale_apply(layer_data, x_vars, scale_map, SCALE_X,
panel$x_scales)
layer_data[, x_vars] <- new_x
y_vars <- intersect(y_scale$aesthetics, names(layer_data))
names(y_vars) <- y_vars
SCALE_Y <- layout$SCALE_Y[match_id]
new_y <- scale_apply(layer_data, y_vars, scale_map, SCALE_Y,
panel$y_scales)
layer_data[, y_vars] <- new_y
layer_data
})
}
# Function for applying scale function to multiple variables in a given
# data set. Implement in such a way to minimise copying and hence maximise
# speed
scale_apply <- function(data, vars, f, scale_id, scales) {
if (length(vars) == 0) return()
if (nrow(data) == 0) return()
n <- length(scales)
if (any(is.na(scale_id))) stop()
scale_index <- split_indices(scale_id, n)
lapply(vars, function(var) {
pieces <- lapply(seq_along(scales), function(i) {
f(scales[[i]], data[[var]][scale_index[[i]]])
})
# Join pieces back together, if necessary
if (!is.null(pieces)) {
unlist(pieces)[order(unlist(scale_index))]
}
})
}
panel_scales <- function(panel, i) {
this_panel <- panel$layout[panel$layout$PANEL == i, ]
list(
x = panel$x_scales[[this_panel$SCALE_X]],
y = panel$y_scales[[this_panel$SCALE_Y]]
)
}
# Compute ranges and dimensions of each panel, using the coord.
train_ranges <- function(panel, coord) {
compute_range <- function(ix, iy) {
# TODO: change coord_train method to take individual x and y scales
coord_train(coord, list(x = panel$x_scales[[ix]], y = panel$y_scales[[iy]]))
}
panel$ranges <- Map(compute_range,
panel$layout$SCALE_X, panel$layout$SCALE_Y)
panel
}
# Calculate statistics
#
# @param layers list of layers
# @param data a list of data frames (one for each layer)
calculate_stats <- function(panel, data, layers) {
lapply(seq_along(data), function(i) {
d <- data[[i]]
l <- layers[[i]]
ddply(d, "PANEL", function(panel_data) {
scales <- panel_scales(panel, panel_data$PANEL[1])
l$calc_statistic(panel_data, scales)
})
})
}
xlabel <- function(panel, labels) {
panel$x_scales[[1]]$name %||% labels$x
}
ylabel <- function(panel, labels) {
panel$y_scales[[1]]$name %||% labels$y
}
|
