问题描述
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;"),tableOutput("pdl1_tbl")),plotOutput("pdl1_plot",tableOutput("pdl1_mono_tbl")),plotOutput("pdl1_mono_plot",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)
),fluidRow(
column(5,checkBoxGroupInput("ecogFilter","Select ECOG",choiceNames = list("0~1","2",">2","unkNown"),choiceValues = list("0-1",selected = list("0-1","unkNown")
)),column(1,checkBoxGroupInput("pdl1Filter","Select PDL1",choiceNames = list("unkNown",">=50%","<1%","1~49%"),selected = list("unkNown","< 1%","1-49%"),choiceValues = unique(df$gp_pdl1_tps)
))
),checkBoxGroupInput("egfrFilter","EGFR Status",choices = list("positive","negative",selected = list("positive",choiceValues = list("positive",checkBoxGroupInput("alkFilter","ALK Status","unkNown")
))
),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,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),na.rm = TRUE)) %>%
mutate(therapy_class = "Total"))%>%
replace(is.na(.),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),na.rm = TRUE)) %>%
mutate(pdl1_based = "Total")) %>%
replace(is.na(.),0) %>%
rename("PD-1/PD-L1-based therapies" = pdl1_based),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),na.rm = TRUE)) %>%
mutate(line_name = "Total")) %>%
replace(is.na(.),0) %>%
rename("PD-1/PD-L1 monotherapies" = line_name),striped = TRUE
)
output$pdl1_combo_tbl <- renderTable(
rbind(filtData_pdl1_combo() %>%
pivot_wider(names_from = Year_month,filtData_pdl1_combo() %>%
pivot_wider(names_from = Year_month,0) %>%
rename("PD-1/PD-L1 + chemo combos (incl. nivo+ipi)" = line_name),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.justification = "center")
})
output$pdl1_mono_plot <- renderPlot({
filtData_pdl1_mono() %>%
ggplot(aes(x = Year_month,group = line_name,color = line_name)) +
geom_line() + geom_point() +
cowplot::theme_minimal_hgrid(font_size = 9) +
theme(legend.position="bottom",legend.justification = "center")
})
}
# Run the application
shinyApp(ui = ui,server = server)
-
我正在运行一个函数（事件、流行）来创建两个数据集。该函数接受 Year 值并创建带有 Yearmonth 计数的数据集。我想将 Year_value 输入传递给函数，但只有在按下操作按钮时才可以。
selectInput("year_value","选择年份:","Run")
-
所有过滤器都在侧边栏中。我将过滤器应用于创建的数据集，然后按各个组进行分组。对于每个组，我都生成了一个计数汇总表和一个线图。由于我基于输入值进行过滤并按多个变量分组，因此我必须为每个组创建一个单独的反应函数。有没有更好的方法来进行过滤和分组？此外，这个反应式函数采用的数据基于采用年份输入的函数。
解决方法
您可以使用 eventReactive() 在按下操作按钮时捕获 selectInput 值。在 eventReative 中，您可以将用户输入值传递给函数。我能够将输入传递给函数以创建数据集，然后在使用反应过滤器的反应中使用该数据集。
https://shiny.rstudio.com/reference/shiny/1.0.3/observeEvent.html
用户界面 - 选择输入
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,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'))
})