基于shinydashboard搭建你的仪表板（五）

前言

承接系列四，这一节介绍一下主体中的4种box函数。顾名思义，box函数是在主体中创建一些对象框，而对象框内可以包含任何内容。

四种box函数

下面结合之前侧边栏以及主体布局简单介绍一下4种box函数。

box对象框

box对象框为基本对象框，用到的最多。函数为box()，函数中有几个常用的参数：

代码

library(shiny)library(shinydashboard)library(ggplot2)
ui <- dashboardPage(  dashboardHeader(title = "WorkingNotes:Box"),    dashboardSidebar(      sidebarMenu(    menuItem("Plot1", tabName = "Plot1", icon = icon("dashboard")),    menuItem("Plot2", tabName = "Plot2", icon = icon("dashboard")),    menuItem("Plot3", tabName = "Plot3", icon = icon("dashboard")))),  dashboardBody(    tabItems(      tabItem(tabName = "Plot1",        fluidPage(          box("仅仅设置宽度为6"),          box("在上图基础上加上对象框title的背景颜色为red")        ),        fluidPage(          box(plotOutput("Plot"), width = 6),          box(plotOutput("Plot1"), status = "danger", width = 6))),      tabItem(tabName = "Plot2",              fluidPage(                box("在上图基础上加上背景颜色为green"),                box("在上图基础上加上最小化按钮")              ),              fluidPage(                box(plotOutput("Plot2"), status = "success",background = "green", width = 6),                box(plotOutput("Plot3"), status = "success",background = "green", collapsible = TRUE, width = 6))),            tabItem(tabName = "Plot3",              fluidPage(                box("在上图基础上加collapsed = TRUE，图形已经最小化"),                box("在上图基础上加上标题")              ),                fluidPage(                box(plotOutput("Plot4"),  status = "success", background = "green",collapsible = TRUE,                     collapsed = TRUE,width = 6),                box(plotOutput("Plot5"), status = "success", background = "green", collapsible = TRUE,                     collapsed = TRUE,title = "histogram", width = 6)))          )))
server <- function(input, output) {  set.seed(123)  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]  p <- renderPlot({    ggplot(data, aes(x = price, fill = cut)) +       geom_histogram(bins = 30) +      ggtitle("geom_histogram") +      theme(plot.title = element_text(hjust = 0.5)) + xlab("")  })    output$Plot <- p  output$Plot1 <- p  output$Plot2 <- p  output$Plot3 <- p  output$Plot4 <- p  output$Plot5 <- p}shinyApp(ui, server)

上述代码中：侧边栏创建3个菜单栏，每一个菜单栏对应的主体界面布局为基于行的主体布局，每一个界面的第一个行整体用于解释第二个行整体。

tabBox对象框

使用tabBox()函数创建具有选项卡的对象框，函数内使用tabPanel()创建不同的选项卡，tabPanel()内添加输出对象。

