带有过滤的选择输入的闪亮渲染图

Question

我正在尝试为一个闪亮的应用程序渲染有条件的图，该应用程序将允许使用总示例或一个委托变量的选择来查看结果。这是数据的示例：

> 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 

我的目标是将结果绘制到用户可以在其中查看每个问题的总响应，然后按小组，同类或学期分解结果的结果。例如，我将共享UI和服务器代码以生成术语图：

UI代码：

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")),

服务器代码：

  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))
      }
    })

运行应用程序时，“ Total”绘图正确呈现，但是当我选择特定术语时，错误运行一个错误说所选术语在数据框中找不到。关于如何解决这一问题的任何建议将不胜感激。

下面的评论，这是该应用程序的较小版本的一个示例，具有相同的错误：

（data ：（切断的术语值，但术语变量的分类级别为：（“术语1”，“ term 2”，“，”，“项3“，”项4“，”项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 <- 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（）数据负责人：

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"))

Answer 1

问题在于您的数据过滤的图，该图仅显示一个学期的结果。 count期望一个列名，但是输入$ term_total_resp是列TERM的值。 项1是data.frame中的列。但是，您不需要按此值进行分组，因为首先使用filter（term％in％input $ term_total_resp）您确保data.frame仅包含您感兴趣的值。

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))

​用户。