在 Shiny 中通过串扰将 Plotly 与 DT 一起使用

Question

我正在编写一个应用程序来将一个 csv 文件读入闪亮并将一个散点图与一个 DT 表链接。我几乎遵循 DT 数据表 (https://plot.ly/r/datatable/) 上的 Plotly 网站上的示例，除了保存的 csv 数据保存为反应输入，并且我为散点图的 x 和 y 变量选择输入。 单击操作按钮后，我可以生成绘图和 DT 表，还可以更新 DT 以仅显示刷散点图的选定行。我的问题是，当我在 DT 中选择行时，散点图中相应的各个点不会被选中（应该是红色）。我似乎是我使用反应函数（）作为 x 和 y 变量的输入，而不是 plotly 中的公式，但我似乎无法克服这个问题。

控制台上出现一条警告消息，但我似乎不知道如何解决此问题：

origRenderFunc() 中的警告： 忽略显式提供的小部件 ID“154870637775”；闪亮不使用它们 设置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 可以共享更新的选择。希望我下面的玩具示例可以帮助说明。不幸的是，我还没有找到一种方法可以使导入的文件产生串扰（我自己的question 参考）。

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)