R Shiny App 布局：shinydashboard 設(shè)置背景

shinydashboard包提供了一組用于創(chuàng)建生成儀表板的HTML的函數(shù)。

#結(jié)構(gòu)概要

dashboardPage()函數(shù)包含三個組件:

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

或者

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

##Header

標(biāo)題可以有標(biāo)題和下拉菜單。

Header

  • 標(biāo)題：創(chuàng)建使用參數(shù)title

  • 下拉菜單：創(chuàng)建使用函數(shù)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"
  )
)

###動態(tài)內(nèi)容

創(chuàng)建方法：

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

###任務(wù)菜單

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

### ###禁用標(biāo)題欄

dashboardHeader(disable = TRUE)

## ##Sidebar

Sidebar

###Sidebar menu items and tabs

當(dāng)單擊一個鏈接時誉己，它將在儀表板的主體中顯示不同的內(nèi)容。

與Shiny中的tabPanel類似缓熟。

注：必須保證dashboardSidebar中menuItem的tabName 與dashboardBody中tabItem的tabName 是一樣的犀勒，這樣才能對應(yīng)。

## 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的圖標(biāo)可以使用Shiny中函數(shù)icon()改變会油。

各種各樣的圖標(biāo)參考：

Skins Icons

Font-Awesome

Glyphicons

默認(rèn)情況下个粱，icon()函數(shù)使用來自Font-Awesome的圖標(biāo)。使用glyphicon翻翩，請使用lib="glyphicon")

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

menuItem中也可以提供鏈接都许，從而訪問外部網(wǎng)站：

 menuItem("Source code", icon = icon("file-code-o"), 
           )

###Bookmarking and restoring selected tabs

Shiny可以添加書簽并恢復(fù)應(yīng)用程序的狀態(tài)。在使用shinydashboard構(gòu)建的應(yīng)用程序中嫂冻，要想添加書簽并恢復(fù)選中的選項(xiàng)胶征，你必須使用id調(diào)用sidebarMenu()。

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

詳細(xì)操作查看： bookmark and restore

###動態(tài)內(nèi)容

可以使用renderMenu和sidebarMenuOutput動態(tài)生成側(cè)邊欄菜單桨仿。

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)

###側(cè)邊欄中的輸入

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

對于這個搜索睛低，server代碼中的對應(yīng)值將是inputsearchText和inputsearchButton。

###禁用側(cè)邊欄

dashboardSidebar(disable = TRUE)

##Body

儀表板頁面的主體可以包含任何規(guī)則的shiny內(nèi)容服傍。然而钱雷，如果正在創(chuàng)建一個指示板，可能想要創(chuàng)建一些更結(jié)構(gòu)化的東西伴嗡。儀表板的基本構(gòu)造是box()急波。box()中可以包含任何內(nèi)容。

###Boxes

box是儀表板頁面的主要構(gòu)建塊瘪校。可以使用box()函數(shù)創(chuàng)建一個基本框名段，box的內(nèi)容可以是任何shiny UI內(nèi)容阱扬。

在典型的儀表板中，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可以有標(biāo)題伸辟，并且標(biāo)題和標(biāo)題欄顏色可以通過title 和status設(shè)置麻惶。

  • Statuses

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

  • colors

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

注：狀態(tài)和顏色可以通過?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設(shè)置實(shí)標(biāo)頭信夫，并在右上角顯示一個按鈕窃蹋，該按鈕將以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静稻，并且不要為狀態(tài)提供值:

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選項(xiàng)創(chuàng)建一個背景警没。

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是存在的押搪，可以訪問哪個選項(xiàng)卡被選擇從服務(wù)器;在下面的示例中树酪，使用輸入$tabset1訪問它浅碾。

tabBox與shinydashboard中box類似，可以修改height, width, 和title.

還可以使用side參數(shù)選擇選項(xiàng)卡出現(xiàn)在哪一邊续语。注意垂谢，如果side="right"，選項(xiàng)卡將以相反的順序顯示疮茄。

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

