tabpanel和浪费的空白区

时间:2017-09-12 19:52:10

标签: r layout shinydashboard tabpanel

我正在创建一个带有一些valuebox和三个数据表的简单闪亮的应用程序。

如果我设计应用而不使用tabpanel ,一切正常。

library(shiny)
library(shinydashboard)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic boxes"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(

      valueBoxOutput("vbox1", width = 2),
      valueBoxOutput("vbox2", width = 2),
      valueBoxOutput("vbox3", width = 2),
      valueBoxOutput("vbox4", width = 2),
      valueBoxOutput("vbox5", width = 2),
      valueBoxOutput("vbox6", width = 2)


    ),

    fluidRow(

      column(width = 4,  box(title = "Iris", width = NULL, solidHeader = FALSE, dataTableOutput("dat1"))),
      column(width = 4,  box(title = "MT Cars", width = NULL, solidHeader = FALSE, dataTableOutput("dat2"))),
      column(width = 4,  box(title = "Old Faithful Gyser", width = NULL, solidHeader = FALSE, dataTableOutput("dat3")))

  ))
  )


server <- function(input, output) {

  output$vbox1 <- renderValueBox({ valueBox( "One","Yes",icon = icon("stethoscope"))})
  output$vbox2 <- renderValueBox({ valueBox( "Two","Yes",icon = icon("stethoscope"))})
  output$vbox3 <- renderValueBox({ valueBox( "Skip","Yes",icon = icon("stethoscope"))})
  output$vbox4 <- renderValueBox({ valueBox( "a Two","Yes",icon = icon("stethoscope"))})
  output$vbox5 <- renderValueBox({ valueBox( "Then","Yes",icon = icon("stethoscope"))})
  output$vbox6 <- renderValueBox({ valueBox( "some","Yes",icon = icon("stethoscope"))})

  output$dat1 <- renderDataTable({datatable(iris)})
  output$dat2 <- renderDataTable({datatable(mtcars,extensions = 'Responsive' )})
  output$dat3 <- renderDataTable({datatable(faithful,rownames = FALSE, options = list(autoWidth = TRUE)  )})
}

shinyApp(ui, server)

现在,如果我使用tabpanel功能设计应用 ,则右侧会有大量浪费的空白区域。

library(shiny)
library(shinydashboard)
library(shinyBS)
library(DT)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarPanel(
                     textInput("text", "Enter Id:"),
                     box(width = 1, background  = 'purple'),
                     actionButton("Ok", "Press Ok",style='padding:8px; font-size:100%')
    )

  ),
  dashboardBody(

    mainPanel(

      tabsetPanel(

        tabPanel("About", value=1, h6("The objective is to test width of ShinyApp in tabPanel design", br(),
                                      br(),

                                      "Distribution Prototype"

                                        )
                  ),


        tabPanel("Data", value=2,

                        fluidRow(

                          valueBoxOutput("vbox1", width = 2),
                          valueBoxOutput("vbox2", width = 2),
                          valueBoxOutput("vbox3", width = 2),
                          valueBoxOutput("vbox4", width = 2),
                          valueBoxOutput("vbox5", width = 2),
                          valueBoxOutput("vbox6", width = 2)


                        ),

                        fluidRow(

                          column(width = 4,  box(title = "Iris", width = NULL, solidHeader = FALSE, dataTableOutput("dat1"))),
                          column(width = 4,  box(title = "MT Cars", width = NULL, solidHeader = FALSE, dataTableOutput("dat2"))),
                          column(width = 4,  box(title = "Old Faithful Gyser", width = NULL, solidHeader = FALSE, dataTableOutput("dat3"))))

                      )
                )
              )
  ))

server <- function(input, output) {

  output$vbox1 <- renderValueBox({ valueBox( "One","Yes",icon = icon("stethoscope"))})
  output$vbox2 <- renderValueBox({ valueBox( "Two","Yes",icon = icon("stethoscope"))})
  output$vbox3 <- renderValueBox({ valueBox( "Skip","Yes",icon = icon("stethoscope"))})
  output$vbox4 <- renderValueBox({ valueBox( "a Two","Yes",icon = icon("stethoscope"))})
  output$vbox5 <- renderValueBox({ valueBox( "Then","Yes",icon = icon("stethoscope"))})
  output$vbox6 <- renderValueBox({ valueBox( "some","Yes",icon = icon("stethoscope"))})

  output$dat1 <- renderDataTable({datatable(iris)})
  output$dat2 <- renderDataTable({datatable(mtcars,extensions = 'Responsive' )})
  output$dat3 <- renderDataTable({datatable(faithful,rownames = FALSE, options = list(autoWidth = TRUE)  )})

}

shinyApp(ui, server)

Wasted White Space Image

我的用例要求我使用tabpanel,因此非常感谢任何关于使这些对象跨越整个布局而不浪费空间的建议。

0 个答案:

没有答案