I have an App that allows the user to stratify data, and select the point-in-time to stratify. A function (stratData(...)) in the below reproducible code generates the data table, and the output stratified table is correctly reactive, updating as the user changes the point-in-time.

However I want the user to also have the option the view the data as a bar plot. Below I comment with "# <<" my attempts to "tap" a data table (tibble) column for plotting. However, the plot as currently drafted doesn't reactively update to user changes in point-in-time the way the data table does.

How can column values be efficiently, and reactively, extracted from the data table? For reactive plotting, consistent with the data table?

Images at the bottom also show the issue, in lieu of "using words".

Reproducible code:

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)

CodePudding user response：

The issue is that your function stratData returns only the dataframe tmp. To make your code work you could

1. Return both the dataframe tmp and the vector Count as a named list, e.g. list(data = tmp, Count = Count) and use stratData()$data or stratData()$Count in renderPlot/Table

or as a second option:

2. Pull the Count column via a separate function or reactive, i.e. do Count <- reactive({ stratData() %>% pull(Count) }) and call it via Count() in renderPlot.

Reproducible code for the first approach:

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