overhaul non-standard (maybe secondary) aesthetics for vector & isoli…

…ne geoms
corybrunson · Jan 23, 2025 · 32ce3a3 · 32ce3a3
1 parent bd96205
commit 32ce3a3
Show file tree

Hide file tree

Showing 71 changed files with 485 additions and 370 deletions.
diff --git a/R/geom-isoline.r b/R/geom-isoline.r
@@ -27,14 +27,9 @@
 #' - `vjust`
 #' - `family`
 #' - `fontface`
-#' - `text_colour`, `text_alpha`, `text_size`, `text_angle`,
 #' - `group`
 #' 
 
-#' The prefixed aesthetics `text_*` are used by the text elements and will
-#' inherit any values passed to their un-prefixed counterparts.
-#' 
-
 #' @import ggplot2
 #' @inheritParams ggplot2::layer
 #' @template param-geom
@@ -45,6 +40,9 @@
 #'   one.
 #' @param text_dodge Numeric; the orthogonal distance of the text from the axis
 #'   or isoline, as a proportion of the minimum of the plot width and height.
+#' @param text.size,text.angle,text.colour,text.color,text.alpha Default
+#'   aesthetics for tick mark labels. Set to NULL to inherit from the data's
+#'   aesthetics.
 #' @template return-layer
 #' @family geom layers
 #' @example inst/examples/ex-geom-isoline.r
