R Shiny App 布局:shinydashboard 设置背景

shinydashboard包提供了一组用于创建生成仪表板的HTML的函数。

#结构概要

dashboardPage()函数包含三个组件:

  • a header
  • sidebar
  • body
dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody()
)

或者

header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody()
dashboardPage(header, sidebar, body)

##Header

标题可以有标题和下拉菜单。

Header
  • 标题:创建使用参数title

  • 下拉菜单:创建使用函数dropdownMenu(),下拉菜单有三种:

    • messages
    • notifications
    • tasks

###Message menus

Messages menu

下拉菜单中组成使用messageItem()

messageItem(from, message, icon = shiny::icon("user"), time = NULL,
  href = NULL)
dropdownMenu(type = "messages",
  messageItem(
    from = "Sales Dept",
    message = "Sales are steady this month."
  ),
  messageItem(
    from = "New User",
    message = "How do I register?",
    icon = icon("question"),
    time = "13:45"
  ),
  messageItem(
    from = "Support",
    message = "The new server is ready.",
    icon = icon("life-ring"),
    time = "2014-12-01"
  )
)

###动态内容

创建方法:

UI中:

dashboardHeader(dropdownMenuOutput("messageMenu"))

server中:

output$messageMenu <- renderMenu({
  # Code to generate each of the messageItems here, in a list. This assumes
  # that messageData is a data frame with two columns, 'from' and 'message'.
  msgs <- apply(messageData, 1, function(row) {
    messageItem(from = row[["from"]], message = row[["message"]])
  })

  # This is equivalent to calling:
  #   dropdownMenu(type="messages", msgs[[1]], msgs[[2]], ...)
  dropdownMenu(type = "messages", .list = msgs)
})

###通知菜单

Notifications menu
dropdownMenu(type = "notifications",
  notificationItem(
    text = "5 new users today",
    icon("users")
  ),
  notificationItem(
    text = "12 items delivered",
    icon("truck"),
    status = "success"
  ),
  notificationItem(
    text = "Server load at 86%",
    icon = icon("exclamation-triangle"),
    status = "warning"
  )
)

###任务菜单

Tasks menu
dropdownMenu(type = "tasks", badgeStatus = "success",
  taskItem(value = 90, color = "green",
    "Documentation"
  ),
  taskItem(value = 17, color = "aqua",
    "Project X"
  ),
  taskItem(value = 75, color = "yellow",
    "Server deployment"
  ),
  taskItem(value = 80, color = "red",
    "Overall project"
  )
)

### ###禁用标题栏

dashboardHeader(disable = TRUE)

## ##Sidebar

Sidebar

###Sidebar menu items and tabs

当单击一个链接时,它将在仪表板的主体中显示不同的内容。

与Shiny中的tabPanel类似。

注:必须保证dashboardSidebar中menuItem的tabName 与dashboardBody中tabItem的tabName 是一样的,这样才能对应。

## ui.R ##
sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Widgets", icon = icon("th"), tabName = "widgets",
             badgeLabel = "new", badgeColor = "green")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "dashboard",
      h2("Dashboard tab content")
    ),

    tabItem(tabName = "widgets",
      h2("Widgets tab content")
    )
  )
)

# Put them together into a dashboardPage
dashboardPage(
  dashboardHeader(title = "Simple tabs"),
  sidebar,
  body
)

menuItems的图标可以使用Shiny中函数icon()改变。

各种各样的图标参考:

Skins Icons

Font-Awesome

Glyphicons

默认情况下,icon()函数使用来自Font-Awesome的图标。使用glyphicon,请使用lib="glyphicon")

"Calendar from Font-Awesome:", icon("calendar"),
"Cog from Glyphicons:", icon("cog", lib = "glyphicon")

menuItem中也可以提供链接,从而访问外部网站:

 menuItem("Source code", icon = icon("file-code-o"), 
           href = "https://github.com/rstudio/shinydashboard/")

###Bookmarking and restoring selected tabs

Shiny可以添加书签并恢复应用程序的状态。在使用shinydashboard构建的应用程序中,要想添加书签并恢复选中的选项,你必须使用id调用sidebarMenu()。

sidebarMenu(id = "sidebar",
  ....
)

