Add treemapify support #2051

moutikabdessabour · 2021-10-22T11:00:24Z

change NEWS.MD

…om2trace.GeomText` so that the place argument in `geom_treemap_text` could be interpreted correctly.

cpsievert · 2021-11-01T22:02:41Z

R/layers2traces.R

@@ -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,


This is equivalent, but simpler

Suggested change

textposition = if("textposition" %in% names(data)) data[[1, "textposition"]] else NULL,

textposition = data$textposition[[1]],

is textposition always provided in the data argument?

It doesn't matter since data$textposition[[1]] in that case is still NULL in that case

cpsievert · 2021-11-01T22:03:49Z

R/layers2traces.R

+  dput(data, class(data)[[1]])
+  dput(params, paste0(class(data)[[1]], "pars"))


Was this added for debugging purposes?

Suggested change

dput(data, class(data)[[1]])

dput(params, paste0(class(data)[[1]], "pars"))

Then please remove it

cpsievert · 2021-11-01T22:04:35Z

R/ggplotly.R

+      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)),


A proper fix for this will happen via #2062

So should we wait for it to be merged?

It's merged now, so please merge/rebase and revert these changes

cpsievert · 2021-11-01T22:04:56Z

R/ggplotly.R

+get_first <- function(x){
+  if(length(x)) x[[1]] else x
+}


This is not a useful abstraction

using [[1]] directly resulted in errors when gglayout$yaxis$ticktext|tickvals was empty and instead of making the code incomprehensible by cramming more conditions I decided on adding a simple function that checked whether x is empty or not

I get what it's doing, but it's not worth making a function out of it (especially now that #2062 is merged)

cpsievert · 2021-11-01T22:07:32Z

R/layers2traces.R

+
+  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")
+}


Is this code being lifted from somewhere else? If yes, please add proper attribution. Also, if ::: is absolutely necessary, you'll have to use getFromNamespace() instead.

some parts of the code were adapted from the treemapify package

This might be a blocker considering that treemapify is GPL licensed and plotly is MIT licensed https://github.com/wilkox/treemapify/blob/master/DESCRIPTION#L23

tbh only some parts of the logic is transfered. I didn't actually copy/paste the code.

moutikabdessabour added 4 commits October 22, 2021 03:57

Support for treemapify. And exposed the textposition param in `ge…

30a7214

…om2trace.GeomText` so that the place argument in `geom_treemap_text` could be interpreted correctly.

Added unit tests.

4dc7046

Updated NEWS.md

7aa9cfd

Merge branch 'master' into add_treemapify_support

d0971d0

moutikabdessabour requested a review from cpsievert October 22, 2021 16:51

cpsievert reviewed Nov 1, 2021

View reviewed changes

This was referenced Nov 2, 2021

quick implementation of most of ggraph/ggforce #1326

Open

Make treemapify compatible with plotly r package wilkox/treemapify#40

Open

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Add treemapify support #2051

Add treemapify support #2051

moutikabdessabour commented Oct 22, 2021 •

edited

Loading

cpsievert Nov 1, 2021 •

edited

Loading

moutikabdessabour Nov 2, 2021

cpsievert Nov 2, 2021 •

edited

Loading

cpsievert Nov 1, 2021

moutikabdessabour Nov 2, 2021

cpsievert Nov 2, 2021

cpsievert Nov 1, 2021

moutikabdessabour Nov 2, 2021

cpsievert Nov 2, 2021 •

edited

Loading

cpsievert Nov 1, 2021

moutikabdessabour Nov 2, 2021

cpsievert Nov 2, 2021

cpsievert Nov 1, 2021

moutikabdessabour Nov 2, 2021 •

edited

Loading

cpsievert Nov 2, 2021 •

edited

Loading

moutikabdessabour Nov 2, 2021

	textposition = if("textposition" %in% names(data)) data[[1, "textposition"]] else NULL,
	textposition = data$textposition[[1]],

		dput(data, class(data)[[1]])
		dput(params, paste0(class(data)[[1]], "pars"))

		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)),

Add treemapify support #2051

Are you sure you want to change the base?

Add treemapify support #2051

Conversation

moutikabdessabour commented Oct 22, 2021 • edited Loading

cpsievert Nov 1, 2021 • edited Loading

Choose a reason for hiding this comment

Choose a reason for hiding this comment

cpsievert Nov 2, 2021 • edited Loading

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

cpsievert Nov 2, 2021 • edited Loading

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

moutikabdessabour Nov 2, 2021 • edited Loading

Choose a reason for hiding this comment

cpsievert Nov 2, 2021 • edited Loading

Choose a reason for hiding this comment

Choose a reason for hiding this comment

moutikabdessabour commented Oct 22, 2021 •

edited

Loading

cpsievert Nov 1, 2021 •

edited

Loading

cpsievert Nov 2, 2021 •

edited

Loading

cpsievert Nov 2, 2021 •

edited

Loading

moutikabdessabour Nov 2, 2021 •

edited

Loading

cpsievert Nov 2, 2021 •

edited

Loading