用R构建Shiny应用程序(一)

用R构建Shiny应用程序(一)

本文是中文教程:用R构建Shiny应用程序的学习笔记。不过我跳过了那些暂时难以理解的内容。最后感觉最好的学习方法可能还是不停地抄代码,计划先把这个仓库里面的示例抄一遍:rstudio/shiny-examples,本文中的 示例是shiny包中的11个示例,正好也是这个仓库里面的前十个示例。

直方图的示例

查看这个例子:

R
1
2
library(shiny)
runExample("01_hello")

源码为:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput(outputId = "distPlot")
)
)
)

server <- function(input, output){
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}

shinyApp(ui = ui, server = server)

这里涉及到两个知识点:滑动条图表渲染

Shiny Text

这个应用程序 展示的是直接打印R对象,以及用HTML表格展示数据框。

R
1
runExample("02_text")

源码:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
ui <- fluidPage(
titlePanel("Shiny Text"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "dataset",
label = "Choose a dataset:",
choices = c("rock", "pressure", "cars")),
numericInput(inputId = "obs",
label = "Number of observations to view:",
value = 10)
),
mainPanel(
verbatimTextOutput("summary"),
tableOutput("view")
)
)
)

# 在服务端我们需要创建:
# 1. 一个反应性表达式来返回用户选择的相应数据集;
# 2. 两个渲染表达式。

server <- function(input, output){
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})

output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
}

shinyApp(ui, server)


这里涉及到两个知识点:选择列表数值输入代码运行结果渲染表格渲染

Reactivity:反应式编程

R
1
runExample("03_reactivity")

源码:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
library(shiny)
ui <- fluidPage(
titlePanel("Reactivity"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "caption",
label = "Caption:",
value = "Data Summary"),

selectInput(inputId = "dataset",
label = "Choose a dataset:",
choices = c("rock", "pressure", "cars")),

numericInput(inputId = "obs",
label = "Number of observations to view:",
value = 10)
),

mainPanel(
h3(textOutput("caption", container = span)),
verbatimTextOutput("summary"),
tableOutput("view")
)
)
)

server <- function(input, output){
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
output$caption <- renderText({
input$caption
})
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
}

shinyApp(ui, server)

这里涉及到的知识点包括:文本输入选择列表数值输入代码运行结果渲染表格渲染

箱线图示例

这里需要把ui.R文件和server.R函数放在同一个项目文件夹里,源码如下:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
# ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Miles per Gallon"),
sidebarPanel(
selectInput(inputId = "variable",
label = "Variable:",
choices = list("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear")),
checkboxInput(inputId = "outliers",
label = "Show outliers",
value = F)
),
mainPanel(
h3(textOutput("caption")),
plotOutput("mpgPlot")
)
))

# server.R
library(datasets)
library(shiny)
mpgData <- mtcars
mpgData$am <- factor(mpgData$am, labels = c("Automatic", "Manual"))
shinyServer(function(input, output){
formulaText <- reactive({
paste("mpg ~", input$variable)
})

output$caption <- renderText({
formulaText()
})

output$mpgPlot <- renderPlot({
boxplot(as.formula(formulaText()),
data = mpgData,
outline = input$outliers)
})
})

这里涉及到的知识点包括:选择列表勾选框文本渲染图表渲染

运行和调试

调试技巧:

  1. 增加cat函数,这样可以在适当的地方打印诊断信息。例如,下面两条调用就是用来打印标准输出和标准错误的信息:
R
1
2
cat("foo\n")
cat("bar\n", file = stderr())
  1. 使用调试浏览器。增加browser函数的显式调用来中断程序的执行,并查看调用browser时所处的环境。注意,使用browser需要你从交互式会话中启动应用程序。

例如,在代码的某个地方无条件地停止执行:

R
1
browser()

也可以使用这种方法在 特定条件下停止执行代码。例如,当用户选择“transmission”作为变量的时候停止执行MPG程序:

R
1
browser(expr = identical(input$variable, "am"))

  1. 建立一个自定义错误处理器

你也可以设置R的 “error”选项,当错误发生的时候,自动进入调试浏览器:

R
1
options(error = browser)

另一种方法,你可以设置recover函数作为错误处理器,它可以打印一个调用列表,并允许你在堆栈的任何位置查看:

R
1
options(error = recover)

滑动条

查看示例:

R
1
runExample("05_sliders")

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
ui <- fluidPage(
titlePanel("Sliders"),
sidebarLayout(
sidebarPanel(
sliderInput("integer", "Integer:",
min = 0, max = 1000,
value = 500),
sliderInput("decimal", "Decimal:",
min = 0, max = 1000,
value = 500),
sliderInput("range", "Range:",
min = 1, max = 1000,
value = c(200, 500)),
sliderInput("format", "Custom Format:",
min = 0, max = 10000,
value = 0, step = 2500,
pre = "$", sep = ",",
animate = T),
sliderInput("animation", "Looping Animation:",
min = 1, max = 2000,
value = 1, step = 100,
animate =
animationOptions(interval = 300, loop = T))
),
mainPanel(
tableOutput("values")
)
)
)

