如何从 tibble 中反应性地提取值列以进行绘图？

Question

我有一个允许用户对数据进行分层的应用程序，select 分层的时间点。以下可重现代码中的函数 (stratData(...)) 生成数据 table，输出分层 table 正确反应，随着用户更改时间点而更新。

但是我希望用户还可以选择以条形图的形式查看数据。下面我用“# <<”评论我尝试“点击”数据 table（tibble）列以进行绘图。但是，当前起草的图不会像数据 table 那样根据时间点的用户更改进行反应性更新。

如何从数据中高效、被动地提取列值 table？对于反应式绘图，与数据一致 table?

底部的图片也显示了这个问题，而不是“使用文字”。

可重现代码：

library(shiny)
library(tidyverse)
library(shinyWidgets)

ui <-
  fluidPage(
    uiOutput("stratPeriod"),
    radioButtons(
      inputId = 'stratsView',
      label = NULL,
      choices = list("Table view" = 1,"Plot view" = 2),
      selected = 1,
      inline = TRUE
    ), 
    conditionalPanel(condition = "input.stratsView == 1",
                     h5(strong("Stratified data:")), tableOutput("stratData")
    ),
    conditionalPanel(condition = "input.stratsView == 2",
                     h5(strong("Stratified data:")), plotOutput("stratPlot")
    )
  )

server <- function(input, output, session) {
  dat <- reactive({
    data.frame(
      ID = c(1,1,2,2,2,2,3,3,3,3),
      Period = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04"),
      Values_1 = c(-6, 26, 36, 46, 56, 86, 100, 10, 20, 30)
    )  
  })
  
  output$stratPeriod <- renderUI({
    chc <- unique(na.omit(dat()[[2]]))
    selectInput(inputId = "stratPeriod", 
                label = "Choose point-in-time:",
                choices = chc,
                selected = chc[1])
  })
  
  stratData <- function(){
    req(input$stratPeriod)
    filter_exp1 <- parse(text=paste0("Period",  "==", "'",input$stratPeriod, "'"))
    dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
    breaks <- seq(min(dat_1()[["Values_1"]]), max(dat_1()[["Values_1"]]), length.out = 6) 
    tmp <- dat() %>% 
      filter(eval(filter_exp1)) %>%
      mutate(Range = cut(!!sym("Values_1"), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>% 
      group_by(Range) 
    tmp <- tmp %>%
      summarise(Count = n(),Values = sum(!!sym("Values_1"))) %>%
      complete(Range, fill = list(Count = 0,Values = 0)) %>% 
      ungroup %>% 
      mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>% 
      dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
      bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
      Count <- tmp %>% pull(Count) # << my attempt to pull column of tibble data
    tmp
  }
  
  output$stratData <- renderTable({stratData()})
  output$stratPlot <- renderPlot({barplot(Count[-length(Count)])}) # << plot attempt, removing last value from vector
}

shinyApp(ui, server)

Answer 1

问题是您的函数 stratData returns 只有数据框 tmp。要使您的代码正常工作，您可以

Return 数据框 tmp 和向量 Count 作为命名列表，例如list(data = tmp, Count = Count) 并在 renderPlot/Table

stratData()$data

stratData()$Count

或作为第二个选项：

通过单独的函数或 reactive 拉取 Count 列，即执行 Count <- reactive({ stratData() %>% pull(Count) }) 并通过 Count() 在 renderPlot.[=37 中调用它=]

第一种方法的可重现代码：

library(shiny)
library(tidyverse)
library(shinyWidgets)

ui <-
  fluidPage(
    uiOutput("stratPeriod"),
    radioButtons(
      inputId = 'stratsView',
      label = NULL,
      choices = list("Table view" = 1,"Plot view" = 2),
      selected = 1,
      inline = TRUE
    ), 
    conditionalPanel(condition = "input.stratsView == 1",
                     h5(strong("Stratified data:")), tableOutput("stratData")
    ),
    conditionalPanel(condition = "input.stratsView == 2",
                     h5(strong("Stratified data:")), plotOutput("stratPlot")
    )
  )

server <- function(input, output, session) {
  dat <- reactive({
    data.frame(
      ID = c(1,1,2,2,2,2,3,3,3,3),
      Period = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04"),
      Values_1 = c(-6, 26, 36, 46, 56, 86, 100, 10, 20, 30)
    )  
  })
  
  output$stratPeriod <- renderUI({
    chc <- unique(na.omit(dat()[[2]]))
    selectInput(inputId = "stratPeriod", 
                label = "Choose point-in-time:",
                choices = chc,
                selected = chc[1])
  })
  
  stratData <- function(){
    req(input$stratPeriod)
    filter_exp1 <- parse(text=paste0("Period",  "==", "'",input$stratPeriod, "'"))
    dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
    breaks <- seq(min(dat_1()[["Values_1"]]), max(dat_1()[["Values_1"]]), length.out = 6) 
    tmp <- dat() %>% 
      filter(eval(filter_exp1)) %>%
      mutate(Range = cut(!!sym("Values_1"), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>% 
      group_by(Range) 
    tmp <- tmp %>%
      summarise(Count = n(),Values = sum(!!sym("Values_1"))) %>%
      complete(Range, fill = list(Count = 0,Values = 0)) %>% 
      ungroup %>% 
      mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>% 
      dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
      bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
    Count <- tmp %>% pull(Count)
    
    list(data = tmp, Count = Count)
  
  }
  
  output$stratData <- renderTable({stratData()$data})
  output$stratPlot <- renderPlot({barplot(stratData()$Count[-length(stratData()$Count)])})
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:3019

如何从 tibble 中反应性地提取值列以进行绘图？

How to reactively extract column of values from tibble for plotting?

r

shiny

dplyr

shiny-reactivity

tibble