在传单中使用条形图和散点图的问题

问题描述

我试图在传单中同时使用散点图和条形图。日期表、传单和散点图工作正常。问题是 当在传单中我们选择地图中的一些点时，条形图不起作用，如下图所示。为什么散点图可以正常工作，而条形图却不行？

如何解决这个问题？这是 R 代码：

#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","C","B","B"),Name2 = c("a","b","a","c"),Value1 = c(12,43,54,34,23,77,44,22),Value2 = c(0,1,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","green","red","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,list(lmap,d3),list(dtable,ggplotly(ggplt)))

下面的代码显示了正确计算的“value2”的#0、#1和#2的计数！ （显示在数据表的标题中）但是条形图有问题！！

#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,class =     "data.frame",radius =3
       
  ) 

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

))

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

解决方法

这是一个有光泽的解决方案。我再次对您的数据表使用回调函数来对共享数据 sdf 进行子集化，以便您可以单击您感兴趣的列并显示条形图：

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","C","B","B"),Name2 = c("a","b","a","c"),Value1 = c(12,43,54,34,23,77,44,22),Value2 = c(0,1,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","green","red","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")),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: ",selection = ~Value2 == 1),"      Value2:  #2: ",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)

如果您只对列 Value2 感兴趣，那么下面的方法也适用：

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,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)