不允许从闪亮的输出对象中读取对象？

Question

我正在尝试编写一个小应用程序,允许用户制作散点图,在图上选择点的子集,然后输出.csv格式的表,只有那些选定的点.我想出了如何启动和运行页面以及如何使用brushedPoints选择点.出现带有所选点的表格,但是当我按下"下载"按钮时,出现错误"不允许从shinyoutput对象中读取对象".出现.我无法下载可以在屏幕上以.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,你并不需要显式设置xvar,并yvar在brushedPoints,所以我删除它这里来提高代码的灵活性.)

我不知道任何"套索"风格的自由绘画能力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)