我正在嘗試找到隱藏一些選項卡并在單擊actionButton. 我找到了這篇文章，但建議的解決方案使用navbarPage. 我嘗試使用sidebarPanel以下方法更改示例：
library(shiny)
library(shinyjs)
ui <- fluidPage(useShinyjs(),
tags$head(tags$style(HTML("#hello li a[data-value = 'tab2_val'], #hello li a[data-value = 'tab3_val']
{ display: none;}"))),
# Application title
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel("hello", id="hello",
tabPanel("home", br(), h3("Click the button"),actionButton("enter", "enter")),
tabPanel("tab2", value = "tab2_val", br(), h4("this is tab2")),
tabPanel("tab3 with a lot of stuff in it", value = "tab3_val", br(), h4("this is tab3"))),
mainPanel(
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$enter, {
show(selector = '#hello li a[data-value="tab3_val"]')
show(selector = '#hello li a[data-value="tab2_val"]')
})}
shinyApp(ui, server)
但我得到這個錯誤：
錯誤：導航容器需要
bslib::nav()/shiny::tabPanel()s 和/或bslib::nav_menu()/shiny::navbarMenu()s的集合 。如果您希望將內容放置在每個面板的內容之上（或之下），請考慮使用header或footer。
我試圖在這篇文章中運行建議的解決方案，但我仍然得到同樣的錯誤。我想這是因為我擁有的閃亮版本（即 1.7.1）。
誰能幫我解決這個問題？
我附上一個可重現的例子。我們的想法是隱藏 Tab2 和 Tab3，當您單擊actionButton“提交”時，它們會出現。
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Tab1",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Tab2",
radioButtons(inputId = "plot_type", label = "I want to see the plot of:",
c("All the samples" = "all_samples",
"Groups" = "samples_group")),
conditionalPanel(
condition = "input.plot_type == 'samples_group'",
style = "margin-left: 20px;",
checkboxGroupInput("group", "Choose the group:",
choices = c("Group1", "Group2", "Group3"))),
actionButton("show_plot", "See the plot")
),
tabPanel("Tab3",
numericInput("alpha", "Opacity of the plot", value=0.2),
checkboxInput(inputId = "Kruskalpval", label = "Show the Kruskal Wallis p-value", value = FALSE),
conditionalPanel(
condition = "input.Kruskalpval == '1'",
style = "margin-left: 20px;",
checkboxInput(inputId = "changeKW", "I want to change the place of the value", value=FALSE),
conditionalPanel(
condition = "input.changeKW == '1'",
numericInput(inputId = "X_axis", "X_axis:", value=2),
numericInput(inputId = "Y_axis", "Y_axis:", value=70)
)
),
actionButton("show_plot_2", "See the plot")
)
)
),
mainPanel(
plotOutput("boxplots")
)
)
)
server <- function(input, output) {
set.seed(1234)
Gene <- floor(runif(25, min=0, max=101))
groups_age <- floor(runif(25, min=18, max=75))
Group <- c("Group1", "Group1", "Group3", "Group2", "Group1", "Group3", "Group2", "Group2", "Group2", "Group1", "Group1", "Group3", "Group1", "Group2", "Group1", "Group2", "Group3", "Group1", "Group3", "Group3", "Group2", "Group1", "Group3", "Group3","Group2")
data <- reactive({
df <- data.frame(Gene, Group, groups_age)
mybreaks <- seq(min(df$groups_age)-1, to=max(df$groups_age) 10, by=10)
df$groups_age <- cut(df$groups_age, breaks = mybreaks, by=10)
if(input$plot_type == "samples_group"){
# if the user selects everything, it will take everything.
if(all(c("Group1", "Group2", "Group3") %in% input$group)){
return(df)
# if the user only selects group1 and group2, it will appear only those columns.
}else if (all(c("Group1", "Group2") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group2"))
return(df)
# if the user only selects group1 and group3, it will appear only those columns.
}else if (all(c("Group1", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group3"))
return(df)
# if the user only selects Group2 and Group3, it will appear only those columns.
}else if (all(c("Group2", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group2" | df$Group == "Group3"))
return(df)
# if the user only selects Group1
} else if ("Group1" %in% input$group) {
df <- subset(df, (df$Group == "Group1"))
return(df)
# if the user only selects group2
} else if ("Group2" %in% input$group) {
df <- subset(df, (df$Group == "Group2"))
return(df)
# if the user only selects group3
} else if ("Group3" %in% input$group) {
df <- subset(df, (df$Group == "Group3"))
return(df)
# if the user doesn't select anything.
} else {
return(df)
}
}else{
df$Group <- NULL
return(df)
}
})
mydata <- reactive({
req(input$submit)
if(input$log2 == TRUE){
data <- data()
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x 1))
}
else{
data <- data()
}
return(data)
})
draw_bp <- eventReactive(c(input$show_plot, input$show_plot_2), {
if(ncol(mydata())==2){
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene))
geom_boxplot(aes(fill=groups_age), alpha = input$alpha)
labs(fill = "groups_age")
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
else{
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene))
geom_boxplot(aes(fill=groups_age), alpha=input$alpha)
facet_grid(. ~ Group)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
})
v <- reactiveValues()
observeEvent(input$show_plot | input$show_plot_2, {
v$plot <- draw_bp()
})
output$boxplots <- renderPlot({
req(input$submit)
draw_bp()
})
}
shinyApp(ui = ui, server = server)
首先十分感謝
問候
uj5u.com熱心網友回復：
這是隱藏/顯示第二個選項卡的代碼。其他選項卡的代碼類似。
library(shiny)
js <- "$(document).ready(function(){
var $tab2 = $('#hello li > a[data-value=tab2_val]').parent();
$tab2.removeClass('active').addClass('hide');
$('#enter').on('click', function(){
$tab2.removeClass('hide');
});
});
"
ui <- fluidPage(
tags$head(
tags$script(HTML(js))
),
# Application title
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel(
"home", br(), h3("Click the button"), actionButton("enter", "enter")
),
tabPanel(
"tab2", value = "tab2_val", br(), h4("this is tab2")
),
tabPanel(
"tab3 with a lot of stuff in it", value = "tab3_val", br(),
h4("this is tab3")
),
id = "hello"
)
),
mainPanel()
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
uj5u.com熱心網友回復：
這是使用的解決方案appendTab，如此處所示：
您的初始示例：
library(shiny)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(id="hello",
tabPanel("home", br(), h3("Click the button"),actionButton("enter", "enter"))
)
),
mainPanel()
)
)
server <- function(input, output, session) {
observeEvent(input$enter, {
appendTab(inputId = "hello", tabPanel("tab2", value = "tab2_val", br(), h4("this is tab2")))
appendTab(inputId = "hello", tabPanel("tab3 with a lot of stuff in it", value = "tab3_val", br(), h4("this is tab3")))
}, once = TRUE)
}
shinyApp(ui, server)
第二個例子：
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
id = "tabsetPanelID",
tabPanel("Tab1",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
)
)
),
mainPanel(
plotOutput("boxplots")
)
)
)
server <- function(input, output) {
observeEvent(input$submit, {
appendTab(inputId = "tabsetPanelID", tab = tabPanel("Tab2",
radioButtons(inputId = "plot_type", label = "I want to see the plot of:",
c("All the samples" = "all_samples",
"Groups" = "samples_group")),
conditionalPanel(
condition = "input.plot_type == 'samples_group'",
style = "margin-left: 20px;",
checkboxGroupInput("group", "Choose the group:",
choices = c("Group1", "Group2", "Group3"))),
actionButton("show_plot", "See the plot")
))
appendTab(inputId = "tabsetPanelID", tab = tabPanel("Tab3",
numericInput("alpha", "Opacity of the plot", value=0.2),
checkboxInput(inputId = "Kruskalpval", label = "Show the Kruskal Wallis p-value", value = FALSE),
conditionalPanel(
condition = "input.Kruskalpval == '1'",
style = "margin-left: 20px;",
checkboxInput(inputId = "changeKW", "I want to change the place of the value", value=FALSE),
conditionalPanel(
condition = "input.changeKW == '1'",
numericInput(inputId = "X_axis", "X_axis:", value=2),
numericInput(inputId = "Y_axis", "Y_axis:", value=70)
)
),
actionButton("show_plot_2", "See the plot")
))
}, once = TRUE)
set.seed(1234)
Gene <- floor(runif(25, min=0, max=101))
groups_age <- floor(runif(25, min=18, max=75))
Group <- c("Group1", "Group1", "Group3", "Group2", "Group1", "Group3", "Group2", "Group2", "Group2", "Group1", "Group1", "Group3", "Group1", "Group2", "Group1", "Group2", "Group3", "Group1", "Group3", "Group3", "Group2", "Group1", "Group3", "Group3","Group2")
data <- reactive({
df <- data.frame(Gene, Group, groups_age)
mybreaks <- seq(min(df$groups_age)-1, to=max(df$groups_age) 10, by=10)
df$groups_age <- cut(df$groups_age, breaks = mybreaks, by=10)
if(input$plot_type == "samples_group"){
# if the user selects everything, it will take everything.
if(all(c("Group1", "Group2", "Group3") %in% input$group)){
return(df)
# if the user only selects group1 and group2, it will appear only those columns.
}else if (all(c("Group1", "Group2") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group2"))
return(df)
# if the user only selects group1 and group3, it will appear only those columns.
}else if (all(c("Group1", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group1" | df$Group == "Group3"))
return(df)
# if the user only selects Group2 and Group3, it will appear only those columns.
}else if (all(c("Group2", "Group3") %in% input$group)) {
df <- subset(df, (df$Group == "Group2" | df$Group == "Group3"))
return(df)
# if the user only selects Group1
} else if ("Group1" %in% input$group) {
df <- subset(df, (df$Group == "Group1"))
return(df)
# if the user only selects group2
} else if ("Group2" %in% input$group) {
df <- subset(df, (df$Group == "Group2"))
return(df)
# if the user only selects group3
} else if ("Group3" %in% input$group) {
df <- subset(df, (df$Group == "Group3"))
return(df)
# if the user doesn't select anything.
} else {
return(df)
}
}else{
df$Group <- NULL
return(df)
}
})
mydata <- reactive({
req(input$submit)
# browser()
if(input$log2 == TRUE){
data <- data()
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x 1))
}
else{
data <- data()
}
return(data)
})
draw_bp <- eventReactive(c(input$show_plot, input$show_plot_2), {
if(ncol(mydata())==2){
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene))
geom_boxplot(aes(fill=groups_age), alpha = input$alpha)
labs(fill = "groups_age")
req(input$Kruskalpval)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
else{
bp <- ggplot(mydata(), aes(x=groups_age, y=Gene))
geom_boxplot(aes(fill=groups_age), alpha=input$alpha)
facet_grid(. ~ Group)
req(input$Kruskalpval)
if((input$Kruskalpval == "TRUE") && (input$changeKW==FALSE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp geom_text(data=pval, aes(x=2, y=max(mydata()$Gene)-10, label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
if((input$Kruskalpval == "TRUE") && (input$changeKW==TRUE)){
pval <- mydata() %>%
group_by(Group) %>%
summarize(Kruskal_pvalue = kruskal.test(Gene ~ groups_age)$p.value)
bp <- bp geom_text(data=pval, aes(x=isolate(input$X_axis), y=isolate(input$Y_axis), label=paste0("Kruskal-Wallis\n p = ",Kruskal_pvalue)))
}
return(bp)
}
})
v <- reactiveValues()
observeEvent(input$show_plot | input$show_plot_2, {
v$plot <- draw_bp()
})
output$boxplots <- renderPlot({
req(input$submit)
draw_bp()
})
}
shinyApp(ui = ui, server = server)
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/409141.html
標籤：
上一篇：如何使用字串函式從向量中提取日期