如何将 Rshiny select 输入带到前层？目前，传单图例阻碍了 selection

Question

在我闪亮的应用程序中，我有一张传单地图，它随 select 公制离子动态变化。但是 drop-down 落后于阻碍指标被 selected 的传单图例。如何提供分层选项（用于 Rshiny 的 select 输入对象或传单图例）并将 drop-down 置于正面视图？

这是我正在使用的代码块：

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)

Answer 1

前段时间我遇到了同样的问题。我用 css 和 z-indexing 修复了它。这是我使用的 css-代码：

.leaflet-top, .leaflet-bottom {
    z-index: unset !important;
}

.leaflet-touch .leaflet-control-layers, .leaflet-touch .leaflet-bar {
    z-index: 10000000000 !important;
}

显然，您还必须在浏览器中打开该应用程序。在 RStudio window 中，传单图例仍然阻挡控件小部件。

编辑：

要将其包含在您的 shinyApp 中，

将 css 包装在一个变量中，然后
分配给html-head。

第 1 步：

css = HTML("
  .leaflet-top, .leaflet-bottom {
    z-index: unset !important;
  }

  .leaflet-touch .leaflet-control-layers, .leaflet-touch .leaflet-bar {
    z-index: 10000000000 !important;
  }
")

第 2 步：

tags$head(tags$style(css))

完整示例：

library(shiny)
library(leaflet)

css = HTML("
  .leaflet-top, .leaflet-bottom {
    z-index: unset !important;
  }

  .leaflet-touch .leaflet-control-layers, .leaflet-touch .leaflet-bar {
    z-index: 10000000000 !important;
  }
")

ui <- fluidPage(
  tags$head(tags$style(css)),
  leafletOutput("map")  
)

server <- function(input, output, session) {
  output$map <- renderLeaflet(
    leaflet() %>% 
      addTiles()
  )
}

shinyApp(ui, server)

如何将 Rshiny select 输入带到前层？目前，传单图例阻碍了 selection

How to bring Rshiny select input to front layer? Currently the leaflet legend is obstructing the selection

r

leaflet

shiny

r-leaflet