From 30a7214efad259ca6236b0d62b195eef931238ef Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Fri, 22 Oct 2021 03:57:02 -0700 Subject: [PATCH 1/3] Support for `treemapify`. And exposed the `textposition` param in `geom2trace.GeomText` so that the place argument in `geom_treemap_text` could be interpreted correctly. --- R/ggplotly.R | 8 +++- R/layers2traces.R | 112 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 118 insertions(+), 2 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index 6db8b6547b..75cd0559ad 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"), From 4dc70465442fa01fb4ab0124f27406503a56b642 Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Fri, 22 Oct 2021 03:58:03 -0700 Subject: [PATCH 2/3] Added unit tests. --- .../_snaps/treemapify/mult-subgroups.svg | 1 + tests/testthat/_snaps/treemapify/subgroup.svg | 1 + .../_snaps/treemapify/tree-map-text.svg | 1 + tests/testthat/_snaps/treemapify/tree-map.svg | 1 + tests/testthat/test-treemapify.R | 49 +++++++++++++++++++ 5 files changed, 53 insertions(+) create mode 100644 tests/testthat/_snaps/treemapify/mult-subgroups.svg create mode 100644 tests/testthat/_snaps/treemapify/subgroup.svg create mode 100644 tests/testthat/_snaps/treemapify/tree-map-text.svg create mode 100644 tests/testthat/_snaps/treemapify/tree-map.svg create mode 100644 tests/testthat/test-treemapify.R 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 @@ +NorthernSouthernSouth AmericaAfricaAsiaOceaniaEuropeAsiaNorth AmericaEurasiaMiddle EastAdvancedDevelopingAdvancedAdvancedDevelopingDevelopingDevelopingAdvancedDevelopingDevelopingDevelopingSouth AfricaBrazilArgentinaIndonesiaAustraliaUnited StatesCanadaMexicoChinaIndiaJapanSouth KoreaRussiaTurkeyEuropean UnionGermanyFranceUnited KingdomItalySaudi Arabia 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 @@ +EuropeNorth AmericaAsiaSouth AmericaEurasiaOceaniaMiddle EastAfricaSouth AfricaUnited StatesCanadaMexicoBrazilArgentinaChinaJapanIndiaSouth KoreaIndonesiaRussiaTurkeyEuropean UnionGermanyFranceUnited KingdomItalySaudi ArabiaAustralia 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 @@ +European UnionUnited StatesChinaJapanGermanyFranceUnited KingdomBrazilRussiaItalyIndiaCanadaAustraliaMexicoSouth KoreaIndonesiaTurkeySaudi ArabiaArgentinaSouth Africa 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 From 7aa9cfd058cd912286e2f155bc4059e0f2aa0c15 Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Fri, 22 Oct 2021 04:04:48 -0700 Subject: [PATCH 3/3] Updated NEWS.md --- NEWS.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/NEWS.md b/NEWS.md index a71da718f9..52a3d2827e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,13 @@ # 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) # 4.10.0