Merge pull request #54 from m-jahn/dev

Update to v0.1.4
m-jahn · Nov 26, 2024 · a863fc5 · a863fc5
2 parents f7ba8e4 + f2a2bfd
commit a863fc5
Show file tree

Hide file tree

Showing 6 changed files with 79 additions and 53 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: WeightedTreemaps
 Title: Generate and Plot Voronoi or Sunburst Treemaps from Hierarchical
     Data
-Version: 0.1.3
+Version: 0.1.4
 Authors@R: c(
     person("Michael", "Jahn", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-3913-153X")),

diff --git a/R/drawTreemap.R b/R/drawTreemap.R
@@ -23,7 +23,11 @@
 #'   Default is to use the lowest level cells for Voronoi treemaps and all levels
 #'   for sunburst treemaps.
 #' @param color_palette (character) A character vector of colors used to fill cells.
-#'   The default is to use \code{\link[colorspace]{rainbow_hcl}} from
+#'   The default is to use \code{\link[colorspace]{rainbow_hcl}}
+#' @param color_steps (numeric) Approximate number of steps for the color gradient
+#'   to be used when drawing cells with \code{color_type = "cell_size"}.
+#'   Default step number is 10, and final step number can a vary a bit because
+#'   \code{pretty()} is used to calculate a decent color range.
 #' @param border_level (numeric) A numeric vector representing the hierarchical level that should be
 #'   used for drawing cell borders, or NULL to omit drawing borders, The default is
 #'   that all borders are drawn.
@@ -43,6 +47,8 @@
 #' @param label_color (character) A single character indicating color for cell labels.
 #'   Alternatively a vector of \code{length(label_level)}, then each label
 #'   is drawn with the specified color.
+#' @param label_autoscale (logical) Whether to automatically scale labels based on
+#'   their estimated width. Default is TRUE.
 #' @param title (character) An optional title, default to \code{NULL}.
 #' @param title_size (numeric) The size (or 'character expansion') of the title.
 #' @param title_color (character) Color for title.
@@ -155,12 +161,14 @@ drawTreemap <- function(
   color_type = "categorical",
   color_level = NULL,
   color_palette = NULL,
+  color_steps = 10,
   border_level = levels,
   border_size = 6,
   border_color = grey(0.9),
   label_level = max(levels),
   label_size = 1,
   label_color = grey(0.9),
+  label_autoscale = TRUE,
   title = NULL,
   title_size = 1,
   title_color = grey(0.5),
@@ -253,7 +261,7 @@ drawTreemap <- function(
   # There are different possible cases to determine the cell color
   # depending on the user's choice
   treemap <- add_color(treemap, color_palette, color_type,
-    color_level, custom_range)
+    color_level, color_steps, custom_range)
   # the treemap object is a nested list
   # use apply function to draw the single polygons for desired level
   lapply(treemap@cells, function(tm_slot) {
@@ -334,7 +342,7 @@ drawTreemap <- function(
 
     } else {
       draw_label_voronoi(
-        treemap@cells, label_level, label_size, label_color
+        treemap@cells, label_level, label_size, label_color, label_autoscale
       )
     }
 

diff --git a/R/drawUtils.R b/R/drawUtils.R
@@ -10,7 +10,7 @@
 #' @importFrom colorspace lighten
 #' @importFrom colorspace rainbow_hcl
 
-# function to coerce and rescale different types of input to 
+# function to coerce and rescale different types of input to
 # numeric range between 1 and 100 (for color coding)
 convertInput <- function(x, from = NULL, to = c(1, 100)) {
   if (is.character(x)) {
@@ -22,8 +22,8 @@ convertInput <- function(x, from = NULL, to = c(1, 100)) {
     }
   }
   if (is.numeric(x)) {
-    res <- scales::rescale(x, 
-      from = {if (!is.null(from)) from else range(x)}, 
+    res <- scales::rescale(x,
+      from = {if (!is.null(from)) from else range(x)},
       to = to) %>% round
     res <- replace(res, res > to[2], to[2])
     res <- replace(res, res < to[1], to[1])
@@ -68,21 +68,21 @@ drawRegions <- function(
   debug = FALSE,
   label = TRUE,
   label.col = grey(0.5),
-  lwd = 2, col = grey(0.8), 
+  lwd = 2, col = grey(0.8),
   fill = NA)
 {
   names <- result$names
   k <- result$k
   sites <- result$s
-  
+
   # draw polygon, pass graphical parameters to drawPoly function
   mapply(drawPoly, k, names, fill = fill,
     SIMPLIFY = FALSE,
     MoreArgs = list(lwd = lwd, col = col)
   )
-  
+
   if (label) {
-    
+
     # function to determine label sizes for each individual cell
     # based on cell dimension and label character length
     cex = sqrt(unlist(result$a)) * 0.01 / nchar(names)  %>%
@@ -93,7 +93,7 @@ drawRegions <- function(
       default = "native",
       gp = gpar(cex = cex, col = label.col)
     )
-    
+
   }
 }
 
@@ -106,7 +106,7 @@ draw_sector <- function(
   diameter_sector,
   name,
   custom_color) {
-  
+
   # compute_sector from lower and upper bounds and diameter arguments
   segment <- c(lower_bound, upper_bound) * 2 * pi
   a <- diameter_inner + (diameter_sector * (level - 1))
@@ -115,7 +115,7 @@ draw_sector <- function(
   yy <- c(a * sin(z), rev((a + diameter_sector) * sin(z)))
   # rescale for canvas dimensions [0, 2000] and convert into sfpoly polygon
   poly = to_sfpoly(list(x = (xx+1)*1000, y = (yy+1)*1000))
-  
+
   # return list of polygon properties
   list(
     name = name,
@@ -126,39 +126,44 @@ draw_sector <- function(
     level = level,
     custom_color = custom_color
   )
-  
+
 }
 
 # function to draw labels for voronoi treemap
 draw_label_voronoi <- function(
-  cells, 
-  label_level, 
+  cells,
+  label_level,
   label_size,
-  label_color
+  label_color,
+  label_autoscale
 ) {
-  
+
   for (tm_slot in rev(cells)) {
-    
+
     if (tm_slot$level %in% label_level) {
-      
+
       # determine label sizes for each individual cell
       # based on cell dimension and label character length
-      label_cex <- sqrt(tm_slot$area) / (100 * nchar(tm_slot$name)) %>% round(1)
-
+      if (label_autoscale) {
+        label_cex <- sqrt(tm_slot$area) / (100 * nchar(tm_slot$name)) %>% round(1)
+      } else {
+        label_cex <- 0.5
+      }
+
       # additionally scale labels size and color from supplied options
       if (length(label_size) == 1) {
         label_cex <- label_cex * label_size
       } else {
         label_cex <- label_cex * label_size[which(label_level %in% tm_slot$level)]
       }
-      
+
       # determine label color
       if (length(label_color) == 1) {
         label_col <- label_color
       } else {
         label_col <- label_color[which(label_level %in% tm_slot$level)]
       }
-      
+
       # draw labels
       grid::grid.text(
         tm_slot$name,
@@ -167,41 +172,41 @@ draw_label_voronoi <- function(
         default = "native",
         gp = gpar(cex = label_cex, col = label_col)
       )
-      
+
     }
   }
-  
+
 }
 
 
 # function to draw labels for sunburst treemap
 draw_label_sunburst <- function(
-  cells, 
-  label_level, 
+  cells,
+  label_level,
   label_size,
   label_color,
   diameter
 ) {
-  
+
   lapply(cells, function(tm_slot) {
-    
+
     if (tm_slot$level %in% label_level) {
-      
+
       # determine label size and color from supplied options
       if (length(label_size) > 1) {
         label_cex <- label_size[1]
         warning("'label_size' should only have length 1. Using first argument.")
       } else {
         label_cex <- label_size
       }
-      
+
       if (length(label_color) > 1) {
         label_col <- label_color[1]
         warning("'label_color' should only have length 1. Using first argument.")
       } else {
         label_col <- label_color
       }
-      
+
       # compute_sector from lower and upper bounds and diameter arguments
       segment <- c(tm_slot$lower_bound, tm_slot$upper_bound) * 2 * pi
       z <- seq(segment[1], segment[2], by = pi/400)
@@ -211,7 +216,7 @@ draw_label_sunburst <- function(
       d1 <- diameter+0.02
       d2 <- diameter+0.05
       d3 <- diameter+0.10
-      
+
       # draw label arcs
       z <- z[-c(1, length(z))]
       grid::grid.lines(
@@ -229,7 +234,7 @@ draw_label_sunburst <- function(
         default.units = "native",
         gp = gpar(lwd = label_cex, col = label_col)
       )
-      
+
       #draw label text
       grid::grid.text(
         label = substr(tm_slot$name, 1, 18),
@@ -239,17 +244,17 @@ draw_label_sunburst <- function(
         default.units = "native",
         gp = gpar(cex = label_cex, col = label_col)
       )
-      
+
     }
   }) %>% invisible
 }
 
 
 # function to add colors to a treemap object
-add_color <- function(treemap, color_palette = NULL, 
+add_color <- function(treemap, color_palette = NULL,
   color_type = "categorical", color_level = 1,
-  custom_range = NULL) {
-  
+  color_steps = 10, custom_range = NULL) {
+
   # CASE 1: CATEGORICAL
   if (color_type %in% c("categorical", "both")) {
     # determine number of required colors
@@ -260,29 +265,30 @@ add_color <- function(treemap, color_palette = NULL,
         unlist
     }
   }
-  
+
   # CASE 2: CELL AREA
   # determine total area
   total_area <- lapply(treemap@cells, function(tm_slot) {
     if (tm_slot$level %in% color_level) tm_slot$area
   }) %>% unlist %>% sum
   # determine number of required colors
   if (color_type == "cell_size") {
-    color_list <- lapply(treemap@cells, function(tm_slot) {
+    cell_sizes <- lapply(treemap@cells, function(tm_slot) {
       if (tm_slot$level %in% color_level) tm_slot$area/total_area
-    }) %>% unlist %>% pretty(n = 10)
+    }) %>% unlist
+    color_list <- cell_sizes %>% pretty(n = color_steps)
   }
-  
+
   # CASE 3: CUSTOM COLOR
   # 'custom_color' to use a color index supplied during treemap generation
   if (color_type == "custom_color") {
-    
+
     # determine number of required colors
     color_list <- lapply(treemap@cells, function(tm_slot) {
         if (tm_slot$level %in% color_level) tm_slot$custom_color
       }) %>% unlist %>% pretty(n = 10)
   }
-  
+
   # DEFINE PALETTE
   # generate palette with defined number of colors
   # use a custom data range if supplied by user (does not work for categorical)
@@ -295,7 +301,7 @@ add_color <- function(treemap, color_palette = NULL,
     pal <- colorRampPalette(color_palette)(length(color_list))
   }
   pal <- setNames(pal, color_list)
-  
+
   # ADD COLORS TO TREEMAP OBJECT
   treemap@cells <- lapply(treemap@cells, function(tm_slot) {
     if (tm_slot$level %in% color_level) {
@@ -314,7 +320,7 @@ add_color <- function(treemap, color_palette = NULL,
     }
     tm_slot
   })
-  
+
   # SPECIAL CASE "BOTH": DARKEN OR LIGHTEN LOWEST CELL LEVEL
   if (color_type == "both") {
     # get range of cell areas for lowest level
@@ -338,9 +344,9 @@ add_color <- function(treemap, color_palette = NULL,
       tm_slot
     })
   }
-  
+
   # return treemap with colors and palette
   treemap@call$palette <- pal
   treemap
-  
+
 }
diff --git a/README.Rmd b/README.Rmd
@@ -159,6 +159,7 @@ drawTreemap(tm, title = "treemap 4", label_size = 2,
   add = TRUE, layout = c(2, 2), position = c(2, 2),
   title_color = "black", legend = TRUE)
 ```
+
 ### Convergence time
 
 The expansion of cells towards a certain target size is a non-deterministic process. During each iteration, cell size is adjusted using weights, but the final result can only be measured after a cell (polygon) was created. Is it too small compared to the target area, it will get a higher weight for the next iteration, and *vice versa*. The adjustment of weights can be controlled by the `convergence` parameter ("slow", "intermediate", "fast"). Faster convergence will adjust weights more strongly and attempts to reach the target size with fewer iterations. However this procedure increases the probability of obtaining problematic polygons with for example self-intersections or holes. Compare the following treemaps generated with identical input except for the `convergence`.

diff --git a/README.md b/README.md
@@ -1,7 +1,7 @@
 WeightedTreemaps
 ================
 Michael Jahn, David Leslie, Ahmadou Dicko, Paul Murrell
-2024-11-04
+2024-11-20
 
 <!-- include logo-->
 
@@ -186,7 +186,8 @@ drawTreemap(tm, title = "treemap 4", label_size = 2,
 ```
 
 <img src="images/fig_cars_colors-1.png" width="100%" style="display: block; margin: auto;" />
-\### Convergence time
+
+### Convergence time
 
 The expansion of cells towards a certain target size is a
 non-deterministic process. During each iteration, cell size is adjusted