R ggplot2点击箱线图答案

【问题标题】：R ggplot2 click with boxplotR ggplot2点击箱线图
【发布时间】：2016-09-28 08:10:52
【问题描述】：

当我单击图表中的一个点时，该点会突出显示为红色。

但很快它又变黑了。

有什么方法可以保持选择吗？

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)

【问题讨论】：

标签： r ggplot2 shiny

【解决方案1】：

好的，我的方法与 Valter 的方法略有不同：选定的点变为红色，而您可以取消选择它们，它们会变回黑色。

实现这种效果的关键（甚至是 Valter 的回答，选择了 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)

【讨论】：

【解决方案2】：

我不确定是什么问题，但这是我想出的第一个解决方法：

            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)

告诉我...

【讨论】：