Search code examples
rshinyleafletr-leaflet

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

In my shiny app, I have a leaflet map which changes dynamically with a selection of metric. But the drop-down is going behind the leaflet legend obstructing the metric to be selected. How to I give layering options (either for select input object of Rshiny or the leaflet legend) and bring the drop-down to front view?

layering problem image Here is the code blocks am using:

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)
Solution

  • I had the same problem some time ago. I fixed it with some css and z-indexing. This is the css-code i was using for it:

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

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

    You also have to open the app in the browser apparently. In the RStudio window, the leaflet legend is still blocking the control-widget.

    EDIT:

    To include this in your shinyApp,

    1. wrap the css in a variable and
    2. assign it to the html-head.

    Step 1:

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

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

    Step 2: 

    tags$head(tags$style(css))

    Full Example:

    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)