Problem with using barplot and scatter plot in leaflet - 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;"))

Answer 1

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)