@@ -55,6 +53,8 @@ geom_isoline <- function(
   by = NULL, num = NULL,
   text_dodge = .03,
   ...,
+  text.size = 3, text.angle = 0,
+  text.colour = NULL, text.color = NULL, text.alpha = NULL,
   parse = FALSE, check_overlap = FALSE,
   na.rm = FALSE,
   show.legend = NA, inherit.aes = TRUE
@@ -71,6 +71,10 @@ geom_isoline <- function(
       isoline_text = isoline_text,
       by = by, num = num,
       text_dodge = text_dodge,
+      text.size = text.size,
+      text.angle = text.angle,
+      text.colour = text.color %||% text.colour,
+      text.alpha = text.alpha,
       parse = parse,
       check_overlap = check_overlap,
       na.rm = na.rm,
@@ -93,12 +97,10 @@ GeomIsoline <- ggproto(
     # isoline
     colour = "black", alpha = .8,
     linewidth = .5, linetype = "dashed",
-    # mark needs
-    center = 0, scale = 1,
-    # isoline mark text
-    text_colour = "black", text_alpha = .8, text_size = 3, text_angle = 0,
     hjust = "inward", vjust = 1,
-    family = "", fontface = 1
+    family = "", fontface = 1,
+    # mark needs
+    center = 0, scale = 1
   ),
 
   setup_params = function(data, params) {
@@ -129,6 +131,8 @@ GeomIsoline <- ggproto(
     isoline_text = TRUE,
     by = NULL, num = NULL,
     text_dodge = .03,
+    text.size = 3, text.angle = 0,
+    text.colour = NULL, text.color = NULL, text.alpha = NULL,
     parse = FALSE, check_overlap = FALSE,
     na.rm = TRUE
   ) {
@@ -166,6 +170,11 @@ GeomIsoline <- ggproto(
 
     if (isoline_text) {
       text_data <- data
+      # specify independent aesthetics
+      text_data$size <- text.size %||% text_data$size
+      # text_data$angle <- text.angle %||% text_data$angle
+      text_data$colour <- text.colour %||% text_data$colour
+      text_data$alpha <- text.alpha %||% text_data$alpha
 
       # omit labels at origin
       text_data <- subset(text_data, x_t != 0 | y_t != 0)
@@ -181,14 +190,9 @@ GeomIsoline <- ggproto(
       # update text angle and put in degrees
       text_data <- transform(
         text_data,
-        angle = (atan(- 1 / tan(angle)) + text_angle) * 180 / pi
+        angle = (atan(- 1 / tan(angle)) + text.angle) * 180 / pi
       )
 
-      # specify aesthetics
-      text_data$colour <- text_data$text_colour
-      text_data$alpha <- text_data$text_alpha
-      text_data$size <- text_data$text_size
-
       # isoline text grobs
       grobs <- c(grobs, list(GeomText$draw_panel(
         data = text_data, panel_params = panel_params, coord = coord,

diff --git a/R/geom-vector.r b/R/geom-vector.r
@@ -31,9 +31,12 @@
 #' - `linetype`
 #' - `label`
 #' - `size`
-#' - `angle`, `hjust`, `vjust`
-#' - `label_colour`, `label_alpha`
-#' - `family`, `fontface`, `lineheight`
+#' - `angle`
+#' - `hjust`
+#' - `vjust`
+#' - `family`
+#' - `fontface`
+#' - `lineheight`
 #' - `group`
 #' 
 
@@ -47,6 +50,8 @@
 #'   `NULL` for no arrows.
 #' @param vector_labels Logical; whether to include labels radiating outward
 #'   from the vectors.
+#' @param label.colour,label.color,label.alpha Default aesthetics for labels.
+#'   Set to NULL to inherit from the data's aesthetics.
 #' @template return-layer
 #' @family geom layers
 #' @example inst/examples/ex-geom-vector.r
@@ -56,6 +61,8 @@ geom_vector <- function(
   arrow = default_arrow, lineend = "round", linejoin = "mitre",
   vector_labels = TRUE,
   ...,
+  label.colour = NULL, label.color = NULL, label.alpha = NULL,
+  parse = FALSE, check_overlap = FALSE,
   na.rm = FALSE,
   show.legend = NA, inherit.aes = TRUE
 ) {
@@ -70,6 +77,9 @@ geom_vector <- function(
     params = list(
       arrow = arrow, lineend = lineend, linejoin = linejoin,
       vector_labels = vector_labels,
+      label.colour = label.color %||% label.colour,
+      parse = parse,
+      check_overlap = check_overlap,
       na.rm = na.rm,
       ...
     )
@@ -89,7 +99,6 @@ GeomVector <- ggproto(
   default_aes = aes(
     colour = "black", linewidth = 0.5, linetype = 1, alpha = NA,
     label = "", size = 3.88, angle = 0, hjust = .5, vjust = .5,
-    label_colour = "black", label_alpha = NA,
     family = "", fontface = 1, lineheight = 1.2
   ),
 
@@ -106,6 +115,7 @@ GeomVector <- ggproto(
     data, panel_params, coord,
     vector_labels = TRUE,
     arrow = default_arrow, lineend = "round", linejoin = "mitre",
+    label.colour = NULL, label.alpha = NULL,
     parse = FALSE, check_overlap = FALSE,
     na.rm = FALSE
   ) {
@@ -128,11 +138,9 @@ GeomVector <- ggproto(
 
     if (vector_labels) {
       label_data <- data
-
-      # specify aesthetics (if necessary)
-      label_data$colour <- label_data$label_colour
-      label_data$alpha <- label_data$label_alpha
-      label_data$label_colour <- label_data$label_alpha <- NULL
+      # specify independent aesthetics
+      label_data$colour <- label.colour %||% label_data$colour
+      label_data$alpha <- label.alpha %||% label_data$alpha
 
       if (is.character(label_data$hjust)) {
         label_data$hjust <- compute_just(label_data$hjust, label_data$x)

diff --git a/R/zzz-biplot-geoms.r b/R/zzz-biplot-geoms.r
@@ -1039,6 +1039,11 @@ geom_rows_isoline <- function(
   num = NULL,
   text_dodge = 0.03,
   ...,
+  text.size = 3,
+  text.angle = 0,
+  text.colour = NULL,
+  text.color = NULL,
+  text.alpha = NULL,
   parse = FALSE,
   check_overlap = FALSE,
   na.rm = FALSE,
@@ -1049,7 +1054,9 @@ geom_rows_isoline <- function(
         geom = GeomIsoline, position = position, show.legend = show.legend, 
         inherit.aes = inherit.aes, params = list(isoline_text = isoline_text, 
             by = by, num = num, text_dodge = text_dodge, 
-            parse = parse, check_overlap = check_overlap, 
+            text.size = text.size, text.angle = text.angle, 
+            text.colour = text.color %||% text.colour, 
+            text.alpha = text.alpha, parse = parse, check_overlap = check_overlap, 
             na.rm = na.rm, ...))    
 
 }
@@ -1066,6 +1073,11 @@ geom_cols_isoline <- function(
   num = NULL,
   text_dodge = 0.03,
   ...,
+  text.size = 3,
+  text.angle = 0,
+  text.colour = NULL,
+  text.color = NULL,
+  text.alpha = NULL,
   parse = FALSE,
   check_overlap = FALSE,
   na.rm = FALSE,
@@ -1076,7 +1088,9 @@ geom_cols_isoline <- function(
         geom = GeomIsoline, position = position, show.legend = show.legend, 
         inherit.aes = inherit.aes, params = list(isoline_text = isoline_text, 
             by = by, num = num, text_dodge = text_dodge, 
-            parse = parse, check_overlap = check_overlap, 
+            text.size = text.size, text.angle = text.angle, 
+            text.colour = text.color %||% text.colour, 
+            text.alpha = text.alpha, parse = parse, check_overlap = check_overlap, 
             na.rm = na.rm, ...))    
 
 }
@@ -1265,6 +1279,11 @@ geom_rows_vector <- function(
   linejoin = "mitre",
   vector_labels = TRUE,
   ...,
+  label.colour = NULL,
+  label.color = NULL,
+  label.alpha = NULL,
+  parse = FALSE,
+  check_overlap = FALSE,
   na.rm = FALSE,
   show.legend = NA,
   inherit.aes = TRUE
@@ -1273,6 +1292,8 @@ geom_rows_vector <- function(
         geom = GeomVector, position = position, show.legend = show.legend, 
         inherit.aes = inherit.aes, params = list(arrow = arrow, 
             lineend = lineend, linejoin = linejoin, vector_labels = vector_labels, 
+            label.colour = label.color %||% label.colour, 
+            parse = parse, check_overlap = check_overlap, 
             na.rm = na.rm, ...))    
 
 }
@@ -1289,6 +1310,11 @@ geom_cols_vector <- function(
   linejoin = "mitre",
   vector_labels = TRUE,
   ...,
+  label.colour = NULL,
+  label.color = NULL,
+  label.alpha = NULL,
+  parse = FALSE,
+  check_overlap = FALSE,
   na.rm = FALSE,
   show.legend = NA,
   inherit.aes = TRUE
@@ -1297,6 +1323,8 @@ geom_cols_vector <- function(
         geom = GeomVector, position = position, show.legend = show.legend, 
         inherit.aes = inherit.aes, params = list(arrow = arrow, 
             lineend = lineend, linejoin = linejoin, vector_labels = vector_labels, 
+            label.colour = label.color %||% label.colour, 
+            parse = parse, check_overlap = check_overlap, 
             na.rm = na.rm, ...))    
 
 }