R ggplot2 click with boxplot

Question

Когда я нажимаю одну точку на диаграмме, эта точка подсвечивается красным цветом.

Но вскоре он возвращается к черному.

Есть ли способ провести выбор?

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) 

Answer 1

Я не уверен, что это проблема, но это первый обходной путь я пришел к:

  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) 

дайте мне знать ...

Answer 2

Хорошо, мой подход немного отличается от Valter's: выбранные точки становятся красными, в то время как вы можете отменить их, и они вернутся к черному.

Ключом для достижения этого эффекта (или даже ответа Валтера с 1 выбранной точкой) является использование reactiveValues для отслеживания выбранных точек.

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)