【发布时间】：2021-09-29 05:44:17
【问题描述】：
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", "选择年份：", c("2019", "2020", "2021")), actionButton("go", "Run")
-
所有过滤器都在侧边栏中。我将过滤器应用于创建的数据集，然后按各个组进行分组。对于每个组，我都制作了一个计数汇总表和一个折线图。由于我基于输入值进行过滤并按多个变量分组，因此我必须为每个组创建一个单独的反应函数。有没有更好的方法来进行过滤和分组？此外，此反应函数采用的数据基于采用年份输入的函数。
【问题讨论】：
-
我没有测试你的代码（因为没有可重现的数据），你能把它放在一个列表中并返回一个列表输出，即`
-
lst_filtData_therapy <- reactive({ dplyr::lst(df, dfs) %>% map(~ .x %>% filter(gp_pdl1_tps %in% input$pdl1Filter | ( is.na(gp_pdl1_tps) & "" %in% input$pdl1Filter )) %>% .... 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')) )}) -
@akrun 我为 df 和 dfs 添加了示例数据集，可以作为输入。函数事件和流行使用许多其他辅助函数和数据映射。 df 和 dfs 是通过这两个函数生成的。我确实想将仪表板的输入传递给函数，以便用户能够检查他们希望的年份。数据通过过滤器提供以显示反应性汇总表。
-
是的，我已经为 df 和 dfs 添加了这些输入
-
谢谢，让我测试一下
标签： r shiny shinydashboard shiny-reactivity