I am trying to render conditional plots for a shiny app that would allow the use to view results by either the total sample or the selections of one factored variable. Here is a sample of the data:
> head(data_share)
# A tibble: 6 × 48
student_id cohort group term `Pre-Survey Que… `Pre-Survey Que… `Pre-Survey Que… `Pre-Survey Que… `Pre-Survey Que… `Pre-Survey Que… `Pre-Survey Que… `Pre-Survey Que…
<dbl> <fct> <fct> <fct> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 1 2017-2019 Spring 2018 Term 3 Undecided Undecided Undecided Undecided Undecided Undecided Agree Undecided
2 2 2017-2019 Spring 2018 Term 3 Undecided Undecided Agree Undecided Agree Undecided Agree Strongly Agree
3 3 2017-2019 Spring 2018 Term 3 Disagree Disagree Undecided Disagree Disagree Disagree Undecided Disagree
4 4 2017-2019 Spring 2018 Term 3 Disagree Strongly Disagr… Undecided Disagree Agree Undecided Undecided Disagree
5 5 2017-2019 Spring 2018 Term 3 Disagree Undecided Undecided Disagree Agree Undecided Agree Disagree
6 6 2017-2019 Spring 2018 Term 3 Undecided Agree Disagree Undecided Undecided Agree Agree Disagree
My goal is to plot results to the survey question where the user can view the total responses per question and then break down results by either group, cohort, or term. As an example, I'll share the ui and server code to produce the term plots:
ui code:
tabPanel(shiny::HTML("<span style = 'color: #0B7A42'>Term Total</span></p>"),
fluidRow(column(width = 12, offset = .7,
selectInput("prequestions_term",
shiny::HTML("<span style = 'color: #0B7A42'>Pre Survey Questions:</span></p>"),
choices = colnames(bricc_survey[c(6:22)]),
size = 5, selectize = FALSE, width = "95%")),
style = "padding-top: 25px; padding-bottom: 25px; padding-left: 25px, padding-right: 25px"),
fluidRow(column(width = 12, offset = .7,
selectInput("postquestions_term",
shiny::HTML("<span style = 'color: #0B7A42'>Post Survey Questions:</span></p>"),
choices = colnames(bricc_survey[c(23:49)]),
size = 5, selectize = FALSE, width = "95%")),
style = "padding-top: 25px; padding-bottom: 25px; padding-left: 25px, padding-right: 25px"),
fluidRow(column(width = 6, offset = .7,
selectInput("term_total_resp",
shiny::HTML("<span style = 'color: #0B7A42'>Term Number:</span></p>"),
choices = c("Total", levels(bricc_survey$term)),
size = 1, selectize = FALSE, width = "50%")),
style = "padding-top: 25px; padding-bottom: 25px; padding-left: 25px, padding-right: 25px"),
plotlyOutput("pretermresp", width = "auto"),
plotlyOutput("posttermresp", width = "auto")),
server code:
output$pretermresp <- renderPlotly({
if(input$term_total_resp == "Total") {
term_pre1 <- bricc_survey %>%
drop_na(!!sym(input$prequestions_term)) %>%
count(!!sym(input$prequestions_term)) %>%
mutate(pct = n/sum(n)*100) %>%
mutate_if(is.numeric, round)
term_pre1 %>%
ggplot() +
aes(x = !!sym(input$prequestions_term),
y = pct,
label = pct) +
geom_col(fill = "#0B7A42") +
scale_x_discrete(limits = survey_resp) +
scale_y_continuous(limits = c(0, 100),
breaks = c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100),
labels = function(x) paste0(x, "%")) +
geom_text(aes(label = paste0(term_pre1$pct, "%")),
nudge_y = 5,
size = 4) +
labs(x = "", y = "") +
theme_minimal() +
ggtitle(stringr::str_wrap(paste("Selected Question: ", input$prequestions_term), 100)) +
theme(plot.title = element_text(hjust = 0.5,size = 14, color = "#0B7A42"),
axis.text = element_text(size = 12),
#axis.text = element_text(angle = 90),
axis.title = element_text(size = 12),
strip.text.x = element_text(size = 12),
legend.title = element_text(size = 12),
legend.text = element_text(size = 12))
} else {
term_pre2 <- bricc_survey %>%
filter(term %in% input$term_total_resp) %>%
drop_na(!!sym(input$prequestions_term)) %>%
count(!!sym(input$term_total_resp), !!sym(input$prequestions_term)) %>%
group_by(!!sym(input$term_total_resp)) %>%
mutate(pct = n/sum(n)*100) %>%
mutate_if(is.numeric, round)
term_pre2 %>%
ggplot() +
aes(x = !!sym(input$prequestions_term),
y = pct,
label = pct) +
geom_col(fill = "#0B7A42") +
scale_x_discrete(limits = survey_resp) +
scale_y_continuous(limits = c(0, 100),
breaks = c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100),
labels = function(x) paste0(x, "%")) +
geom_text(aes(label = paste0(term_pre2$pct, "%")),nudge_y = 5, size = 4) +
labs(x = "", y = "") +
theme_minimal() +
ggtitle(stringr::str_wrap(paste("Selected Question: ", input$prequestions_term), 100)) +
theme(plot.title = element_text(hjust = 0.5,size = 14, color = "#0B7A42"),
axis.text = element_text(size = 12),
#axis.text = element_text(angle = 90),
axis.title = element_text(size = 12),
strip.text.x = element_text(size = 12),
legend.title = element_text(size = 12),
legend.text = element_text(size = 12))
}
})
when I run the app, the "total" plot renders correctly, but when I select a specific term, an error runs saying that the selected term cannot be found in the dataframe. How to resolve this?
Per comment below, here's an example of a smaller version of the app with the same error:
data: (The term values cut off, but the factored levels for the term variable are: ("Term 1", "Term 2", "Term 3", "Term 4", "Term 5")
student_id cohort group term pre_survey_q1 pre_survey_q2 pre_survey_q3 pre_survey_q4 pre_survey_q5 pre_survey_q6 pre_survey_q7 pre_survey_q8 pre_survey_q9 pre_survey_q10
<dbl> <fct> <fct> <fct> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 1 2017-2019 Spring 2018 Term… Undecided Undecided Undecided Undecided Undecided Undecided Agree Undecided Undecided Undecided
2 2 2017-2019 Spring 2018 Term… Undecided Undecided Agree Undecided Agree Undecided Agree Strongly Agr… Agree Undecided
3 3 2017-2019 Spring 2018 Term… Disagree Disagree Undecided Disagree Disagree Disagree Undecided Disagree Undecided Disagree
4 4 2017-2019 Spring 2018 Term… Disagree Strongly Dis… Undecided Disagree Agree Undecided Undecided Disagree Undecided Strongly Disa…
5 5 2017-2019 Spring 2018 Term… Disagree Undecided Undecided Disagree Agree Undecided Agree Disagree Agree Disagree
6 6 2017-2019 Spring 2018 Term… Undecided Agree Disagree Undecided Undecided Agree Agree Disagree Disagree Disagree
ui:
ui <- fluidPage(
# Application title
titlePanel("Term Totals"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("prequestions_term",
shiny::HTML("<span style = 'color: #0B7A42'>Pre Survey Questions:</span></p>"),
choices = colnames(prac_data[c(5:21)]),
size = 5, selectize = FALSE, width = "95%"),
selectInput("term_total_resp",
shiny::HTML("<span style = 'color: #0B7A42'>Term Number:</span></p>"),
choices = c("Total", levels(prac_data$term)),
size = 1, selectize = FALSE, width = "50%")),
# Show a plot of the generated distribution
mainPanel(
plotlyOutput("termplot")
)
))
Server:
server <- function(input, output) {
output$termplot <- renderPlotly({
if(input$term_total_resp == "Total") {
term_pre1 <- prac_data %>%
drop_na(!!sym(input$prequestions_term)) %>%
count(!!sym(input$prequestions_term)) %>%
mutate(pct = n/sum(n)*100) %>%
mutate_if(is.numeric, round)
term_pre1 %>%
ggplot() +
aes(x = !!sym(input$prequestions_term),
y = pct,
label = pct) +
geom_col(fill = "#0B7A42") +
scale_x_discrete(limits = survey_resp) +
scale_y_continuous(limits = c(0, 100),
breaks = c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100),
labels = function(x) paste0(x, "%")) +
geom_text(aes(label = paste0(term_pre1$pct, "%")),
nudge_y = 5,
size = 4) +
labs(x = "", y = "") +
theme_minimal() +
ggtitle(stringr::str_wrap(paste("Selected Question: ", input$prequestions_term), 100)) +
theme(plot.title = element_text(hjust = 0.5,size = 14, color = "#0B7A42"),
axis.text = element_text(size = 12),
#axis.text = element_text(angle = 90),
axis.title = element_text(size = 12),
strip.text.x = element_text(size = 12),
legend.title = element_text(size = 12),
legend.text = element_text(size = 12))
} else {
term_pre2 <- prac_data %>%
filter(term %in% input$term_total_resp) %>%
drop_na(!!sym(input$prequestions_term)) %>%
count(!!sym(input$term_total_resp), !!sym(input$prequestions_term)) %>%
group_by(!!sym(input$term_total_resp)) %>%
mutate(pct = n/sum(n)*100) %>%
mutate_if(is.numeric, round)
term_pre2 %>%
ggplot() +
aes(x = !!sym(input$prequestions_term),
y = pct,
label = pct) +
geom_col(fill = "#0B7A42") +
scale_x_discrete(limits = survey_resp) +
scale_y_continuous(limits = c(0, 100),
breaks = c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100),
labels = function(x) paste0(x, "%")) +
geom_text(aes(label = paste0(term_pre2$pct, "%")),nudge_y = 5, size = 4) +
labs(x = "", y = "") +
theme_minimal() +
ggtitle(stringr::str_wrap(paste("Selected Question: ", input$prequestions_term), 100)) +
theme(plot.title = element_text(hjust = 0.5,size = 14, color = "#0B7A42"),
axis.text = element_text(size = 12),
#axis.text = element_text(angle = 90),
axis.title = element_text(size = 12),
strip.text.x = element_text(size = 12),
legend.title = element_text(size = 12),
legend.text = element_text(size = 12))
}
})
}
dput() head of data:
dput(head(prac_data[, 1:21]))
structure(list(student_id = structure(c(1, 2, 3, 4, 5, 6), label = "Student ID", format.spss = "F8.2", display_width = 9L),
cohort = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("2017-2019",
"2018-2020", "2019-2021", "2020-2022", "2021-2023"), class = "factor"),
group = structure(c(9L, 9L, 9L, 9L, 9L, 9L), .Label = c("Fall 2018 1st Years",
"Fall 2018 2nd Years", "Fall 2019 1st Years", "Fall 2019 2nd Years",
"Fall 2020 1st Years", "Fall 2020 2nd Years", "Fall 2021 1st Years",
"Fall 2021 2nd Years", "Spring 2018", "Spring 2019", "Spring 2020",
"Spring 2021", "Spring 2022", "Summer 2018", "Summer 2019",
"Summer 2020", "Summer 2021", "Winter 2019", "Winter 2020",
"Winter 2021", "Winter 2022"), class = "factor"), term = structure(c(3L,
3L, 3L, 3L, 3L, 3L), .Label = c("Term 1", "Term 2", "Term 3",
"Term 4", "Term 5", "Term 6"), class = "factor"), pre_survey_q1 = structure(c("Undecided",
"Undecided", "Disagree", "Disagree", "Disagree", "Undecided"
), label = "Pre Survey Question 1 - I am confident in my ability to conduct a consultation for the BrICC clinic"),
pre_survey_q2 = structure(c("Undecided", "Undecided", "Disagree",
"Strongly Disagree", "Undecided", "Agree"), label = "Pre Survey Question 2 - I am confident in my ability to administer standardized cognitive tests"),
pre_survey_q3 = structure(c("Undecided", "Agree", "Undecided",
"Undecided", "Undecided", "Disagree"), label = "Pre Survey Question 3 - I am confident in my ability to conduct a client-centered clinical interview"),
pre_survey_q4 = structure(c("Undecided", "Undecided", "Disagree",
"Disagree", "Disagree", "Undecided"), label = "Pre Survey Question 4 - I am confident in my ability to identify treatment options to assist people with acquired cognitive impairments"),
pre_survey_q5 = structure(c("Undecided", "Agree", "Disagree",
"Agree", "Agree", "Undecided"), label = "Pre Survey Question 5 - I am prepared to write cognitive rehabilitation goals"),
pre_survey_q6 = structure(c("Undecided", "Undecided", "Disagree",
"Undecided", "Undecided", "Agree"), label = "Pre Survey Question 6 - I am prepared to administer direct interventions such as attention training or goal management training"),
pre_survey_q7 = structure(c("Agree", "Agree", "Undecided",
"Undecided", "Agree", "Agree"), label = "Pre Survey Question 7 - I am prepared to engage in systematic instruction to support the use of external aids"),
pre_survey_q8 = structure(c("Undecided", "Strongly Agree",
"Disagree", "Disagree", "Disagree", "Disagree"), label = "Pre Survey Question 8 - I am prepared to engage in a needs assessment to identify cognitive strategies and support learning and use of them"),
pre_survey_q9 = structure(c("Undecided", "Agree", "Undecided",
"Undecided", "Agree", "Disagree"), label = "Pre Survey Question 9 - I am confident in my ability to collect and analyze client session data"),
pre_survey_q10 = structure(c("Undecided", "Undecided", "Disagree",
"Strongly Disagree", "Disagree", "Disagree"), label = "Pre Survey Question 10 - I am prepared to justify my decisions related to assessment and treatment selection"),
pre_survey_q11 = structure(c("Undecided", "Agree", "Agree",
"Agree", "Agree", "Agree"), label = "Pre Survey Question 11 - I am confident in my ability to apply principles of evidence-based practice to my assessment and treatment decisions"),
pre_survey_q12 = structure(c("Agree", "Agree", "Disagree",
"Undecided", "Undecided", "Strongly Disagree"), label = "Pre Survey Question 12 - I am confident in my ability to make ‘online’ (in session) changes to my daily plans"),
pre_survey_q13 = structure(c("Undecided", "Agree", "Undecided",
"Undecided", "Agree", "Undecided"), label = "Pre Survey Question 13 - I am knowledgeable about concussion management"),
pre_survey_q14 = structure(c("Agree", "Agree", "Undecided",
"Undecided", "Disagree", "Undecided"), label = "Pre Survey Question 14 - I am comfortable working with clients with brain injuries"),
pre_survey_q15 = structure(c("Undecided", "Undecided", "Undecided",
"Undecided", "Disagree", "Undecided"), label = "Pre Survey Question 15 - I am comfortable working with clients with awareness deficits"),
pre_survey_q16 = structure(c("Agree", "Agree", "Agree", "Undecided",
"Agree", "Undecided"), label = "Pre Survey Question 16 - I am able to use case history information (e.g., information about etiology) to guide my clinical decision making"),
pre_survey_q17 = structure(c("Agree", "Undecided", "Undecided",
"Disagree", "Undecided", "Agree"), label = "Pre Survey Question 17 - I feel prepared to orally present cases")), row.names = c(NA,
-6L), class = c("tbl_df", "tbl", "data.frame"))
The problem is in your data filtering for the plots that show the results for only one term. count expects a column name, but input$term_total_resp is a value of the column term. Term 1 is no column in the data.frame. However, you don't need to group by this value, because at first with filter(term %in% input$term_total_resp) you make sure that the data.frame only contains the values you are interested in. If I understand what you want to do correctly, the following should do the job:
term_pre2 <- prac_data %>%
filter(term %in% input$term_total_resp) %>%
drop_na(.data[[input$prequestions_term]]) %>%
count(.data[[input$prequestions_term]]) %>%
mutate(pct = n / sum(n) * 100,
across(where(is.numeric), round))
N.B. You should include a session in your server function so that the app works correctly with several users.