Shiny是一个网页端app,所以得同时满足多个用户的独立操作。不能因为小A修改了输入导致小B想要看的结果出现了错误。所以会用到reactivity来保证流程独立。
2.1 服务器
服务器两个重要也是最基本的功能就是输入和输出。
2.1.1 Input 输入
ui <- fluidPage(
numericInput("count", label = "Number of values", value = 100)
)
这是一个最常见的输入模式。默认值是100。
但是server端的话就不能给input指定数值了,因为在server端input是只读参数。强行写入数值的话会返回错误。
server <- function(input, output, session) {
input$count <- 10
}
shinyApp(ui, server)
#> Error: Can't modify read-only reactive value 'count'
这个错误是因为input只会反馈浏览器的数值,当你强行修改server内部input的时候就会造成混乱。需要用到类似updateNumericInput()的函数来让sever自动更新。
2.1.2 Output输出
和输入很相似。一定也要用render函数。
ui <- fluidPage(
textOutput("greeting")
)
server <- function(input, output, session) {
output$greeting <- renderText("Hello human!")
}
- render的功能
- 自动更新input和output
- 把R code转换成html格式
和input一样,如果忘了render函数或者是图直接读取的话会报错。
server <- function(input, output, session) {
output$greeting <- "Hello human"
}
shinyApp(ui, server)
#> Error: Unexpected character object for output$greeting
#> Did you forget to use a render function?
server <- function(input, output, session) {
message("The greeting is ", output$greeting)
}
shinyApp(ui, server)
#> Error: Reading from shinyoutput object is not allowed.
2.2 Reactive程序
ui <- fluidPage(
textInput("name", "What's your name?"), #注意到有个逗号
textOutput("greeting")
)
server <- function(input, output, session) {
output$greeting <- renderText({
paste0("Hello ", input$name, "!")
})
}
textInput是设置UI输入界面,并且给输入指定变量”name”。下面一行textOutput是给输出指定变量。这里的变量名就是”greeting”。如果没有textInput的话那每次显示的东西都变成了固定的,没法进行UI互动了。
对于reactive,书里的定义比较复杂。理解成可以用来生成介于input和output之间的中间变量的函数。
2.3 Reactive Graph
原著中给出了reactive graph的概念,就是reactive的流程图。比方说刚才的例子就可以变成,
我们可以说greeting
和 name
之间有reactive依存关系。
可以接下去看一个例子
server <- function(input, output, session) {
string <- reactive(paste0("Hello ", input$name, "!"))
output$greeting <- renderText(string()) ## 注意string的属性是reactive, 所以是string()
}
这个例子在简单的reactive里看不出什么作用,等以后编写复杂的reactive的时候就可以大幅度减少代码重复,提高效率了。
- 练习
把下面的代码黏贴给ui, 然后修改4个server的错误
ui <- fluidPage(
textInput("name", "What's your name?"),
textOutput("greeting")
)
server1 <- function(input, output, server) {
input$greeting <- renderText(paste0("Hello ", name))
}
server2 <- function(input, output, server) {
greeting <- paste0("Hello ", input$name)
output$greeting <- renderText(greeting)
}
server3 <- function(input, output, server) {
output$greting <- paste0("Hello", input$name)
}
2.3 Reactivity 表现
文中举了一个比较复杂的例子。比较两组数据的和密度图,并进行t-test。试着把代码改编成Shiny App.
下面是正常R的实现方法。
library(ggplot2)
freqpoly <- function(x1, x2, binwidth = 0.1, xlim = c(-3, 3)) {
df <- data.frame(
x = c(x1, x2),
g = c(rep("x1", length(x1)), rep("x2", length(x2)))
)
ggplot(df, aes(x, colour = g)) +
geom_freqpoly(binwidth = binwidth, size = 1) +
coord_cartesian(xlim = xlim)
}
t_test <- function(x1, x2) {
test <- t.test(x1, x2)
# use sprintf() to format t.test() results compactly
sprintf(
"p value: %0.3f\n[%0.2f, %0.2f]",
test$p.value, test$conf.int[1], test$conf.int[2]
)
}
x1 <- rnorm(100, mean = 0, sd = 0.5)
x2 <- rnorm(200, mean = 0.15, sd = 0.9)
freqpoly(x1, x2)
cat(t_test(x1, x2))
#> p value: 0.016
#> [-0.35, -0.04]
然后是改成shiny。
首先是ui端,可以从文面大概猜到fluidRow column
的大概用法,之后会花篇幅详细介绍。
ui <- fluidPage(
fluidRow(
column(4,
"Distribution 1",
numericInput("n1", label = "n", value = 1000, min = 1),
numericInput("mean1", label = "µ", value = 0, step = 0.1),
numericInput("sd1", label = "σ", value = 0.5, min = 0.1, step = 0.1)
),
column(4,
"Distribution 2",
numericInput("n2", label = "n", value = 1000, min = 1),
numericInput("mean2", label = "µ", value = 0, step = 0.1),
numericInput("sd2", label = "σ", value = 0.5, min = 0.1, step = 0.1)
),
column(4,
"Frequency polygon",
numericInput("binwidth", label = "Bin width", value = 0.1, step = 0.1),
sliderInput("range", label = "range", value = c(-3, 3), min = -5, max = 5)
)
),
fluidRow(
column(9, plotOutput("hist")),
column(3, verbatimTextOutput("ttest"))
)
)
server <- function(input, output, session) {
output$hist <- renderPlot({
x1 <- rnorm(input$n1, input$mean1, input$sd1)
x2 <- rnorm(input$n2, input$mean2, input$sd2)
freqpoly(x1, x2, binwidth = input$binwidth, xlim = input$range)
}, res = 96)
output$ttest <- renderText({
x1 <- rnorm(input$n1, input$mean1, input$sd1)
x2 <- rnorm(input$n2, input$mean2, input$sd2)
t_test(x1, x2)
})
}
https://hadley.shinyapps.io/ms-case-study-1 部署在云端服务器的效果。
代码行数有点多,其实把变量之间的关系稍做整理然后可视化一下就会清楚很多。
稍做观察就不难看出变量之间的关系很密切。这就造成了两个问题。
- 因为关系网太密,所以导致这个app比较难理解。没法单独提取app里面的变量进行分析
- app计算效率不高。每修改一个变量都会导致整体计算全部重来。
所以可以对这个app进行优化。在前面套一个reactive函数,让x1,x2变成了可活动的变量。这样就不会在x1或者x2发生改变的时候重新计算整个流程,而是仅更新发生变化的地方。
Reactivity里的变量需要加()
,表示是活动的函数,不是固定的value。
server <- function(input, output, session) {
x1 <- reactive(rnorm(input$n1, input$mean1, input$sd1))
x2 <- reactive(rnorm(input$n2, input$mean2, input$sd2))
output$hist <- renderPlot({
freqpoly(x1(), x2(), binwidth = input$binwidth, xlim = input$range)
}, res = 96)
output$ttest <- renderText({
t_test(x1(), x2())
})
}
其实这里还涉及到了组快化的概念。如下图所示
其实x1, x2都被组块话了,组块话这个概念在之后的篇幅里会详细介绍。
2.4 Timer功能
Shiny里还有定时激活功能。
在下面的程序里添加Timer也就是定时自动激活功能。通过观察代码可以看出这是一段随机数生成程序。自动激活就等于自动重新生成随机数。
ui <- fluidPage(
fluidRow(
column(3,
numericInput("lambda1", label = "lambda1", value = 3),
numericInput("lambda2", label = "lambda2", value = 5),
numericInput("n", label = "n", value = 1e4, min = 0)
),
column(9, plotOutput("hist"))
)
)
server <- function(input, output, session) {
x1 <- reactive(rpois(input$n, input$lambda1))
x2 <- reactive(rpois(input$n, input$lambda2))
output$hist <- renderPlot({
freqpoly(x1(), x2(), binwidth = 1, xlim = c(0, 40))
}, res = 96)
}
server <- function(input, output, session) {
timer <- reactiveTimer(500)
x1 <- reactive({
timer()
rpois(input$n, input$lambda1)
})
x2 <- reactive({
timer()
rpois(input$n, input$lambda2)
})
output$hist <- renderPlot({
freqpoly(x1(), x2(), binwidth = 1, xlim = c(0, 40))
}, res = 96)
}
这样就成功变成了下面的模式。每隔默认的半秒钟程序就会自动运行一次。
也可以添加Action标签 。只有action标签被点击的时候程序才会运行。
ui <- fluidPage(
fluidRow(
column(3,
numericInput("lambda1", label = "lambda1", value = 3),
numericInput("lambda2", label = "lambda2", value = 5),
numericInput("n", label = "n", value = 1e4, min = 0),
actionButton("simulate", "Simulate!")
),
column(9, plotOutput("hist"))
)
)
server <- function(input, output, session) {
x1 <- reactive({
input$simulate
rpois(input$n, input$lambda1)
})
x2 <- reactive({
input$simulate
rpois(input$n, input$lambda2)
})
output$hist <- renderPlot({
freqpoly(x1(), x2(), binwidth = 1, xlim = c(0, 40))
}, res = 96)
}
仔细看一下,其实添加了按钮只是多此一举,只要改变了lambda或者n,都会自动更新。因为从程序图里可以看出这是一个并联的关系,并不是串联。要把simulate串联在里面才行。
所以需要进行下面的修改。用eventReactive ,稍微有点难懂。有点接近If/else的逻辑关系。
server <- function(input, output, session) {
x1 <- eventReactive(input$simulate, {
rpois(input$n, input$lambda1)
})
x2 <- eventReactive(input$simulate, {
rpois(input$n, input$lambda2)
})
output$hist <- renderPlot({
freqpoly(x1(), x2(), binwidth = 1, xlim = c(0, 40))
}, res = 96)
}
文章还提到了观测函数observer
,用来提示命令是否被执行。可以用来反馈代码执行情况。这个函数出的结果不会被保存在任何变量里。但是可以用来Debugg。
ui <- fluidPage(
textInput("name", "What's your name?"),
textOutput("greeting")
)
server <- function(input, output, session) {
string <- reactive(paste0("Hello ", input$name, "!"))
output$greeting <- renderText(string())
observeEvent(input$name, {
message("Greeting performed")
})
}
网友评论