Fix #140: Add ability to disable automatic showSelected on legends

R/z_animint.R

@@ -58,7 +58,12 @@ parsePlot <- function(meta, plot, plot.name){
     class(L$mapping) <- "list"
 
     ## If any legends are specified, add showSelected aesthetic
+    ## Also updates legend$selector to NULL if user opts out (#140)
     L <- addShowSelectedForLegend(meta, plot.info$legend, L)
+    if(!is.null(L$legend)){
+      plot.info$legend <- L$legend
+      L$legend <- NULL
+    }
 
     ## Check if showSelected and clickSelects have been used as aesthetics
     ## If yes, raise error

R/z_animintHelpers.R

@@ -6,6 +6,10 @@
 #' @param L layer of the plot
 #' @return L : Layer with additional mapping to new aesthetic
 addShowSelectedForLegend <- function(meta, legend, L){
+  ## Check if user explicitly disabled showSelected with character()
+  ## If showSelected is character(0), user wants to opt out of auto-showSelected
+  user_disabled_showSelected <- is.character(L$extra_params$showSelected) &&
+    length(L$extra_params$showSelected) == 0
   for(legend.i in seq_along(legend)) {
     one.legend <- legend[[legend.i]]
     ## the name of the selection variable used in this legend.
@@ -26,39 +30,45 @@ addShowSelectedForLegend <- function(meta, legend, L){
       ## If s.name is used with another interactive aes, then do
       ## not add any showSelected aesthetic for it.
       var.is.interactive <- any(is.interactive.aes & is.legend.var)
-      if(!var.is.interactive){
+      ## Skip adding showSelected if user explicitly disabled it (#140)
+      if(!var.is.interactive && !user_disabled_showSelected){
         ## only add showSelected aesthetic if the variable is
         ## used by the geom
         type.vec <- one.legend$legend_type
         if(any(type.vec %in% names(L$mapping))){
           L$extra_params$showSelected <- c(L$extra_params$showSelected, s.name)
         }
+        ## if selector.types has not been specified, create it
+        if(is.null(meta$selector.types)) {
+          meta$selector.types <- list()
+        }
+        ## if selector.types is not specified for this variable, set
+        ## it to multiple.
+        if(is.null(meta$selector.types[[s.name]])) {
+          meta$selector.types[[s.name]] <- "multiple"
+          meta$selectors[[s.name]]$type <- "multiple"
+        }
+        ## if first is not specified, create it
+        if(is.null(meta$first)) {
+          meta$first <- list()
+        }
+        ## if first is not specified, add all to first
+        if(is.null(meta$first[[s.name]])) {
+          u.vals <- unique(var)
+        }
+        ## Tell this selector that it has a legend somewhere in the
+        ## viz. (if the selector has no interactive legend and no
+        ## clickSelects, then we show the widgets by default).
+        meta$selectors[[s.name]]$legend <- TRUE
+      }else if(user_disabled_showSelected){
+        ## User explicitly disabled showSelected, so clear legend selector (#140)
+        ## This makes the legend display-only (not interactive)
+        legend[[legend.i]]$selector <- NULL
       }
-      ## if selector.types has not been specified, create it
-      if(is.null(meta$selector.types)) {
-        meta$selector.types <- list()
-      }
-      ## if selector.types is not specified for this variable, set
-      ## it to multiple.
-      if(is.null(meta$selector.types[[s.name]])) {
-        meta$selector.types[[s.name]] <- "multiple"
-        meta$selectors[[s.name]]$type <- "multiple"
-      }
-      ## if first is not specified, create it
-      if(is.null(meta$first)) {
-        meta$first <- list()
-      }
-      ## if first is not specified, add all to first
-      if(is.null(meta$first[[s.name]])) {
-        u.vals <- unique(var)
-      }
-      ## Tell this selector that it has a legend somewhere in the
-      ## viz. (if the selector has no interactive legend and no
-      ## clickSelects, then we show the widgets by default).
-      meta$selectors[[s.name]]$legend <- TRUE
     }#length(s.name)
   }#legend.i
-  return(L)
+  L$legend <- legend
+  L
 }
 
 

tests/testthat/test-renderer2-legend-without-showSelected.R

@@ -0,0 +1,48 @@
+acontext("legend without showSelected")
+## Test for issue #140: legend forces showSelected, no way to opt out
+## https://github.com/animint/animint2/issues/140
+##
+## The problem: when using aes(color=variable), animint2 automatically:
+## 1. Creates a legend (good)
+## 2. Adds showSelected behavior so clicking legend filters data (unwanted)
+##
+## Users want option 4: legend visible but NO showSelected filtering.
+## Create test data similar to the issue example
+test_data <- data.frame(
+  x = c(-10, -8, -6, -4, -2, -10, -8, -6, -4, -2),
+  y = c(0.1, 0.2, 0.15, 0.25, 0.3, 0.05, 0.1, 0.08, 0.12, 0.15),
+  comparison = rep(c("control", "treatment"), each = 5),
+  facet_var = rep(c("all", "other"), 5)
+)
+test_that("default: legend with color aesthetic creates selector for interactivity", {
+  viz <- list(
+    plot1 = ggplot(test_data, aes(x, y, color = comparison)) +
+      geom_point() +
+      facet_wrap(~facet_var)
+  )
+  info <- animint2dir(viz, open.browser = FALSE)
+  legend_info <- info$plots$plot1$legend$comparison
+  ## Legend should exist with entries
+  expect_false(is.null(legend_info))
+  expect_true(length(legend_info$entries) > 0)
+  ## Selector should be created (current default behavior)
+  expect_identical(legend_info$selector, "comparison")
+  expect_true("comparison" %in% names(info$selectors))
+})
+test_that("showSelected=character() should allow legend without selector", {
+  ## Proposed API: empty character vector disables auto showSelected from legend
+  ## This is consistent with existing API where showSelected accepts character vectors
+  viz_no_ss <- list(
+    plot1 = ggplot(test_data, aes(x, y, color = comparison)) +
+      geom_point(showSelected = character()) +
+      facet_wrap(~facet_var)
+  )
+  info <- animint2dir(viz_no_ss, open.browser = FALSE)
+  legend_info <- info$plots$plot1$legend$comparison
+  ## Legend should STILL exist and render with entries
+  expect_false(is.null(legend_info))
+  expect_true(length(legend_info$entries) > 0)
+  ## But selector should NOT be created - legend is display-only
+  expect_null(legend_info$selector)
+  expect_false("comparison" %in% names(info$selectors))
+})