美文网首页Rshiny
R Shiny 基础. 2 reactivity

R Shiny 基础. 2 reactivity

作者: Jason数据分析生信教室 | 来源:发表于2022-07-27 22:00 被阅读0次

    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的流程图。比方说刚才的例子就可以变成,

    我们可以说greetingname 之间有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")
      })
    }
    

    相关文章

      网友评论

        本文标题:R Shiny 基础. 2 reactivity

        本文链接:https://www.haomeiwen.com/subject/lrftwrtx.html