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

最新推荐文章于 2024-06-20 22:17:01 发布

Sim1480

最新推荐文章于 2024-06-20 22:17:01 发布

阅读量882

点赞数 2

前言

前面简单介绍了shinydashboard的标题栏，会发现标题栏是个鸡肋，只要掌握如何设置title即可。这一节简单介绍一下侧边栏。侧边栏（siderbar）主要起到导航作用，可以简单理解为输入栏，不同的输入栏（输入），主体（body）就呈现出不同内容（输出）。

侧边栏简介

侧边栏由菜单项（menu item）和输入项（inputs）组成。菜单项切换不同的界面，输入项决定界面呈现什么内容。简单理解为：侧边栏（siderbar）就是主体(body)的输入“参数”，用于切换不同的界面和改变界面呈现的内容。正如下面动态图所示：下方Author、Data、Summary、Plot、Plot1是菜单项，点击切换不同的界面；Number of Data、The Tpye of Plot、Variable、Choose CSV File等都是输入项，改变界面所呈现出的内容。

640?wx_fmt=gif

输入项

侧边栏的输入项主要改变界面所呈现的内容。下面简单介绍一些常见的输入项。以每一个完整的小栗子讲解怎么使用每一个输入项。

640?wx_fmt=png

上表中最后4个输入项函数可以归为一类：控制型输入项，控制操作是否生效。有输入就有输出，输入项需要传给输出项，输出项都是成对出现的：在ui中使用*Output，在serve中render*与之对应，两者通过变量名对应。常用的有以下几对常用的输出项：

640?wx_fmt=png

说明

以下所用到的app.R脚本按照标准的shinydashboard代码书写，谨记：侧边栏一般放置输入项以及菜单栏，主体中呈现输出部分，故输入项函数和菜单栏函数写在ui脚本dashboardSiderbar()中，输入项函数的输出项*Output()函数写在ui脚本dashboardBody()中，render*函数写在server脚本中与之对应。

 library(shinydashboard)	
  shinyApp(	
    ui = dashboardPage(	
      dashboardHeader(),	
      dashboardSidebar(),	
      dashboardBody()	
    ),	
    server = function(input, output) { }	
  )	
  	
 --- 或者	
   library(shinydashboard)	
   header <- dashboardHeader()	
   side <- dashboardSidebar()	
   body <- dashboardBody()	
  shinyApp(	
    ui = dashboardPage(	
      header,	
      side,	
      body	
    ),	
    server = function(input, output) { }	
  )

selectInput输入项

以下拉菜单形式选择某个value。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    selectInput("Position", "The Type of Plot:",	
                c("fill" = "fill",	
                  "dodge" = "dodge",	
                  "stack" = "stack"))),	
  dashboardBody(plotOutput("Plot"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
  output$Plot <- renderPlot({	
    ggplot(data, aes(x = price, fill = cut)) + 	
      geom_histogram(position = input$Position, bins = 30) +	
      ggtitle("histogram") +	
      theme(plot.title = element_text(hjust = 0.5)) + xlab("")	
  })	
}	
shinyApp(ui, server)

640?wx_fmt=gif

请留意上图代码中输入项selectInput函数书写位置以及输出函数plotOutput以及renderPlot位置，两者是通过“Plot”变量名对应的。上图主要实现选择不同参数fill、dodge和stack控制直方图的类型。

sliderInput输入项

滑动条形式选择某个数值，可以设置自动滑动按钮。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    sliderInput("obs", "Number of Data:",	
                min = 0, max = 100, value = 2, animate = TRUE)),	
  dashboardBody(dataTableOutput("Data"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
  	
  output$Data <- renderDataTable({	
    datatable(head(data,input$obs))	
  })	
  	
}	
shinyApp(ui, server)

640?wx_fmt=gif

注意上图代码中输入项sliderInput函数书写位置以及输出函数dataTableOutput以及renderDataTable位置，两者是通过“Data”变量名对应的。上图通过滑动条控制展示数据的行数。

fileInput输入项

fileInput函数主要用于从本地上传数据。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    fileInput('file1', 'Choose CSV File',	
              accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv'))),	
  dashboardBody(dataTableOutput("Data"))	
)	
server <- function(input, output) {	
  dataset <- reactive({	
    inFile <- input$file1	
    if (!is.null(inFile))	
      read.csv(inFile$datapath, header = TRUE, sep= ",", stringsAsFactors = T)	
  })	
  	
  output$Data <- renderDataTable({	
    datatable(dataset())	
  })	
  	
}	
shinyApp(ui, server)

640?wx_fmt=gif

textInput输入项

用于交互式文本输入。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    textInput("text","textInput:")),	
  dashboardBody(textOutput("Author"))	
)	
server <- function(input, output) {	
  output$Author <- renderText({	
    paste("The Author:", input$text)	
  })	
}	
shinyApp(ui, server)

640?wx_fmt=gif

输入不同的作者名，主体部分发生相应的变化，textOutput函数与renderText函数通过“Author”字段对应。

checkboxInpu输入项

用于控制是否展示内容，例如是否展示原数据、绘制图形的时候是否展示异常点等。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    checkboxInput("value", "Show Data", FALSE)),	
  dashboardBody(textOutput("value"),	
                 dataTableOutput("Data"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
    output$Data <- renderDataTable({	
      if((!!input$value) == "TRUE") {	
        datatable(data)	
      }	
    })	
}	
shinyApp(ui, server)

640?wx_fmt=gif

dateInput与dateRangeInput输入项

用于日期的选择，dateInput输入项是选择某个日期，dateRangeInput是选择日期范围。

library(shiny)	
library(shinydashboard)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    dateInput("date1", "Date:", value = "2019-02-21"),	
    dateInput("date4", "Date:", value = Sys.Date()-10),	
    dateRangeInput("daterange4", "Date range:",	
                   start = Sys.Date()-10,	
                   end = Sys.Date()+10),	
    dateRangeInput("daterange3", "Date range:",	
                   start  = "2018-01-01",	
                   end    = "2019-12-31",	
                   min    = "2018-01-01",	
                   max    = "2019-12-21",	
                   format = "mm/dd/yy",	
                   separator = " - ")),	
  dashboardBody()	
)	
	