這是一種特殊的框滥朱，用于顯示簡單的數(shù)字或文本值，并帶有圖標(biāo)娃豹。

Info boxes

第一行使用默認(rèn)設(shè)置fill=FALSE焚虱，而第二行使用fill=TRUE。

由于infoBox的內(nèi)容通常是動態(tài)的懂版，因此shinydashboard包含了用于動態(tài)內(nèi)容的幫助函數(shù)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)

###布局

布局方框需要了解一些引導(dǎo)網(wǎng)格布局系統(tǒng)的知識。主體可以視為被劃分為12個等寬列和任意數(shù)量的行躯畴，可變高度的區(qū)域民鼓。當(dāng)在網(wǎng)格中放置一個框(或其他項(xiàng))時，可以指定希望它占據(jù)12列中的多少列蓬抄。在這個屏幕截圖中丰嘉，第一行框的寬度各為4列，第二列框的寬度各為6列嚷缭。

一般來說饮亏，有兩種方式來布置方框:基于行的布局，或者基于列的布局阅爽。

####Row-based layout

在基于行的布局中路幸，框必須放在由fluidRow()創(chuàng)建的行中。行的網(wǎng)格寬度為12付翁，因此寬度=4的框占寬度的三分之一简肴，寬度=6(默認(rèn))的框占寬度的一半。

在基于行的布局中百侧，每行框的頂部將對齊砰识，但底部可能不對齊——這取決于每個框的內(nèi)容。

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) { })

通過設(shè)置height佣渴，可以強(qiáng)制所有框具有相同的高度辫狼。與使用12寬引導(dǎo)網(wǎng)格設(shè)置的寬度相反，高度是用像素指定的观话。

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

如果設(shè)置所有框的高度予借，可以得到這樣的儀表盤:

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響應(yīng)式結(jié)果展示
R shiny教程-5：調(diào)用R程序和導(dǎo)入數(shù)據(jù)
R shiny教程-6:使用響應(yīng)表達(dá)式reactive()
R shiny教程-7：共享Shiny app
Shiny Server安裝
shinydashboard安裝挣跋、使用指南

