用戶輸入更新點擊數據的數據框

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)