Using Plotly with DT via crosstalk in Shiny

Question

I am writing an app to read a csv file into shiny and link a plotly scatter plot with a DT table. I pretty much followed the example from the Plotly website on DT datatable (https://plot.ly/r/datatable/) with the exception that the saved data from the csv is saved as a reactive input and that I have selectinput for the x and y variables for the scatterplot. I can generate the plot and DT table after clicking on the action button and I can also update the DT to only show selected rows from brushing the scatterplot. My problem is that when I select rows in the DT, then the corresponding individual points in the scatterplot does not become selected (should be in red color). I seems to be that I used reactive functions() as input for the x and y variables instead of formulas in plotly but I cannot seem to overcome this problem.

A warning message appear on the console but I cant seem to figure out how to fix this:

Warning in origRenderFunc() : Ignoring explicitly provided widget ID "154870637775"; Shiny doesn't use them Setting the off event (i.e., 'plotly_deselect') to match the on event (i.e., 'plotly_selected'). You can change this default via the highlight() function.

Would be thankful for any input on this issue.

I have simplified my shiny app to include only the relevant code chunks:

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

You need a sharedData object so that both Plotly and DT can share updated selections. Hopefully my toy example below can help illustrate. Unfortunately, I have not found a way of making crosstalk work with imported files (my own question refers).

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)