且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

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

更新时间:2023-02-11 10:00:41

这里有一个闪亮的解决方案.我再次对您的数据表使用回调函数来对共享数据 sdf 进行子集化,以便您可以单击您感兴趣的列并显示条形图:

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)

如果您只对列 Value2 感兴趣,那么下面的方法也可以:

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)