R Shiny 基礎(chǔ). 2 reactivity

Shiny是一個(gè)網(wǎng)頁端app，所以得同時(shí)滿足多個(gè)用戶的獨(dú)立操作。不能因?yàn)樾修改了輸入導(dǎo)致小B想要看的結(jié)果出現(xiàn)了錯(cuò)誤。所以會(huì)用到reactivity來保證流程獨(dú)立。

2.1 服務(wù)器

服務(wù)器兩個(gè)重要也是最基本的功能就是輸入和輸出。

2.1.1 Input 輸入

ui <- fluidPage(
  numericInput("count", label = "Number of values", value = 100)
)

這是一個(gè)最常見的輸入模式。默認(rèn)值是100。

但是server端的話就不能給input指定數(shù)值了，因?yàn)樵趕erver端input是只讀參數(shù)。強(qiáng)行寫入數(shù)值的話會(huì)返回錯(cuò)誤。

server <- function(input, output, session) {
  input$count <- 10  
}

shinyApp(ui, server)
#> Error: Can't modify read-only reactive value 'count'

這個(gè)錯(cuò)誤是因?yàn)閕nput只會(huì)反饋瀏覽器的數(shù)值，當(dāng)你強(qiáng)行修改server內(nèi)部input的時(shí)候就會(huì)造成混亂。需要用到類似updateNumericInput()的函數(shù)來讓sever自動(dòng)更新。

2.1.2 Output輸出

和輸入很相似。一定也要用render函數(shù)。

ui <- fluidPage(
  textOutput("greeting")
)

server <- function(input, output, session) {
  output$greeting <- renderText("Hello human!")
}
  • render的功能
  1. 自動(dòng)更新input和output
  2. 把R code轉(zhuǎn)換成html格式

和input一樣，如果忘了render函數(shù)或者是圖直接讀取的話會(huì)報(bào)錯(cuò)。

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?"),　#注意到有個(gè)逗號(hào)
  textOutput("greeting")
)

server <- function(input, output, session) {
  output$greeting <- renderText({
    paste0("Hello ", input$name, "!")
  })
}

textInput是設(shè)置UI輸入界面，并且給輸入指定變量”name”。下面一行textOutput是給輸出指定變量。這里的變量名就是”greeting”。如果沒有textInput的話那每次顯示的東西都變成了固定的，沒法進(jìn)行UI互動(dòng)了。

對于reactive，書里的定義比較復(fù)雜。理解成可以用來生成介于input和output之間的中間變量的函數(shù)。

2.3 Reactive Graph

原著中給出了reactive graph的概念，就是reactive的流程圖。比方說剛才的例子就可以變成，

我們可以說greeting 和 name 之間有reactive依存關(guān)系。

可以接下去看一個(gè)例子

server <- function(input, output, session) {
  string <- reactive(paste0("Hello ", input$name, "!"))
  output$greeting <- renderText(string()) ## 注意string的屬性是reactive， 所以是string()
}

這個(gè)例子在簡單的reactive里看不出什么作用，等以后編寫復(fù)雜的reactive的時(shí)候就可以大幅度減少代碼重復(fù)，提高效率了。

  • 練習(xí)

把下面的代碼黏貼給ui, 然后修改4個(gè)server的錯(cuò)誤

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 表現(xiàn)

文中舉了一個(gè)比較復(fù)雜的例子。比較兩組數(shù)據(jù)的和密度圖，并進(jìn)行t-test。試著把代碼改編成Shiny App.

下面是正常R的實(shí)現(xiàn)方法。

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 的大概用法，之后會(huì)花篇幅詳細(xì)介紹。

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 部署在云端服務(wù)器的效果。

代碼行數(shù)有點(diǎn)多，其實(shí)把變量之間的關(guān)系稍做整理然后可視化一下就會(huì)清楚很多。


稍做觀察就不難看出變量之間的關(guān)系很密切。這就造成了兩個(gè)問題。

  1. 因?yàn)殛P(guān)系網(wǎng)太密，所以導(dǎo)致這個(gè)app比較難理解。沒法單獨(dú)提取app里面的變量進(jìn)行分析
  2. app計(jì)算效率不高。每修改一個(gè)變量都會(huì)導(dǎo)致整體計(jì)算全部重來。

所以可以對這個(gè)app進(jìn)行優(yōu)化。在前面套一個(gè)reactive函數(shù)，讓x1,x2變成了可活動(dòng)的變量。這樣就不會(huì)在x1或者x2發(fā)生改變的時(shí)候重新計(jì)算整個(gè)流程，而是僅更新發(fā)生變化的地方。

Reactivity里的變量需要加(),表示是活動(dòng)的函數(shù)，不是固定的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())
  })
}

其實(shí)這里還涉及到了組快化的概念。如下圖所示


其實(shí)x1, x2都被組塊話了，組塊話這個(gè)概念在之后的篇幅里會(huì)詳細(xì)介紹。

2.4 Timer功能

Shiny里還有定時(shí)激活功能。

在下面的程序里添加Timer也就是定時(shí)自動(dòng)激活功能。通過觀察代碼可以看出這是一段隨機(jī)數(shù)生成程序。自動(dòng)激活就等于自動(dòng)重新生成隨機(jī)數(shù)。

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)
}

這樣就成功變成了下面的模式。每隔默認(rèn)的半秒鐘程序就會(huì)自動(dòng)運(yùn)行一次。

也可以添加Action標(biāo)簽 。只有action標(biāo)簽被點(diǎn)擊的時(shí)候程序才會(huì)運(yùn)行。

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)
}

仔細(xì)看一下，其實(shí)添加了按鈕只是多此一舉，只要改變了lambda或者n，都會(huì)自動(dòng)更新。因?yàn)閺某绦驁D里可以看出這是一個(gè)并聯(lián)的關(guān)系，并不是串聯(lián)。要把simulate串聯(lián)在里面才行。

所以需要進(jìn)行下面的修改。用eventReactive ,稍微有點(diǎn)難懂。有點(diǎn)接近If/else的邏輯關(guān)系。

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)
}

文章還提到了觀測函數(shù)observer，用來提示命令是否被執(zhí)行?？梢杂脕矸答伌a執(zhí)行情況。這個(gè)函數(shù)出的結(jié)果不會(huì)被保存在任何變量里。但是可以用來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")
  })
}
最后編輯于 ：
?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請聯(lián)系作者
【社區(qū)內(nèi)容提示】社區(qū)部分內(nèi)容疑似由AI輔助生成，瀏覽時(shí)請結(jié)合常識(shí)與多方信息審慎甄別。
平臺(tái)聲明：文章內(nèi)容（如有圖片或視頻亦包括在內(nèi)）由作者上傳并發(fā)布，文章內(nèi)容僅代表作者本人觀點(diǎn)，簡書系信息發(fā)布平臺(tái)，僅提供信息存儲(chǔ)服務(wù)。

相關(guān)閱讀更多精彩內(nèi)容

友情鏈接更多精彩內(nèi)容