我正在使用shinydashboards tabboxes
,并且fluidrows
内tabbox
的垂直对齐方式存在问题,因此在我的图的顶部显示了一个按钮。
tabbox
中的第一个选项卡包含一个绘图和下载按钮,每个按钮都在自己的FluidRow中,第二个选项卡中包含一个datatable
和下载按钮,每个按钮都在各自的fluidRow中。该图是一个facet_grid,为了使其可见,我在服务器中指定了图的高度。图形可以正确渲染,但是UI
似乎在渲染按钮时并没有响应指定的高度,而是在图形顶部渲染按钮。
我还使用服务器为data标签中的datatable对象指定了高度。
renderDataTable(options = list(scrollY = "400px"){}
。
在这种情况下,“数据”标签中的按钮呈现在数据表下方的正确垂直位置。
下面是仪表板结构的可复制示例。对于为什么图形选项卡中的按钮在图的顶部呈现的原因,我们将不胜感激。
谢谢
library(shiny)
library(shinyBS)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(lubridate)
library(DT)
library(tidyr)
# load data in long format
dat <- mtcars
dat <- dat %>%
select(c("mpg", "cyl", "disp", "drat", "wt")) %>%
gather(key = "key", value = "value", cyl, disp, drat, wt )
#############################
#The dashboard
############################
header <- dashboardHeader(title = "Title", titleWidth = 450)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Model", icon = icon("dashboard"), tabName = "model")
)
)
body <- dashboardBody(
tabItems(
#====================================
tabItem(tabName = "model",
#===========
fluidRow(
tabBox(side="left",
width = 8,
height = "700px",
title = "",
id = "model_tab",
tabPanel("Graph",
column(width = 12,
fluidRow(
plotOutput("plot")
), # close fluidRow
fluidRow(
downloadButton("plot_download")
) #close fluidRow
) #close column
), #close tabPanel
tabPanel("Data",
column(width = 12,
fluidRow(
DT::dataTableOutput("data",
height = "350px")
), #close fluidRow
fluidRow(
downloadButton("data_download")
) # close fluidRow
) #close column
) # close tabPabel
), # close tabBox
#===========
sidebarPanel(width = 4,
align = "left",
title = "User controls",
color = "fuchsia",
solidHeader = TRUE,
sliderInput("mpg",
"mpg",
min = 1,
max = 100,
value = 10),
sliderInput("cyl",
"cyl",
min = 5,
max = 50,
value = 10),
sliderInput("disp",
"disp",
min = 5,
max = 50,
value = 10),
sliderInput("drat",
"drat",
min = 100,
max = 300,
value = 155),
dateRangeInput("date_range",
"Date range",
start=as.Date('2020-04-01') ,
end = as.Date('2025-03-01'),
format = "yyyy-mm-dd")#,
) #close sidebarpanel
) #close fluidRow
) #close tabItem
) #close tabItems
) #close dashboardBody
#################################################
ui <- dashboardPage(header,
sidebar,
body,
skin= "purple")
#################################################
# Define server logic required to draw a histogram
server <- function(input, output, session) {
output$plot <- renderPlot({
plt <- ggplot(dat, aes(x=value, y=mpg))+
geom_point()+
facet_grid(rows=vars(unique(dat$key)))
plt
plt
}, height = 600)
output$plot_download <- downloadHandler(
filename = function() { paste(input$dataset, '.png', sep='') },
content = function(file) {
png(file)
print(plotInput())
dev.off()
})
output$data <- renderDataTable(options = list(scrollY = "400px"), {
dat
})
output$HOW_data_download <- downloadHandler(
filename = "data.csv",
content = function(file) {
write.csv(dat, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
答案 0 :(得分:0)
如果您像这样plotOutput("plot", height = "600px")
在ui中指定高度,则应该正确显示