R flexdashboard 与两个同时输入 $map_shape_click 不工作

Question

我正在创建一个 R flexdashboard。仪表板包含孟加拉国的几张地图，这些地图链接到通过单击多边形（例如区域）激活的（Highcharts）图表。我能够让它在一页上工作。但是，如果我将其设置为两页，则不再有效。

似乎 flexdashboard（至少我是如何设置的）无法同时处理两个 input$map_shape_click 操作。目前它只适用于第一页，而地图在第二页上没有反应，尽管生成了一个图形。我欢迎任何建议来完成这项工作。

下面是一个可重现的例子。请注意，（1）我在示例中省略了 flexdashboard yaml，（2）stackoverflow 使用的 markdown 自动呈现第一、第二和第三标头级别。它们在 flexdasboard 中运行时呈现不同（即大标题是 flexdashboard 中的新页面）。

# Packages
library(tidyverse)
library(raster)
library(sf)
library(highcharter)
library(leaflet)
library(htmltools)

# Get data
adm1 <- getData('GADM', country='BGD', level=1)
adm1 <- st_as_sf(adm1)

# Create dummy data.frames with link to polygon
df1 <- data.frame(NAME_1 = adm1$NAME_1,
                 value_1 = c(1:7))

df2 <- data.frame(NAME_1 = adm1$NAME_1,
                 value_2 = c(8:14))

第 1 页

列 {data-width=350}

地图 1

# MAIN MAP --------------------------------------------------------------------------------
output$map <- renderLeaflet({

  # Base map
  leaflet() %>%
    addTiles(group = "OpenStreetMap") %>%
    clearShapes() %>%
    addPolygons(data = adm1, 
                smoothFactor = 0, 
                color = "black",
                opacity = 1,
                fillColor = "transparent",
                weight = 0.5,
                stroke = TRUE,
                label = ~htmlEscape(NAME_1),
                layerId = ~NAME_1,
                )
  
})
leafletOutput('map')  


# REGION SELECTION -----------------------------------------------------------------------

# Click event for the map to draw chart
click_poly <- eventReactive(input$map_shape_click, {

  x <- input$map_shape_click
  y <- x$id
  return(y)
}, ignoreNULL = TRUE) 


observe({
  req(click_poly()) # do this if click_poly() is not null

  # Add the clicked poly and remove when a new one is clicked
  map <- leafletProxy('map') %>%
      removeShape('NAME_1') %>%
      addPolygons(data = adm1[adm1$NAME_1 == click_poly(), ],
                  fill = FALSE,
                  weight = 4,
                  color = '#d01010', 
                  opacity = 1, 
                  layerId = 'NAME_1')
  })

列 {data-width=350}

情节 1

data <- reactive({

  # Fetch data for the click poly
  out <- df1[df1$NAME_1 == click_poly(), ]
  print("page 1") # print statement to show which click_poly is used
  return(out)
  })


output$plot <- renderHighchart({
  req(data()) # do this if click_poly() is not null
  
  chart <- highchart() %>%
      hc_chart(type = 'column') %>%
      hc_legend(enabled = FALSE) %>%
      hc_xAxis(categories = c('A'),
               title = list(text = 'Title 1')) %>%
      hc_yAxis(title = list(text = 'Value 1')) %>%
      hc_plotOptions(series = list(dataLabels = list(enabled = TRUE))) %>%
      hc_add_series(name = 'Series', 
                    data = c(data()$value_1)) %>%
      hc_add_theme(hc_theme_smpl()) %>%
      hc_colors(c('#d01010'))
  })

highchartOutput('plot')

第 2 页

列 {data-width=350}

地图 2

# MAIN MAP --------------------------------------------------------------------------------
output$map2 <- renderLeaflet({

  # Base map
  leaflet() %>%
    addTiles(group = "OpenStreetMap") %>%
    clearShapes() %>%
    addPolygons(data = adm1, 
                smoothFactor = 0, 
                color = "black",
                opacity = 1,
                fillColor = "transparent",
                weight = 0.5,
                stroke = TRUE,
                label = ~htmlEscape(NAME_1),
                layerId = ~NAME_1,
                )
  
})
leafletOutput('map2')  


# REGION SELECTION -----------------------------------------------------------------------

# Click event for the map to draw chart
click_poly2 <- eventReactive(input$map_shape_click, {

  x <- input$map_shape_click
  y <- x$id
  return(y)
}, ignoreNULL = TRUE) 


observe({
  req(click_poly2()) # do this if click_poly() is not null

  # Add the clicked poly and remove when a new one is clicked
  map <- leafletProxy('map2') %>%
      removeShape('NAME_1') %>%
      addPolygons(data = adm1[adm1$NAME_1 == click_poly2(), ],
                  fill = FALSE,
                  weight = 4,
                  color = '#d01010', 
                  opacity = 1, 
                  layerId = 'NAME_1')
  })

列 {data-width=350}

情节 2

data2 <- reactive({

  # Fetch data for the click poly
  out <- df2[df2$NAME_1 == click_poly2(), ]
  print("page 2") # print statement to show which click_poly is used
  return(out)
  })


output$plot2 <- renderHighchart({
  req(data2()) # do this if click_poly() is not null
  
  chart <- highchart() %>%
      hc_chart(type = 'column') %>%
      hc_legend(enabled = FALSE) %>%
      hc_xAxis(categories = c('A'),
               title = list(text = 'Title 2')) %>%
      hc_yAxis(title = list(text = 'Value 2')) %>%
      hc_plotOptions(series = list(dataLabels = list(enabled = TRUE))) %>%
      hc_add_series(name = 'Series', 
                    data = c(data2()$value_2)) %>%
      hc_add_theme(hc_theme_smpl()) %>%
      hc_colors(c('#d01010'))
  })

highchartOutput('plot2')

Answer 1

在您的click_poly2 <- eventReactive(input$map_shape_click 中，click_poly2 是第二张地图，但您拥有相同的map_shape_click，如果您制作了map_shape_click2，希望 flexdashboard 能够以不同的方式处理它，因为现在它们是 2 个不同的地图

Answer 2

根据我在其他地方找到的类似问题，我自己找到了答案。由于我对闪亮并且基于我找到的示例的代码非常陌生，我没有意识到'map_shape_click'在'map'上应用'shape_click'，其中'map'与output$map中的地图相对应。由于我有两个地图：map 和 map2，因此 page2 的 eventReactive 语句应该更改为

click_poly2 <- eventReactive(input$map2_shape_click, {

  x <- input$map2_shape_click
  y <- x$id
  return(y)
}, ignoreNULL = TRUE) 

现在回复 map2 上的 shape_click