Skip to content

Commit eb2caca

Browse files
committed
reduce Reduce() for merging lists
use do.call() instead to avoid quadratic complexity of growing lists
1 parent d9662a6 commit eb2caca

File tree

1 file changed

+8
-7
lines changed

1 file changed

+8
-7
lines changed

R/subplots.R

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -266,7 +266,7 @@ subplot <- function(..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02
266266
}
267267

268268
p <- list(
269-
data = Reduce(c, traces),
269+
data = unlist(traces, recursive = FALSE),
270270
layout = Reduce(modify_list, c(xAxes, rev(yAxes)))
271271
)
272272

@@ -275,9 +275,10 @@ subplot <- function(..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02
275275
annotations <- Map(reposition, annotations, split(domainInfo, seq_along(plots)))
276276
shapes <- Map(reposition, shapes, split(domainInfo, seq_along(plots)))
277277
images <- Map(reposition, images, split(domainInfo, seq_along(plots)))
278-
p$layout$annotations <- Reduce(c, annotations)
279-
p$layout$shapes <- Reduce(c, shapes)
280-
p$layout$images <- Reduce(c, images)
278+
p$layout$annotations <- unlist(annotations, recursive = FALSE)
279+
p$layout$shapes <- unlist(shapes, recursive = FALSE)
280+
p$layout$images <- unlist(images, recursive = FALSE)
281+
281282
# merge non-axis layout stuff
282283
layouts <- lapply(layouts, function(x) {
283284
x[!grepl("^[x-y]axis|^geo|^mapbox|annotations|shapes|images", names(x))] %||% list()
@@ -290,8 +291,8 @@ subplot <- function(..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02
290291
}
291292
layouts <- layouts[which_layout]
292293
}
293-
p$attrs <- Reduce(c, lapply(plots, "[[", "attrs"))
294-
p$layout <- modify_list(p$layout, Reduce(modify_list, layouts))
294+
p$attrs <- unlist(lapply(plots, "[[", "attrs"), recursive = FALSE)
295+
p$layout <- Reduce(modify_list, layouts, p$layout)
295296
p$source <- ensure_one(plots, "source")
296297
p$config <- ensure_one(plots, "config")
297298
p$highlight <- ensure_one(plots, "highlight")
@@ -399,7 +400,7 @@ get_domains <- function(nplots = 1, nrows = 1, margins = 0.01,
399400

400401
list2df <- function(x, nms) {
401402
#stopifnot(length(unique(sapply(x, length))) == 1)
402-
m <- if (length(x) == 1) t(x[[1]]) else Reduce(rbind, x)
403+
m <- if (length(x) == 1) t(x[[1]]) else do.call(rbind, x)
403404
row.names(m) <- NULL
404405
df <- data.frame(m)
405406
if (!missing(nms)) setNames(df, nms) else df

0 commit comments

Comments
 (0)