My friend and I are making a shiny app where you can upload data and by clicking a button create a tab where a plot is rendered using that data. We want to dynamically make as many tabs as we want and then when we filter the data using the selectInput on the tab we're currently on, render a plot(overwrite the one on the current tab) based on the changes that have been made. Is there an example we can follow and possibly use to get our script to work?
CodePudding user response：
Following https://mastering-shiny.org/action-layout.html#multi-page-layouts
Using standard tabsetPanel and associated input variable, it is possible to draw/plot accordingly to selected tab, even out side the tab. See example below (from referenced page).
Note that the tabsetPanel needs an id in order to be able to reference it with the inputs.
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textOutput("panel")
),
mainPanel(
tabsetPanel(
id = "tabset",
tabPanel("panel 1", "one"),
tabPanel("panel 2", "two"),
tabPanel("panel 3", "three")
)
)
)
)
server <- function(input, output, session) {
output$panel <- renderText({
paste("Current panel: ", input$tabset)
})
}
Based on your description, you would have empty tabPanel entries.
CodePudding user response：
library(shiny)
library(shinythemes)
library(tidyr)
library(tidyverse)
library(readxl)
library(ggtext)
library(RColorBrewer)
library(dplyr)
library(bslib)
library(shinydashboard)
library(tools)
tid <<- 0
data_list <<- list()
pl_list <<- list()
ui <- fluidPage(
textOutput("text"),
tabsetPanel(id = "tabs",
tabPanel(
title = "Home",
value = "home",
sidebarLayout(
sidebarPanel(
h3("Generate plots"),
fileInput("probe1", "Metadata .XLSX File", accept = "xlsx", buttonLabel = "Browse"),
fileInput("probe2", "Otu_counts (subsample.shared) .TSV File", accept = "tsv", buttonLabel = "Browse"),
fileInput("probe3", "Taxonomy .TSV File", accept = "tsv", buttonLabel = "Browse"),
textInput("caption", "Name of the plot", "Example: plot1"),
verbatimTextOutput("value"),
actionButton("add", "Add", icon = icon("plus-circle"))
),
mainPanel(
helpText("Description:"),
helpText("The required tables need to have information about:...")
)
)
))
)
server <- function(input, output, session) {
shinyInput <- function(name, id) paste(name, id, sep = "_")
rv <- reactiveValues(counter = 0L)
observeEvent(input$add, {
rv$counter <- rv$counter 1L
## GO TO THE NEWLY CREATED TAB:
updateTabsetPanel(session, "tabs", shinyInput("new_tab", rv$counter))
}, ignoreInit = TRUE)
observeEvent(input$add, {
tid <<- tid 1
#p_name <<- p('plot', tid)
inputs <- reactiveValues(input1 = input$probe1, input2 = input$probe2, input3 = input$probe3)
print(inputs)
print(paste0("This is input1: ", inputs$input1))
#data_list <<- append(data_list,
metadata <- read_excel(inputs$input1$datapath, na="NA") %>%
select(sample_id, disease_stat) %>%
drop_na(disease_stat)
otu_counts <- read_tsv(inputs$input2$datapath) %>%
select(Group, starts_with("Otu")) %>%
rename(sample_id = Group) %>%
pivot_longer(-sample_id, names_to="otu", values_to = "count")
taxonomy <- read_tsv(inputs$input3$datapath) %>%
select("OTU", "Taxonomy") %>%
rename_all(tolower) %>%
mutate(taxonomy = str_replace_all(taxonomy, "\\(\\d \\)", ""),
taxonomy = str_replace(taxonomy, ";$", "")) %>%
separate(taxonomy,
into=c("kingdom", "phylum", "class", "order", "family", "genus"),
sep=";")
otu_rel_abund <- inner_join(metadata, otu_counts, by="sample_id") %>%
inner_join(., taxonomy, by="otu") %>%
group_by(sample_id) %>%
mutate(rel_abund = count / sum(count)) %>%
ungroup() %>%
select(-count) %>%
pivot_longer(c("kingdom", "phylum", "class", "order", "family", "genus", "otu"),
names_to="level",
values_to="taxon") %>%
mutate(disease_stat = factor(disease_stat,
levels=c("NonDiarrhealControl",
"DiarrhealControl",
"Case")))
taxon_rel_abund <- otu_rel_abund %>%
filter(level=="phylum") %>%
group_by(disease_stat, sample_id, taxon) %>%
summarize(rel_abund = sum(rel_abund), .groups="drop") %>%
group_by(disease_stat, taxon) %>%
summarize(mean_rel_abund = 100*mean(rel_abund), .groups="drop") %>%
mutate(taxon = str_replace(taxon,
"(.*)_unclassified", "Unclassified *\\1*"),
taxon = str_replace(taxon,
"^(\\S*)$", "*\\1*"))
taxon_pool <- taxon_rel_abund %>%
group_by(taxon) %>%
summarize(pool = max(mean_rel_abund) < 3,
mean = mean(mean_rel_abund),
.groups="drop")
df <- inner_join(taxon_rel_abund, taxon_pool, by="taxon") %>%
mutate(taxon = if_else(pool, "Other", taxon)) %>%
group_by(disease_stat, taxon) %>%
summarize(mean_rel_abund = sum(mean_rel_abund),
mean = min(mean),
.groups="drop") %>%
mutate(taxon = factor(taxon),
taxon = fct_reorder(taxon, mean, .desc=TRUE),
taxon = fct_shift(taxon, n=1))
print(c(df))
#print(df$taxon)
dff <<- as.data.frame(df)
data_list[[tid]] <<- dff
# pl_list[[tid]] <<- ggplot(data_list[[tid]], aes(x="", y=mean_rel_abund, fill=taxon))
# geom_bar(stat="identity", width=1)
# # facet_grid(.~ data2()$disease_stat) F
# theme_classic()
# theme(axis.line = element_blank(),
# axis.text = element_blank(),
# axis.ticks = element_blank())
print(paste("Before append:", data_list[[tid]]$disease_stat ))
#output$plot <- render....
appendTab(inputId = "tabs", tabPanel(title = input$caption, value = tid,
headerPanel('Microbiome'),
mainPanel(
plotOutput(pl_list[tid]),
selectInput(inputId = shinyInput("case", rv$counter), label = strong("Case"),
choices = unique(data_list[[tid]]$disease_stat),
selected = "DiarrhealControl")
),
actionButton(shinyInput("remove_btn", rv$counter), "Remove", icon = icon("minus-circle"))
))
print(paste("After append", data_list[[tid]]$disease_stat))
##########################
print(inputs)
})
## REACTIVITY TO ARRANGE TAB NAMES:
current.tab <- eventReactive(input$tabs, {
# don't accidentally remove main tab:
if (!identical(input$tabs, "home")) {
input$tabs
} else {
NULL
}
})
observe({
if (rv$counter > 0L) {
lapply(seq(rv$counter), function(x) {
observeEvent(input[[paste("case", x, sep = "_")]], {
dfg <- filter(data_list[[tid]], disease_stat == input[[paste("case", x, sep = "_")]])
print(paste("this is dfg disease_stat:", dfg$disease_stat))
v2 <- rainbow(length(dfg$taxon))
names(v2) <- unique(dfg$taxon)
print(length(names(v2)))
print(paste(dfg$taxon, " ", round(dfg$mean_rel_abund, 1),"%"))
if (length(names(v2)) == 1)
{
# v2["Other"] = "#FFFFFF"
}
else
{
v2["Other"] = "#808080"
}
pl_list[[x]] <<- ggplot(dfg, aes(x="", y=mean_rel_abund, fill=taxon))
geom_bar(stat="identity", width=1)
scale_fill_manual(values = v2, labels=paste(gsub('\\*', '', dfg$taxon), str_replace_all(paste(round(dfg$mean_rel_abund, 1),"%"), " ", "")))
# facet_grid(.~ data2()$disease_stat)
theme_classic()
theme(axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank())
output$pl_list[[x]] <- renderPlot(pl_list[[x]])
})
})
}
})
observe({
if (rv$counter > 0L) {
lapply(seq(rv$counter), function(x) {
observeEvent(input[[paste("remove_btn", x, sep = "_")]], {
print(paste0("This is x: ",x))
removeTab(inputId = "tabs", target = current.tab())
print(paste0("Removing: ", input[[paste("remove_btn", x, sep = "_")]]))
})
})
}
})
output$text <- renderText({paste0("You are viewing tab \"", input$tabs, "\"", " Rv$counter is: ", rv$counter)})
}
shinyApp(ui, server)