闪亮 - 固定高度的可滚动面板

Question

我正在关注一个闪亮的示例，以在uiOutput中绘制多个图。我想有一个包含这些图的面板（右边的单词？）具有固定的高度，但允许滚动查看超出此高度的图。

我已经尝试在固定高度的fixedRow中包含uiOutput（），但它不起作用。

我已经包含下面

require(shiny) 
 

 
ui <- shinyUI(fluidPage(
 
    #fixedRow(uiOutput('plots'), height="100px") 
 
    uiOutput('plots') 
 
)) 
 

 
server <- shinyServer(function(input, output) { 
 
    
 
    plots <- lapply(1:10, function(i){ 
 
     plot(runif(50),main=sprintf('Plot nr #%d',i)) 
 
     p <- recordPlot() 
 
     plot.new() 
 
     p 
 
    }) 
 
    n.col <- 3 
 
    
 
    output$plots <- renderUI({ 
 
     col.width <- round(12/n.col) # Calculate bootstrap column width 
 
     n.row <- ceiling(length(plots)/n.col) # calculate number of rows 
 
     cnter <<- 0 # Counter variable 
 
     
 
     # Create row with columns 
 
     rows <- lapply(1:n.row,function(row.num){ 
 
      cols <- lapply(1:n.col, function(i) { 
 
       cnter <<- cnter + 1 
 
       plotname <- paste("plot", cnter, sep="") 
 
       column(col.width, plotOutput(plotname, height = 280, width = 250)) 
 
      }) 
 
      fluidRow(do.call(tagList, cols)) 
 
     }) 
 
     
 
     do.call(tagList, rows) 
 
    }) 
 
    
 
    for (i in 1:length(plots)) { 
 
     local({ 
 
      n <- i # Make local variable 
 
      plotname <- paste("plot", n , sep="") 
 
      output[[plotname]] <- renderPlot({ 
 
       plots[[n]] 
 
      }) 
 
     }) 
 
    } 
 
}) 
 

 
shinyApp(ui=ui,server=server)

Answer 1

一个选项的代码使用CSS。可能需要一点小把戏，让所有的东西都按你想要的方式定位。这里有一个简单的例子：

require(shiny) 

ui <- shinyUI(fluidPage(
    #fixedRow(uiOutput('plots'), height="100px") 
    tags$style(HTML(" 
        #plots { 
        height:100px; 
        overflow-y:scroll 
        } 
        ")), 
    uiOutput('plots') 
)) 

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

    plots <- lapply(1:10, function(i){ 
    plot(runif(50),main=sprintf('Plot nr #%d',i)) 
    p <- recordPlot() 
    plot.new() 
    p 
    }) 
    n.col <- 3 

    output$plots <- renderUI({ 
    col.width <- round(12/n.col) # Calculate bootstrap column width 
    n.row <- ceiling(length(plots)/n.col) # calculate number of rows 
    cnter <<- 0 # Counter variable 

    # Create row with columns 
    rows <- lapply(1:n.row,function(row.num){ 
     cols <- lapply(1:n.col, function(i) { 
     cnter <<- cnter + 1 
     plotname <- paste("plot", cnter, sep="") 
     column(col.width, plotOutput(plotname, height = 280, width = 250)) 
     }) 
     fluidRow(do.call(tagList, cols)) 
    }) 

    do.call(tagList, rows) 
    }) 

    for (i in 1:length(plots)) { 
    local({ 
     n <- i # Make local variable 
     plotname <- paste("plot", n , sep="") 
     output[[plotname]] <- renderPlot({ 
     plots[[n]] 
     }) 
    }) 
    } 
}) 

shinyApp(ui=ui,server=server)