diff --git a/NEWS.md b/NEWS.md
index 56775ea13a..3a121cd4be 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,9 +1,19 @@
# 4.10.0.9000
+## New Features
+
+* `ggplotly` now can convert treemaps made using the `treemapify` package. (#2051)
+* `ggplotly` now supports `geom_function`/`stat_function` geoms. (#2042)
+
+## BUG fixes
+
+* `ggplotly` now correctly interprets `color` as an aesthetic mapping. (#2034)
+
## Improvements
* `ggplotly()` does not issue warnings with `options(warnPartialMatchArgs = TRUE)` any longer. (#2046, @bersbersbers)
+
# 4.10.0
## Breaking changes in JavaScript API
diff --git a/R/ggplotly.R b/R/ggplotly.R
index c9ccda8bc7..fa00468152 100644
--- a/R/ggplotly.R
+++ b/R/ggplotly.R
@@ -1377,6 +1377,10 @@ ggtype <- function(x, y = "geom") {
sub(y, "", tolower(class(x[[y]])[1]))
}
+get_first <- function(x){
+ if(length(x)) x[[1]] else x
+}
+
# colourbar -> plotly.js colorbar
gdef2trace <- function(gdef, theme, gglayout) {
if (inherits(gdef, "colorbar")) {
@@ -1386,8 +1390,8 @@ gdef2trace <- function(gdef, theme, gglayout) {
gdef$bar$value <- scales::rescale(gdef$bar$value, from = rng)
gdef$key$.value <- scales::rescale(gdef$key$.value, from = rng)
list(
- x = with(gglayout$xaxis, if (identical(tickmode, "auto")) ticktext else tickvals)[[1]],
- y = with(gglayout$yaxis, if (identical(tickmode, "auto")) ticktext else tickvals)[[1]],
+ x = get_first(with(gglayout$xaxis, if (identical(tickmode, "auto")) ticktext else tickvals)),
+ y = get_first(with(gglayout$yaxis, if (identical(tickmode, "auto")) ticktext else tickvals)),
# esentially to prevent this getting merged at a later point
name = gdef$hash,
type = "scatter",
diff --git a/R/layers2traces.R b/R/layers2traces.R
index 8ddd90c156..958dda7a12 100644
--- a/R/layers2traces.R
+++ b/R/layers2traces.R
@@ -624,9 +624,120 @@ to_basic.GeomQuantile <- function(data, prestats_data, layout, params, p, ...){
#' @export
to_basic.default <- function(data, prestats_data, layout, params, p, ...) {
+ dput(data, class(data)[[1]])
+ dput(params, paste0(class(data)[[1]], "pars"))
data
}
+
+####
+## TODO : this function should be generalised to be used with ggalluvial and geom_rect
+####
+rectangular_coords <- function(data){
+ data <- data[order(data$xmin+data$xmax), ]
+
+ if(all(unique(data$colour) == 0)) data$colour <- NULL
+
+ unused_aes <- ! names(data) %in% c("x", "y", "ymin", "ymax")
+
+ row_number <- nrow(data)
+
+ data_rev <- data[row_number:1L, ]
+ structure(rbind(
+ cbind(x = data$xmin, y = data$ymin, data[unused_aes]),
+ cbind(x = data$xmin[row_number], y = data$ymin[row_number], data[row_number, unused_aes]),
+ cbind(x = data_rev$xmax, y = data_rev$ymax, data_rev[unused_aes])
+ ), class = class(data))
+}
+
+
+#' @export
+to_basic.GeomTreemap <- function(data, prestats_data, layout, params, p, ...) {
+ to_basic.GeomRect(tree_transform(data, params))
+}
+
+tree_transform <- function(data, params){
+ pars <- params[c("fixed", "layout", "start")]
+ pars$data <- data
+ pars$area <- "area"
+
+ inter <- intersect(names(data), paste0("subgroup", c("", 2:3)))
+ if(length(inter)) pars[inter] <- inter
+
+ do.call(treemapify:::treemapify, pars)
+}
+
+#' @export
+to_basic.GeomTreemapText <- function(data, prestats_data, layout, params, p, ...){
+ data <- tree_transform(data, params)
+
+ if(any(grepl("subgroup", params)))
+
+ data$size <- with(data, 2*(xmax - xmin)/strwidth(label, units = "figure"))
+ data[, c("x", "y", "textposition")] <- with(data, list(x = (xmin+xmax)/2, y=(ymin+ymax)/2 , textposition = params$place))
+ #data[, c("x", "y", "hjust", "vjust")] <- with(data, place_to_coords(xmin, xmax, ymin, ymax, params$place))
+ #data[, c("x", "y")] <- with(data, list(x = (xmax+xmin)/2, y = if(any(grepl("subgroup", params))) ymax - strheight(label, units="figure")*.5*size else (ymax+ymin)/2 ) )
+ data$colour <- params$colour
+ data$fontface <- params$fontface
+
+ prefix_class(data, "GeomText")
+}
+#place_to_coords <- function(xmin, xmax, ymin, ymax, place){
+# #width <- strwidth(label)
+# #height <- strheight(label)
+# switch(place,
+# "bottom" = list(y = (ymax+ymin)/2, x = (xmin+xmax)/2, hjust=0, vjust=0),
+# "right" = list(y = xmax, y = (ymin+ymax)/2, hjust=0, vjust=.5),
+# "middle" = list(y = (xmax+xmax)/2, y = (ymin+ymax)/2, hjust=.5, vjust=.5),
+# "left" = list(y = xmin, y = (ymin+ymax)/2, hjust = .5, vjust=.5),
+# "top" = list(y = ymax, x = (xmin+xmax)/2, vjust=0, hjust=.5),
+# )
+#}
+treesubgroup_transform <- function(data, params){
+
+ pars <- params[c("fixed", "layout", "start")]
+ pars$area <- "area"
+
+ levels <- paste0("subgroup", c("", 2:3))
+
+ levels <- levels[1:which(levels == params$level)]
+
+
+ bys <- lapply(levels, function(x) data[[x]])
+ areasums <- aggregate(data$area, by = bys, FUN = sum)
+ names(areasums) <- c(levels, "area")
+ for (aesthetic in setdiff(names(data), names(areasums))) {
+ values <- data[[aesthetic]]
+ names(values) <- data[[params$level]]
+ areasums[aesthetic] <- values[as.character(areasums[[params$level]])]
+ }
+
+
+ pars$data <- areasums
+ if(length(levels) > 1) pars[head(levels, -1)] <- head(levels, -1)
+
+ do.call(treemapify:::treemapify, pars)
+
+}
+
+#' @export
+to_basic.GeomSubgroupBorder <- function(data, prestats_data, layout, params, p, ...){
+ prefix_class(to_basic.GeomRect(treesubgroup_transform(data, params)), "GeomPath")
+}
+#' @export
+to_basic.GeomSubgroupText <- function(data, prestats_data, layout, params, p, ...){
+ data <- treesubgroup_transform(data, params)
+ names(data)[names(data) == params$level] <- "label"
+
+ data$size <- with(data, 3*(xmax - xmin)/strwidth(label, units = "figure"))
+ #data[, c("x", "y")] <- with(data, list( x = (xmin+xmax)/2, y = (ymin+ymax)/2 ))
+ data[, c("x", "y", "textposition")] <- with(data, list(x = (xmin+xmax)/2, y=(ymin+ymax)/2 , textposition = params$place))
+
+ data$colour <- params$colour
+ data$fontface <- params$fontface
+ prefix_class(data, "GeomText")
+}
+
#' Convert a "basic" geoms to a plotly.js trace.
#'
#' This function makes it possible to convert ggplot2 geoms that
@@ -844,6 +955,7 @@ geom2trace.GeomText <- function(data, params, p) {
customdata = data[["customdata"]],
frame = data[["frame"]],
ids = data[["ids"]],
+ textposition = if("textposition" %in% names(data)) data[[1, "textposition"]] else NULL,
textfont = list(
# TODO: how to translate fontface/family?
size = aes2plotly(data, params, "size"),
diff --git a/tests/testthat/_snaps/treemapify/mult-subgroups.svg b/tests/testthat/_snaps/treemapify/mult-subgroups.svg
new file mode 100644
index 0000000000..a9ecf7e649
--- /dev/null
+++ b/tests/testthat/_snaps/treemapify/mult-subgroups.svg
@@ -0,0 +1 @@
+
diff --git a/tests/testthat/_snaps/treemapify/subgroup.svg b/tests/testthat/_snaps/treemapify/subgroup.svg
new file mode 100644
index 0000000000..d7e6f44f03
--- /dev/null
+++ b/tests/testthat/_snaps/treemapify/subgroup.svg
@@ -0,0 +1 @@
+
diff --git a/tests/testthat/_snaps/treemapify/tree-map-text.svg b/tests/testthat/_snaps/treemapify/tree-map-text.svg
new file mode 100644
index 0000000000..e8efa196d7
--- /dev/null
+++ b/tests/testthat/_snaps/treemapify/tree-map-text.svg
@@ -0,0 +1 @@
+
diff --git a/tests/testthat/_snaps/treemapify/tree-map.svg b/tests/testthat/_snaps/treemapify/tree-map.svg
new file mode 100644
index 0000000000..30161c8e57
--- /dev/null
+++ b/tests/testthat/_snaps/treemapify/tree-map.svg
@@ -0,0 +1 @@
+
diff --git a/tests/testthat/test-treemapify.R b/tests/testthat/test-treemapify.R
new file mode 100644
index 0000000000..ef65ed3625
--- /dev/null
+++ b/tests/testthat/test-treemapify.R
@@ -0,0 +1,49 @@
+if(require(treemapify)){
+ test_that("`geom_treemap` gets converted correctly", {
+ p <- ggplot(G20, aes(area = gdp_mil_usd, fill = hdi)) +
+ geom_treemap()
+ expect_doppelganger(ggplotly(p), "tree-map")
+ } )
+ test_that("`geom_treemap`/`geom_treemap_text` gets converted correctly", {
+ p <- ggplot(G20, aes(area = gdp_mil_usd, fill = hdi, label= country)) +
+ geom_treemap() +
+ geom_treemap_text(fontface = "italic", colour = "white", place = "centre",
+ grow = TRUE)
+
+ expect_doppelganger(ggplotly(p), "tree-map-text")
+ })
+ test_that("`treemap_subgroup` gets converted correctly", {
+ p <- ggplot(G20, aes(area = gdp_mil_usd, fill = hdi, label = country,
+ subgroup = region)) +
+ geom_treemap() +
+ geom_treemap_subgroup_border() +
+ geom_treemap_subgroup_text(place = "centre", grow = T, alpha = 0.5, colour =
+ "black", fontface = "italic", min.size = 0) +
+ geom_treemap_text(colour = "white", place = "topleft", reflow = T)
+ expect_doppelganger(ggplotly(p), "subgroup")
+ })
+ test_that("multiple `subgroup`s get converted correctly", {
+ p <- ggplot(G20, aes(area = 1, label = country, subgroup = hemisphere,
+ subgroup2 = region, subgroup3 = econ_classification)) +
+ geom_treemap() +
+ geom_treemap_subgroup3_border(colour = "blue", size = 1) +
+ geom_treemap_subgroup2_border(colour = "white", size = 3) +
+ geom_treemap_subgroup_border(colour = "red", size = 5) +
+ geom_treemap_subgroup_text(
+ place = "middle",
+ colour = "red",
+ alpha = 0.5,
+ grow = T
+ ) +
+ geom_treemap_subgroup2_text(
+ colour = "white",
+ alpha = 0.5,
+ fontface = "italic"
+ ) +
+ geom_treemap_subgroup3_text(place = "top", colour = "blue", alpha = 0.5) +
+ geom_treemap_text(colour = "white", place = "middle", reflow = T)
+
+ expect_doppelganger(ggplotly(p), "mult-subgroups")
+ })
+
+}
\ No newline at end of file