详细操作查看: bookmark and restore

###动态内容

可以使用renderMenu和sidebarMenuOutput动态生成侧边栏菜单。

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic sidebar"),
  dashboardSidebar(
    sidebarMenuOutput("menu")
  ),
  dashboardBody()
)

server <- function(input, output) {
  output$menu <- renderMenu({
    sidebarMenu(
      menuItem("Menu item", icon = icon("calendar"))
    )
  })
}

shinyApp(ui, server)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic sidebar"),
  dashboardSidebar(
    sidebarMenu(
      menuItemOutput("menuitem")
    )
  ),
  dashboardBody()
)

server <- function(input, output) {
  output$menuitem <- renderMenu({
    menuItem("Menu item", icon = icon("calendar"))
  })
}

shinyApp(ui, server)

###侧边栏中的输入

Sidebar inputs
 sidebarSearchForm(textId = "searchText", buttonId = "searchButton",
                    label = "Search...")

对于这个搜索,server代码中的对应值将是inputsearchText和inputsearchButton。

###禁用侧边栏

dashboardSidebar(disable = TRUE)

##Body

仪表板页面的主体可以包含任何规则的shiny内容。然而,如果正在创建一个指示板,可能想要创建一些更结构化的东西。仪表板的基本构造是box()。box()中可以包含任何内容。

###Boxes

box是仪表板页面的主要构建块。可以使用box()函数创建一个基本框,box的内容可以是任何shiny UI内容。

在典型的仪表板中,box将被放置在一个fluidRow()中.

# This is just the body component of a dashboard
dashboardBody(
  fluidRow(
    box(plotOutput("plot1")),
    
    box(
      "Box content here", br(), "More box content",
      sliderInput("slider", "Slider input:", 1, 100, 50),
      textInput("text", "Text input:")
    )
  )
)
Basic boxes

####Basic boxes

box可以有标题,并且标题和标题栏颜色可以通过titlestatus设置。

  • Statuses

  • status="primary"`, `status="success"
    
Statuses
  • colors

  • color="red"`, `color="black"
    
Colors

注:状态和颜色可以通过?validStatuses和?validColors查看。

box(title = "Histogram", status = "primary", plotOutput("plot2", height = 250)),

box(
  title = "Inputs", status = "warning",
  "Box content here", br(), "More box content",
  sliderInput("slider", "Slider input:", 1, 100, 50),
  textInput("text", "Text input:")
)
Box header color and title

####Box header color and title

使用solidHeader=TRUE设置实标头,并在右上角显示一个按钮,该按钮将以collapsible=TRUE折叠该框:

box(
  title = "Histogram", status = "primary", solidHeader = TRUE,
  collapsible = TRUE,
  plotOutput("plot3", height = 250)
),

box(
  title = "Inputs", status = "warning", solidHeader = TRUE,
  "Box content here", br(), "More box content",
  sliderInput("slider", "Slider input:", 1, 100, 50),
  textInput("text", "Text input:")
)

####Solid header and collapse

如果希望方框顶部没有灰色或有色条,请使用solidHeader=TRUE,并且不要为状态提供值:

box(
  title = "Histogram", solidHeader = TRUE,
  collapsible = TRUE,
  plotOutput("plot3", height = 250)
),

box(
  title = "Inputs", solidHeader = TRUE,
  "Box content here", br(), "More box content",
  sliderInput("slider", "Slider input:", 1, 100, 50),
  textInput("text", "Text input:")
)
No colored bar

####No colored bar

还可以使用background选项创建一个背景。

Colors
box(
  title = "Histogram", background = "maroon", solidHeader = TRUE,
  plotOutput("plot4", height = 250)
),

box(
  title = "Inputs", background = "black",
  "Box content here", br(), "More box content",
  sliderInput("slider", "Slider input:", 1, 100, 50),
  textInput("text", "Text input:")
)
Solid background

####tabBox

  • tabBox
Tabbed boxes

tabBox与Shiny 中tabsetPanel类似,tabPanels作为输入,允许您选择选择哪个tab,并可以分配一个id。

如果id是存在的,可以访问哪个选项卡被选择从服务器;在下面的示例中,使用输入$tabset1访问它。

