Масштабное событие onclick, напечатанное в консоли

Question

Я создал блестящее приложение с interactive legend, используя функцию scale_fill_manual_interactive из пакета Beautiful ggiraph. Тем не менее, я хотел бы напечатать информацию (мужской или женский, в зависимости от выбора) из события onclick в консоль. Вот фрагмент кода.

library(ggplot2)
library(ggiraph)

dat <- data.frame(
  name = c( "Guy", "Ginette", "David", "Cedric", "Frederic" ),
  gender = c( "Male", "Female", "Male", "Male", "Male" ),
  height = c(169, 160, 171, 172, 171 ) )

p <- ggplot(dat, aes( x = name, y = height, fill = gender,
                      data_id = name ) ) +
  geom_bar_interactive(stat = "identity")

p3 <- p +
  scale_fill_manual_interactive(
    name = label_interactive("gender", tooltip="Gender levels", data_id="legend.title"),
    values = c(Male = "#0072B2", Female = "#009E73"),
    data_id = function(breaks) { as.character(breaks)},
    tooltip = function(breaks) { as.character(breaks)},
    onclick = function(breaks) { cat( as.character(breaks)) }
  )
x <- girafe(ggobj = p3)
x <- girafe_options(x,
                    opts_hover_key(girafe_css("stroke:red", text="stroke:none;fill:red")))
if (interactive()) print(x)

теперь он печатает только весь список

Female Male

вместо только одного выбранного.

Answer 1

Это должно ответить на ваш вопрос. Он напечатает в консоли R последний нажатый ключ. Реактивное значение доступно для нажатия клавиши, его идентификатор plot_key_selected: идентификатор ggiraph + _key_selected

library(shiny)
library(ggplot2)
library(ggiraph)

gg <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, color = Species)) +
    geom_point_interactive( size = 3 ) + theme_minimal() +
    scale_colour_manual_interactive(
        data_id = c("setosa" = "setosa", "versicolor" = "versicolor", "virginica" = "virginica"),
        tooltip = c("setosa" = "setosa", "versicolor" = "versicolor", "virginica" = "virginica"),
        values = c("setosa" = "purple", "versicolor" = "blue", "virginica" = "darkgreen")
        )

ui <- fluidPage(

    sidebarLayout(
        sidebarPanel(
        ),
        mainPanel(
            ggiraph::ggiraphOutput("plot")
        )
    )
)

server <- function(input, output) {
    output$plot <- renderggiraph({
        x <- girafe(code = print(gg), width_svg = 6, height_svg = 8)
        x
    })
    observe({
        print(input$plot_key_selected)
    })
}

shinyApp(ui = ui, server = server)

Answer 2

Элемент onclick ожидает инструкции javascript. Это также означает, что это будет жить в вашем браузере, но не в R, следующее настраивает событие onclick так, чтобы консоль браузера получала инструкцию печати при нажатии элемента:

library(ggplot2)
library(ggiraph)

dat <- data.frame(
  name = c( "Guy", "Ginette", "David", "Cedric", "Frederic" ),
  gender = c( "Male", "Female", "Male", "Male", "Male" ),
  height = c(169, 160, 171, 172, 171 ) )

p <- ggplot(dat, aes( x = name, y = height, fill = gender,
                      data_id = name ) ) +
  geom_bar_interactive(stat = "identity")

p3 <- p +
  scale_fill_manual_interactive(
    name = label_interactive("gender", tooltip="Gender levels", data_id="legend.title"),
    values = c(Male = "#0072B2", Female = "#009E73"),
    data_id = function(breaks) { as.character(breaks)},
    tooltip = function(breaks) { as.character(breaks)},
    onclick = function(breaks) { sprintf("console.log(\"%s\")", breaks ) }
  )
x <- girafe(ggobj = p3)
x <- girafe_options(x,
                    opts_hover_key(girafe_css("stroke:red", text="stroke:none;fill:red")))
if (interactive()) print(x)