Я использую shinydashboards tabboxes и у меня возникают проблемы с вертикальным выравниванием fluidrows внутри tabbox, из-за чего кнопка отображается поверх моего графика.
Первая вкладка в tabbox содержит график и кнопку загрузки, каждая в своем собственном FluidRow, вторая вкладка содержит datatable и кнопку загрузки, каждая в своем собственном FluidRow. График представляет собой facet_grid, и чтобы сделать его видимым, я указал высоту графика на моем сервере. График отображается правильно, но UI не реагирует на указанную высоту при рендеринге кнопки и отображает кнопку в верхней части графика.
Я также указываю высоту объекта с данными для вкладки данных на сервере, используя; 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)