Below I am pasting the code of my shiny app.
In this version, it has 2 tabs. In real life, they would be filled with various visualisations and explanatory comments, based on different variables of interest.
I want to use conditionalPanel() to create 2 versions of sidebar menu for controlling plotting options. Some of them would be common for two tabs, while the other would not.
In my dummy example, the "Select gene of interest" dropdown is common for both tabs.
If the user would pick a certain gene, let's say "XYZ" in the first tab, I would like this choice "to be remembered" and passed by a default to the second tab, so the plot for "XYZ" would be displayed in the second tab, until the user would select otherwise.
In my working example I have 2 conditional panels and I have 2 selectizeInput() dropdowns, each of them having unique ID. I tried to recycle the same dropdown twice, but this threw an error. In the app below, if user selects "XYZ" in the first tab, the second tab will show "ABC", which is the first level on the list, not the desired level.
I tried multiple times and failed, so I post this here.
Minimal working example:
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)
CodePudding user response：
Just don't wrap the selectizeInput in the conditionalPanel if you want to display it on both tabs:
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.")),
conditionalPanel(condition = "input.my_tabs==2",
shiny::helpText("Test of second tab.")),
shiny::selectizeInput(
inputId = "list_of_genes",
label = "Select gene:",
choices = NULL
),
conditionalPanel(
condition = "input.my_tabs==2",
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)