fix(viz): visual-review defects across 41 charts

.gitignore

@@ -24,5 +24,6 @@ coverage/
 /screenshots
 /screenshots-review
 review-home.png
-/scripts
+/scripts/*
+!/scripts/screenshot-all.js
 /md

NAMESPACE

@@ -31,6 +31,7 @@ export(setExportOptions)
 export(setFacet)
 export(setKeyframe)
 export(setLayerOpacity)
+export(setLegendTitle)
 export(setLinked)
 export(setLinkedCursor)
 export(setMargin)

R/addIoLayer.R

@@ -4,7 +4,10 @@
 #'
 #' @param myIO an htmlwidget object created by the \code{myIO()} function
 #' @param type chart type
-#' @param color optional CSS color string or vector for grouped layers
+#' @param color optional CSS color string or vector for grouped layers. For
+#'   \code{type = "regression"} the first element colors the raw scatter and the
+#'   optional second element colors the fitted line and confidence band; supply
+#'   the same color twice to render data and model in a single hue.
 #' @param label unique layer label
 #' @param data data frame backing the layer
 #' @param mapping named aesthetic mapping list
@@ -93,6 +96,13 @@ addIoLayer <- function(myIO,
     if (!is.null(tick_labels)) {
       myIO$x$config$axes$xTickLabels <- tick_labels
     }
+    y_tick_labels <- derive_positional_y_tick_labels(type, sub_layers)
+    if (!is.null(y_tick_labels)) {
+      myIO$x$config$axes$yTickLabels <- y_tick_labels
+      if (is.null(myIO$x$config$axes$yAxisLabel) && !is.null(mapping$group)) {
+        myIO$x$config$axes$yAxisLabel <- mapping$group
+      }
+    }
     for (i in seq_along(sub_layers)) {
       sl <- sub_layers[[i]]
       sl_mapping <- inject_transform_mapping(sl$transform, sl$mapping)
@@ -160,7 +170,7 @@ addIoLayer <- function(myIO,
 build_layer <- function(layer_type, layer_label, layer_data, layer_mapping, layer_color,
                         layer_transform_meta, options, transform, layer_id, order,
                         derived_from = NULL, composite = NULL, composite_role = NULL,
-                        scale_hints = NULL) {
+                        scale_hints = NULL, group_var = NULL) {
   layer <- list(
     id = if (order == 1L) layer_id else sprintf("%s_sub_%02d", layer_id, order),
     type = layer_type,
@@ -184,6 +194,12 @@ build_layer <- function(layer_type, layer_label, layer_data, layer_mapping, laye
   if (!is.null(scale_hints)) {
     layer$scaleHints <- scale_hints
   }
+  # Marks a layer whose label IS a value of `group_var`. Composite sub-layers
+  # carry mapping$group too but their labels are not bare group values, so they
+  # deliberately never get this field.
+  if (!is.null(group_var)) {
+    layer$groupVar <- group_var
+  }
   layer
 }
 
@@ -230,6 +246,48 @@ derive_positional_x_tick_labels <- function(type, sub_layers) {
   stats::setNames(as.list(labels), positions)
 }
 
+derive_positional_y_tick_labels <- function(type, sub_layers) {
+  if (!identical(type, "ridgeline")) {
+    return(NULL)
+  }
+
+  positions <- character()
+  labels <- character()
+  for (sl in sub_layers) {
+    if (is.null(sl$data) || is.null(sl$mapping$low_y) || is.null(sl$mapping$group)) {
+      next
+    }
+    y_col <- sl$mapping$low_y
+    group_col <- sl$mapping$group
+    if (!(y_col %in% names(sl$data)) || !(group_col %in% names(sl$data))) {
+      next
+    }
+    y_values <- suppressWarnings(as.numeric(sl$data[[y_col]]))
+    group_values <- sl$data[[group_col]]
+    keep <- !is.na(y_values) & abs(y_values - round(y_values)) < 1e-9 & !is.na(group_values)
+    if (!any(keep)) {
+      next
+    }
+    positions <- c(positions, as.character(y_values[keep]))
+    labels <- c(labels, as.character(group_values[keep]))
+  }
+
+  if (length(positions) == 0L) {
+    return(NULL)
+  }
+
+  first_seen <- !duplicated(positions)
+  positions <- positions[first_seen]
+  labels <- labels[first_seen]
+  numeric_positions <- suppressWarnings(as.numeric(positions))
+  if (all(!is.na(numeric_positions))) {
+    order_idx <- order(numeric_positions)
+    positions <- positions[order_idx]
+    labels <- labels[order_idx]
+  }
+  stats::setNames(as.list(labels), positions)
+}
+
 validate_layer_inputs <- function(type, transform, mapping, label, data, existing_layers) {
   if (!is.character(type) || length(type) != 1 || is.na(type) || !(type %in% ALLOWED_TYPES)) {
     msg <- paste0("addIoLayer(): Unknown layer type '", paste(type, collapse = ", "), "'. Must be one of: ",
@@ -405,8 +463,13 @@ build_grouped_layers <- function(data, mapping, type, label, color, transform_fn
 
   for (index in seq_along(group_list)) {
     group_value <- group_list[[index]]
-    layer_label <- paste0(label, " \u2014 ", as.character(group_value))
+    layer_label <- as.character(group_value)
     all_labels <- c(existing_labels, vapply(layers, function(layer) layer$label, character(1)))
+    if (layer_label %in% all_labels) {
+      # Fall back to the legacy "<label> - <group>" form when the bare group
+      # value would collide with a layer already on the chart.
+      layer_label <- paste0(label, " \u2014 ", as.character(group_value))
+    }
     if (layer_label %in% all_labels) {
       stop("addIoLayer(): Layer label '", layer_label, "' already exists.", call. = FALSE)
     }
@@ -424,7 +487,8 @@ build_grouped_layers <- function(data, mapping, type, label, color, transform_fn
       transform = transform,
       layer_id = layer_id,
       order = index,
-      derived_from = layer_id
+      derived_from = layer_id,
+      group_var = mapping$group
     )
   }
 

R/composite_boxplot.R

@@ -8,58 +8,66 @@ composite_boxplot <- function(data, mapping, label, color, options) {
   base_color <- if (is.null(color)) OKABE_ITO_PALETTE[[1]] else if (length(color) > 0) color[[1]] else OKABE_ITO_PALETTE[[1]]
 
   quantiles <- transform_quantiles(data, mapping, options)$data
-  groups <- as.character(quantiles[[mapping$x_var]])
+  # Positions follow the shared rule (factor levels win, else ascending, C
+  # locale for characters) so boxplot, violin and ridgeline agree.
+  groups <- as.character(order_group_values(unique(data[[mapping$x_var]])))
   positions <- seq_along(groups)
   position_lookup <- stats::setNames(positions, groups)
+  # transform_quantiles() and transform_median() each derive their own row
+  # order from unique(x_values), which is data-encounter order. Index them by
+  # group NAME, never by position: a positional read would pair one group's
+  # box with another group's median.
+  quantile_idx <- match(groups, as.character(quantiles[[mapping$x_var]]))
 
   if (whisker_type == "minmax") {
     group_values <- lapply(groups, function(group_value) {
-      values <- data[data[[mapping$x_var]] == group_value, mapping$y_var]
+      values <- data[as.character(data[[mapping$x_var]]) == group_value, mapping$y_var]
       values <- values[!is.na(values)]
       c(whisker_low = min(values), whisker_high = max(values))
     })
     whisker_df <- do.call(rbind, group_values)
   } else {
-    whisker_df <- quantiles[, c("whisker_low", "whisker_high"), drop = FALSE]
+    whisker_df <- quantiles[quantile_idx, c("whisker_low", "whisker_high"), drop = FALSE]
   }
 
   median_df <- transform_median(data, mapping, options)$data
+  median_idx <- match(groups, as.character(median_df[[mapping$x_var]]))
   outliers_df <- transform_outliers(data, mapping, options)$data
 
   box_data <- data.frame(
     x_var = positions,
-    low_y = quantiles$q1,
-    high_y = quantiles$q3,
+    low_y = quantiles$q1[quantile_idx],
+    high_y = quantiles$q3[quantile_idx],
     group = groups,
     stringsAsFactors = FALSE,
     check.names = FALSE
   )
 
   whisker_low_data <- data.frame(
     x_var = positions,
-    y_var = whisker_df$whisker_low,
-    low_y = whisker_df$whisker_low,
-    high_y = quantiles$q1,
+    y_var = whisker_df[, "whisker_low"],
+    low_y = whisker_df[, "whisker_low"],
+    high_y = quantiles$q1[quantile_idx],
     group = groups,
     stringsAsFactors = FALSE,
     check.names = FALSE
   )
 
   whisker_high_data <- data.frame(
     x_var = positions,
-    y_var = whisker_df$whisker_high,
-    low_y = quantiles$q3,
-    high_y = whisker_df$whisker_high,
+    y_var = whisker_df[, "whisker_high"],
+    low_y = quantiles$q3[quantile_idx],
+    high_y = whisker_df[, "whisker_high"],
     group = groups,
     stringsAsFactors = FALSE,
     check.names = FALSE
   )
 
   median_plot_data <- data.frame(
     x_var = positions,
-    y_var = median_df[[mapping$y_var]],
-    low_y = median_df[[mapping$y_var]],
-    high_y = median_df[[mapping$y_var]],
+    y_var = median_df[[mapping$y_var]][median_idx],
+    low_y = median_df[[mapping$y_var]][median_idx],
+    high_y = median_df[[mapping$y_var]][median_idx],
     group = groups,
     stringsAsFactors = FALSE,
     check.names = FALSE

R/composite_qq.R

@@ -12,7 +12,7 @@ composite_qq <- function(data, mapping, label, color, options) {
     sublayers <- list()
     for (idx in seq_along(group_vals)) {
       group_data <- data[data[[mapping$group]] == group_vals[idx], , drop = FALSE]
-      group_label <- paste0(label, " \u2014 ", as.character(group_vals[idx]))
+      group_label <- as.character(group_vals[idx])
       sublayers <- c(sublayers,
         build_qq_sublayers(group_data, mapping, group_label, colors[idx], options, show_envelope))
     }

R/composite_regression.R

@@ -18,12 +18,25 @@ composite_regression <- function(data, mapping, label, color, options) {
     group_vals <- list(NULL)
   }
 
+  # Raw data and fitted model take distinct hues from the package palette so the
+  # scatter, the fit line, and the uncertainty band are visually separable.
+  # A second element in `color` is the explicit model/band color.
+  data_color <- if (is.null(color)) OKABE_ITO_PALETTE[[1L]] else as.character(color)[[1L]]
+  model_color <- if (!is.null(color) && length(color) >= 2L) {
+    as.character(color)[[2L]]
+  } else if (identical(tolower(data_color), tolower(OKABE_ITO_PALETTE[[5L]]))) {
+    OKABE_ITO_PALETTE[[6L]]
+  } else {
+    OKABE_ITO_PALETTE[[5L]]
+  }
+  band_opacity <- if (is.null(options$areaOpacity)) 0.18 else options$areaOpacity
+
   sublayers <- list()
 
   for (gv in group_vals) {
     if (!is.null(gv)) {
       group_data <- data[data[[mapping$group]] == gv, , drop = FALSE]
-      group_label <- paste0(label, " \u2014 ", as.character(gv))
+      group_label <- as.character(gv)
     } else {
       group_data <- data
       group_label <- label
@@ -34,15 +47,15 @@ composite_regression <- function(data, mapping, label, color, options) {
       type = "point", role = "scatter",
       label = paste0(group_label, " (data)"),
       data = group_data, mapping = mapping, transform = "identity",
-      color = color, options = list()
+      color = data_color, options = list()
     )
 
     # 2. Trend line
     sublayers[[length(sublayers) + 1L]] <- list(
       type = "line", role = "trend",
       label = paste0(group_label, " (trend)"),
       data = group_data, mapping = mapping, transform = method,
-      color = color, options = options
+      color = model_color, options = options
     )
 
     # 3. CI band
@@ -54,9 +67,10 @@ composite_regression <- function(data, mapping, label, color, options) {
         mapping = list(x_var = mapping$x_var, y_var = mapping$y_var,
                        low_y = "low_y", high_y = "high_y"),
         transform = "ci",
-        color = color,
+        color = model_color,
         options = list(method = method, level = level, interval = interval,
-                       span = options$span, degree = options$degree)
+                       span = options$span, degree = options$degree,
+                       areaOpacity = band_opacity)
       )
     }
 

R/composite_ridgeline.R

@@ -4,7 +4,10 @@
 composite_ridgeline <- function(data, mapping, label, color, options) {
   overlap <- if (is.null(options$overlap)) 0.4 else as.numeric(options$overlap)
   bandwidth <- options$bandwidth
-  group_values <- unique(data[[mapping$group]])
+  # Ridges stack upward from baseline 1, so the first group renders at the
+  # bottom. order_group_values() defines the shared rule: factor level order
+  # wins, everything else sorts ascending, character sorting in the C locale.
+  group_values <- order_group_values(unique(data[[mapping$group]]))
   group_labels <- as.character(group_values)
   n_groups <- length(group_labels)
   group_colors <- if (is.null(color)) rep_len(OKABE_ITO_PALETTE, n_groups) else rep_len(color, n_groups)

R/composite_survfit.R

@@ -20,7 +20,7 @@ composite_survfit <- function(data, mapping, label, color, options) {
   for (gv in group_vals) {
     if (!is.null(gv)) {
       group_data <- data[data[[mapping$group]] == gv, , drop = FALSE]
-      group_label <- paste0(label, " \u2014 ", as.character(gv))
+      group_label <- as.character(gv)
     } else {
       group_data <- data
       group_label <- label

R/composite_violin.R

@@ -7,7 +7,7 @@ composite_violin <- function(data, mapping, label, color, options) {
   show_points <- isTRUE(options$showPoints)
   bandwidth <- options$bandwidth
   box_half_width <- if (is.null(options$boxWidth)) 0.35 else as.numeric(options$boxWidth) / 2
-  group_values <- unique(data[[mapping$x_var]])
+  group_values <- order_group_values(unique(data[[mapping$x_var]]))
   group_labels <- as.character(group_values)
   positions <- seq_along(group_labels)
   position_lookup <- stats::setNames(positions, group_labels)
@@ -96,6 +96,8 @@ composite_violin <- function(data, mapping, label, color, options) {
     median_points <- data.frame(
       x_var = unname(position_lookup[median_groups]),
       y_var = median_df[[mapping$y_var]],
+      low_y = median_df[[mapping$y_var]],
+      high_y = median_df[[mapping$y_var]],
       group = median_groups,
       stringsAsFactors = FALSE,
       check.names = FALSE
@@ -104,7 +106,7 @@ composite_violin <- function(data, mapping, label, color, options) {
     layers[[length(layers) + 1L]] <- list(
       type = "point",
       data = median_points,
-      mapping = list(x_var = "x_var", y_var = "y_var", group = "group"),
+      mapping = list(x_var = "x_var", y_var = "y_var", low_y = "low_y", high_y = "high_y", group = "group"),
       transform = "identity",
       label = paste0(label, " - median"),
       color = group_colors[[1]],

R/expand_grouped_df.R

@@ -37,11 +37,19 @@ expand_grouped_df <- function(myIO, type, color, label, data, mapping, transform
     colors <- rep_len(color, n_groups)
   }
 
+  existing_labels <- vapply(myIO$x$config$layers, function(layer) layer$label, character(1))
+
+  n_before <- length(myIO$x$config$layers)
+
   for (i in seq_len(n_groups)) {
     key_row <- group_keys[i, , drop = FALSE]
     group_label_parts <- vapply(group_vars, function(v) as.character(key_row[[v]]), character(1))
     group_suffix <- paste(group_label_parts, collapse = " / ")
-    layer_label <- paste0(label, " \u2014 ", group_suffix)
+    layer_label <- group_suffix
+    if (layer_label %in% existing_labels) {
+      layer_label <- paste0(label, " \u2014 ", group_suffix)
+    }
+    existing_labels <- c(existing_labels, layer_label)
 
     # Subset rows matching this group key
     mask <- rep(TRUE, nrow(ungrouped))
@@ -62,5 +70,15 @@ expand_grouped_df <- function(myIO, type, color, label, data, mapping, transform
     )
   }
 
+  # One added layer per group means every new label is a bare group value, so
+  # the grouping variable names them all. Composite types expand to several
+  # layers per group; their labels are not group values, so they are skipped.
+  if (n_groups > 0L && length(myIO$x$config$layers) - n_before == n_groups) {
+    group_var <- paste(group_vars, collapse = " / ")
+    for (j in seq_len(n_groups)) {
+      myIO$x$config$layers[[n_before + j]]$groupVar <- group_var
+    }
+  }
+
   myIO
 }

R/linkCharts.R

@@ -5,6 +5,11 @@
 #' this does not require Crosstalk --- it uses a shared group identifier and key
 #' column to coordinate selections across charts rendered in the same page.
 #'
+#' @details Cross-selection is driven by the brush, so at least one linked
+#'   chart must also call \code{\link{setBrush}}; brushing that chart
+#'   propagates the selected \code{on} values to every other chart in the
+#'   group, which dim their non-matching marks.
+#'
 #' @param ... myIO widget objects to link.
 #' @param on Character. Column name to match rows across charts.
 #' @param group Character. Group identifier. Default auto-generated.
@@ -45,7 +50,7 @@ linkCharts <- function(..., on, group = NULL, cursor = FALSE, cursorAxis = "x")
       enabled = TRUE,
       keyColumn = on,
       group = group,
-      mode = "bidirectional",
+      mode = "both",
       cursor = cursor,
       cursorAxis = cursorAxis
     )