代码之家 › 专栏 › 技术社区 › Murali

如何将Rshiny select输入带到前一层?目前传单图例阻碍了选择

r-leaflet leaflet shiny r

Murali · 技术社区 · 6 年前

在我闪亮的应用程序中,我有一个传单地图,它会随着度量的选择而动态变化。但下拉列表位于传单图例后面,阻碍了要选择的指标。如何提供分层选项(用于选择Rshiny的输入对象或传单图例)并将下拉菜单置于前视图?

以下是am使用的代码块:

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)

1 回复 | 直到 6 年前

SeGa 6 年前

不久前我也有同样的问题。我用一些css和z索引修复了它。这是我使用的css代码:

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

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

显然,你还必须在浏览器中打开应用程序。在RStudio窗口中,传单图例仍在阻止控件小部件。

编辑:

将css包装在变量中
将其分配给html标头。

步骤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)