Как вывести Rshiny select на вход переднего слоя? В настоящее время легенда листовки препятствует отбору - PullRequest
Новая
       79

Как вывести Rshiny select на вход переднего слоя? В настоящее время легенда листовки препятствует отбору

0 голосов
/ 11 мая 2018

В моем блестящем приложении у меня есть листовка, которая динамически меняется с выбором метрики. Но выпадающий список идет за легендой листовки, препятствующей выбору метрики. Как задать параметры наложения (либо для выбранного входного объекта Rshiny, либо для листовки с надписью) и вывести раскрывающийся список на вид спереди?

layering problem image Вот блоки кода, которые я использую: 

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 Ответ

0 голосов
/ 14 мая 2018

У меня была такая же проблема некоторое время назад. Я исправил это с помощью 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 легенда листовки все еще блокирует виджет управления.

EDIT:

Чтобы включить это в своем блестящем приложении,

  1. обернуть CSS в переменную и
  2. назначить его 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)
...