Problem with using barplot and scatter plot in leaflet

Question

I am trying to have both a scatter plot and a barplot in leaflet. The datetable, the leaflet and the scatter plot work fine. The problem is the barplot does not work when in leaflet we select some points in map as shown in the following figure. Why scatter plot works fine but bar plot does not?

How to solve this problem? Here is the R code:

#R code
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
#devtools::install_github("jcheng5/d3scatter")
library(d3scatter)

data_2<-structure(list(ID = 1:8, Name1 = c("A", "A", "A", "C", "B", "B", 
"A", "B"), Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"), 
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22), Value2 = c(0, 
1, 1, 0, 0, 0, 0, 2), Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 
54.3, 60.4, 49.2), Lon = c(5, -3, -2, -1, 4, 3, -5, 0), lab_DB = c("blue", 
"blue", "blue", "green", "red", "red", "blue", "red")), class = "data.frame", row.names = c(NA,-8L))
sdf <- SharedData$new(data_2, key=~ID)
lmap <- leaflet(data = sdf) %>% addTiles() %>%
  addCircleMarkers(data = sdf,
           lng = ~Lon,
           lat = ~Lat,
           group = ~Name1 ,color = ~lab_DB
           ,radius =3
           
  ) 
dtable <- datatable(sdf , width = "100%",editable=TRUE)
ggplt<-ggplot(sdf, aes(x=factor(Value2)))+
  geom_bar(stat="count", width=0.7, fill="steelblue")
d3<-d3scatter(sdf , x=~Value1 ,y=~Value2, width="100%", height=300)
bscols( widths=c(6,6,0), list(lmap, d3),list(dtable,ggplotly(ggplt)))

The below code shows the counts of #0, #1 and #2 for "value2" calculated correctly! (showed in the caption of datatable) but something wrongs with barplot!!

#R code
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
#devtools::install_github("jcheng5/d3scatter")
library(d3scatter)

data_2<-structure(list(ID = 1:8, Name1 = c("A", "A", "A", "C", "B", "B", 
"A", "B"), Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"), 
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22), Value2 = c(0, 
1, 1, 0, 0, 0, 0, 2), Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 
54.3, 60.4, 49.2), Lon = c(5, -3, -2, -1, 4, 3, -5, 0), lab_DB = c("blue", 
"blue", "blue", "green", "red", "red", "blue", "red")), class =     "data.frame", row.names = c(NA,-8L))
sdf <- SharedData$new(data_2, key=~ID)
lmap <- leaflet(data = sdf) %>% addTiles() %>%
  addCircleMarkers(data = sdf,
       lng = ~Lon,
       lat = ~Lat,
       group = ~Name1 ,color = ~lab_DB
       ,radius =3
       
  ) 

ggplt<-ggplotly(sdf %>% ggplot( aes(x=factor(Value2)))+
  geom_bar(stat="count", width=0.7, fill="steelblue"))
d3<-d3scatter(sdf , x=~Value1 ,y=~Value2, width="100%", height=300)
dtable <- datatable(sdf , width = "100%",editable=TRUE, 
caption=tags$caption("Value2:  #0: ",summarywidget(sdf ,     selection=~Value2==0)
,"      Value2:  #1: ",summarywidget(sdf , selection=~Value2==1)
,"      Value2:  #1: ",summarywidget(sdf , selection=~Value2==2)

))

bscols( list(lmap, dtable),list(d3,ggplt), htmltools::p(summarywidget(sdf , selection=~Value2==0,column="Value2")
,summarywidget(sdf , selection=~Value2==1,column="Value2")
,summarywidget(sdf , selection=~Value2==2,column="Value2")
, style="display:none;"))

You want the plots to show data filtered by the selected/clicked circle marker on leaflet? You'll need shiny to have that interactivity. — rbasa, Jul 18 '21 at 12:43
@rbasa, The scatter plot works fine, but the barplot does not! Is it possible to solve it without shiny? — Masoud, Jul 18 '21 at 15:10
the scatter plot works fine because you are using `jcheng5/d3scatter` which provides support for "updating data and brushing". The readme of that github repo states "don't take this library too seriously, it's just intended as a testing ground for cross-widget communications". It also provides examples. One of which is "Linked brushing between d3scatter and ggplot2, using Shiny". — rbasa, Jul 19 '21 at 12:23
@rbasa, I think with this trick we can handle it without shiny https://stackoverflow.com/questions/68103456/can-plotly-use-a-dynamic-html-table-as-source-data — Masoud, Jul 20 '21 at 08:52
@Massoud, that uses Javascript, not R. If that's a language/environment you are comfortable with, then using Javascript to interface directly with the Plotly Javascript library will work. — rbasa, Jul 20 '21 at 12:17

TimTeaFan · Accepted Answer · 2021-07-29T14:20:33.317

Here is a solution with shiny. Again I use a callback function with your datatable to subset the shared data sdf so you can click the column you are interested in and display a bar chart:

library(shiny)
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
library(d3scatter)

data_2 <- structure(
  list(ID = 1:8,
       Name1 = c("A", "A", "A", "C", "B", "B", "A", "B"),
       Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"), 
       Value1 = c(12, 43, 54, 34, 23, 77, 44, 22),
       Value2 = c(0, 1, 1, 0, 0, 0, 0, 2),
       Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
       Lon = c(5, -3, -2, -1, 4, 3, -5, 0),
       lab_DB = c("blue", "blue", "blue", "green", "red", "red", "blue", "red")),
  class = "data.frame",
  row.names = c(NA,-8L))