?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請聯(lián)系作者
  • 人面猴
    序言：七十年代末，一起剝皮案震驚了整個濱河市狞换，隨后出現(xiàn)的幾起案子避咆，更是在濱河造成了極大的恐慌，老刑警劉巖修噪，帶你破解...
    沈念sama閱讀 206,013評論 6贊 481
  • 死咒
    序言：濱河連續(xù)發(fā)生了三起死亡事件查库，死亡現(xiàn)場離奇詭異，居然都是意外死亡黄琼，警方通過查閱死者的電腦和手機(jī)樊销，發(fā)現(xiàn)死者居然都...
    沈念sama閱讀 88,205評論 2贊 382
  • 救了他兩次的神仙讓他今天三更去死
    文/潘曉璐 我一進(jìn)店門，熙熙樓的掌柜王于貴愁眉苦臉地迎上來脏款，“玉大人围苫，你說我怎么就攤上這事〕肥Γ” “怎么了剂府？”我有些...
    開封第一講書人閱讀 152,370評論 0贊 342
  • 道士緝兇錄：失蹤的賣姜人
    文/不壞的土叔 我叫張陵，是天一觀的道長剃盾。 經(jīng)常有香客問我腺占，道長，這世上最難降的妖魔是什么痒谴？ 我笑而不...
    開封第一講書人閱讀 55,168評論 1贊 278
  • ?港島之戀（遺憾婚禮）
    正文 為了忘掉前任湾笛，我火速辦了婚禮，結(jié)果婚禮上闰歪，老公的妹妹穿的比我還像新娘。我一直安慰自己蓖墅，他們只是感情好库倘，可當(dāng)我...
    茶點(diǎn)故事閱讀 64,153評論 5贊 371
  • 惡毒庶女頂嫁案：這布局不是一般人想出來的
    文/花漫 我一把揭開白布。 她就那樣靜靜地躺著论矾，像睡著了一般教翩。 火紅的嫁衣襯著肌膚如雪。 梳的紋絲不亂的頭發(fā)上贪壳，一...
    開封第一講書人閱讀 48,954評論 1贊 283
  • 城市分裂傳說
    那天饱亿，我揣著相機(jī)與錄音，去河邊找鬼。 笑死彪笼，一個胖子當(dāng)著我的面吹牛钻注，可吹牛的內(nèi)容都是我干的。 我是一名探鬼主播配猫，決...
    沈念sama閱讀 38,271評論 3贊 399
  • 雙鴛鴦連環(huán)套：你想象不到人心有多黑
    文/蒼蘭香墨 我猛地睜開眼幅恋，長吁一口氣：“原來是場噩夢啊……” “哼！你這毒婦竟也來了泵肄？” 一聲冷哼從身側(cè)響起捆交，我...
    開封第一講書人閱讀 36,916評論 0贊 259
  • 萬榮殺人案實(shí)錄
    序言：老撾萬榮一對情侶失蹤，失蹤者是張志新（化名）和其女友劉穎腐巢，沒想到半個月后品追，有當(dāng)?shù)厝嗽跇淞掷锇l(fā)現(xiàn)了一具尸體，經(jīng)...
    沈念sama閱讀 43,382評論 1贊 300
  • ?護(hù)林員之死
    正文 獨(dú)居荒郊野嶺守林人離奇死亡冯丙，尸身上長有42處帶血的膿包…… 初始之章·張勛 以下內(nèi)容為張勛視角 年9月15日...
    茶點(diǎn)故事閱讀 35,877評論 2贊 323
  • ?白月光啟示錄
    正文 我和宋清朗相戀三年肉瓦，在試婚紗的時候發(fā)現(xiàn)自己被綠了。 大學(xué)時的朋友給我發(fā)了我未婚夫和他白月光在一起吃飯的照片银还。...
    茶點(diǎn)故事閱讀 37,989評論 1贊 333
  • 活死人
    序言：一個原本活蹦亂跳的男人離奇死亡风宁，死狀恐怖，靈堂內(nèi)的尸體忽然破棺而出蛹疯，到底是詐尸還是另有隱情戒财，我是刑警寧澤，帶...
    沈念sama閱讀 33,624評論 4贊 322
  • ?日本核電站爆炸內(nèi)幕
    正文 年R本政府宣布捺弦，位于F島的核電站饮寞，受9級特大地震影響，放射性物質(zhì)發(fā)生泄漏列吼。R本人自食惡果不足惜幽崩，卻給世界環(huán)境...
    茶點(diǎn)故事閱讀 39,209評論 3贊 307
  • 男人毒藥：我在死后第九天來索命
    文/蒙蒙 一、第九天 我趴在偏房一處隱蔽的房頂上張望寞钥。 院中可真熱鬧慌申，春花似錦、人聲如沸理郑。這莊子的主人今日做“春日...
    開封第一講書人閱讀 30,199評論 0贊 19
  • 一樁弒父案，背后竟有這般陰謀
    文/蒼蘭香墨 我抬頭看了看天上的太陽您炉。三九已至柒爵，卻和暖如春，著一層夾襖步出監(jiān)牢的瞬間赚爵，已是汗流浹背棉胀。 一陣腳步聲響...
    開封第一講書人閱讀 31,418評論 1贊 260
  • 情欲美人皮
    我被黑心中介騙來泰國打工法瑟， 沒想到剛下飛機(jī)就差點(diǎn)兒被人妖公主榨干…… 1. 我叫王不留，地道東北人唁奢。 一個月前我還...
    沈念sama閱讀 45,401評論 2贊 352
  • 代替公主和親
    正文 我出身青樓霎挟，卻偏偏與公主長得像，于是被迫代替她去往敵國和親驮瞧。 傳聞我的和親對象是個殘疾皇子氓扛，可洞房花燭夜當(dāng)晚...
    茶點(diǎn)故事閱讀 42,700評論 2贊 345