[英]Shiny: Dynamic height adjustment of plot
问题:在下面的 Shiny 应用程序中,用户可以根据选择输入添加值框中显示的信息。 如果用户选择了所有可能的选项,则 UI 看起来如屏幕截图所示。
问题:图(与值框在同一行)是否有可能调整高度(因此图的底部与最后一个值框的底部对齐)?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectizeInput(
inputId = "select",
label = "Select country:",
choices = c("CH", "JP", "GER", "AT", "CA", "HK"),
multiple = TRUE)
),
dashboardBody(
fluidRow(column(2, uiOutput("ui1")),
column(10, plotOutput("some_plot"))))#,
# column(4, uiOutput("ui2")),
# column(4, uiOutput("ui3")))
)
server <- function(input, output) {
output$ui1 <- renderUI({
req(input$select)
lapply(seq_along(input$select), function(i) {
fluidRow(
valueBox(value = input$select[i],
subtitle = "Box 1",
width = 12)
)
})
})
output$some_plot <- renderPlot(
plot(iris)
)
}
shinyApp(ui = ui, server = server)
您可以在renderPlot
调整高度。 我已将最小值设置为 3 值框高度。 因此,它会在您添加 3 个值框后开始增加高度。 您可以根据需要对其进行修改。 试试下面的代码。
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectizeInput(
inputId = "select",
label = "Select country:",
choices = c("CH", "JP", "GER", "AT", "CA", "HK"),
multiple = TRUE)
),
dashboardBody(
fluidRow(column(2, uiOutput("ui1")),
column(10, plotOutput("some_plot"))))#,
# column(4, uiOutput("ui2")),
# column(4, uiOutput("ui3")))
)
server <- function(input, output) {
plotht <- reactiveVal(360)
observe({
req(input$select)
nvbox <- length(input$select)
if (nvbox > 3) {
plotheight <- 360 + (nvbox-3)*120
}else plotheight <- 360
plotht(plotheight)
})
output$ui1 <- renderUI({
req(input$select)
lapply(seq_along(input$select), function(i) {
fluidRow(
valueBox(value = input$select[i],
subtitle = "Box 1",
width = 12)
)
})
})
observe({
output$some_plot <- renderPlot({
plot(iris)
}, height=plotht())
})
}
shinyApp(ui = ui, server = server)
这是我的尝试,基于这个答案。 这使用窗口大小侦听器来动态调整绘图的大小(可能通过在plotOutput
调用中使用inline = TRUE
)。 外层容器的宽度是固定的,所以可以直接引用,但是高度是动态的,所以我的解决方法是使用窗口高度减去50像素。 只要有一个情节元素,这似乎就可以工作,并且侧边栏没有被调整到情节的顶部,而不是旁边。
窗口调整大小会在半秒内没有变化后才调整大小,这样服务器不会在重绘调用中负担太多。 如果尺寸尚未确定,代码也不会绘制任何内容,因此没有初始绘图闪烁。
library(shiny)
ui <- fluidPage(
## Add a listener for the window height and plot container width
tags$head(tags$script('
var winDims = [0, 0];
var plotElt = document;
$(document).on("shiny:connected", function(e) {
plotElt = document.getElementById("plotContainer");
winDims[0] = plotElt.clientWidth;
winDims[1] = window.innerHeight;
Shiny.onInputChange("winDims", winDims);
});
$(window).resize(function(e) {
winDims[0] = plotElt.clientWidth;
winDims[1] = window.innerHeight;
Shiny.onInputChange("winDims", winDims);
});
')),
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
sliderInput("height", label="Height",
min=100, max=900, value = 600)
),
mainPanel(
tags$div(id="plotContainer", ## Add outer container to make JS constant
## Use an "inline" plot, so that width and height can be set server-side
plotOutput("distPlot", inline = TRUE))
)
)
)
server <- function(input, output) {
## reduce the amount of redraws on window resize
winDims_d <- reactive(input$winDims) %>% debounce(500)
## fetch the changed window dimensions
getWinX <- function(){
print(input$winDims);
if(is.null(winDims_d())) { 400 } else {
return(winDims_d()[1])
}
}
getWinY <- function(){
if(is.null(winDims_d())) { 600 } else {
return(winDims_d()[2] - 50)
}
}
output$distPlot <- renderPlot({
if(is.null(winDims_d())){
## Don't plot anything if we don't yet know the size
return(NULL);
}
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
}, width = getWinX, height=getWinY)
}
shinyApp(ui = ui, server = server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.