在我闪亮的应用程序中,我有一张传单地图,它随着一系列指标的选择而动态变化。但是下拉菜单落后于传单图例,阻碍了要选择的指标。如何提供分层选项(用于选择 Rshiny 的输入对象或传单图例)并将下拉菜单置于前视图?
output$geo_metric_type <- renderUI({
selectInput(inputId = 'geo_metric_type',label="",
choices=c('Targeted Change','Reg. Rate Change', 'Act. Rate Change', 'Inf. Rev/Act Change'), selected="Targeted Change")
})
# Leaflet Object
mycolpal <- function(x){
if(min(x) > 0 && max(x) > 0){
x <- x*10
min = abs(round(min(x)))
max = abs(round(max(x)))
rc2 = colorRampPalette(colors = c("white", "green"), space="Lab")(max-min)
rampcols <- rc2
rampcols
} else if (min(x) < 0 && max(x) < 0){
x <- x*10
min = abs(round(min(x)))
max = abs(round(max(x)))
rc1 = colorRampPalette(colors = c("red", "white"), space="Lab")(min-max)
rampcols <- rc1
rampcols
} else{
x <- x*10
min = abs(round(min(x)))
max = abs(round(max(x)))
rc1 = colorRampPalette(colors = c("red", "white"), space="Lab")(min)
rc2 = colorRampPalette(colors = c("white", "green"), space="Lab")(max)
rampcols = c(rc1, rc2)
rampcols
}
}
color = "#666"
weight = 0.5
opacity = 1
fillOpacity = 1
dashArray = ""
hl_color = "black"
hl_weight = 1
hl_dashArray = ""
pal <- colorNumeric(
palette = mycolpal(regions1()@data$change_targeted), #"Blues", #YlGnBu,YlOrRd
domain = regions1()@data$change_targeted)
legendpal <- colorNumeric(
palette = rev(mycolpal(regions1()@data$change_targeted)), #"Blues", #YlGnBu,YlOrRd
domain = regions1()@data$change_targeted)
leaflet(regions1(), options = leafletOptions(zoomControl = FALSE, attributionControl=FALSE)) %>%
addPolygons(color = color,
weight = weight, #smoothFactor = 0.5,
opacity = opacity, fillOpacity = fillOpacity,
dashArray = dashArray,
fillColor = ~pal(change_targeted),
#fillColor = ~colorQuantile("magma", Max_value)(Max_value),
highlightOptions = highlightOptions(color = hl_color,
weight = hl_weight,
dashArray = hl_dashArray,
bringToFront = TRUE),
label = ~as.character(paste0(region," : ",round(change_targeted,1),"%")),
labelOptions = labelOptions(noHide = T, textOnly = F, direction = "left",
textsize = "12px")) %>%
setView(35, 40, 0.4) %>%
addLegend("bottomright", pal = legendpal, values = ~change_targeted,
title = NULL,
labFormat = labelFormat(suffix = "%",transform = function(x) sort(x, decreasing = T))
, opacity=1)