【发布时间】：2022-11-23 18:22:12
【问题描述】：
下面我粘贴了我闪亮的应用程序的代码。
在此版本中，它有 2 个选项卡。在现实生活中，它们会充满各种基于不同兴趣变量的可视化和解释性信息。
我想使用 conditionalPanel() 创建 2 个版本的侧边栏菜单来控制绘图选项。其中一些对于两个选项卡是通用的，而另一个则不是。
在我的虚拟示例中，“选择感兴趣的基因”下拉菜单对于两个选项卡都很常见。
如果用户选择某个基因，比如第一个选项卡中的“XYZ”，我希望这个选择“被记住”并默认传递给第二个选项卡，因此“XYZ”的图将显示在第二个选项卡，直到用户选择其他方式。
在我的工作示例中，我有 2 个条件面板和 2 个 selectizeInput() 下拉菜单，每个都有唯一的 ID。我试图两次回收相同的下拉菜单，但这引发了错误。在下面的应用程序中，如果用户在第一个选项卡中选择“XYZ”，第二个选项卡将显示“ABC”，这是列表中的第一级，而不是所需的级别。
我试了很多次都失败了，所以我把这个贴在这里。
最小的工作示例：
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
library(plotly)
library(ggplot2)
group <- c(rep("MINUS", 40), rep("PLUS", 40))
sample <- c(rep("KO1",20),rep("KO2",20), rep("WT1",20), rep("WT2",20))
gene <- c(rep("ABC",4),rep("DEF",7), rep("XYZ",9), rep("ABC",6),
rep("XYZ",3),rep("DEF",11),rep("ABC",8),rep("DEF",5),
rep("XYZ",7), rep("ABC",7),rep("XYZ",6),rep("DEF",7))
length <- c(5.42, 5.92, 4.73, 5.64, 5.57, 6.22, 5.61, 6.95, 5.28, 3.13,
4.66, 5.06, 4.83, 7.29, 6.92, 5.89, 8.33, 6.40, 6.10, 5.50,
5.32, 5.02, 3.29, 3.57, 2.79, 4.14, 3.85, 3.95, 3.91, 5.34,
4.52, 4.15, 6.19, 4.32, 1.19, 4.67, 3.71, 4.34, 2.93, 2.63,
8.35, 8.07, 6.54, 9.23, 8.01, 8.05, 7.84, 7.62, 9.15, 7.03,
7.93, 7.18, 9.76, 5.89, 7.66, 8.34, 7.55, 6.76, 7.28, 8.98,
7.42, 7.97, 5.86, 6.61, 6.58, 7.42, 5.77, 5.99, 8.11, 8.65,
7.13, 6.42, 7.52, 7.87, 4.66, 7.76, 6.46, 6.21, 8.18, 7.73)
data <- data.frame(group, sample, gene, length)
# label genes for dropdown menu
gene_labels <- sort(unique(data$gene))
# custom function for plotting data
plot_distr <- function(data, groupby=NA){
plot <- ggplot2::ggplot(data,ggplot2::aes(x=length,color=!!rlang::sym(groupby)))+
ggplot2::geom_line(stat="density",size=1,ggplot2::aes(y=..ndensity..))
return(plot)
}
# Define ui logic ----
ui <- fluidPage(
shinyWidgets::useShinydashboard(),
shinyjs::useShinyjs(),
titlePanel("Test application"),
sidebarLayout(
sidebarPanel(
conditionalPanel(
condition = "input.my_tabs==1",
shiny::helpText("Test of first tab."),
shiny::selectizeInput(
inputId = "list_of_genes",
label = "Select gene:",
choices = NULL
), #selectizeInput
),
conditionalPanel(
condition ="input.my_tabs==2",
shiny::helpText("Test of second tab."),
shiny::selectizeInput(
inputId = "list_of_genes",
label = "Select gene:",
choices = NULL
), #selectizeInput
selectInput(
inputId = "selected_grouping_variable",
label = "Select grouping variable:",
choices = c(
"sample" = "sample",
"condition (group)" = "group")),
checkboxInput("show_comment",label = "Display comments?",value = FALSE),
uiOutput("level"),
# selectInput(
# inputId = "selected_grouping_variable_level",
# label = "Select certain condition:",
# choices = c(unique(data$sample))),#this is only a placeholder with hardcode
checkboxInput("show_comment2",label = "Plot only selected condition?",value = FALSE)
)
),
mainPanel(
tabsetPanel(type='tabs',
id = "my_tabs",
tabPanel("My first tab",
value=1),
tabPanel("My second tab",
value=2,
box(
width=8,
plotlyOutput("distribution_plot", height = "450px"),
div(id = "text_div",
textOutput("textofinterest"),
style="text-align: justify;")
),
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
observe({print(input$show_comment2)})
#select var to plot
selected_variable_plot <- reactive({
selected_grouping_variable <- switch(input$selected_grouping_variable,
sample = "sample",
group = "group")
})
output$level <- renderUI({
req(input$selected_grouping_variable)
choices <- as.list(unique(data[[input$selected_grouping_variable]]))
pickerInput(inputId = 'selected_grouping_variable_level',
label = 'Select certain condition:',
choices = choices, selected=choices[[1]], multiple = TRUE,
options = list(`style` = "btn-success"))
})
selected_variable_capt <- shiny::reactive({
selected_variable_2 <- switch(input$selected_grouping_variable,
sample = "sample",
group = "group")
})
# SELECTIZE INPUT - SERVER SIDE
shiny::updateSelectizeInput(
inputId = 'list_of_genes',
label = 'Select gene of interest:',
choices = unique(gene_labels),
server=TRUE,
options = list(maxOptions = length(gene_labels))
)
shiny::observe({print(input$list_of_genes)})
filtered_data <- shiny::reactive({
data %>% dplyr::filter(gene==as.character(input$list_of_genes))
})
mydata <- reactive({
req(input$selected_grouping_variable_level)
if (input$show_comment2){
df <- filtered_data() %>% mutate(newvar = !!sym(input$selected_grouping_variable)) %>%
dplyr::filter(newvar %in% input$selected_grouping_variable_level) %>%
select(-newvar)
}else df <- filtered_data()
df
})
# plot
output$distribution_plot <- renderPlotly({
req(mydata(),selected_variable_plot())
distr_plot <- plot_distr(data = mydata(), groupby = selected_variable_plot())
distr_plot <- ggplotly(distr_plot)
return(distr_plot)
})
# caption
whichcaption <- reactive(input$selected_grouping_variable)
which_caption <- reactive({
if (whichcaption()=="sample") {
caption1 <- "I'm a Barbie girl, in a Barbie world"
} else {
caption2 <- "Life in plastic is fantastic!"
}
})
# display comments or do not
observe({
toggle(id = "text_div", condition = input$show_comment)
output$textofinterest <- renderText({
which_caption()
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
【问题讨论】：