Оборачивание раскрывающейся кнопки в абсолютной панели в R Shiny - PullRequest
Новая
       89

Оборачивание раскрывающейся кнопки в абсолютной панели в R Shiny

0 голосов
/ 03 апреля 2020

Я создаю интерактивную карту с Shiny, и в настоящее время я пытаюсь скрыть свои элементы пользовательского интерфейса в раскрывающейся кнопке от pakg woolWidgets.

Моя проблема в том, что до сих пор у меня может быть либо работающая выпадающая кнопка, и мне нужно удалить width = "100%", height = "100%" из моего листка. Выход

ИЛИ

с моей картой, как я хочу и выпадающая кнопка невидима.

Есть ли способ иметь оба? Спасибо!

Вот репрезентация: 

library(shiny)
library(leaflet)
library(RColorBrewer)
library(shinyWidgets)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  dropdownButton(sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
      value = range(quakes$mag), step = 0.1
    ),
    selectInput("colors", "Color Scheme",
      rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
    ),
    checkboxInput("legend", "Show legend", TRUE)
  )
)

server <- function(input, output, session) {

  # Reactive expression for the data subsetted to what the user selected
  filteredData <- reactive({
    quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
  })

  # This reactive expression represents the palette function,
  # which changes as the user makes selections in UI.
  colorpal <- reactive({
    colorNumeric(input$colors, quakes$mag)
  })

  output$map <- renderLeaflet({
    # Use leaflet() here, and only include aspects of the map that
    # won't need to change dynamically (at least, not unless the
    # entire map is being torn down and recreated).
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })

  # Incremental changes to the map (in this case, replacing the
  # circles when a new color is chosen) should be performed in
  # an observer. Each independent set of things that can change
  # should be managed in its own observer.
  observe({
    pal <- colorpal()

    leafletProxy("map", data = filteredData()) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
        fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
      )
  })

  # Use a separate observer to recreate the legend as needed.
  observe({
    proxy <- leafletProxy("map", data = quakes)

    # Remove any existing legend, and only if the legend is
    # enabled, create a new one.
    proxy %>% clearControls()
    if (input$legend) {
      pal <- colorpal()
      proxy %>% addLegend(position = "bottomright",
        pal = pal, values = ~mag
      )
    }
  })
}

shinyApp(ui, server)

1 Ответ

1 голос
/ 03 апреля 2020

Вместо установки html ширины и высоты вы можете поместить карту в контейнер на целую страницу следующим образом: 

ui <- bootstrapPage(
  tags$style(type = "text/css", ".map-container {position:absolute; top:0; bottom:0; right:0; left:0;}"),
  tags$style(type = "text/css", "#dropdown {margin-top: 80px; margin-left: 10px;}"),
  tags$div(
    class = "map-container",
    leafletOutput("map", width = "100%", height = "100%")
  ),
  dropdownButton(
    inputId = "dropdown",
    icon = icon("gears"),
    circle = FALSE,
    sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
                value = range(quakes$mag), step = 0.1
    ),
    selectInput("colors", "Color Scheme",
                rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
    ),
    checkboxInput("legend", "Show legend", TRUE)
  )
)
...