web-dev-qa-db-ja.com

光沢のあるダッシュボードのメインパネルの高さの問題

これは私の 前の質問 の拡張です。メインパネルの高さを伸ばすことができなくなりました。

これは以下の私のコードです

_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(width = 12, 

      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")))),

                 fluidRow(


                   column(width = 4,  box(title = "Plot1", width = NULL, solidHeader = FALSE, plotOutput("plot1", height = "600px"))),
                   column(width = 4,  box(title = "Plot2", width = NULL, solidHeader = FALSE, plotOutput("plot2", height = "600px"))),
                   column(width = 4,  box(title = "Plot3", width = NULL, solidHeader = FALSE, plotOutput("plot3", height = "600px")))


                 )

        )
      )
    )
  ))

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( "Three","Yes",icon = icon("stethoscope"))})
  output$vbox4 <- renderValueBox({ valueBox( "Four","Yes",icon = icon("stethoscope"))})
  output$vbox5 <- renderValueBox({ valueBox( "Five","Yes",icon = icon("stethoscope"))})
  output$vbox6 <- renderValueBox({ valueBox( "Six","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)
_

プロットがデフォルトのレイアウトスペースからはみ出しているため、mainPanel()に高さを増やすオプションが見つかりません。このmainPanel()のように、mainPanel(width = 12, height, 20 ....)内で高さの値を強制しようとしましたが、機能しませんでした。どんな提案でも大歓迎です。

+ Main Panel Height issue

- - - - -更新しました - - - - - - -

これが役立つかどうかはわかりませんが、mainpanel（）を使用しない場合は問題になりません。

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

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


  dashboardSidebar(
    conditionalPanel(condition="input.tabselected==3",
                     textInput("text", "Enter Id:"),
                     box(width = 1, background  = 'purple'),
                     actionButton("Ok", "Press Ok",style='padding:8px; font-size:100%')
    )
  ),
  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")))


  ),

  fluidRow(


    column(width = 4,  box(title = "Plot1 ", width = NULL, solidHeader = FALSE, plotOutput("plot1", height = "600px"))),
    column(width = 4,  box(title = "Plot2", width = NULL, solidHeader = FALSE, plotOutput("plot2", height = "600px"))),
    column(width = 4,  box(title = "Plot3", width = NULL, solidHeader = FALSE, plotOutput("plot3", height = "600px")))


  )



  )
  )


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( "Three","Yes",icon = icon("stethoscope"))})
  output$vbox4 <- renderValueBox({ valueBox( "Four","Yes",icon = icon("stethoscope"))})
  output$vbox5 <- renderValueBox({ valueBox( "Five","Yes",icon = icon("stethoscope"))})
  output$vbox6 <- renderValueBox({ valueBox( "Six","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)  )})
  #output$dat4 <- renderDataTable({datatable(data.frame(HairEyeColor),extensions = 'Responsive' )})
}

shinyApp(ui, server)
_
rlayoutshinyshinydashboardtabpanel
7
Sundown Brownbear

shinydashboardの関数ではなく、標準のshinyパッケージを使用しており、tabBoxをfluidRowでラップする必要があります。

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(

              fluidRow(
              tabBox(width = 12, height = NULL,

                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")))),

                         fluidRow(


                           column(width = 4,  box(title = "Plot1", width = NULL, solidHeader = FALSE, plotOutput("plot1"))),
                           column(width = 4,  box(title = "Plot2", width = NULL, solidHeader = FALSE, plotOutput("plot2"))),
                           column(width = 4,  box(title = "Plot3", width = NULL, solidHeader = FALSE, plotOutput("plot3")))


                         )

                )
              )
    )
  ))

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( "Three","Yes",icon = icon("stethoscope"))})
  output$vbox4 <- renderValueBox({ valueBox( "Four","Yes",icon = icon("stethoscope"))})
  output$vbox5 <- renderValueBox({ valueBox( "Five","Yes",icon = icon("stethoscope"))})
  output$vbox6 <- renderValueBox({ valueBox( "Six","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)
9
Kevin Arseneau