R ggplot2 click with boxplot

When I click one point on the chart, that point is highlighted in red.

But he soon returns to black.

Is there a way to keep the selection?

library(shiny) library(ggplot2) server <- function(input, session, output) { mtcars$cyl = as.character(mtcars$cyl) D = reactive({ nearPoints(mtcars, input$click_1,allRows = TRUE) }) output$plot_1 = renderPlot({ set.seed(123) ggplot(D(),aes(x=cyl,y=mpg)) + geom_boxplot(outlier.shape = NA) + geom_jitter(aes(color=selected_),width=0.02,size=4)+ scale_color_manual(values = c("black","red"),guide=FALSE) }) output$info = renderPrint({ D() }) } ui <- fluidPage( plotOutput("plot_1",click = clickOpts("click_1")), verbatimTextOutput("info") ) shinyApp(ui = ui, server = server) 
+5
source share
2 answers

Well, my approach is a little different from Valter's: the selected dots turn red while you can cancel them and they go back to black.

The key to achieving this effect (or even Valter's answer with 1 selected point) is to use reactiveValues to track selected points.

 library(shiny) library(ggplot2) server <- function(input, session, output) { mtcars$cyl = as.character(mtcars$cyl) vals <- reactiveValues(clicked = numeric()) observeEvent(input$click_1, { # Selected point/points slt <- which(nearPoints(mtcars, input$click_1,allRows = TRUE)$selected) # If there are nearby points selected: # add point if it wasn't clicked # remove point if it was clicked earlier # Else do nothing if(length(slt) > 0){ remove <- slt %in% vals$clicked vals$clicked <- vals$clicked[!vals$clicked %in% slt[remove]] vals$clicked <- c(vals$clicked, slt[!remove]) } }) D = reactive({ # If row is selected return "Yes", else return "No" selected <- ifelse(1:nrow(mtcars) %in% vals$clicked, "Yes", "No") cbind(mtcars, selected) }) output$plot_1 = renderPlot({ set.seed(123) ggplot(D(),aes(x=cyl,y=mpg)) + geom_boxplot(outlier.shape = NA) + geom_jitter(aes(color=selected),width=0.02,size=4)+ scale_color_manual(values = c("black","red"),guide=FALSE) }) output$info = renderPrint({ D() }) } ui <- fluidPage( plotOutput("plot_1",click = clickOpts("click_1")), verbatimTextOutput("info") ) shinyApp(ui = ui, server = server) 
+2
source

I'm not sure what the problem is, but this is the first workaround I came up with:

  library(shiny) library(ggplot2) server <- function(input, session, output) { mtcars$cyl = as.character(mtcars$cyl) df <- reactiveValues(dfClikced = mtcars) observe({ if (!is.null(input$click_1)) { df$dfClikced <- nearPoints(mtcars, input$click_1, allRows = TRUE) }}) output$plot_1 = renderPlot({ set.seed(123) if (names(df$dfClikced)[NCOL(df$dfClikced)]== "selected_") { ggplot(df$dfClikced,aes(x=cyl,y=mpg)) + geom_boxplot(outlier.shape = NA) + geom_jitter(aes(color=selected_),width=0.02,size=4)+ scale_color_manual(values = c("black","red"),guide=FALSE) } else { ggplot(df$dfClikced,aes(x=cyl,y=mpg)) + geom_boxplot(outlier.shape = NA) + geom_jitter(width=0.02,size=4)+ scale_color_manual(values = c("black","red"),guide=FALSE) } }) output$info = renderPrint({ df$dfClikced }) } ui <- fluidPage( plotOutput("plot_1",click = clickOpts("click_1")), verbatimTextOutput("info") ) shinyApp(ui = ui, server = server) 

let me know...

+1
source

Source: https://habr.com/ru/post/1257376/


All Articles