tabBox与shinydashboard中box类似,可以修改height, width, 和title.

还可以使用side参数选择选项卡出现在哪一边。注意,如果side="right",选项卡将以相反的顺序显示。

body <- dashboardBody(
  fluidRow(
    tabBox(
      title = "First tabBox",
      # The id lets us use input$tabset1 on the server to find the current tab
      id = "tabset1", height = "250px",
      tabPanel("Tab1", "First tab content"),
      tabPanel("Tab2", "Tab content 2")
    ),
    tabBox(
      side = "right", height = "250px",
      selected = "Tab3",
      tabPanel("Tab1", "Tab content 1"),
      tabPanel("Tab2", "Tab content 2"),
      tabPanel("Tab3", "Note that when side=right, the tab order is reversed.")
    )
  ),
  fluidRow(
    tabBox(
      # Title can include an icon
      title = tagList(shiny::icon("gear"), "tabBox status"),
      tabPanel("Tab1",
        "Currently selected tab from first box:",
        verbatimTextOutput("tabset1Selected")
      ),
      tabPanel("Tab2", "Tab content 2")
    )
  )
)

shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "tabBoxes"),
    dashboardSidebar(),
    body
  ),
  server = function(input, output) {
    # The currently selected tab from the first box
    output$tabset1Selected <- renderText({
      input$tabset1
    })
  }
)

####infoBox

这是一种特殊的框,用于显示简单的数字或文本值,并带有图标。

Info boxes

第一行使用默认设置fill=FALSE,而第二行使用fill=TRUE。

由于infoBox的内容通常是动态的,因此shinydashboard包含了用于动态内容的帮助函数infoBoxOutput renderInfoBox。

library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Info boxes"),
  dashboardSidebar(),
  dashboardBody(
    # infoBoxes with fill=FALSE
    fluidRow(
      # A static infoBox
      infoBox("New Orders", 10 * 2, icon = icon("credit-card")),
      # Dynamic infoBoxes
      infoBoxOutput("progressBox"),
      infoBoxOutput("approvalBox")
    ),

    # infoBoxes with fill=TRUE
    fluidRow(
      infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),
      infoBoxOutput("progressBox2"),
      infoBoxOutput("approvalBox2")
    ),

    fluidRow(
      # Clicking this will increment the progress amount
      box(width = 4, actionButton("count", "Increment progress"))
    )
  )
)

server <- function(input, output) {
  output$progressBox <- renderInfoBox({
    infoBox(
      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
      color = "purple"
    )
  })
  output$approvalBox <- renderInfoBox({
    infoBox(
      "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "yellow"
    )
  })

  # Same as above, but with fill=TRUE
  output$progressBox2 <- renderInfoBox({
    infoBox(
      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
      color = "purple", fill = TRUE
    )
  })
  output$approvalBox2 <- renderInfoBox({
    infoBox(
      "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "yellow", fill = TRUE
    )
  })
}

shinyApp(ui, server)

###布局

布局方框需要了解一些引导网格布局系统的知识。主体可以视为被划分为12个等宽列和任意数量的行,可变高度的区域。当在网格中放置一个框(或其他项)时,可以指定希望它占据12列中的多少列。在这个屏幕截图中,第一行框的宽度各为4列,第二列框的宽度各为6列。

一般来说,有两种方式来布置方框:基于行的布局,或者基于列的布局。

####Row-based layout

在基于行的布局中,框必须放在由fluidRow()创建的行中。行的网格宽度为12,因此宽度=4的框占宽度的三分之一,宽度=6(默认)的框占宽度的一半。

在基于行的布局中,每行框的顶部将对齐,但底部可能不对齐——这取决于每个框的内容。

Row-based layout
body <- dashboardBody(
  fluidRow(
    box(title = "Box title", "Box content"),
    box(status = "warning", "Box content")
  ),

  fluidRow(
    box(
      title = "Title 1", width = 4, solidHeader = TRUE, status = "primary",
      "Box content"
    ),
    box(
      title = "Title 2", width = 4, solidHeader = TRUE,
      "Box content"
    ),
    box(
      title = "Title 1", width = 4, solidHeader = TRUE, status = "warning",
      "Box content"
    )
  ),

  fluidRow(
    box(
      width = 4, background = "black",
      "A box with a solid black background"
    ),
    box(
      title = "Title 5", width = 4, background = "light-blue",
      "A box with a solid light-blue background"
    ),
    box(
      title = "Title 6",width = 4, background = "maroon",
      "A box with a solid maroon background"
    )
  )
)

# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
  dashboardHeader(title = "Row layout"),
  dashboardSidebar(),
  body
)

# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) { })

通过设置height,可以强制所有框具有相同的高度。与使用12宽引导网格设置的宽度相反,高度是用像素指定的。

box(title = "Box title", height = 300, "Box content")

如果设置所有框的高度,可以得到这样的仪表盘:

Row-based layout with fixed height

####Column-based layout

Column-based layout

下面的代码是这个基于列的布局的基本框架。注意,在fluidRow中,有指定宽度的列,列中的每个框的width=NULL。

body <- dashboardBody(
  fluidRow(
    column(width = 4,
      box(
        title = "Box title", width = NULL, status = "primary",
        "Box content"
      ),
      box(
        title = "Title 1", width = NULL, solidHeader = TRUE, status = "primary",
        "Box content"
      ),
      box(
        width = NULL, background = "black",
        "A box with a solid black background"
      )
    ),

    column(width = 4,
      box(
        status = "warning", width = NULL,
        "Box content"
      ),
      box(
        title = "Title 3", width = NULL, solidHeader = TRUE, status = "warning",
        "Box content"
      ),
      box(
        title = "Title 5", width = NULL, background = "light-blue",
        "A box with a solid light-blue background"
      )
    ),

    column(width = 4,
      box(
        title = "Title 2", width = NULL, solidHeader = TRUE,
        "Box content"
      ),
      box(
        title = "Title 6", width = NULL, background = "maroon",
        "A box with a solid maroon background"
      )
    )
  )
)

# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
  dashboardHeader(title = "Column layout"),
  dashboardSidebar(),
  body
)

# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) { })

####Mixed row and column layout

也可以混合使用行和列。

Mixed row and column layout
body <- dashboardBody(
  fluidRow(
    box(
      title = "Box title", width = 6, status = "primary",
      "Box content"
    ),
    box(
      status = "warning", width = 6,
      "Box content"
    )
  ),
    
  fluidRow(
    column(width = 4,
      box(
        title = "Title 1", width = NULL, solidHeader = TRUE, status = "primary",
        "Box content"
      ),
      box(
        width = NULL, background = "black",
        "A box with a solid black background"
      )
    ),

    column(width = 4,
      box(
        title = "Title 3", width = NULL, solidHeader = TRUE, status = "warning",
        "Box content"
      ),
      box(
        title = "Title 5", width = NULL, background = "light-blue",
        "A box with a solid light-blue background"
      )
    ),

    column(width = 4,
      box(
        title = "Title 2", width = NULL, solidHeader = TRUE,
        "Box content"
      ),
      box(
        title = "Title 6", width = NULL, background = "maroon",
        "A box with a solid maroon background"
      )
    )
  )
)

# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
  dashboardHeader(title = "Mixed layout"),
  dashboardSidebar(),
  body
)

# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) { })

#原文:

Background: Shiny and HTML
shinydashboard

R shiny教程-1:一个 Shiny app的基本组成部分
R shiny教程-2:布局用户界面
R shiny教程-3:添加小部件到Shiny App
R shiny教程-4:Shiny app响应式结果展示
R shiny教程-5:调用R程序和导入数据
R shiny教程-6:使用响应表达式reactive()
R shiny教程-7:共享Shiny app
Shiny Server安装
shinydashboard安装、使用指南

©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 199,271评论 5 466
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 83,725评论 2 376
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 146,252评论 0 328
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 53,634评论 1 270
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 62,549评论 5 359
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 47,985评论 1 275
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 37,471评论 3 390
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,128评论 0 254
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 40,257评论 1 294
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,233评论 2 317
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,235评论 1 328
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 32,940评论 3 316
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 38,528评论 3 302
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,623评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 30,858评论 1 255
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 42,245评论 2 344
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 41,790评论 2 339