我正在尝试向我的应用添加第二个tabpanel，并且网页已正确显示，但数据不再加载。
library(shiny)
source('myui.R', local = TRUE)
source('myserver.R')
shinyApp(
ui = myui,
server = myserver
)
library(shiny)
library(phyloseq)
library(reshape2)
library(ggplot2)
myui <- navbarPage("GLOBAL",id = "navbar",
tabPanel("iAlpha Diversity",
titlePanel("Alpha diversity"),
sidebarLayout(
sidebarPanel(
radioButtons("taxa", label = h3("Select taxonomic rank"),
choices = list("Phylum" = "Phylum",
"Class" = "Class",
"Order" = "Order",
"Family" = "Family",
"Genus" = "Genus",
"Species" = "Species"),
selected = "Genus"),
radioButtons("radio", label = h3("Select ecological index"),
choices = list("Observed" = "Observed",
"Chao1" = "Chao1",
"se.chao1" = "se.chao1",
"Ace" = "ACE",
"Shannon" = "Shannon",
"Simpson" = "Simpson"),
selected = "Shannon"),
radioButtons("sdata", label = h3("Select metadata"),
choices = list("gender" = "gender",
"time" = "time",
"CO2" = "CO2",
"H2O" = "H20"),
selected = "time"),
downloadButton('downloadPlot', 'Download current plot'),
hr(),
br()),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Summary", value=1, verbatimTextOutput("summary")),
tabPanel("Plot", value=2, plotOutput("plot")),
tabPanel("Table",value=3, tableOutput("table"))
)
)
)
),
tabPanel(id="Ordinations",
titlePanel("Ordinations"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
radioButtons("test", label = h3("Select other"),
choices = list("Phylum" = "Phylum",
"Class" = "Class",
"Order" = "Order",
"Family" = "Family",
"Genus" = "Genus",
"Species" = "Species"),
selected = "Genus"),
hr(),
br() element to introduce extra vertical spacing ----
br()
),
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Plot2", value=1, plotOutput("plot2"))
)
)
)
)
)
myserver <- function(input, output, session) {
values <-reactiveValues(data = NULL, taxo=NULL)
# Observe click on button and load corresponding table
observeEvent(input$taxa, {
taxoRLD <- readRDS(paste0("data/alphadiv_",input$taxa,".rds"))
alpha = estimate_richness(taxoRLD, split = TRUE, measures = c("Observed", "Chao1", "ACE", "Shannon", "Simpson", "RecSimpson"))
alpha$sample=as.character(row.names(alpha))
a <- melt(alpha)
colnames(a)[2] <- "metric"
a <- merge(a,sample_data(taxoRLD),by.x="sample",by.y="row.names")
values$data <- a
values$taxo <- taxoRLD
})
d <- reactive({input$radio
a
})
s <- reactive({input$sdata
s
})
# Generate a plot of the data ----
# Create plot
plotInput <- reactive({
a <- values$data
b <- a[a$metric == input$radio,]
b <- droplevels.data.frame(b)
#observe(print(b))
p1 <- ggplot(b, aes(x=b[,input$sdata], y=value)) +
geom_boxplot(aes(fill=b[,input$sdata])) +
scale_colour_manual(values=hmcol) +
labs(x="",y="Value",colour=input$sdata) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5)) +
ggtitle(b$metric) +
theme(legend.text=element_text(size=8)) +
scale_colour_manual(name = a$metric,values=hmcol)+
theme(axis.text.x=element_text(angle = -90, hjust = 0,size=10)) +
theme(legend.text=element_text(size=10)) +
guides(fill = guide_legend(input$sdata,nrow = 15))
if (input$sdata != "Site") {
p1 <- p1 + facet_wrap(~ Site , nrow=1)
}
p1
})
#print plot
output$plot1 <- renderPlot({
print(plotInput())
}, height = 800, width = 1200,res=90)
#print plot
output$plot2 <- renderPlot({
print(plotInput())
}, height = 800, width = 1200,res=90)
# Generate a summary of the data ----
output$summary <- renderPrint({
values$taxo
})
# Generate an HTML table view of the data ----
output$table <- renderTable({
values$data
})
# Download data
output$downloadPlot <- downloadHandler(
filename = function() { paste(input$taxa, '.png', sep='') },
content = function(file) {
ggsave(file, plot = plotInput(), width = 12, height = 10, dpi=100, units= "in", device = "png")
})
}
所以为了说清楚，我们的想法是添加第二个标签而不会丢失第一个标签中加载的信息。因此，通过defautl，第一个选项卡应该像往常一样加载所有数据。正确创建选项卡和选项卡以及tabsetpanel。
不确定是什么问题？