ui <- fluidPage(
  fluidRow(
    column(6, leafletOutput("lmap")),
    column(6, d3scatterOutput("scatter"))
  ),
  fluidRow(
    column(6, DTOutput("table")),
    column(6,
           style = "padding-top: 105px;",
           plotlyOutput("plot"))
  )
)

server <- function(input, output) {
  
  sdf <- SharedData$new(data_2, key=~ID)
  
  output$lmap <- renderLeaflet({
    
    leaflet(data = sdf) %>%
    addTiles() %>%
    addCircleMarkers(data = sdf,
                     lng = ~Lon,
                     lat = ~Lat,
                     group = ~Name1 ,color = ~lab_DB,
                     radius =3)
  })
  
  
  output$scatter <- renderD3scatter({
    
    d3scatter(sdf,
              x = ~Value1 ,
              y = ~Value2,
              width = "100%",
              height=300)
    })
  
  output$table <- renderDT({

    datatable(

      sdf,
      filter = 'top',
      editable=TRUE,
      extensions = c('Select', 'Buttons'),
      selection = 'none',
      options = list(select = list(style = 'os',
                                   items = 'row'),
                     dom = 'Bfrtip',
                     autoWidth = TRUE,
                     buttons = list('copy' ,
                                    list(extend = 'collection',
                                         buttons = c('csv', 'excel', 'pdf', 'print'),
                                         text = 'Download'))),
      caption = tags$caption("Value2:  #0: ",
                             summarywidget(sdf, selection = ~Value2 == 0),
                             "      Value2:  #1: ", summarywidget(sdf, selection = ~Value2 == 1),
                             "      Value2:  #2: ", summarywidget(sdf, selection = ~Value2 == 2)),

      # This part is new: callback to get col number as `input$col`
      callback = JS("table.on('click.dt', 'td', function() {
            var col=table.cell(this).index().column;
            var data = [col];
           Shiny.onInputChange('col',data );
    });")
    )
  },
  server = FALSE)

  # plotly bar chart
  output$plot <- renderPlotly({

    req(input$col)

    dat <- sdf$data(withSelection = TRUE) %>% 
      filter(selected_ == TRUE) %>%
      pull(input$col) %>% 
      table()

    fig <- plot_ly(
      x = names(dat),
      y = dat,
      name = "Count",
      type = "bar"
    )

    fig

  })
  
}

shinyApp(ui, server)

If you are only interested in column Value2 then the approach below works as well:

library(shiny)
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
library(d3scatter)

data_2 <- structure(
  list(ID = 1:8,
       Name1 = c("A", "A", "A", "C", "B", "B", "A", "B"),
       Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"), 
       Value1 = c(12, 43, 54, 34, 23, 77, 44, 22),
       Value2 = c(0, 1, 1, 0, 0, 0, 0, 2),
       Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
       Lon = c(5, -3, -2, -1, 4, 3, -5, 0),
       lab_DB = c("blue", "blue", "blue", "green", "red", "red", "blue", "red")),
  class = "data.frame",
  row.names = c(NA,-8L))


ui <- fluidPage(
  fluidRow(
    column(6, leafletOutput("lmap")),
    column(6, d3scatterOutput("scatter"))
  ),
  fluidRow(
    column(6, DTOutput("table")),
    column(6,
           style = "padding-top: 105px;",
           plotlyOutput("plot"))
  )
)

server <- function(input, output) {
  
  sdf <- SharedData$new(data_2, key=~ID)
  
  output$lmap <- renderLeaflet({
    
    leaflet(data = sdf) %>%
    addTiles() %>%
    addCircleMarkers(data = sdf,
                     lng = ~Lon,
                     lat = ~Lat,
                     group = ~Name1 ,color = ~lab_DB,
                     radius =3)
  })
  
  
  output$scatter <- renderD3scatter({
    
    d3scatter(sdf,
              x = ~Value1 ,
              y = ~Value2,
              width = "100%",
              height=300)
    })
  
  output$table <- renderDT({

    datatable(

      sdf,
      filter = 'top',
      editable=TRUE,
      extensions = c('Select', 'Buttons'),
      selection = 'none',
      options = list(select = list(style = 'os',
                                   items = 'row'),
                     dom = 'Bfrtip',
                     autoWidth = TRUE,
                     buttons = list('copy' ,
                                    list(extend = 'collection',
                                         buttons = c('csv', 'excel', 'pdf', 'print'),
                                         text = 'Download'))),
      caption = tags$caption("Value2:  #0: ",
                             summarywidget(sdf, selection = ~Value2 == 0),
                             "      Value2:  #1: ", summarywidget(sdf, selection = ~Value2 == 1),
                             "      Value2:  #2: ", summarywidget(sdf, selection = ~Value2 == 2))
    )
  },
  server = FALSE)

  # plotly bar chart
  output$plot <- renderPlotly({
    
    dat <- sdf$data(withSelection = TRUE) %>% filter(selected_ == TRUE)
    
    p <- ggplot(data = dat,
                aes(x=factor(Value2))) +
      geom_bar(stat="count", width=0.7, fill="steelblue")
    
    ggplotly(p)
    
  })
}

shinyApp(ui, server)

Problem with using barplot and scatter plot in leaflet

1 Answers1

Linked