具有两个同时输入$map_shape_click的R flexdashboard不起作用

Question

我正在创建一个R flexdashboard。仪表板包含孟加拉国的几张地图，这些地图链接到通过单击多边形(例如区域(激活的(Highcharts(图表。我能让它在一页纸上工作。然而，如果我把它设置为两页，事情就不起作用了。

flexdashboard(至少我是如何设置的(似乎无法同时处理两个输入$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页

列｛数据宽度=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')
})

列｛数据宽度=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页

列｛数据宽度=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')
})

列｛数据宽度=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将以不同的方式处理它，因为现在它们是两个不同的映射

Answer 2

我在其他地方找到了一个类似的问题，然后自己找到了答案。由于我对shine还很陌生，并且我的代码基于我发现的示例，所以我没有意识到"map_shape_click"在"map"上应用了"shape_click"，其中"map"与输出$map中的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作出响应