Question

我是新手，并希望跟进我以前的一个问题： Add reactive values from click events to existing data frame and update plot. 我已经更新了代码，但似乎不明白我应该如何进行。到目前为止，我提供了一些帮助，使应用程序使用点击数据更新现有数据框，以便绘制并更新绘图中的回归线。现在我希望用户有一个选项（我正在考虑无线电按钮），这样他就可以为他添加点击的点选择一个类（-1/1）。我不知道为什么我不能用第三个变量（类）更新数据框，或者即使我正确地使用它。

 library(shiny)
    library(ggplot2)

    ui <- basicPage(
      plotOutput("plot1", click = "plot_click"),
      radioButtons("cls", "Clasa:", choices = list("Red" = -1, "Blue" = 1), selected = 1), 
      actionButton("refreshline", "Rline"),
      verbatimTextOutput("info")
    )

    server <- function(input, output) {

      x1 <- c(3, 10, 15, 3, 4, 7, 1, 12, 8, 18, 20, 4, 4, 5, 10)   #x
      x2 <- c(4, 10, 12, 17, 15, 20, 14, 3, 4, 15, 12, 5, 5, 6, 2) #y
      cls <- c(-1, 1, -1, 1, 1, 1, -1, 1, -1, 1, 1, 1, 1, -1, 1)   #class

      # initialize reactive values with existing data
      val <- reactiveValues( clickx = NULL, clicky = NULL, data = cbind (x1, x2, cls))

        observe({
        input$cls
        input$plot_click
        isolate({
          # save new points added
          val$clickx = c(val$clickx, input$plot_click$x)
          val$clicky = c(val$clicky, input$plot_click$y)

          # add new points to data                                              
          val$data <- rbind(val$data, cbind(input$plot_click$x, input$plot_click$y, as.numeric(input$cls)))
         })
  })


    output$plot1 <- renderPlot({
      p <- ggplot(data = NULL, aes(x=val$data[,1], y=val$data[,2], color = ifelse(val$data[,3] > 0, "Class 1","Class -1")))
      p <- p + geom_point()
      p <- p + xlab("x1")  
      p <- p + ylab("x2") 
     p <- p + scale_color_manual(name="Class Labels", values=c('#f8766d','#00BFC4'))
      p <- p + guides(color = guide_legend(override.aes = list(linetype = 0 )), 
                      linetype = guide_legend())
      p <- p + theme_bw() 
      p

      if(input$refreshline)
      p <- p + stat_smooth(method=lm)                         
      p

    })


      output$info <- renderText({
        input$plot_click
        paste0("x = ", val$clickx, ", y = ",val$clicky, "\n")
      })

    }

    shinyApp(ui, server)

Answer 1

看看这个解决方案。它可能仍有一些工作要做，但它给你一个可能的方向。我认为对两个输入作出反应的观察者并不是一个好的解决方案，因为任何一个输入的改变都会给val $数据添加一行。

这是修改后的代码：

    library(shiny)
    library(ggplot2)

    ui <- basicPage(
            plotOutput("plot1", click = "plot_click"),
            radioButtons("cls", "Clasa:", choices = list("Red" = -1, "Blue" = 1), selected = 1), 
            actionButton("updateData", "Update data"),
            actionButton("refreshline", "Rline"),
            verbatimTextOutput("info"),
            verbatimTextOutput("data")
    )

    server <- function(input, output) {

            x1 <- c(3, 10, 15, 3, 4, 7, 1, 12, 8, 18, 20, 4, 4, 5, 10)   #x
            x2 <- c(4, 10, 12, 17, 15, 20, 14, 3, 4, 15, 12, 5, 5, 6, 2) #y
            cls <- c(-1, 1, -1, 1, 1, 1, -1, 1, -1, 1, 1, 1, 1, -1, 1)   #class

            # initialize reactive values with existing data
            val <- reactiveValues( clickx = NULL, clicky = NULL, data = cbind (x1, x2, cls))

            observeEvent(input$updateData, {
                    if (input$updateData > 0) {
                            val$data <- rbind(val$data, cbind(input$plot_click$x, input$plot_click$y, as.numeric(input$cls)))
                    }

            })
            observeEvent(input$plot_click, {
                    val$clickx = c(val$clickx, input$plot_click$x)
                    val$clicky = c(val$clicky, input$plot_click$y)  
            })        

            output$plot1 <- renderPlot({
                    p <- ggplot(data = NULL, aes(x=val$data[,1], y=val$data[,2], color = ifelse(val$data[,3] > 0, "Class 1","Class -1")))
                    p <- p + geom_point()
                    p <- p + xlab("x1")  
                    p <- p + ylab("x2") 
                    p <- p + scale_color_manual(name="Class Labels", values=c('#f8766d','#00BFC4'))
                    p <- p + guides(color = guide_legend(override.aes = list(linetype = 0 )), 
                                    linetype = guide_legend())
                    p <- p + theme_bw() 
                    p

                    if(input$refreshline)
                            p <- p + stat_smooth(method=lm)                         
                    p

            })


            output$info <- renderText({
                    input$plot_click
                    paste0("x = ", val$clickx, ", y = ",val$clicky, "\n")
            })
            output$data <- renderPrint({
                    val$data
            })

    }

    shinyApp(ui, server)

使用用户输入更新点击数据的数据框

1 个答案: