如何允许selectInput列表在Shiny中溢出absolutePanel的边界?

时间:2018-03-25 07:07:38

标签: r shiny shinydashboard

我有一个闪亮的应用程序,让用户从一组输入中进行选择,这些输入会更新地图上显示的点。控件放在absolutePanel中,我希望面板的高度增加/减少,由每个selectInput列表中的项目数决定。有没有办法访问selectInputList的高度或以其他方式设置absolutePanel的高度是否灵活?提前谢谢!

以下示例:

app.r

library(shiny)
library(shinydashboard)
library(tidyverse)
library(leaflet)
library(leaflet.extras)

foo <- c("first", "first", "first", "first", "second", "second", "second", "second", "third", "third")
bar <- c("a","a","a","a","b","b","b","b","c","c")
lat <- c(41.1,41.2,41.3,41.4,41.5,41.6,41.7,41.8,41.9,41.10)
lon <- c(-4.1,-4.2,-4.3,-4.4,-4.5,-4.6,-4.7,-4.8,-4.9,-4.10)

df_tmp <- data.frame(foo, bar, lat, lon, stringsAsFactors = FALSE)

icon <- awesomeIcons(
  icon = 'home',
  iconColor = '#00CCFF',
  library = 'fa',
  markerColor = 'gray'
)

firstList <- setNames(foo, foo)
secondList <- setNames(bar, bar)

# ---------------------- UI ----------------------------------------

ui <- dashboardPage(
  skin = "black",
  dashboardHeader(
    title = "Foo",
    titleWidth = 220
  ),
  dashboardSidebar(
    width = 220,
    sidebarMenu(
      menuItem(
        text = "First Tab",
        tabName = "firstTab",
        icon = icon("map-signs")
      )
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "firstTab",
        div(
          class = "outer",
          tags$head(
            includeCSS("www/styles.css")
          ),
          leafletOutput("firstMapOutput", width = "100%", height = "100%"),
          absolutePanel(
            id = "controls", class = "panel panel-default", fixed = TRUE,
            draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
            width = 330, height = "auto",

            h3("Controls"),

            selectInput(
              inputId = "firstMapFirstSelection",
              label = "First",
              choices = firstList,
              selected = "first",
              multiple = TRUE
            ),
            selectInput(
              inputId = "firstMapSecondSelection",
              label = "Second",
              choices = secondList,
              selected = "a",
              multiple = TRUE
            )
          )
        )
      )
    )
  )
)
  ##### ---------------------- SERVER -----
  server <- function(input, output, session) {
    output$firstMapOutput <- renderLeaflet({
      selectedData <- reactive({
        df_tmp %>%
          filter(
            foo == input$firstMapFirstSelection &
            bar == input$firstMapSecondSelection
          ) 
      })
      leaflet() %>%
        addProviderTiles(providers$CartoDB.Positron) %>%
        addAwesomeMarkers(
          lng = ~lon,
          lat = ~lat,
          icon = icon,
          data = selectedData()
        )
    })
  }

  shinyApp(ui, server)

styles.css的:

input[type="number"] {
  max-width: 80%;
}

div.outer {
  position: fixed;
  top: 41px;
  left: 0;
  right: 0;
  bottom: 0;
  overflow-y: auto;
  /*overflow: hidden;*/
  padding: 0;
}

/* Customize fonts */
body, label, input, button, select { 
  font-family: 'Helvetica Neue', Helvetica;
  font-weight: 200;
}
h1, h2, h3, h4 { font-weight: 400; }

#controls {
  /* Appearance */
  background-color: white;
  padding: 0 20px 20px 20px;
  cursor: move;
  /* Fade out while not hovering */
  opacity: 0.65;
  zoom: 0.9;
  transition: opacity 500ms 1s;
  overflow-y: auto;
}

#controls:hover {
  /* Fade in while hovering */
  opacity: 0.95;
  transition-delay: 0;
}

/* Position and style citation */
#cite {
  position: absolute;
  bottom: 10px;
  left: 10px;
  font-size: 12px;
}

/* If not using map tiles, show a white background */
.leaflet-container {
  background-color: white !important;
}

1 个答案:

答案 0 :(得分:1)

您想要覆盖选择输入列表的默认定位行为。而不是绝对定位,这意味着它不会重排兄弟元素和父元素,你希望它们是静态的。静态元素占用空间并将嵌入周围条件面板的大小。 (默认情况下,条件面板大小是灵活的。)

css规则是

def scene(housesize):
   for i in range (3):
     hs = housesize*0.8
     myhouse(hanzi, hs)
     hanzi.pu()
     hanzi.goto(200,20)
     hanzi.pd()
scene(100)

static dropdown