当我在 Shiny table 中 select 一行时,如何更改传单中的圆圈标记颜色?
How to change circle marker color in leaflet when I select a row in the table in Shiny?
所以我想在 select table 中的一行时更改 Leaflet 地图中的 CircleMarker 颜色。我没有收到任何错误,但什么也没发生。我不知道如何在我的 Shiny 应用程序中正确创建和应用反应函数。
当 select 在 table 中编辑行时,我尝试创建一个反应函数,并将其应用于单独的传单代理和传单地图。
library(shiny)
library(DT)
library(dplyr)
library(leaflet)
library(leaflet.extras)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Quakes Test"),
# Sidebar with numericInput for quakes depth range
sidebarLayout(
sidebarPanel(
numericInput(inputId = "min_depth", label = "Mininum depth", value = min(quakes$depth), min = min(quakes$depth), max = max(quakes$depth)),
numericInput(inputId = "max_depth", label = "Maximum depth", value = max(quakes$depth), min = min(quakes$depth), max = max(quakes$depth))
),
# Show a map
mainPanel(
fluidRow(
leafletOutput("mymap_occ", width = "98%", height = 500))
)
),
fluidRow(DT::dataTableOutput(outputId = "prop_table"))
)
server <- function(input, output) {
#filter terrains
depth_final <- reactive({
obj <- quakes
if (input$min_depth != "All") {
obj <- quakes %>%
filter(depth >= as.numeric(input$min_depth)) %>%
filter(depth <= as.numeric(input$max_depth))
}
})
#row selected in table
table2_bat <- reactive({
data <- depth_final()
data <- data[input$prop_table, ]
})
output$prop_table <- renderDT({
datatable(depth_final(), extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'single')
})
#row selected map
observe({
leafletProxy("mymap_occ", data = table2_bat()) %>%
clearGroup(group = "FOO") %>%
addCircleMarkers(lng = ~long, lat = ~lat,
color = "white", fillColor = "yellow", opacity = 1, fillOpacity = 1,
radius = 5, weight = 20, group = "FOO")
})
#map
observe({
leafletProxy("mymap_occ", data = depth_final()) %>%
clearGroup(group = "FOO_2") %>%
addCircleMarkers(lng = ~long, lat = ~lat,
color = "white", fillColor = "red", opacity = 1, fillOpacity = 0.75,
radius = 5, weight = 2, group = "FOO_2")
})
output$mymap_occ <- renderLeaflet({
leaflet(table2_bat()) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
})
output$mymap_occ <- renderLeaflet({
leaflet(depth_final()) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
})
}
shinyApp(ui = ui, server = server)
首先。您必须使用 eventReactive
而不是 reactive
来触发基于事件的操作,即当用户选择一行时。第二。要获取所选行的索引,您必须使用 input$prop_table_rows_selected
(参见 here)而不是 input$prop_table
。 input$prop_table
不存在,即returnsNULL
。因此,要让您的应用正常运行,请尝试以下操作:
#row selected in table
table2_bat <- eventReactive(input$prop_table_rows_selected, {
data <- depth_final()
data <- data[input$prop_table_rows_selected, ]
})
所以我想在 select table 中的一行时更改 Leaflet 地图中的 CircleMarker 颜色。我没有收到任何错误,但什么也没发生。我不知道如何在我的 Shiny 应用程序中正确创建和应用反应函数。
当 select 在 table 中编辑行时,我尝试创建一个反应函数,并将其应用于单独的传单代理和传单地图。
library(shiny)
library(DT)
library(dplyr)
library(leaflet)
library(leaflet.extras)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Quakes Test"),
# Sidebar with numericInput for quakes depth range
sidebarLayout(
sidebarPanel(
numericInput(inputId = "min_depth", label = "Mininum depth", value = min(quakes$depth), min = min(quakes$depth), max = max(quakes$depth)),
numericInput(inputId = "max_depth", label = "Maximum depth", value = max(quakes$depth), min = min(quakes$depth), max = max(quakes$depth))
),
# Show a map
mainPanel(
fluidRow(
leafletOutput("mymap_occ", width = "98%", height = 500))
)
),
fluidRow(DT::dataTableOutput(outputId = "prop_table"))
)
server <- function(input, output) {
#filter terrains
depth_final <- reactive({
obj <- quakes
if (input$min_depth != "All") {
obj <- quakes %>%
filter(depth >= as.numeric(input$min_depth)) %>%
filter(depth <= as.numeric(input$max_depth))
}
})
#row selected in table
table2_bat <- reactive({
data <- depth_final()
data <- data[input$prop_table, ]
})
output$prop_table <- renderDT({
datatable(depth_final(), extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'single')
})
#row selected map
observe({
leafletProxy("mymap_occ", data = table2_bat()) %>%
clearGroup(group = "FOO") %>%
addCircleMarkers(lng = ~long, lat = ~lat,
color = "white", fillColor = "yellow", opacity = 1, fillOpacity = 1,
radius = 5, weight = 20, group = "FOO")
})
#map
observe({
leafletProxy("mymap_occ", data = depth_final()) %>%
clearGroup(group = "FOO_2") %>%
addCircleMarkers(lng = ~long, lat = ~lat,
color = "white", fillColor = "red", opacity = 1, fillOpacity = 0.75,
radius = 5, weight = 2, group = "FOO_2")
})
output$mymap_occ <- renderLeaflet({
leaflet(table2_bat()) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
})
output$mymap_occ <- renderLeaflet({
leaflet(depth_final()) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
})
}
shinyApp(ui = ui, server = server)
首先。您必须使用 eventReactive
而不是 reactive
来触发基于事件的操作,即当用户选择一行时。第二。要获取所选行的索引,您必须使用 input$prop_table_rows_selected
(参见 here)而不是 input$prop_table
。 input$prop_table
不存在,即returnsNULL
。因此,要让您的应用正常运行,请尝试以下操作:
#row selected in table
table2_bat <- eventReactive(input$prop_table_rows_selected, {
data <- depth_final()
data <- data[input$prop_table_rows_selected, ]
})