library(shiny)library(shinydashboard)library(ggplot2)library(DT)sider <- dashboardSidebar(      sidebarMenu(      menuItem("tabbox1", tabName = "tabbox1", icon = icon("dashboard")),      menuItem("tabbox2", tabName = "tabbox2", icon = icon("dashboard")),      menuItem("tabbox3", tabName = "tabbox3", icon = icon("dashboard")))    )
body <- dashboardBody(  tabItems(  ###tabBox标题为tabbox1,宽度为12，高度为500px，其他参数为默认    tabItem(tabName = "tabbox1",             fluidRow(              tabBox(title = "tabbox1",height = "500px", width = 12,                tabPanel("plot", plotOutput("Plot")),                tabPanel("data", dataTableOutput("Data")))            )  ),    tabItem(tabName = "tabbox2",            fluidRow(            ###selected = "data",故data为活跃选项卡，side="right",选项卡呈现在右边              tabBox(title = "tabbox2",                side = "right", height = "500px", width = 12,                selected = "data",                tabPanel("plot", plotOutput("Plot1")),                tabPanel("data", dataTableOutput("Data1"))))          ),    tabItem(tabName = "tabbox3",          fluidRow(          ###selected="plot",故plot选项卡为活跃            tabBox(height = "500px", width = 12,selected = "plot",              title = tagList(shiny::icon("gear"), "tabbox3"),              tabPanel("data", dataTableOutput("Data2")),              tabPanel("plot", plotOutput("Plot2"))))          ))  )  ui <- dashboardPage(  dashboardHeader(title = "WorkingNotes:tabBox"),  sider,  body)
server = function(input, output) {  set.seed(123)  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]    p <- renderPlot({    ggplot(data, aes(x = price, fill = cut)) +       geom_histogram(position = "dodge", bins = 30) +      ggtitle("geom_histogram") +      theme(plot.title = element_text(hjust = 0.5)) + xlab("")  })    d <- renderDataTable({    datatable(data)  })  output$Plot <- p  output$Plot1 <- p  output$Plot2 <- p  output$Data <- d  output$Data1 <- d  output$Data2 <- d
}shinyApp(ui, server)

上图侧边栏创建3个菜单栏，三个菜单栏对应的主体界面都是基于行的布局。第一个菜单栏主体的tabBox设置标题为“tabbox1”，其他参数为默认值，故选项卡位于左侧，第一个选项卡plot为激活状态；第二个菜单栏主体设置side = "right“，故选项卡位置位于右侧，且设置selected = "data“,故data选项卡为激活状态；第三个菜单栏设置一下title，设置selected = "plot“，故plot选项卡为激活状态。

infoBox对象框

infoBox对象框和valueBox两者功能类似，而且用到的不多，故这里简单介绍一下。infoBox()函数中有一个逻辑参数fill决定对象框是否为纯色，有静态infoBox，使用infoBox()函数创建，有动态infoBox，使用成对的infoBoxouput()函数和激活函数renderInfoBox()创建。

library(shinydashboard)
ui <- dashboardPage(  dashboardHeader(title = "WorkingNotes:Infoboxes"),  dashboardSidebar(),  dashboardBody(    ##fill为默认，非纯色填充    fluidRow(      # 静态infoBox      infoBox("New Orders", 10 * 2, icon = icon("credit-card")),      # 动态infoBoxes      infoBoxOutput("progressBox"),      infoBoxOutput("approvalBox")    ),        ##fill为TRue，纯色填充    fluidRow(      infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),      infoBoxOutput("progressBox2"),      infoBoxOutput("approvalBox2")    ),        fluidRow(      ##点击按钮，增加值      box(width = 4, "no actionButton"),      box(width = 4, actionButton("count", "Increment progress")),      box(width = 4, actionButton("count1", "Increment approval"))    )  ))
server <- function(input, output) {  output$progressBox <- renderInfoBox({    infoBox(      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),      color = "purple"    )  })  output$approvalBox <- renderInfoBox({    infoBox(      "Approval", paste0(70 + input$count1, "%"), icon = icon("thumbs-up", lib = "glyphicon"),      color = "yellow"    )  })    ##与上面显示一样，唯一区别是实填充  output$progressBox2 <- renderInfoBox({    infoBox(      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),      color = "purple", fill = TRUE    )  })  output$approvalBox2 <- renderInfoBox({    infoBox(      "Approval", paste0(70 + input$count1, "%"), icon = icon("thumbs-up", lib = "glyphicon"),      color = "yellow", fill = TRUE    )  })}
shinyApp(ui, server)

valueBox对象框

library(shinydashboard)
ui <- dashboardPage(  dashboardHeader(title = "WorkingNotes:Valueboxes"),  dashboardSidebar(),  dashboardBody(    fluidRow(      ##静态valuebox      valueBox(10 * 2, "New Orders", icon = icon("credit-card")),            ##动态valuebox      valueBoxOutput("progressBox"),            valueBoxOutput("approvalBox")    ),    fluidRow(      ##点击按钮,增加值      box(width = 4, "no actionButton"),      box(width = 4, actionButton("count", "Increment progress")),      box(width = 4, actionButton("count1", "Increment approval"))    )  ))
server <- function(input, output) {  output$progressBox <- renderValueBox({    valueBox(      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),      color = "purple"    )  })    output$approvalBox <- renderValueBox({    valueBox(      "Approval", paste0(70 + input$count1, "%"), icon = icon("thumbs-up", lib = "glyphicon"),      color = "yellow"    )  })}
shinyApp(ui, server)

总结

到这里将shinydashborad的标题栏、侧边栏以及主体简单的介绍一下，可以开发出自己的shinyapp了。下面章节将介绍如何将shinyapp共享到服务器上以及对shinyapp加密，输入账号和密码才能访问shinyapp。