不允許從閃亮的輸出對象讀取對象？

Question

我正在嘗試編寫一個小應用程序，它允許用戶製作一個散點圖，在圖上選擇一個點的子集，然後以.csv格式輸出一個只有這些選定點的表。我想出瞭如何讓頁面正常運行，以及如何使用brushedPoints來選擇點。出現選定點的表格，但當按下「下載」按鈕時，將出現錯誤「不允許從閃亮輸出對象讀取對象」。出現。我無法下載我可以在屏幕上以.csv形式直觀看到的表格嗎？如果是這樣，是否有解決方法？

我已經使用下面的虹膜數據集重新創建了該問題。任何幫助搞清楚爲什麼我不能下載顯示行的表格將不勝感激。

data(iris) 

ui <- basicPage(
    plotOutput("plot1", brush = "plot_brush"), 
    verbatimTextOutput("info"),mainPanel(downloadButton('downloadData', 'Download')) 
) 


server <- function(input, output) { 
    output$plot1 <- renderPlot({ 
ggplot(iris,aes(x=Sepal.Width,y=Sepal.Length)) + 
    geom_point(aes(color=factor(Species))) + 
    theme_bw() 
    }) 

    output$info <- renderPrint({ 
brushedPoints(iris, input$plot_brush, xvar = "Sepal.Width", yvar = "Sepal.Length") 
    }) 

    output$downloadData <- downloadHandler(
     filename = function() { 
     paste('SelectedRows', '.csv', sep='') }, 
     content = function(file) { 
     write.csv(output$info, file) 
     } 
) 

} 


shinyApp(ui, server) 

Answer 1

問題是輸出對象也生成了所有的Web顯示內容。相反，您需要單獨提取數據以供下載。您可以在下載代碼中第二次撥打brushedPoints來完成。但是，更好的做法是使用reactive()函數只做一次，然後在需要的地方隨時調用它。下面是我會怎樣修改代碼以使這項工作：

data(iris) 

ui <- basicPage(
    plotOutput("plot1", brush = "plot_brush"), 
    verbatimTextOutput("info"),mainPanel(downloadButton('downloadData', 'Download')) 
) 


server <- function(input, output) { 
    output$plot1 <- renderPlot({ 
    ggplot(iris,aes(x=Sepal.Width,y=Sepal.Length)) + geom_point(aes(color=factor(Species))) + theme_bw() 
    }) 


    selectedData <- reactive({ 
    brushedPoints(iris, input$plot_brush) 
    }) 

    output$info <- renderPrint({ 
    selectedData() 
    }) 

    output$downloadData <- downloadHandler(
    filename = function() { 
     paste('SelectedRows', '.csv', sep='') }, 
    content = function(file) { 
     write.csv(selectedData(), file) 
    } 
) 

} 


shinyApp(ui, server) 

（注意，與ggplot2，你不需要在brushedPoints所以明確設定xvar和yvar，我刪除了在這裏增加的靈活性）

我並不知道shiny有任何「套索」風格的自由繪畫能力（雖然，給它一個星期 - 他們不斷添加有趣的工具）。但是，您可以通過允許用戶選擇多個區域和/或單擊各個點來模仿行爲。服務器邏輯變得更加混亂，因爲您需要將結果存儲在reactiveValues對象中以便能夠重複使用它。我做了類似的事情，讓我選擇一個地塊上的點，並在其他地塊上突出顯示/刪除它們。這比你在這裏需要更復雜，但下面應該工作。您可能希望添加其他按鈕/邏輯（例如，「重置」選擇），但我相信這應該起作用。我確實向劇情添加了選擇的顯示，以便您可以跟蹤選定的內容。

data(iris) 

ui <- basicPage(
    plotOutput("plot1", brush = "plot_brush", click = "plot_click") 
    , actionButton("toggle", "Toggle Seletion") 
    , verbatimTextOutput("info") 
    , mainPanel(downloadButton('downloadData', 'Download')) 
) 


server <- function(input, output) { 
    output$plot1 <- renderPlot({ 

    ggplot(withSelected() 
      , aes(x=Sepal.Width 
       , y=Sepal.Length 
       , color=factor(Species) 
       , shape = Selected)) + 
     geom_point() + 
     scale_shape_manual(
     values = c("FALSE" = 19 
        , "TRUE" = 4) 
     , labels = c("No", "Yes") 
     , name = "Is Selected?" 
    ) + 
     theme_bw() 
    }) 

    # Make a reactive value -- you can set these within other functions 
    vals <- reactiveValues(
    isClicked = rep(FALSE, nrow(iris)) 
) 


    # Add a column to the data to ease plotting 
    # This is really only necessary if you want to show the selected points on the plot 
    withSelected <- reactive({ 
    data.frame(iris 
       , Selected = vals$isClicked) 
    }) 



    # Watch for clicks 
    observeEvent(input$plot_click, { 

    res <- nearPoints(withSelected() 
         , input$plot_click 
         , allRows = TRUE) 

    vals$isClicked <- 
     xor(vals$isClicked 
      , res$selected_) 
    }) 


    # Watch for toggle button clicks 
    observeEvent(input$toggle, { 
    res <- brushedPoints(withSelected() 
         , input$plot_brush 
         , allRows = TRUE) 

    vals$isClicked <- 
     xor(vals$isClicked 
      , res$selected_) 
    }) 

    # pull the data selection here 
    selectedData <- reactive({ 
    iris[vals$isClicked, ] 
    }) 

    output$info <- renderPrint({ 
    selectedData() 
    }) 

    output$downloadData <- downloadHandler(
    filename = function() { 
     paste('SelectedRows', '.csv', sep='') }, 
    content = function(file) { 
     write.csv(selectedData(), file) 
    } 
) 

} 


shinyApp(ui, server)