server <- function(input, output) {	
}	
shinyApp(ui, server)

640?wx_fmt=gif

downloadLink与downloadButton输入项

用于下载数据，两个输入项函数可以等价替换，downloadLink输入项函数显示的是一个下载链接，downloadButton输入项函数显示的是一个下载按钮。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    downloadLink('downloadData', 'Download', class = "A"),	
    downloadButton('downloadData1', 'Download')	
    ),	
  dashboardBody(dataTableOutput("Data"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
  output$Data <- renderDataTable({	
    datatable(data)	
  })	
  output$downloadData <- downloadHandler(	
    filename = function() {	
      paste('data-', Sys.Date(), '.csv', sep='')	
    },	
    content = function(con) {	
      write.csv(data, con)	
    }	
  )	
  output$downloadData1 <- downloadHandler(	
    filename = function() {	
      paste('data1-', Sys.Date(), '.csv', sep='')	
    },	
    content = function(con) {	
      write.csv(data, con)	
    }	
  )	
}	
	
shinyApp(ui, server)

640?wx_fmt=gif

注意上图第一个是下载链接形式，第二个是下载按钮形式。

numericInput输入项

用于选择某个数字，可以设置“跳跃”的步长。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    numericInput("obs", "Number of Data:",	
                min = 0, max = 100, value = 2, step = 2)),	
  dashboardBody(dataTableOutput("Data"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
  	
  output$Data <- renderDataTable({	
    datatable(head(data,input$obs))	
  })	
}	
shinyApp(ui, server)

640?wx_fmt=gif

上图跳跃步长设置的为2.

helpText输入项

解释说明作用，见submitButton输入项函数。

varSelectInput输入项函数

用于获取数据源的列名。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    varSelectInput("variable", "variable:", diamonds)),	
  dashboardBody(plotOutput("Plot"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
  output$Plot <- renderPlot({	
    ggplot(data = data, aes(x = (!!!input$variable), y = price, colour = color)) +	
      geom_point() +  ggtitle("scatter diagram") +	
      theme(plot.title = element_text(hjust = 0.5))	
  })	
  	
}	
shinyApp(ui, server)

640?wx_fmt=gif

这里有一个小技巧，使用三个“!!!”(!!!input$variabl）将带有引号的“carat”字段转化为不带引号的carat字段，绘制ggplot图以及建模的时候经常用到。

actionLink与actionButton输入项

两个输入项函数作用相同，用于控制操作是否有效，可以等价替换。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    sliderInput("obs", "Number of Data:",	
                min = 0, max = 100, value = 2),	
    actionButton("goButton", "Go!")),	
  dashboardBody(dataTableOutput("Data"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
  	
  output$Data <- renderDataTable({	
    input$goButton	
    data <- isolate(head(data,input$obs))	
    datatable(data)	
  })	
}	
shinyApp(ui, server)

640?wx_fmt=gif

上图，当滑动滑动条的时候，界面主体部分内容不再发生变化，当点击“Go”按钮的时候，主体部分才发生变化。

passwordInput输入项

当输入密码正确的时候才展示相关内容。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    sliderInput("obs", "Number of Data:",	
                min = 0, max = 100, value = 2),	
    passwordInput("password", "Author:")),	
  dashboardBody(dataTableOutput("Data"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
  	
  output$Data <- renderDataTable({	
    if (input$password == "Flash") {	
      datatable(data)	
    }	
  })	
}	
shinyApp(ui, server)

640?wx_fmt=gif

上图的正确密码为“Flash”，第一次输入“123”的时候，密码错误，不展示内容；当第二次输入密码“Flash”的时候，密码正确，展示内容。

submitButton输入项

类似于actionButton输入项与passwordInput输入项，点击按钮时候才更新主体内容。

library(shiny)	
library(shinydashboard)	
library(ggplot2)	
library(DT)	
ui <- dashboardPage(	
  dashboardHeader(title = "Flash WorkingNotes"),	
  dashboardSidebar(	
    sliderInput("obs", "Number of Data:",	
                min = 0, max = 100, value = 2),	
    submitButton("Update Data", icon("refresh")),	
    	
    helpText("click the button above, update the date:")),	
  dashboardBody(dataTableOutput("Data"))	
)	
	
server <- function(input, output) {	
  set.seed(123)	
  data = diamonds[sample(1:nrow(diamonds), 10000, replace = F), ]	
  	
  output$Data <- renderDataTable({	
      datatable(head(data, input$obs))	
  }) 	
}	
shinyApp(ui, server)

640?wx_fmt=gif

上图当滑动滑动条的时候，主体数据没有发生变化，点击“Update Data”按钮之后，主体部门数据发生了相应的变化。

总结

本部分简单介绍常用的几个侧边栏的输入项函数。当你做交互式界面的时候，需要用到几个输入项函数时，累加一起使用即可。重点注意输入项函数写在ui中dashboardSidebar函数中，有输入项函数就有输出项函数与之对应，输出项函数成对出现（*Output函数和render*函数），*Output函数写在ui中的dashboardBody函数中，render*函数写在server中。