R包shiny开发网页–shinydashboard自定义—科研工具箱

请关注公众号【叨客学习资料】 在使用网站的过程中有疑问,请来公众号进行反馈哦

转自:R包shiny开发网页–6.shinydashboard自定义 – 简书

Part1 侧边栏sidebar

1.1.菜单栏与选项卡模版

图片[1]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 
library(shiny)
library(shinydashboard)
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\")
    )
  )
)

ui <- dashboardPage(
  dashboardHeader(title = \"Simple tabs\"),
  sidebar,
  body
)
server <- function(input, output) {
}
shinyApp(ui, server) 

1.2.侧边栏输入

(1)搜索框

library(shiny)
library(shinydashboard)
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarSearchForm(textId = \"searchText\", buttonId = \"searchButton\",
                      label = \"Search...\")
  ),
  dashboardBody()
)
server <- function(input, output) { }
shinyApp(ui, server)

(2)再加上滑动输入和文本输入

library(shiny)
library(shinydashboard)
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarSearchForm(textId = \"searchText\", buttonId = \"searchButton\",
                      label = \"Search...\"),
    sliderInput(\"integer\", \"Integer:\", 
                min=0, max=1000, value=500),
    textInput(\"text\",\"textInput:\")
  ),
  dashboardBody()
)
server <- function(input, output) { }
shinyApp(ui, server)

(3)停用侧边栏

dashboardSidebar(disable = TRUE)

Part2 正文-body

参考学习:http://rstudio.github.io/shinydashboard/structure.html#boxes

2.1.基本框

shinydashboard基本构建块是box。box()可以创建基本框,框里的内容可以是大多数的UI控件。

图片[2]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
在同一行放两个box:一个文本输入框,一个滑块
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      box(textInput(\"text\", \"Text input:\")),
      box(
        \"Box content here\", br(), \"More box content\",
        sliderInput(\"slider\", \"Slider input:\", 1, 100, 50)
      )
    )
  )
)
server <- function(input, output) { }
shinyApp(ui, server)

2.2.设置标题(title)和标题栏(header bar)颜色(status)

图片[3]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 

在这里status = “primary”显示了蓝色,status = “warning”显示了橙黄色

library(shiny)
library(shinydashboard)
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      box(title = \"box1\", status = \"primary\",
        textInput(\"text\", \"Text input:\")),
      box(title = \"box2\", status = \"warning\",
        \"Box content here\", br(), \"More box content\",
        sliderInput(\"slider\", \"Slider input:\", 1, 100, 50)
      )
    )
  )
)
server <- function(input, output) { }
shinyApp(ui, server)

2.3.实体标题栏、可折叠box

solidHeader = TRUE可以设置这种格式,collapsible = TRUE可以设置box可折叠。

图片[4]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar()
  dashboardBody(
    fluidRow(
      box(title =\"box1\",status = \"primary\",solidHeader = TRUE,
          collapsible = TRUE,
        textInput(\"text\", \"Text input:\")),
      box(title =\"box2\",status = \"warning\",solidHeader = TRUE,
        sliderInput(\"slider\", \"Slider input:\", 1, 100, 50)
      )
    )
  )
)
server <- function(input, output) { }
shinyApp(ui, server)

2.4.带背景色的box

图片[5]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      box(title = \"box1\", background = \"maroon\",
        textInput(\"text\", \"Text input:\")
      ),
      box(title = \"box2\", background = \"black\",
        sliderInput(\"slider\", \"Slider input:\", 1, 100, 50)
      )
    )
  )
)
server <- function(input, output) { }
shinyApp(ui, server)

2.5.标签box

图片[6]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 
library(shiny)
library(shinydashboard)
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\")
    )
  )
)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  body)
server <- function(input, output) {
  output$tabset1Selected <- renderText({
    input$tabset1
  })
}
shinyApp(ui, server)

2.6.infobox

一种特殊的box,用于显示简单的数字或文本值,带有图标。
第一行是无填充的,第二行是有填充。

图片[7]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = \"Info boxes\"),
  dashboardSidebar(),
  dashboardBody(
    # 无填充的box
    fluidRow(
      # 静止
      infoBox(\"New Orders\", 10 * 2, icon = icon(\"credit-card\")),
      # 动态
      infoBoxOutput(\"progressBox\"),
      infoBoxOutput(\"approvalBox\")
    ),
    
    # 有填充的框
    fluidRow(
      infoBox(\"New Orders\", 10 * 2, icon = icon(\"credit-card\"), fill = TRUE),
      infoBoxOutput(\"progressBox2\"),
      infoBoxOutput(\"approvalBox2\")
    ),
    
    fluidRow(
      # 点一次加一个数
      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)

2.7.valueBox
和info的区别好像是图标嵌入?

图片[8]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = \"Value boxes\"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      # A static valueBox
      valueBox(10 * 2, \"New Orders\", icon = icon(\"credit-card\")),
      
      # Dynamic valueBoxes
      valueBoxOutput(\"progressBox\"),
      
      valueBoxOutput(\"approvalBox\")
    ),
    fluidRow(
      # Clicking this will increment the progress amount
      box(width = 4, actionButton(\"count\", \"Increment progress\"))
    )
  )
)

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

shinyApp(ui, server)

Part3 外观美化

本部分包括调节皮肤、box颜色、图标、标题和侧边栏加宽的代码。
整理自:https://rstudio.github.io/shinydashboard/appearance.html#logout-panel

3.1.皮肤:skin

指定主题颜色,主要是标题栏的颜色
默认是:dashboardPage(skin = “blue”)
还有“blue”, “black”, “purple”, “green”, “red”, “yellow”可选,好玩的是,选black标题栏就变成白色了。

图片[9]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
白色丑哭了
图片[10]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
绿色蛮顺眼
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody()
ui <- dashboardPage(skin = \"green\",
  header, sidebar, body)
server= function(input, output) { }
shinyApp(ui = ui, server=server )

3.2.box颜色:status或color

图片[11]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
status
图片[12]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
color

3.3.图标

图标来自Font-Awesome和Glyphicons。所有可用图标列表:

  • http://fontawesome.io/icons/
  • http://getbootstrap.com/components/#glyphicons/
    使用的命令
\"doudou:\", icon(\"calendar\"),
\"huahua:\", icon(\"cog\", lib = \"glyphicon\")

以上两行代码分别是这两个网站对应的图标使用方法。
举例:

图片[13]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(box(\"doudou:\", icon(\"calendar\")),
                      box(\"huahua:\", icon(\"cog\", lib = \"glyphicon\")))
ui <- dashboardPage(skin = \"black\",
  header, sidebar, body)
server= function(input, output) { }
shinyApp(ui = ui, server=server )

3.4.给侧边栏和标题栏加宽

图片[14]-R包shiny开发网页–shinydashboard自定义—科研工具箱-叨客学习资料网
 
  ui = dashboardPage(
    dashboardHeader(
      title = \"Title and sidebar 350 pixels wide\",
      titleWidth = 350
    ),
    dashboardSidebar(
      width = 350,
      sidebarMenu(
        menuItem(\"Menu Item\")
      )
    ),
    dashboardBody()
  )
  server = function(input, output) { }

  shinyApp(ui,server)
© 版权声明
THE END
喜欢就支持一下吧
点赞0 分享
评论 抢沙发
头像
请输入有效评论哦,肆意灌水或者乱打评论是不会通过的,会影响您评论后获得资源哦~~
提交
头像

昵称

取消
昵称表情

    暂无评论内容