web-dev-qa-db-ja.com

光沢のある出力オブジェクトからオブジェクトを読み取ることはできませんか？

ユーザーが散布図を作成し、プロット上の点のサブセットを選択して、選択した点のみを含む.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)
rshinyscatter-plotshiny-server
11
KrisF

問題は、出力オブジェクトがすべてのWeb表示のものも生成していることです。代わりに、ダウンロードのためにデータを個別にプルする必要があります。ダウンロードコードでbrushedPointsを2回呼び出して、これを行うことができます。ただし、reactive()関数を使用して1回だけ実行し、必要なすべての場所でそれを呼び出すのがより良い方法です。これが動作するようにコードを変更する方法です。

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の「なげなわ」スタイルの自由な描画機能に気づいていません（ただし、1週間あけてください-彼らは常に楽しいツールを追加しています）。ただし、ユーザーが複数の領域を選択したり、個々のポイントをクリックしたりできるようにすることで、動作を模倣できます。結果をreactiveValuesオブジェクトに格納して繰り返し使用できるようにする必要があるため、サーバーロジックは非常に複雑になります。 1つのプロットでポイントを選択し、他のプロットでそれらを強調表示/削除できるように、同様のことを行いました。これは、ここで必要とするものよりも複雑ですが、以下は機能するはずです。他のボタン/ロジックを追加することもできます（たとえば、選択を「リセット」する）が、これでうまくいくと思います。選択の表示をプロットに追加して、何が選択されたかを追跡できるようにしました。

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)
17
Mark Peterson