feat: add girafe_class_add/remove/toggle for CSS class manipulation

See #321

Author: davidgohel

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: ggiraph
 Title: Make 'ggplot2' Graphics Interactive
-Version: 0.9.5.003
+Version: 0.9.5.004
 Authors@R: c(
     person("David", "Gohel", , "david.gohel@ardata.fr", role = c("aut", "cre")),
     person("Panagiotis", "Skintzos", , "sigmapi@posteo.net", role = "aut"),
@@ -117,6 +117,7 @@ Collate:
     'geom_vline_interactive.R'
     'ggiraph.R'
     'girafe.R'
+    'girafe_class.R'
     'grob_interactive.R'
     'guide_bins_interactive.R'
     'guide_colourbar_interactive.R'

NAMESPACE

@@ -128,6 +128,9 @@ export(ggiraph)
 export(ggiraphOutput)
 export(girafe)
 export(girafeOutput)
+export(girafe_class_add)
+export(girafe_class_remove)
+export(girafe_class_toggle)
 export(girafe_css)
 export(girafe_css_bicolor)
 export(girafe_defaults)

NEWS.md

@@ -2,6 +2,10 @@
 
 ## Feature
 
+- New functions `girafe_class_add()`, `girafe_class_remove()` and
+`girafe_class_toggle()` allow programmatic manipulation of CSS classes
+on girafe SVG elements from Shiny. Elements are targeted by `data_id`,
+`key_id` or `theme_id` (#321).
 - `opts_hover()` and `opts_selection()` gain a new `linked` parameter. When
 `linked = TRUE`, hover and selection states are shared between geometry
 elements (`data-id`) and legend/guide elements (`key-id`): hovering or

R/girafe_class.R

@@ -0,0 +1,73 @@
+#' @title Add, remove or toggle CSS classes on girafe elements
+#'
+#' @description
+#' These functions allow programmatic manipulation of CSS classes
+#' on SVG elements within a girafe output in Shiny applications.
+#' Elements are targeted by their `data-id`, `key-id`, or `theme-id`
+#' attributes.
+#'
+#' @param session The Shiny session object.
+#' @param id The output id of the girafe element
+#'   (the `outputId` used in [girafeOutput()]).
+#' @param class A non-empty character string of CSS class names to
+#'   add, remove, or toggle.
+#' @param data_id A character vector of `data-id` values identifying
+#'   the target elements.
+#' @param key_id A character vector of `key-id` values identifying
+#'   the target elements.
+#' @param theme_id A character vector of `theme-id` values identifying
+#'   the target elements.
+#'
+#' @details
+#' At least one of `data_id`, `key_id`, or `theme_id` must be provided.
+#'
+#' These functions send a custom message to the JavaScript side,
+#' which applies the CSS class operation to all matching SVG elements
+#' within the girafe root node.
+#'
+#' @examples
+#' \dontrun{
+#' # In a Shiny server function:
+#' girafe_class_add(session, "plot", "highlighted", data_id = "some_id")
+#' girafe_class_remove(session, "plot", "highlighted", data_id = "some_id")
+#' girafe_class_toggle(session, "plot", "highlighted", data_id = "some_id")
+#' }
+#' @name girafe_class
+NULL
+
+#' @rdname girafe_class
+#' @export
+girafe_class_add <- function(session, id, class, data_id = NULL, key_id = NULL, theme_id = NULL) {
+  girafe_class_action(session, id, class, action = "add", data_id = data_id, key_id = key_id, theme_id = theme_id)
+}
+
+#' @rdname girafe_class
+#' @export
+girafe_class_remove <- function(session, id, class, data_id = NULL, key_id = NULL, theme_id = NULL) {
+  girafe_class_action(session, id, class, action = "remove", data_id = data_id, key_id = key_id, theme_id = theme_id)
+}
+
+#' @rdname girafe_class
+#' @export
+girafe_class_toggle <- function(session, id, class, data_id = NULL, key_id = NULL, theme_id = NULL) {
+  girafe_class_action(session, id, class, action = "toggle", data_id = data_id, key_id = key_id, theme_id = theme_id)
+}
+
+girafe_class_action <- function(session, id, class, action, data_id = NULL, key_id = NULL, theme_id = NULL) {
+  if (!is.character(class) || length(class) != 1 || !nzchar(class)) {
+    stop("`class` must be a non-empty string.", call. = FALSE)
+  }
+  if (is.null(data_id) && is.null(key_id) && is.null(theme_id)) {
+    stop("At least one of `data_id`, `key_id`, or `theme_id` must be provided.", call. = FALSE)
+  }
+
+  message <- list(action = action, cls = class)
+  if (!is.null(data_id)) message$data_id <- as.character(data_id)
+  if (!is.null(key_id)) message$key_id <- as.character(key_id)
+  if (!is.null(theme_id)) message$theme_id <- as.character(theme_id)
+
+  session$sendCustomMessage(
+    type = paste0(id, "_class"),
+    message = message
+  )
+}

inst/examples/shiny/css_class/DESCRIPTION

@@ -0,0 +1,7 @@
+Title: CSS class manipulation
+Author: David Gohel
+AuthorUrl: https://www.ardata.fr
+License: GPL-3
+DisplayMode: Showcase
+Tags: girafe-class
+Type: Shiny

inst/examples/shiny/css_class/Readme.md

@@ -0,0 +1,5 @@
+This Shiny application demonstrates `girafe_class_add()`, `girafe_class_remove()` and `girafe_class_toggle()`.
+
+Use the text input to type a state name (e.g. "florida"), then click
+"Add class", "Remove class" or "Toggle class" to manipulate the
+`highlighted` CSS class on the corresponding point.

inst/examples/shiny/css_class/server.R

@@ -0,0 +1,55 @@
+library(ggplot2)
+library(ggiraph)
+
+crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
+
+gg_crime <- ggplot(crimes, aes(x = Murder, y = Assault, colour = UrbanPop)) +
+  geom_point_interactive(
+    aes(data_id = state, tooltip = state), size = 3,
+    hover_nearest = TRUE
+  ) +
+  scale_colour_gradient(low = "#999999", high = "orange") +
+  theme_minimal()
+
+shinyServer(function(input, output, session) {
+
+  output$plot <- renderGirafe({
+    girafe(
+      code = print(gg_crime),
+      width_svg = 6, height_svg = 5,
+      options = list(
+        opts_hover(css = "cursor:pointer;", reactive = TRUE)
+      )
+    )
+  })
+
+  output$console <- renderPrint({
+    input$plot_hovered
+  })
+
+  get_ids <- reactive({
+    ids <- trimws(unlist(strsplit(input$data_ids, ",")))
+    ids[nzchar(ids)]
+  })
+
+  observeEvent(input$btn_add, {
+    ids <- get_ids()
+    if (length(ids) > 0) {
+      girafe_class_add(session, "plot", "highlighted", data_id = ids)
+    }
+  })
+
+  observeEvent(input$btn_remove, {
+    ids <- get_ids()
+    if (length(ids) > 0) {
+      girafe_class_remove(session, "plot", "highlighted", data_id = ids)
+    }
+  })
+
+  observeEvent(input$btn_toggle, {
+    ids <- get_ids()
+    if (length(ids) > 0) {
+      girafe_class_toggle(session, "plot", "highlighted", data_id = ids)
+    }
+  })
+})

inst/examples/shiny/css_class/ui.R

@@ -0,0 +1,28 @@
+shinyUI(fluidPage(
+  tags$h1("girafe CSS class demo"),
+
+  tags$style(HTML(
+    ".highlighted { fill: red !important; stroke: black !important; r: 8 !important; }"
+  )),
+
+  fluidRow(
+    column(
+      width = 7,
+      ggiraph::girafeOutput("plot")
+    ),
+    column(
+      width = 5,
+      h4("Class manipulation"),
+      textInput("data_ids", label = "data-id values (comma separated)",
+                value = "florida, texas"),
+      fluidRow(
+        column(4, actionButton("btn_add", label = "Add class")),
+        column(4, actionButton("btn_remove", label = "Remove class")),
+        column(4, actionButton("btn_toggle", label = "Toggle class"))
+      ),
+      hr(),
+      h4("Current selection (hover)"),
+      verbatimTextOutput("console")
+    )
+  )
+))