Use Crosstalk with fileInput from UI side

[Teolone88]

Hi,

I am trying to use plotly with Crosstalk to brush and return a data table. My problem is that all the example that I have currently saw, are natively loading a predefined data set. However, I am trying to have a SharedData$new() with a fileInput. The vignette says that it accepts a data frame-like object, or a Shiny reactive expression that returns a data frame-like object. However, it doesn't work.

Could you please help me understand how you can use the SharedData$new function in together with a reactive fileInput expression?

library(shiny)
library(plotly)
library(dplyr)
library(crosstalk)

ui <- fluidPage(

            sidebarPanel(
              id = "Outliers_sidebar",
              width = 2,
              h3("Explore Outliers"),
              fileInput("fileOutliers", NULL, accept = c(".csv", ".tsv", ".txt")),
              tags$hr(),
              uiOutput('chartOptions'),
              checkboxInput("persist", "Persistent?", FALSE)
            ),
            mainPanel(
              fluidRow(
                       h3("Scatter plot"),
                       plotlyOutput("scatterplot")
                       ),
              DT::dataTableOutput("dat")
              )
              # helpText("To zoom: Click, drag, and double click to zoom into the scatter plot. Double click to zoom back out to original extent."),
              # helpText("To identify points: Click on or near point(s). Data table below will be populated."),
              # hr(),
              # h2("Data Table"),
              # tableOutput('table_or_click'),
              # hr(),
              # h4("X Axis Variable Summary"),
              # verbatimTextOutput("xAxisSummary"),
              # h4("Y Axis Variable Summary"),
              # verbatimTextOutput("yAxisSummary")
            
)