server <- function(input, output){
sliderValues <- reactive({
data.frame(
Name = c("Integer", "Decimal",
"Range", "Custom Format",
"Animation"),
Value = as.character(c(input$integer,
input$decimal,
paste(input$range, collapse = " "),
input$format,
input$animation)),
stringsAsFactors = F
)
})
output$values <- renderTable({
sliderValues()
})
}

shinyApp(ui, server)

选项卡

R
1
runExample("06_tabsets")
R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
ui <-  fluidPage(
titlePanel("TabSets"),
sidebarLayout(
sidebarPanel(
radioButtons("dist", "分布类型:",
choices = c("正态分布" = "norm",
"均匀分布" = "unif",
"对数正态分布" = "lnorm",
"指数分布" = "exp")),
# br()函数可以产生一个换行
br(),
sliderInput("n",
"观测值数目:",
value = 500,
min = 1,
max = 1000)
),

mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table")))
)
)
)

server <- function(input, output){
d <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})

output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(d(),
main = paste0("r", dist, "(", n, ")"),
col = "#75AADB", border = "white")
})

output$summary <- renderPrint({
summary(d())
})

output$table <- renderTable({
d()
})
}
shinyApp(ui, server)

更多小部件

R
1
runExample("07_widgets")

helpText和actionButton。后者用于延迟渲染输出。

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
ui <- fluidPage(
titlePanel("更多小部件"),
sidebarLayout(
sidebarPanel(
selectInput("dataset", "选择一个数据集: ",
choices = c("rock", "pressure", "cars")),
numericInput("obs", "预览的观测值数目", 10),
helpText("注意:只有观测值数目被指定的时候数据视图才会显现,汇总表仍旧是完整数据集的。"),
actionButton("update", "更新视图")
),
mainPanel(
h4("汇总"),
verbatimTextOutput("summary"),
h4("观测值数目"),
tableOutput("view")
)
)
)

server <- function(input, output){
datasetInput <- eventReactive(input$update, {
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
}, ignoreNULL = F)

output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})

# isolate()函数可以使得观测值变化的时候表格不变,而只有点击激活按钮的时候表格才会更新。
output$view <- renderTable({
head(datasetInput(), n = isolate(input$obs))
})
}

shinyApp(ui, server)

这里涉及的知识点有:帮助文本激发按钮

上传文件

有时你希望用户上传数据到你的应用程序里。shiny使得用户可以很容易地用浏览器上传数据,然后服务端可以访问这些数据。

默认情况下,shiny上传的每个文件最大不能超过5M。可以 通过shiny.maxRequestSize选项来修改这个限制。例如,在server.R的最前面加上options(shiny.maxRequestSize = 30*1024^2),可以把文件大小限制提高到30M。

R
1
runExample("09_upload")

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
ui <- fluidPage(
titlePanel("上传文件"),
sidebarLayout(
sidebarPanel(
fileInput("file1", "选择一个csv文件",
multiple = T,
accept = c("text/csv",
"text/comma-separated-values, text/plain",
".csv")),
# 添加一条水平线
tags$hr(),
checkboxInput("header", "表头", T),
radioButtons("sep", "分隔符",
choices = c(逗号 = ",",
分号 = ";",
制表符 = "\t"),
selected = ","),
radioButtons("quotes", "引号",
choices = c(无 = "",
"双引号" = '"',
"单引号" = "'"),
selected = '"'),
tags$hr(),
radioButtons("disp", "显示:",
choices = c(表头 = "head",
全部 = "all"),
selected = "head")
),
mainPanel(
tableOutput("contents")
)
)
)

server <- function(input, output){
output$contents <- renderTable({
req(input$file1)
# 文件内容可以通过datapath提供的文件名来访问。
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
if(input$disp == "head"){
return(head(df))
}
else{
return(df)
}
})
}

shinyApp(ui, server)

这里涉及到的知识点包括:文件输入

下载文件

R
1
runExample("10_download")
R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
ui <- fluidPage(
titlePanel("下载数据"),
sidebarLayout(
sidebarPanel(
selectInput("dataset", "选择一个数据集:",
choices = c("rock", "pressure", "cars")),
downloadButton("downloadData", "下载")
),
mainPanel(
tableOutput("table")
)
)
)

server <- function(input, output){
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars)
})
output$table <- renderTable({
datasetInput()
})

