r-闪亮应用程序中reactable和传单之间的交互(串扰、传单代理)

Question

我的应用程序有一个传单对象和一个可反应对象，它们通过串扰进行交互。

当用户从表中选择一条记录时(使用复选框(，我希望应用程序只添加相应的标记(使用不同的图标(，并完全删除所有其他标记(不显示阴影(。

我正试图使用串扰和leafleproxy来实现这一点，但observeEvent似乎不起作用。

可复制示例见下文。谢谢你的帮助。António

library(shiny)
library(leaflet)
library(reactable)
library(crosstalk)
icon_x = makeIcon("https://icons.getbootstrap.com/assets/icons/arrow-up-circle-fill.svg",
iconWidth = 16, iconHeight = 16)
icon_y = makeIcon("https://icons.getbootstrap.com/assets/icons/arrow-up-circle-fill.svg",
iconWidth = 64, iconHeight = 64)
d <- data.frame(
id = c(1,2,3),
label = c("a","b","c"),
long = c(-8,-8,-8.1),
lat = c(39,39.1,39)
)
ui <- fluidPage(
textOutput("texto"),
reactableOutput("tbl"),
leafletOutput(outputId = "map")
)
server <- function(input, output) {
shared_d <- SharedData$new(d)

output$map <- renderLeaflet({
leaflet(shared_d) %>%
addTiles()  %>%
setView(-8.05,39.05,11) %>%
addMarkers(lng = ~long, lat = ~lat, icon = icon_x)
})

output$tbl <- renderReactable({
t<-  reactable(
shared_d,
onClick = "select",
selection = "multiple",
selectionId = "sel"
)
})

d_new <- reactive({
shared_d$data()[input$sel,]
})   
observeEvent(input$sel, {
#  d_new <- d[d$id == input$sel,]
output$texto <- renderText(print(input$sel))

if (is.null(input$sel)){
leafletProxy("map", data = d_new()) %>%
clearMarkers() %>%
addMarkers(lng = ~long, lat = ~lat, icon = icon_y)
}
})
}
shinyApp(ui = ui, server = server)

Answer 1

我使用getReactableState而不是selectionID解决了这个问题。在observeEvent中，getReactableState必须转换为文本。

这是一个有效的解决方案。

library(shiny)
library(leaflet)
library(reactable)
library(crosstalk)
icon_x = makeIcon("https://icons.getbootstrap.com/assets/icons/arrow-up-circle-fill.svg",
iconWidth = 16, iconHeight = 16)
icon_y = makeIcon("https://icons.getbootstrap.com/assets/icons/arrow-up-circle-fill.svg",
iconWidth = 64, iconHeight = 64)
d <- data.frame(
id = c(1,2,3),
label = c("a","b","c"),
long = c(-8,-8,-8.1),
lat = c(39,39.1,39)
)
ui <- fluidPage(
#  textOutput("texto"),
reactableOutput("tbl"),
leafletOutput(outputId = "map")
)
server <- function(input, output) {
shared_d <- SharedData$new(d)

output$map <- renderLeaflet({
leaflet(shared_d) %>%
addTiles()  %>%
setView(-8.05,39.05,11)
})

output$tbl <- renderReactable({
t<-  reactable(
shared_d,
onClick = "select",
selection = "multiple",
selectionId = "sel"
)
})
d_new <- reactive({
shared_d$data()[getReactableState("tbl","selected"),]
})   
observeEvent(as.character(getReactableState("tbl","selected")), {
#  output$texto <- renderText(print(getReactableState("tbl","selected")))
if (is.null(getReactableState("tbl","selected"))){
leafletProxy("map", data = shared_d) %>%
clearMarkers() %>%
addMarkers(lng = ~long, lat = ~lat, icon = icon_x)
}
else{
leafletProxy("map", data = d_new()) %>%
clearMarkers() %>%
addMarkers(lng = ~long, lat = ~lat, icon = icon_y)
}
})
}
shinyApp(ui = ui, server = server)