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)
The issue is that your function stratData
returns only the dataframe tmp
. To make your code work you could
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:
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