server <- function(input, output, session) {
  
  # change these variables to customize the app

#########################################################################
#########################################################################
  data_shared <- SharedData$new(myOutliers_load()) ###   <-------   HERE IS MY BOTTLENECK
#########################################################################
#########################################################################

  color_base <- "black"
  color_select <- "red"

data_orig <- data_shared$origData()

  ## Axis Selectors
  output$chartOptions <- renderUI({
    if(is.null(input$url)){}
    else {
      list(
        selectizeInput("xAxisSelector", "X Axis Variable (?xAxis=)",
            colnames(datasetInput())),
        selectizeInput("yAxisSelector", "Y Axis Variable (?yAxis=)",
            colnames(datasetInput())),
        selectizeInput("colorBySelector", "Color By (?colorBy=) [scatter plot only]:",
            c(c("Do not color",colnames(datasetInput()))))
      )      
    }
  })

  datasetInput <- reactive({
    # parse URL query and adjust text fields accordingly
    urlQuery <- parseQueryString(session$clientData$url_search)
    if(!is.null(urlQuery$url)){ 
      updateTextInput(session, "url", value = urlQuery$url)
    }
    if(!is.null(urlQuery$xAxis)){
      updateSelectizeInput(session, "xAxisSelector", selected = urlQuery$xAxis)
    } else {
      updateSelectizeInput(session, "xAxisSelector", selected = 'Track')
    }
    if(!is.null(urlQuery$yAxis)){
      updateSelectizeInput(session, "yAxisSelector", selected = urlQuery$yAxis)
    } else {
      updateSelectizeInput(session, "yAxisSelector", selected = 'ACO.1')
    }
    if(!is.null(urlQuery$colorBy)){
      updateSelectizeInput(session, "colorBySelector", selected = urlQuery$colorBy)
    } else {
      updateSelectizeInput(session, "colorBySelector", selected = 'Do not color')
    }
    # read text box's URL, read, and store in data frame which is returned
    inURL <- input$url
    if(is.null(inURL)){
      return(NULL)
    } 
    else {
      data_frame <- read.csv(inURL)
    }
  })

  myOutliers_load <- reactive({
    library(dplyr)
    
    req(input$fileOutliers)
    
    # Dependency on format
    ext <- tools::file_ext(input$fileOutliers$name)
    switch(ext,
           csv = vroom::vroom(input$fileOutliers$datapath, delim = ","),
           tsv = vroom::vroom(input$fileOutliers$datapath, delim = "\t"),
           txt = vroom::vroom(input$fileOutliers$datapath, delim = ","),
           validate("Invalid file; Please upload a .csv or .tsv file")
    )
    
    # Read file upload
    df <- read.csv(
      input$fileOutliers$datapath,
      strip.white = TRUE,
      skipNul = TRUE,
      blank.lines.skip = TRUE,
      fill = TRUE,
      header = TRUE
    )

    return(df)
  })
  
 
  output$scatterplot <- renderPlotly({
    plot_ly(x = data_orig[[xAxisSelector]], y = data_orig[[yAxisSelector]) %>%
      add_markers(
        color = I(color_base),
        selected = list(
          marker = list(color = color_select)
        )
      ) %>%
      layout(
        dragmode = "select",
        xaxis = list(title = xAxisSelector),
        yaxis = list(title = yAxisSelector)
      ) %>%
      config(
        displayModeBar = FALSE,
        edits = list(shapePosition = TRUE)
      ) %>%
      toWebGL()
  })
  
  # listen to the brushing event and draw a
  # rect shape that mimics the brush
  observe({
    brush <- event_data("plotly_brushing")
    
    # if the brush is undefined, remove all shapes and exit
    if (is.null(brush)) {
      plotlyProxy("scatterplot", session) %>%
        plotlyProxyInvoke("relayout", list(shapes = NULL))
      return()
    }
    
    # mimc the brush as a rect shape
    brush_rect <- list(
      type = "rect",
      x0 = brush$x[1],
      x1 = brush$x[2],
      y0 = brush$y[1],
      y1 = brush$y[2],
      fillcolor = NA,
      line = list(
        color = "black",
        dash = "dot",
        width = 1
      )
    )
    
    # draw the rect shape and turn off brush coloring
    # imposed by plotly.js
    plotlyProxy("scatterplot", session) %>%
      plotlyProxyInvoke("relayout", list(shapes = list(brush_rect))) %>%
      plotlyProxyInvoke("restyle", "selectedpoints", list(list()))
  })
  
  # A reactive value that tracks the dimensions of the brush
  brush <- reactiveVal()
  
  # Update the brush in response to changes to shapes
  # NOTE: if you need more shapes in the plot your brushing,
  # you'll need to be mindful of which shape the brush represents
  observe({
    evt <- event_data("plotly_relayout")
    val <- if (!is.null(evt$shapes)) {
      evt$shapes
    } else if (!is.null(evt[["shapes[0].x0"]])) {
      list(
        x0 = evt[["shapes[0].x0"]],
        x1 = evt[["shapes[0].x1"]],
        y0 = evt[["shapes[0].y0"]],
        y1 = evt[["shapes[0].y1"]]
      )
    }
    brush(val)
  })
  
  # double-click clears the brush
  observe({
    event_data("plotly_doubleclick", priority = "event")
    event_data("plotly_deselect", priority = "event")
    brush(NULL)
  })
  
  # map the brush limits to a data selection
  observe({
    
    # if brush isn't active, no selection is active
    if (is.null(brush())) {
      data_shared$selection(FALSE)
      return()
    }
    
    selection <- between(data_orig[[xAxisSelector]], brush()$x0, brush()$x1) &
      between(data_orig[[yAxisSelector]], brush()$y0, brush()$y1)
    
    if (isTRUE(input$persist)) {
      selection_old <- data_shared$selection()
      # This should be fixed in crosstalk
      if (is.null(selection_old)) selection_old <- FALSE
      data_shared$selection(selection_old | selection)
    } else {
      data_shared$selection(selection)
    }
  })
  
  # update the marker colors
  observe({
    dat <- data_shared$data(withSelection = TRUE)
    color <- if_else(dat$selected_, color_select, color_base)
    plotlyProxy("scatterplot", session) %>%
      plotlyProxyInvoke("restyle", "marker.color", list(color), 0)
  })
  
  # display the selected data
  output$dat <- DT::renderDataTable({
    dat <- data_shared$data(withSelection = TRUE)
    filter(dat, selected_)

     DT::datatable(dat)
  })
}

shinyApp(ui, server)