闪亮布局：使用可滚动面板和保持固定面板构建闪亮页面

Question

我想构建一个具有以下布局的闪亮面板：

黄色面板是显示绘图的位置，如果生成了多个绘图并且无法在页面上查看，则黄色面板应该是可滚动的。绿色面板应该几乎像页面上的页脚一样，并且即使在黄色面板滚动时也是固定的。

这是我到目前为止的代码。我已经设法获得蓝色、黄色和绿色面板，但不确定如何使内容可滚动和固定。

data <- mtcars

ui <- fluidPage(
  tags$head(
    tags$style(HTML("body, pre { height: 100%}")),
    tags$style("#panel1 {background: green; height: 100%; position: fixed}"),
  ),

  fluidRow(id='row1',
    column(2,id='panel1',
      selectizeInput(inputId= "obs", label= "Obs", 
                     choices= names(mtcars), 
                     selected= names(mtcars)[1],
                     multiple=F),
      selectizeInput(inputId= "sublevel", label= "Sublevel", 
                     choices= sort(unique(mtcars$cyl)), 
                     selected= sort(unique(mtcars$cyl))[1],
                     multiple=F)
    ),
    column(10, id='panel2',offset = 2,
           fluidRow(tableOutput("tab")),
           fluidRow(textOutput("hi"))
    )
  )
)

server <- function(input, output){
  sorted <- reactive({data %>% arrange_(input$obs) %>% filter(cyl == input$sublevel)})
  output$tab= renderTable(sorted())
  output$hi<-renderPrint(paste0("hello"))
}

shinyApp(ui = ui, server = server)

Any help is very much appreciated.

Answer 1

干得好。

关键点是：

• 用于absolutePanel设置左、右、上、下位置；
• 使用height和width限制盒子；
• 在 css 中，使用overflow: auto;黄色框来滚动扩展元素

data <- mtcars

ui <- fluidPage(
    tags$head(
        tags$style("html, body { height: 100%; width: 100%}"),
        tags$style("#panel1 {background: #ADD8E6; height: 100px; position: fixed}"),
        tags$style("#panel2 {
            overflow: auto;
            background: orange;
            margin-left: 5px;
        }"),
        tags$style("#panel3 {background: green}")
    ),
    absolutePanel(id = "panel1",
                  height = "100%", width = "20%", right = "80%",
                  selectizeInput(inputId= "obs", label= "Obs", 
                                 choices= names(mtcars), 
                                 selected= names(mtcars)[1],
                                 multiple=F),
                  selectizeInput(inputId= "sublevel", label= "Sublevel", 
                                 choices= sort(unique(mtcars$cyl)), 
                                 selected= sort(unique(mtcars$cyl))[1],
                                 multiple=F)
    ), 
    absolutePanel(id = "panel2", 
                  top = "0%", left = "20%", height = "80%", width = "80%", right = "0%",bottom = "20%",
                  fluidRow(tableOutput("tab")),
                  HTML("<br><br><br><br><br><br><br><br><br><br><br><br><br><br>
                         <br><br><br><br><p>sdsdsd</p>"),
                  fluidRow(textOutput("hi"))

    ),
    absolutePanel(id = "panel3",
                  top = "80%", left = "20%", height = "20%", width = "80%", right = "0%",bottom = "0",
                  p("haha")
    )
)

server <- function(input, output){
    sorted <- reactive({data %>% arrange_(input$obs) %>% filter(cyl == input$sublevel)})
    output$tab= renderTable(sorted())
    output$hi<-renderPrint(paste0("hello"))
}

shinyApp(ui = ui, server = server)