rshinyplotlyflexdashboardcrosstalk

Make selection of plotly appear in a datatable - flexdashboard


I am trying to build a flexdashbaord with two columns, The first one is a simple plot_ly scatter plot. In the second column I want a DT data table that will show the data of the points selected via box or lasso select in the scatter plot as shown in the screenshot below.

problem screenshot

Code below:

```{r global, include=FALSE}
library(flexdashboard)
library(reticulate)
library(tidyr)
library(tidyverse)
library(ggplot2)
library(plotly)
library(purrr) 
library(DT)
library(shinyalert)
library(shinyWidgets)
library(thematic)
library(dashboardthemes)
library(shinyjs)
library(datasets)
library(crosstalk)


data(iris)
summary(iris)

```


```{r runandsavereactive}

#run and generate data
actionButton("run_button", "RUN")

```

### create plot
```{r update_data}
output_data <- eventReactive(input$run_button, {

    showModal(modalDialog(title = "Running!"))
  
  
    ## Start initial plot
  fig2 <- iris %>% 
    plot_ly(
      type = 'scatter',
      mode = 'markers',
      x = ~Sepal.Length,
      y = ~Petal.Length,
      #marker = list(size = ~numbEmployed, sizeref = 4000, sizemode = 'area'),
      color = ~Species,
      marker = list(size = 5),
      hoverinfo = 'text',
      text = ~paste0("Name: ",Species),
      source="A"
    ) 


  ## style the layout
  fig2 <- fig2 %>% 
    layout(
      title = 'iris data test',
      scene = list(
        xaxis = list(title = ' ',
                     range = list(-4,7),
                     showticklabels=FALSE,
                     zeroline = F,
                     showgrid = F
        ),
        yaxis = list(title = ' ',
                     range = list(-1, 5),
                     showticklabels=FALSE,
                     zeroline = F,
                     showgrid = F
        )
     
      ))
   
  list("fig2" = fig2)
})
```


### Scatter Plot
```{r data }

plotlyOutput("iris")

output$iris <- renderPlotly({
req(input$run_button)
req(output_data()$fig2)

output_data()$fig2 

})

```



### Data Table

```{r datatsble }

output$table <- DT::renderDataTable(data)
proxy <- DT::dataTableProxy("table")
observe({
... 
})
```

Solution

  • You did not really provide a reprex, so I show some toy example of how to solve this issue (no need for shiny):

    ---
    title: "Crosstalk"
    output: 
      flexdashboard::flex_dashboard:
        orientation: rows
    ---
    
    ```{r setup, include=FALSE}
    library(flexdashboard)
    library(plotly)
    library(crosstalk)
    library(DT)
    library(dplyr)
    ```
    
    ```{r crosstalk-setup}
    ## Add an id to not rely only on rownumbers
    my_iris <- iris %>% 
      mutate(id = paste("id", 1:n()))
    shared_iris <- SharedData$new(my_iris, key = ~ id)
    ```
    
    
    ## Row
    
    ### Plot
    
    ```{r plot}
    shared_iris %>% 
      plot_ly(
        type = "scatter",
        mode = "markers",
        x = ~ Sepal.Length,
        y = ~ Petal.Length,
        color = ~ Species,
        marker = list(size = 5),
        hoverinfo = "text",
        text = ~ id
      ) %>%
      ## Tell plotly do highlight on selection rather on click
      highlight(on = "plotly_selected",
                off = "plotly_deselect")
    ```
    
    
    ### Table
    
    ```{r}
    datatable(shared_iris)
    ```
    

    All you need is crosstalk. You create a SharedData object (I decided to use an explicit id column instead of relying on row numbers which can be fragile in some scenarios) and pass this to both plotly and datatable. Finaly, you just need to use highlight to change the default behaviour of plotly to select on rectangular / lasso brush instead of click.

    Picture showing that the selected points are now shown in the table