如何将下拉值作为输入传递给函数以在 Shiny Dashboard 中生成数据集？数据集使用反应过滤器

Question

library(shiny)
library(shinydashboard)
library(tidyverse)
library(tidyr)
library(ggplot2)

options(dplyr.summarise.inform = FALSE)

header <- dashboardHeader(
    title = "NSCLC Market Share"
)


body <- dashboardBody(
    tags$head(tags$style(
        HTML('.wrapper {height: auto !important; position:relative; overflow-x:hidden; overflow-y:hidden}')
    )),
    fluidRow(
        HTML("<div class='col-sm-4' style='min-width: 900px !important; 
             font-size:10px; color: #404040;'>"),
        tabBox(
            width = NULL,
            title = "MarketShare",
            id = "tabset1", height = "250px",
            tabPanel(
                "Incidence",
                fluidRow(
                    column(6, tableOutput("therapy_tbl")),
                    column(6, plotOutput("therapy_plot", height = "150px"))
                ),
                br(),
                hr(style = "border-color: black;"),
                fluidRow(
                    column(6, tableOutput("pdl1_tbl")),
                    column(6, plotOutput("pdl1_plot", height = "150px"))
                ),
                br(),
                hr(style = "border-color: black;"),
                fluidRow(
                    column(6, tableOutput("pdl1_mono_tbl")),
                    column(6, plotOutput("pdl1_mono_plot", height = "150px"))
                ),
                br(),
                hr(style = "border-color: black;"),
                fluidRow(
                    column(6, tableOutput("pdl1_combo_tbl"))
                )
                
                
            )
            
            ,
            tabPanel("Prevalence", fluidRow(
                column(6, tableOutput("therapy_p_tbl"))
            ))
        )
    )
)



sidebar <- dashboardSidebar(
    radioButtons("datasource", "Select a data source:",
                 c("Flatiron", "Truven Commercial")),
    
    radioButtons("cohort", "Select a cohort:",
                 c("All", "Cohort X")),
    
    checkboxGroupInput("LineFilter", "Select Line Number",
                       choiceNames = list("1L", "2L"),
                       choiceValues = list(1, 2), selected = c(1, 2)
    ),
    
    br(),
    
    fluidRow(
        column(5, checkboxGroupInput("ecogFilter", "Select ECOG",
                                     choiceNames = list("0~1", "2", ">2", "unknown"),
                                     choiceValues = list("0-1","2", ">2", "unknown"),
                                     selected = list("0-1","2", ">2", "unknown")
        )),
        
        column(1, checkboxGroupInput("pdl1Filter", "Select PDL1",
                                     choiceNames = list("unknown", ">=50%", "<1%", "1~49%"),
                                     selected = list("unknown", ">=50%", "< 1%", "1-49%"),
                                     choiceValues = unique(df$gp_pdl1_tps)
        ))
    ),
    br(),
    fluidRow(
        column(5, checkboxGroupInput("egfrFilter", "EGFR Status",
                                     choices = list("positive", "negative", "unknown"),
                                     selected = list("positive", "negative", "unknown"),
                                     choiceValues = list("positive", "negative", "unknown")
        )),
        column(1, checkboxGroupInput("alkFilter", "ALK Status",
                                     choices = list("positive", "negative", "unknown"),
                                     selected = list("positive", "negative", "unknown"),
                                     choiceValues = list("positive", "negative", "unknown")
        ))
    ),
    br(),
    selectInput("year_value", "Select Year:",
                c("2019", "2020", "2021")),
    actionButton("go", "Run")
)





ui <- dashboardPage(
    header,
    sidebar,
    body
)

server = function(input, output) {
    
    filtData_therapy <- reactive({
        
        df %>% 
            filter(gp_pdl1_tps %in% input$pdl1Filter | ( is.na(gp_pdl1_tps) & "" %in% input$pdl1Filter )) %>% 
            filter(gp_ecog %in% input$ecogFilter | ( is.na(value_ecog) & "" %in% input$ecogFilter )) %>% 
            filter(has_egfr %in% input$egfrFilter | ( is.na(has_egfr) & "" %in% input$egfrFilter )) %>%
            filter(has_alk %in% input$alkFilter | ( is.na(has_alk) & "" %in% input$alkFilter )) %>%
            filter(line_number %in% input$LineFilter) %>% 
            group_by(therapy_class, Year_month) %>% 
            summarise(count = n()) %>% 
            full_join(data.frame('therapy_class' = therapy_class), by = c('therapy_class')) 
        
        
    })
    
    
    filtData_therapy_p <- reactive({
        
        dfs %>% 
            filter(gp_pdl1_tps %in% input$pdl1Filter | ( is.na(gp_pdl1_tps) & "" %in% input$pdl1Filter )) %>% 
            filter(gp_ecog %in% input$ecogFilter | ( is.na(value_ecog) & "" %in% input$ecogFilter )) %>% 
            filter(has_egfr %in% input$egfrFilter | ( is.na(has_egfr) & "" %in% input$egfrFilter )) %>%
            filter(has_alk %in% input$alkFilter | ( is.na(has_alk) & "" %in% input$alkFilter )) %>%
            filter(line_number %in% input$LineFilter) %>% 
            group_by(therapy_class, Year_month) %>% 
            summarise(count = n()) %>% 
            full_join(data.frame('therapy_class' = therapy_class), by = c('therapy_class'))
        
        
    })
    
    
    
    filtData_pdl1 <- reactive({
        
        df %>% 
            filter(gp_pdl1_tps %in% input$pdl1Filter) %>% 
            filter(gp_ecog %in% input$ecogFilter) %>%
            filter(line_number %in% input$LineFilter) %>% 
            filter(has_egfr %in% input$egfrFilter | ( is.na(has_egfr) & "" %in% input$egfrFilter )) %>%
            filter(has_alk %in% input$alkFilter | ( is.na(has_alk) & "" %in% input$alkFilter )) %>%
            filter( is.na(pdl1_based) == FALSE) %>% 
            group_by(pdl1_based, Year_month) %>% 
            summarise(count = n())
        
        
    })
    
    filtData_pdl1_mono <- reactive({
        
        df %>% 
            filter(gp_pdl1_tps %in% input$pdl1Filter | ( is.na(gp_pdl1_tps) & "" %in% input$pdl1Filter )) %>% 
            filter(gp_ecog %in% input$ecogFilter | ( is.na(value_ecog) & "" %in% input$ecogFilter )) %>% 
            filter(line_number %in% input$LineFilter) %>%
            filter(has_egfr %in% input$egfrFilter | ( is.na(has_egfr) & "" %in% input$egfrFilter )) %>%
            filter(has_alk %in% input$alkFilter | ( is.na(has_alk) & "" %in% input$alkFilter )) %>%
            filter(pdl1_based %in% c("PD-1/PD-L1 monotherapies")) %>% 
            group_by(line_name, Year_month) %>% 
            summarise(count = n()) %>% 
            full_join(data.frame(line_name = pdl1_based_therapy))
        
        
    })
    
    filtData_pdl1_combo <- reactive({
        
        df %>% 
            filter(gp_pdl1_tps %in% input$pdl1Filter | ( is.na(gp_pdl1_tps) & "" %in% input$pdl1Filter )) %>% 
            filter(gp_ecog %in% input$ecogFilter | ( is.na(value_ecog) & "" %in% input$ecogFilter )) %>% 
            filter(line_number %in% input$LineFilter) %>%
            filter(has_egfr %in% input$egfrFilter | ( is.na(has_egfr) & "" %in% input$egfrFilter )) %>%
            filter(has_alk %in% input$alkFilter | ( is.na(has_alk) & "" %in% input$alkFilter )) %>%
            filter(pdl1_based %in% c("PD-1/PD-L1 + chemo combos (incl. nivo+ipi)")) %>% 
            group_by(line_name, Year_month) %>% 
            summarise(count = n())
        
        
    })
    
    output$therapy_tbl <- renderTable(
        rbind(
            filtData_therapy() %>%
                pivot_wider(names_from = Year_month, values_from = count) %>%
                ungroup(),
            filtData_therapy() %>%
                pivot_wider(names_from = Year_month, values_from = count) %>%
                ungroup() %>%
                summarise(across(where(is.numeric), sum, na.rm = TRUE)) %>%
                mutate(therapy_class = "Total")) %>% 
            replace(is.na(.), 0),
        spacing = c("xs"), striped = TRUE
    )
    
    output$therapy_p_tbl <- renderTable(
        rbind(
            filtData_therapy_p() %>% 
                pivot_wider(names_from = Year_month, values_from = count) %>% 
                ungroup(),
            filtData_therapy_p() %>% 
                pivot_wider(names_from = Year_month, values_from = count) %>% 
                ungroup() %>%
                summarise(across(where(is.numeric), sum, na.rm = TRUE)) %>%
                mutate(therapy_class = "Total"))%>% 
            replace(is.na(.), 0),
        spacing = c("xs"), striped = TRUE
    )
    
    output$pdl1_tbl <- renderTable(
        rbind(filtData_pdl1() %>% 
                  pivot_wider(names_from = Year_month, values_from = count) %>% 
                  ungroup(),
              filtData_pdl1() %>% 
                  pivot_wider(names_from = Year_month, values_from = count) %>% 
                  ungroup() %>% 
                  summarise(across(where(is.numeric), sum, na.rm = TRUE)) %>% 
                  mutate(pdl1_based = "Total")) %>% 
            replace(is.na(.), 0) %>% 
            rename("PD-1/PD-L1-based therapies" = pdl1_based),
        spacing = c("xs"), striped = TRUE
        
        
    )
    
    
    output$pdl1_mono_tbl <- renderTable(
        rbind(filtData_pdl1_mono() %>% 
                  pivot_wider(names_from = Year_month, values_from = count) %>% 
                  ungroup() %>% select_if(not_all_na) ,
              filtData_pdl1_mono() %>%
                  pivot_wider(names_from = Year_month, values_from = count) %>% 
                  ungroup() %>% 
                  select_if(not_all_na) %>% 
                  summarise(across(where(is.numeric), sum, na.rm = TRUE)) %>% 
                  mutate(line_name = "Total")) %>% 
            replace(is.na(.), 0) %>% 
            rename("PD-1/PD-L1 monotherapies" = line_name),
        spacing = c("xs"), striped = TRUE
    )
    
    output$pdl1_combo_tbl <- renderTable(
        rbind(filtData_pdl1_combo() %>% 
                  pivot_wider(names_from = Year_month, values_from = count) %>% 
                  ungroup(),
              filtData_pdl1_combo() %>%
                  pivot_wider(names_from = Year_month, values_from = count) %>% 
                  ungroup() %>% 
                  summarise(across(where(is.numeric), sum, na.rm = TRUE)) %>% 
                  mutate(line_name = "Total")) %>% 
            replace(is.na(.), 0) %>% 
            rename("PD-1/PD-L1 + chemo combos (incl. nivo+ipi)" = line_name),
        spacing = c("xs"), striped = TRUE
    )
    
    
    output$therapy_plot <- renderPlot({
        filtData_therapy() %>% 
            pivot_wider(names_from = Year_month, values_from = count) %>%
            ungroup() %>% 
            mutate_if(endsWith(names(.),"2020"),function(x) x / sum(x, na.rm = TRUE) * 100) %>% 
            melt(id=c("therapy_class")) %>% 
            ggplot(aes(x = variable, y = value, group = therapy_class, color = therapy_class)) +
            geom_line() + geom_point() + scale_y_continuous(labels = function(x) paste0(x, "%")) +
            cowplot::theme_minimal_hgrid(font_size = 9) + 
            theme(legend.position="bottom", legend.title = element_blank(),legend.justification = "center")
    })
    
    output$pdl1_plot <- renderPlot({
        filtData_pdl1() %>% 
            ggplot(aes(x = Year_month, y = count, group = pdl1_based, color = pdl1_based)) +
            geom_line() + geom_point() +
            cowplot::theme_minimal_hgrid(font_size = 9) +
            theme(legend.position="bottom", legend.title = element_blank(), legend.justification = "center")
    })
    
    output$pdl1_mono_plot <- renderPlot({
        filtData_pdl1_mono() %>% 
            ggplot(aes(x = Year_month, y = count, group = line_name, color = line_name)) +
            geom_line() + geom_point() +
            cowplot::theme_minimal_hgrid(font_size = 9) +
            theme(legend.position="bottom", legend.title = element_blank(), legend.justification = "center")
    })
    
}

# Run the application 
shinyApp(ui = ui, server = server)

我有这个闪亮的仪表板代码。我正在尝试一些不起作用的东西。

我运行一个函数（事件，普遍）创建两个数据集。该函数接受 Year 值并创建具有 Yearmonth 计数的数据集。我想将 Year_value 输入传递给函数，但仅当按下操作按钮时。

selectInput("year_value", "Select 年份:", c("2019", "2020", "2021")), actionButton("go", "运行")
所有过滤器都在边栏中。我正在对创建的数据集应用过滤器，然后按不同的组进行分组。对于每个组，我生成了计数摘要 table 和线图。由于我根据输入值进行过滤并按多个变量分组，因此我必须为每个组创建一个单独的反应函数。有没有更好的方法来进行过滤和分组？此反应函数采用的数据也基于采用年份输入的函数。

Answer 1

您可以使用 eventReactive() 来捕捉按下操作按钮时的 selectInput 值。在 eventReative 中，您可以将用户输入值传递给函数。我能够将输入传递给函数以创建数据集，然后在使用反应过滤器的反应中使用该数据集。

https://shiny.rstudio.com/reference/shiny/1.0.3/observeEvent.html

UI - 选择输入

                        fluidRow(offset = 2,
                        selectInput("year_value", "Select Year:",
                                    c("2018", "2019", "2020", "2021"),
                                    selected = "2020")),
                    fluidRow(
                        selectInput("month_value", "Select Month:",
                                    choices = list( "January" = 1, "February" = 2, "March" = 3, "April" = 4, "May" = 5, 
                                                    "June" = 6, "July" = 7, "August" = 8, "September" = 9, "October" = 10,
                                                    "November" = 11, "December" = 12),
                                    selected = 1),
                        actionButton("go", "Update")),
                    tags$head(tags$style(HTML(".selectize-input {height: 80%; width: 50%; font-size: 15px;}")))

服务器 - eventReactive 和 Reactive

 server = function(input, output) {
    
    df <- eventReactive(input$go, {
        incident(df_analysis_nsclc, year = input$year_value, month = input$month_value)
    }, ignoreNULL = FALSE)
    
    dfs <- eventReactive(input$go, {
        incident(df_analysis_nsclc, year = input$year_value, month = input$month_value)
    }, ignoreNULL = FALSE)
    
    filtData_therapy <- reactive({
        
        df() %>% 
            filter(gp_pdl1_tps %in% input$pdl1Filter | ( is.na(gp_pdl1_tps) & "" %in% input$pdl1Filter )) %>% 
            filter(gp_ecog %in% input$ecogFilter | ( is.na(value_ecog) & "" %in% input$ecogFilter )) %>% 
            filter(has_egfr %in% input$egfrFilter | ( is.na(has_egfr) & "" %in% input$egfrFilter )) %>%
            filter(has_alk %in% input$alkFilter | ( is.na(has_alk) & "" %in% input$alkFilter )) %>%
            filter(line_number %in% input$LineFilter) %>% 
            group_by(therapy_class, Year_month) %>% 
            summarise(count = n()) %>% 
            full_join(data.frame('therapy_class' = therapy_class), by = c('therapy_class')) 
        
        
    })

如何将下拉值作为输入传递给函数以在 Shiny Dashboard 中生成数据集？数据集使用反应过滤器

How to pass the Drop down value as an input to a function to generate dataset within Shiny Dashboard? The dataset uses reactive filters

r

shiny

shinydashboard

shiny-reactivity