通過Shiny中的串擾與DT一起使用Plotly

Question

我正在編寫一個應用程序，以將csv文件讀取為閃亮的文件，並將繪圖散點圖與DT表鏈接起來。 我幾乎遵循了DT datatable（ https://plot.ly/r/datatable/ ）上Plotly網站上的示例，但從csv中保存的數據被另存為響應輸入，並且我為散點圖的x和y變量。 單擊操作按鈕后，我可以生成圖和DT表，還可以更新DT以僅顯示通過刷繪制散點圖選擇的行。 我的問題是，當我在DT中選擇行時，散點圖中的相應單個點不會被選中（應為紅色）。 我似乎是我使用反應函數（）作為x和y變量的輸入，而不是使用圖的公式，但是我似乎無法克服這個問題。

警告消息出現在控制台上，但我似乎無法弄清楚如何解決此問題：

origRenderFunc（）中的警告：忽略顯式提供的小部件ID“ 154870637775”； Shiny不使用它們設置off事件（即“ plotly_deselect”）以匹配on事件（即“ plotly_selected”）。 您可以通過highlight()函數更改此默認值。

感謝您對此問題的任何投入。

我簡化了我閃亮的應用程序，使其僅包含相關的代碼塊：

library(shiny)
library(dplyr)
library(shinythemes)
library(DT)
library(plotly)
library(crosstalk)

ui <- fluidPage(
  theme = shinytheme('spacelab'),
  titlePanel("Plot"),
  tabsetPanel(

    # Upload Files Panel
    tabPanel("Upload File",
             titlePanel("Uploading Files"),
             sidebarLayout(
               sidebarPanel(
                 fileInput('file1', 'Choose CSV File',
                           accept=c('text/csv', 
                                    'text/comma-separated-values,text/plain', 
                                    '.csv')),

                 tags$br(),

                 checkboxInput('header', 'Header', TRUE),
                 radioButtons('sep', 'Separator',
                              c(Comma=',',
                                Semicolon=';',
                                Tab='\t'),
                              ','),
                 radioButtons('quote', 'Quote',
                              c(None='',
                                'Double Quote'='"',
                                'Single Quote'="'"),
                              '"'),
                 # Horizontal line ----
                 tags$hr(),

                 # Input: Select number of rows to display ----
                 radioButtons("disp", "Display",
                              choices = c(Head = "head",
                                          All = "all"),
                              selected = "head")


               ),
               mainPanel(
                 tableOutput('contents')
               )
             )
    ),

    # Plot and DT Panel
    tabPanel("Plots",
             titlePanel("Plot and Datatable"),
             sidebarLayout(
               sidebarPanel(
                 selectInput('xvar', 'X variable', ""),
                 selectInput("yvar", "Y variable", ""),
                 actionButton('go', 'Update')
               ),
               mainPanel(
                 plotlyOutput("Plot1"),
                 DT::dataTableOutput("Table1")
                 )
             )
    )
  )
)


# Server function ---------------------------------------------------------


server <- function(input, output, session) {

  ## For uploading Files Panel ## 

  MD_data <- reactive({ 
    req(input$file1) ## ?req #  require that the input is available
    df <- read.csv(input$file1$datapath, 
                   header = input$header, 
                   sep = input$sep,
                   quote = input$quote)
    return(df)
  })


  # add a table of the file
  output$contents <- renderTable({
    if(is.null(MD_data())){return()}

    if(input$disp == "head") {
      return(head(MD_data()))
    }
    else {
      return(MD_data())
    }
  })



  #### Plot Panel ####

  observeEvent(input$go, {

    m <- MD_data ()



    updateSelectInput(session, inputId = 'xvar', label = 'Specify the x variable for plot',
                      choices = names(m), selected = NULL)
    updateSelectInput(session, inputId = 'yvar', label = 'Specify the y variable for plot',
                      choices = names(m), selected = NULL)

    plot_x1 <- reactive({
      m[,input$xvar]})

    plot_y1 <- reactive({
      m[,input$yvar]})

    ########   
    d <- SharedData$new(m)


    # highlight selected rows in the scatterplot
    output$Plot1 <- renderPlotly({

      s <- input$Table1_rows_selected

      if (!length(s)) {
        p <- d %>%
          plot_ly(x = ~plot_x1(), y = ~plot_y1(), type = "scatter", mode = "markers", color = I('black'), name = 'Unfiltered') %>%
          layout(showlegend = T) %>% 
          highlight("plotly_selected", color = I('red'), selected = attrs_selected(name = 'Filtered'), deselected = attrs_selected(name ="Unfiltered)"))
      } else if (length(s)) {
        pp <- m %>%
          plot_ly() %>% 
          add_trace(x = ~plot_x1(), y = ~plot_y1(), type = "scatter", mode = "markers", color = I('black'), name = 'Unfiltered') %>%
          layout(showlegend = T)

        # selected data
        pp <- add_trace(pp, data = m[s, , drop = F], x = ~plot_x1(), y = ~plot_y1(), type = "scatter", mode = "markers",
                        color = I('red'), name = 'Filtered')
      }

    })

    # highlight selected rows in the table
    output$Table1 <- DT::renderDataTable({
      T_out1 <- m[d$selection(),]
      dt <- DT::datatable(m)
      if (NROW(T_out1) == 0) {
        dt
      } else {
        T_out1
        }
    })


    }) 



}

shinyApp(ui, server)

Answer 1

您需要一個sharedData對象，以便Plotly和DT都可以共享更新的選擇。 希望我下面的玩具示例可以幫助說明。 不幸的是，我還沒有找到使串擾與導入文件一起工作的方法（我自己的問題是參考）。

library(shiny)
library(crosstalk)
library(plotly)
library(ggplot2)

# Shared data available for use by the crosstalk package
shared_df <- SharedData$new(iris)

ui <- fluidPage(

  # Application title
  titlePanel("Crosstalk test"),

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      filter_select("iris-select", "Select Species:",
                    shared_df,
                    ~Species),
      filter_slider("iris-slider", "Select width:",
                    shared_df,
                    ~Sepal.Width, step=0.1, width=250)
    ),

    # Show a plot of the generated data
    mainPanel(
      plotlyOutput("distPlot"),
      DTOutput("table")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  output$distPlot <- renderPlotly({
    ggplotly(ggplot(shared_df) +
      geom_point(aes(x = Sepal.Width, y = Sepal.Length, colour = Species))
    )
  })

  output$table <- renderDT({
    datatable(shared_df, extensions="Scroller", style="bootstrap", class="compact", width="100%",
              options=list(deferRender=TRUE, scrollY=300, scroller=TRUE))
  }, server = FALSE)
}

# Run the application 
shinyApp(ui = ui, server = server)