output$downloadData <- downloadHandler(
filename = function(){
paste(input$dataset, ".csv", sep = "")
},
content = function(file){
write.csv(datasetInput(), file, row.names = F)
}
)
}

shinyApp(ui, server)

这里涉及的知识点是:文件下载

HTML UI

查看示例

R
1
runExample("08_html")

R
1
2
3
4
# 首先进入www文件夹编辑index.html文件
setwd("~/Desktop/HTML_UI/www")
# 然后进入项目主文件夹创建server.R文件
setwd("~/Desktop/HTML_UI")

index.html的代码为:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
<!DOCTYPE html>

<html>

<head>
<meta charset = "utf-8" />
<script src = "shared/jquery.js" type = "text/javascript"></script>
<script src = "shared/shiny.js" type = "text/javascript"></script>
<link rel = "stylesheet" type = "text/css" href = "shared/shiny.css" />
</head>

<body>
<h1>HTML UI</h1>
<p>
<label>分布类型:</label><br />
<select name = "dist">
<option value = "norm">正态分布</option>
<option value = "unif">均匀分布</option>
<option value = "lnorm">对数正态分布</option>
<option value = "exp">指数分布</option>
</select>
</p>

<p>
<label>观测值数目:</label><br />
<input type = "number" name = "n" value = "500" min = "1" max = "1000" />
</p>
<h3>数据汇总:</h3>
<pre id = "summary" class = "shiny-text-output"></pre>
<h3>数据分布:</h3>
<div id = "plot" class = "shiny-plot-output" style = "width: 100%; height: 400px"></div>
<h3>数据展示:</h3>
<div id = "table" class = "shiny-html-output"></div>
</body>
</html>

server.R的代码为:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
library(shiny)
shinyServer(function(input, output){
data <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})

output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(data(),
main = paste('r', dist, '(', n, ')', sep = ''))
})

output$summary <- renderPrint({
summary(data())
})

output$table <- renderTable({
data.frame(x = data())
})
})

效果:

从客户端获取非输入数据

下面的示例中,客户端浏览器将显示URL的组件,并解析和打印查询/搜索字符串(”?”之后的URL部分):

R
1
setwd("~/Desktop/clientData")

ui.R:

R
1
2
3
4
5
6
7
8
library(shiny)
shinyUI(bootstrapPage(
h3("URL components"),
verbatimTextOutput("urlText"),

h3("Parsed query string"),
verbatimTextOutput("queryText")
))

server.R:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
library(shiny)
shinyServer(function(input, output, session){
output$urlText <- renderText({
paste(sep = "",
"protocol: ", session$clientData$url_protocol, "\n",
"hostname: ", session$clientData$url_hostname, "\n",
"pathname: ", session$clientData$url_pathname, "\n",
"port: ", session$clientData$url_port, "\n",
"search: ", session$clientData$url_search, "\n")
})

output$queryText <- renderText({
query <- parseQueryString(session$clientData$url_search)
paste(names(query), query, sep = "=", collapse = ",")
})
})

查看clientData中的所有可用值

下面的应用程序有一个绘图输出,并显示session$clientData的所有值。

  • output_myplot_height:网页上绘图的高度,以像素为单位。
  • output_myplot_width:网页上绘图的宽度(以像素为单位)。
  • output_myplot_hidden:如果对象被隐藏(不可见),则为TRUE。使用它是因为Shiny将默认在隐藏时暂停输出对象。暂停时,即使输入发生变化,观察者也不会执行。
R
1
setwd("~/Desktop/clientData2")

ui.R:

R
1
2
3
4
5
6
7
8
9
10
11
12
shinyUI(pageWithSidebar(
headerPanel("Shiny Client Data"),
sidebarPanel(
sliderInput("obs", "观测值数目:",
min = 0, max = 1000, value = 500)
),
mainPanel(
h3("clientData values"),
verbatimTextOutput("clientdataText"),
plotOutput("myplot")
)
))

server.R:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
shinyServer(function(input, output, session){
cdata = session$clientData
output$clientdataText <- renderText({
cnames <- names(cdata)
allvalues <- lapply(cnames, function(name){
paste(name, cdata[[name]], sep = " = ")
})
paste(allvalues, collapse = "\n")
})
output$myplot <- renderPlot({
hist(rnorm(input$obs), main = "Generated in renderPLot()")
})
})

Timer

R
1
runExample("11_timer")

源码:

R
1
2
3
4
5
6
7
8
9
10
11
ui <- fluidPage(
h2(textOutput("currentTime"))
)

server <- function(input, output, session){
output$currentTime <- renderText({
invalidateLater(1000, session)
paste("当前时间为:", Sys.time())
})
}
shinyApp(ui, server)

# R

评论

程振兴

程振兴 @czxa.top
截止今天,我已经在本博客上写了354.2k个字了!

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×