R Shiny 基础. 2 reactivity

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的功能

1. 自动更新input和output
2. 把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 部署在云端服务器的效果。

代码行数有点多，其实把变量之间的关系稍做整理然后可视化一下就会清楚很多。

稍做观察就不难看出变量之间的关系很密切。这就造成了两个问题。

1. 因为关系网太密，所以导致这个app比较难理解。没法单独提取app里面的变量进行分析
2. 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")
  })
}