Shiny 基础
shiny introduction
Shiny 是一个可以从R中方便地构建交互式的WEB应用的R包
作为一个实例展示， Shiny 中内置了一些例子，我们可以通过运行 runExample() 来探索Shiny APP的结构：
library(shiny)
runExample("01_hello")
image-20201103184214756
Shiny App的结构
Shiny apps是被包含在名为app.R的脚本中，如果这个脚本在一个目录下(比如newdir/)，那么可以通过runApp("newdir")来运行
app.R有3个部分：
- UI对象(user interface)，控制这APP的布局和外观
- server function包含计算机创建APP所需的指令
- 调用shinyApp的命令,
shinyApp(ui = ui, server = server)
上面的01_hello的源代码如下：
library(shiny)
# Define UI for app that draws a histogram ----
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Slider for the number of bins ----
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Histogram ----
plotOutput(outputId = "distPlot")
)
)
)
# Define server logic required to draw a histogram ----
server <- function(input, output) {
# Histogram of the Old Faithful Geyser Data ----
# with requested number of bins
# This expression that generates a histogram is wrapped in a call
# to renderPlot to indicate that:
#
# 1. It is "reactive" and therefore should be automatically
# re-executed when inputs (input$bins) change
# 2. Its output type is a plot
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)
当我们将上面的代码复制到一个app.R文件中，Rstudio就会显示Run App图标：
image-20201103185856829
存储和运行APP可以有几种方式：
- 单独的文件夹下存放
app.R文件，使用runApp加上文件夹的路径 - 也可以不使用
app.R文件名，但是需要在runApp函数中指定.R文件的路径 - 将
ui.R和server.R分开存放，但是要在一个文件夹内，这个时候可以使用runApp加上文件夹的路径
Build a user interface
UI包括一些元素，比如布局，添加文字，图像和其他的一些HTML元素
让我们先生成一个空白的UI界面，然后再一步步的扩充它：
library(shiny)
# Define UI ----
ui <- fluidPage(
)
# Define server logic ----
server <- function(input, output) {
}
# Run the app ----
shinyApp(ui = ui, server = server)
布局
Shiny使用fluidPage函数来创建一个自动适应用户浏览器窗口的展示界面，通过将一些元素放到这个函数里面来对APP的UI进行布局
最流行的两个元素为titlePanel和sidebarLayout
sidebarLayout总是有两个参数：
sidebarPanelmainPanel
最简单的用法如下:
ui <- fluidPage(
titlePanel("title panel"),
sidebarLayout(
sidebarPanel("sidebar panel"),
mainPanel("main panel")
)
)
image-20201104214853377
Sidebar panel默认是出现在app的左侧，可以通过sidebarLayout的参数position=right来指定位置在右边：
ui <- fluidPage(
titlePanel("title panel"),
sidebarLayout(position = "right",
sidebarPanel("sidebar panel"),
mainPanel("main panel")
)
)
image-20201104215144288
除了这两个元素之外，还可以创建一些更高级的布局：见more
HTML content
可以使用HTML的tag函数来向*Panel函数添加内容，一些常用的tag函数如下：
image-20201104215616831
比如下面的代码就添加了几个级别标题到mainPanel：
ui <- fluidPage(
titlePanel("My Shiny App"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h1("First level title"),
h2("Second level title"),
h3("Third level title"),
h4("Fourth level title"),
h5("Fifth level title"),
h6("Sixth level title")
)
)
)
image-20201104215836278
下面的代码使用一系列的HTML标签对文本进行格式化：
ui <- fluidPage(
titlePanel("My Shiny App"),
sidebarLayout(
sidebarPanel(),
mainPanel(
p("p creates a paragraph of text."),
p("A new p() command starts a new paragraph. Supply a style attribute to change the format of the entire paragraph.", style = "font-family: 'times'; font-si16pt"),
strong("strong() makes bold text."),
em("em() creates italicized (i.e, emphasized) text."),
br(),
code("code displays your text similar to computer code"),
div("div creates segments of text with a similar style. This division of text is all blue because I passed the argument 'style = color:blue' to div", style = "color:blue"),
br(),
p("span does the same thing as div, but it works with",
span("groups of words", style = "color:blue"),
"that appear inside a paragraph.")
)
)
)
image-20201104220046053
也可以通过img()tag函数来放置图片，需要使用src参数来指定图片的路径,注意一定要写上这个src因为这些tag函数都是将里面的内容转化成HTML，而src是HTML表示这个tag必需的：
> img(src = "my_image.png")
<img src="my_image.png"/>
> img("my_image.png")
<img>my_image.png</img>
也可以指定height和width，单位都是像素
另外一个需要注意的就是图片的路径必须是在app.R相同的路径下，并且放到www的文件夹中(其实和app.R放到一个文件夹就行)
还有一些其他的tag可以看1和2
Add control widgets(部件)
widgets就是用来和用户交互的web组件
shiny app响应widgets收集的用户交互的信息，从而改变UI界面展示的内容
标准的shiny组件包括：
image-20201105221936151
image-20201105221953898
Adding widgets
添加部件和上一节讲的添加HTML内容是一样的，只需要将特定的widget函数放进sidebarPanel 或者 mainPanel里面就可以了
每个组件函数都需要几个参数，对于每个组件，前两个参数是：
- 名称(name) 用户是看不见的，但是我们可以通过名称来找到这个组件,字符串
- 标签(label) 在web界面会显示这个label，是一个字符串，但是可以使用空字符:
""
下面的代码可以创建出上面的界面：
library(shiny)
# Define UI ----
ui <- fluidPage(
titlePanel("Basic widgets"),
fluidRow(
column(3,
h3("Buttons"),
actionButton("action", "Action"),
br(),
br(),
submitButton("Submit")),
column(3,
h3("Single checkbox"),
checkboxInput("checkbox", "Choice A", value = TRUE)),
column(3,
checkboxGroupInput("checkGroup",
h3("Checkbox group"),
choices = list("Choice 1" = 1,
"Choice 2" = 2,
"Choice 3" = 3),
selected = 1)),
column(3,
dateInput("date",
h3("Date input"),
value = "2014-01-01"))
),
fluidRow(
column(3,
dateRangeInput("dates", h3("Date range"))),
column(3,
fileInput("file", h3("File input"))),
column(3,
h3("Help text"),
helpText("Note: help text isn't a true widget,",
"but it provides an easy way to add text to",
"accompany other widgets.")),
column(3,
numericInput("num",
h3("Numeric input"),
value = 1))
),
fluidRow(
column(3,
radioButtons("radio", h3("Radio buttons"),
choices = list("Choice 1" = 1, "Choice 2" = 2,
"Choice 3" = 3),selected = 1)),
column(3,
selectInput("select", h3("Select box"),
choices = list("Choice 1" = 1, "Choice 2" = 2,
"Choice 3" = 3), selected = 1)),
column(3,
sliderInput("slider1", h3("Sliders"),
min = 0, max = 100, value = 50),
sliderInput("slider2", "",
min = 0, max = 100, value = c(25, 75))
),
column(3,
textInput("text", h3("Text input"),
value = "Enter text..."))
)
)
# Define server logic ----
server <- function(input, output) {
}
# Run the app ----
shinyApp(ui = ui, server = server)
练习
使用基础的布局部件创建下面的界面：
image-20201105223412617
image-20201105224026889
library(shiny)
# Define UI ----
ui <- fluidPage(
titlePanel("censusVis"),
sidebarLayout(
mainPanel(),
sidebarPanel(
h3("Create demographic maps with information from the 2010 US Census"),
##or
## helpText("Create demographic maps with
## information from the 2010 US Census.")
selectInput("Vis",label = h3("Choose a varible to display"),
choices = list("Percent White"=1,"Percent Black"=2,"Percent Hispanic"=3,"Percent Asian"=4),
selected = "Percent White",multiple = F),
sliderInput("s1",h3("Range of interest"),min = 0,max = 100,step = 2,value = c(0,100))
)
)
)
# Define server logic ----
server <- function(input, output) {
}
# Run the app ----
shinyApp(ui = ui, server = server)
Display reactive output
之前的内容都是展示布局，并没有输出，要想创建一个交互式的输出需要两步：
- 在UI里面添加一个R对象
- 在server函数内部告诉R如何去创建这个对象
在UI里面添加R对象
shiny提供了一系列的函数将R对象转化成UI界面的输出，每一个函数创建一个特定类型的输出：
image-20201106225411772
每一个*output函数需要一个参数：创建的R对象的名称(字符串)
添加output和添加HTML以及UI组件是一样的，在UI元素(mainPanel,sidebarPanel等)内部添加output函数就可以了：
ui <- fluidPage(
titlePanel("censusVis"),
sidebarLayout(
sidebarPanel(
helpText("Create demographic maps with
information from the 2010 US Census."),
selectInput("var",
label = "Choose a variable to display",
choices = c("Percent White",
"Percent Black",
"Percent Hispanic",
"Percent Asian"),
selected = "Percent White"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 100, value = c(0, 100))
),
mainPanel(
textOutput("selected_var")
)
)
)
上面的代码在mainPanel里面放置了一个文字类型的输出，R对象名称为selected_var
提供R代码来创建这个对象
将R对象的名称放在UI里面只是告诉shiny在哪儿放置我们的输出结果，接下来我们需要告诉shiny如何去创建这个对象
server函数会创建一个类似列表的对象，名称叫output，其包含更新app输出所需要的全部R代码；所以我们创建的每个R对象都要是这个output对象的一个元素，这个元素的名称和前面在UI里面创建的R对象名称要一致：
server <- function(input, output) {
output$selected_var <- renderText({
paste("You have selected", input$var)
})
}
output的每个元素都要含有shiny render*函数的输出，不同的render*函数对应不同类型的输出：
image-20201106230835574
每个render函数也都有一个参数：使用{}括起来的R代码，每次更新输出的时候，shiny都会运行这里面的代码
server函数还会将app当前的所有组件的值存为一个input对象，每个组件都是input对象的一个元素，元素的名称就是我们设定的组件的名称(组件的第一个参数，像上面的var,range)
所以将上面的代码组合起来运行：
runApp('test_app/test.R',display.mode = "showcase")
image-20201106231950793
display.mode = "showcase"可以展示我们的源代码，并在每次更新的时候将相应的代码高亮
Use R scripts and data
本节将使用美国的人口和地图数据来展现每个城市的人口密度，使用的数据可以从这里下载
绘图代码为：
# Note: percent map is designed to work with the counties data set
# It may not work correctly with other data sets if their row order does
# not exactly match the order in which the maps package plots counties
percent_map <- function(var, color, legend.title, min = 0, max = 100) {
# generate vector of fill colors for map
shades <- colorRampPalette(c("white", color))(100)
# constrain gradient to percents that occur between min and max
var <- pmax(var, min)
var <- pmin(var, max)
percents <- as.integer(cut(var, 100,
include.lowest = TRUE, ordered = TRUE))
fills <- shades[percents]
# plot choropleth map
map("county", fill = TRUE, col = fills,
resolution = 0, lty = 0, projection = "polyconic",
myborder = 0, mar = c(0,0,0,0))
# overlay state borders
map("state", col = "white", fill = FALSE, add = TRUE,
lty = 1, lwd = 1, projection = "polyconic",
myborder = 0, mar = c(0,0,0,0))
# add a legend
inc <- (max - min) / 4
legend.text <- c(paste0(min, " % or less"),
paste0(min + inc, " %"),
paste0(min + 2 * inc, " %"),
paste0(min + 3 * inc, " %"),
paste0(max, " % or more"))
legend("bottomleft",
legend = legend.text,
fill = shades[c(1, 25, 50, 75, 100)],
title = legend.title)
}
数据：
image-20201107230932367
需要用到的包为maps and mapproj
可以直接运行这些代码：
library(maps)
library(mapproj)
source("test_app/helpers.R")
counties <- readRDS("test_app/counties.rds")
percent_map(counties$white, "darkgreen", "% White")
image-20201107231538685
展示了每个城市白人的比例
在把这些代码放到app.R里面的时候需要注意：
- 路径问题，app在运行的时候是以
app.R作为工作路径 - 代码的位置，因为不同位置的代码运行的次数不一样，可能会影响APP的性能
image-20201107232031918
image-20201107232048001
image-20201107232102417基于这些规律，在放置代码的时候可以遵循以下原则：
source代码，load包，载入数据都可以放在server函数之外，只需要运行一次- 将定义用户特定对象的代码放到
server函数内但是render*函数外，每个用户运行一次(比如记录用户的seeeion 信息) - 将需要响应部件改动的代码放到
render*内部，每次用户改变部件值的时候都需要运行
练习
将以上代码组织成APP：
library(maps)
library(mapproj)
source("helpers.R")
counties <- readRDS("counties.rds")
# User interface ----
ui <- fluidPage(
titlePanel("censusVis"),
sidebarLayout(
sidebarPanel(
helpText("Create demographic maps with
information from the 2010 US Census."),
selectInput("var",
label = "Choose a variable to display",
choices = c("Percent White", "Percent Black",
"Percent Hispanic", "Percent Asian"),
selected = "Percent White"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 100, value = c(0, 100))
),
mainPanel(plotOutput("map"))
)
)
# Server logic ----
server <- function(input, output) {
output$map <- renderPlot({
data <- switch(input$var,
"Percent White" = counties$white,
"Percent Black" = counties$black,
"Percent Hispanic" = counties$hispanic,
"Percent Asian" = counties$asian)
percent_map(var = data, color = "darkgreen",
legend.title = paste("%",gsub("Percent ","",input$var)),
max = input$range[2],
min = input$range[1])
})
}
# Run app ----
shinyApp(ui, server)
image-20201107234150921
Use reactive expressions
当shiny需要进行耗时的运算或者数据下载时可以通过响应式的表达式来减少不必要的重复计算
下面是一个展示股票走势的例子：
# Load packages ----
library(shiny)
library(quantmod)
# Source helpers ----
source("helpers.R")
# User interface ----
ui <- fluidPage(
titlePanel("stockVis"),
sidebarLayout(
sidebarPanel(
helpText("Select a stock to examine.
Information will be collected from Yahoo finance."),
textInput("symb", "Symbol", "SPY"),
dateRangeInput("dates",
"Date range",
start = "2013-01-01",
end = as.character(Sys.Date())),
br(),
br(),
checkboxInput("log", "Plot y axis on log scale",
value = FALSE),
checkboxInput("adjust",
"Adjust prices for inflation", value = FALSE)
),
mainPanel(plotOutput("plot"))
)
)
# Server logic
server <- function(input, output) {
output$plot <- renderPlot({
data <- getSymbols(input$symb, src = "yahoo",
from = input$dates[1],
to = input$dates[2],
auto.assign = FALSE)
chartSeries(data, theme = chartTheme("white"),
type = "line", log.scale = input$log, TA = NULL)
})
}
# Run the app
shinyApp(ui, server)
上面的代码中,getSymbols是从yahoo上抓取相应的数据，所以每次改变输入都会重新下数据(比如将y轴以log形式展示)，这一方面会使APP的性能下降，另一方面yahoo针对下载数据频率过快会切断连接，可以使用响应式的表达式改写上面的代码：
server <- function(input, output) {
dataInput <- reactive({
getSymbols(input$symb, src = "yahoo",
from = input$dates[1],
to = input$dates[2],
auto.assign = FALSE)
})
output$plot <- renderPlot({
chartSeries(dataInput(), theme = chartTheme("white"),
type = "line", log.scale = input$log, TA = NULL)
})
}
reactive的用法和render*是类似的，将函数放到reactive({})里面就行了
reactive第一次运行就会保存运行的结果，在第二次运行reactive的时候会检查这个结果所依赖的部件值是否改变(这里是symb和date)，如果没有改变就不会运行，仍然返回之前保存的值，如果发生改变就会再次运行并且保存更新后的结果
Share your apps
有两种方式可以将我们的shiny app分享给别人：
- R脚本 这种方式需要用户电脑上安装了R并且有一定的R基础
- 网页
R脚本
Shiny提供了3个函数来使用网络上公开的shiny app: runUrl runGitHub runGist
runUrl
runUrl可以直接下载并启动shiny app，需要提供weblink
为了让别人可以使用shiny app,我们需要：
- 将shiny app的目录打包成zip格式的文件
- 将zip文件放到网上(有网页链接)
然后就可以运行runUrl( "<the weblink>")来进行运行
runGitHub
可以在github上建一个仓库存放我们的shiny app文件(app.R和其他的附属文件)
通过运行runGitHub( "<your repository name>", "<your user name>")来运行app
runGist
网页
一种选择是自己在服务器上部署app，弄一个URL
还有一种选择是Rstudio提供了3种方法将app托管为网页：
- shinyapp.io
- shiny server
- Rstudio Connect
参考：https://shiny.rstudio.com/tutorial/written-tutorial/
腾讯云开发者
