Having trouble deleting tabs that have been newly created in Shiny.
Scenario:
Add new tab "A"
Add new tab "B"
Click delete on tab B - doesn't delete
Select tab A, click delete it works
I feel its something to do with ids, stumped with the logic.
Thanks in advance.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test", id="tabs",
tabPanel("Home",
sidebarPanel(
selectInput("testlist", "Select test:",
list("A", "B", "C")),
actionButton("append", "New tab")),
mainPanel()
)
)
)
server <- function(input, output, session) {
tabnamesinput<-reactive({
input$testlist
})
observeEvent(input$append,{
id<-paste0(tabnamesinput())
appendTab(inputId = "tabs",
tabPanel(id,
sidebarPanel(
actionButton("remove", "Delete")
)
)
)
})
observeEvent(input$remove,{
removeTab(inputId = "tabs", target = input$tabs)
})
}
shinyApp(ui, server)
With your above approach you are trying to assign the same id = "remove" to each delete-button. This won't work. Every button needs it's own id.
Once each button has it's unique id you need an observer listening to all events triggered by those buttons. The following looks for all inputs matching the pattern "^remove_":
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = "Test", id = "tabs",
tabPanel("Home",
sidebarPanel(
selectInput("testlist", "Select test:", list("A", "B", "C"), selected = "A"),
actionButton("append", "New tab")),
mainPanel()
)
)
)
server <- function(input, output, session) {
observeEvent(input$append,{
appendTab(inputId = "tabs",
tabPanel(input$testlist,
sidebarPanel(
actionButton(paste0("remove_", input$testlist), "Delete")
)
)
)
})
observeEvent(lapply(grep(pattern = "^remove_", x = names(input), value = TRUE), function(x){input[[x]]}),{
if(input$tabs != "Home"){
removeTab(inputId = "tabs", target = input$tabs)
updateSelectInput(session, "testlist", selected = input$testlist) # keep the selection when re-rendering sidebarPanel
}
})
}
shinyApp(ui, server)
Related
I have this simple app and I would like to be able to "catch" the active tab.
For example, if I'm on "tab1", my selectInput at the top would be c("a","b","c") but it would change if I am on the other tab
I want to create a variable active_tab that would be dynamic but I have no idea how to do it.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
title="Shiny Dashboard",
header = shinydashboardPlus::dashboardHeader(
title = "Example",
leftUi = tagList(
uiOutput("reactive_ui")
)),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem("tab1",tabName = "tab1"),
menuItem("tab2",tabName = "tab2")
)
),
body = dashboardBody(
tabItems(
tabItem("tab1"),
tabItem("tab2")
)
)
),
server = function(input, output) {
output$reactive_ui =renderUI({
if (active_tab == "tab1") choice = c("a","b","c","d")
if (active_tab == "tab2") choice = c("e","f","g")
selectInput("select", NULL,choices = choice )
})
}
)
sidebarMenu contains an id parameter that can be used to retrieve the name of the active tab on the server side.
If it is just the selectInput you want to update on the tab change, then have a look at updateSelectInput so that you can update the choices without having to re-render the input every time the tab changes. It also means the input is defined once the application opens.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
title = "Shiny Dashboard",
header = shinydashboardPlus::dashboardHeader(
title = "Example",
leftUi = tagList(
selectInput("select", NULL, choices = c("a", "b", "c", "d"))
)
),
sidebar = dashboardSidebar(
sidebarMenu(
id = "tab",
menuItem("tab1", tabName = "tab1"),
menuItem("tab2", tabName = "tab2")
)
),
body = dashboardBody(
tabItems(
tabItem("tab1"),
tabItem("tab2")
)
)
),
server = function(input, output, session) {
observeEvent(input$tab, {
if (input$tab == "tab1") {
choices <- c("a", "b", "c", "d")
} else if (input$tab == "tab2") {
choices <- c("e", "f", "g")
}
updateSelectInput(session, "select", choices = choices)
})
}
)
I have a Shiny dashboard with multiple tabs. In one of the tabs, a slow database query fills the choices for a dropdown menu. I want the slow database query to execute only when the relevant tab is selected.
In the following ReprEx, the slowDatabaseQuery is executed at launch and blocks the R process.
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel(
"panel1",
"Panel 1 content"
),
tabPanel(
"panel2",
"Panel 2 content",
selectizeInput(
"selected",
label = "Selector",
choices = NULL
),
verbatimTextOutput("text")
)
)
)
server <- function(input, output, session) {
slowDatabaseQuery <- reactive({
Sys.sleep(5)
return(c("C", "D"))
})
observe(
updateSelectizeInput(
session,
"selected",
choices = slowDatabaseQuery(),
selected = "C",
server = TRUE
)
)
output$text <- renderText(input$selected)
}
shinyApp(ui = ui, server = server)
A partial solution would be using renderUI() instead of updateSelectizeInput(). However, I would like to use the server = TRUE argument which is only available in updateSelectizeInput() and do not like that it would take the UI element a long time to appear.
We can provide your tabsetPanel with an id and observe the selections via observeEvent.
There are two different options in the code below.
The DB query is done each time tab2 is selected.
The DB query is done the first time tab2 is selected in the current shiny-session (commented out).
library(shiny)
ui <- fluidPage(
tabsetPanel(
id = "tabsetPanelID",
tabPanel(
"panel1",
"Panel 1 content"
),
tabPanel(
"panel2",
"Panel 2 content",
selectizeInput(
"selected",
label = "Selector",
choices = NULL
),
verbatimTextOutput("text")
)
)
)
server <- function(input, output, session) {
slowDatabaseQuery <- reactive({
Sys.sleep(5)
return(c("C", "D"))
})
observeEvent(input$tabsetPanelID,{
if(input$tabsetPanelID == "panel2"){
updateSelectizeInput(
session,
"selected",
choices = slowDatabaseQuery(),
selected = "C",
server = TRUE
)
}
})
# observeEvent(input$tabsetPanelID == "panel2", {
# updateSelectizeInput(
# session,
# "selected",
# choices = slowDatabaseQuery(),
# selected = "C",
# server = TRUE
# )
# }, once = TRUE) # should the query be done only once or each time the tab is selected?
output$text <- renderText(input$selected)
}
shinyApp(ui = ui, server = server)
I need to show "fileinput"/file upload option when a particular tabpanel is selected.
Ex. There are 3 tabpanels like A,B and C
When tab B is selected the "fileinput" option should appear and when A or C is selected, the "fileinput" option should be hidden from the sidebarpanel.
I tried the below but not working. Can anyone help? Thanks...
sidebarPanel(
conditionalPanel(condition = "input$id == 'B'", fileInput("file", "Choose xlsx file", accept = ".xlsx"))
mainPanel(
tabsetPanel(
tabPanel("A", value = 'A', DT::dataTableOutput("Table A")),
tabPanel("B", value = 'B', DT::dataTableOutput("Table B")),
tabPanel("C", value = 'C', DT::dataTableOutput("Table C")),
id ="tabselected"
)
)
You need to use the appropriate ID of the tabsetPanel in the condition with a . instead of $. Try this
library(readxl)
runApp(list(
ui = shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
conditionalPanel(condition = "input.tabselected == 'tab2'",
fileInput("file", "Choose xlsx file", accept = ".xlsx")),
selectInput(
inputId = 'selected.indicator',
label = 'Select an option: ',
choices = colnames(mtcars)
)
),
mainPanel(
tabsetPanel(
tabPanel("A", value = 'tab1', DTOutput("t1")),
tabPanel("B", value = 'tab2', DTOutput("t2")),
tabPanel("C", value = 'tab3', DTOutput("t3")),
id ="tabselected"
)
)
)
)
),
server = function(input, output, session) {
output$t1 <- renderDT(cars)
output$t3 <- renderDT(mtcars)
mydata <- reactive({
req(input$file)
inFile <- input$file
df <- read_excel(inFile$datapath)
})
output$t2 <- renderDT({
req(mydata())
mydata()
})
}
))
If you run this app 'a' the default selected value does not appear until the UI tab is selected
and the UI element which populates 'input$select' is generated. How can I force this element to be created when the app is loaded without the need to click on the panel to initialize it in order to get access to its default value.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabsetPanel(
tabPanel(
title = "landing",
"Stuff"
),
tabPanel(
title = "UI",
uiOutput("select")
)
),
textOutput("out")
)
server <- function(input, output, session) {
output$select <- renderUI(
selectInput(
"select", "Selector:", choices = c("a", "b"), selected = "a"
)
)
output$out <- renderText(input$select)
}
shinyApp(ui, server)
You can use the argument suspendWhenHidden = FALSE from outputOptions. I had to play a bit where to place outputOptions (it doesn't work at the beginning of the server function). However, it still needs a little bit of time to load, so maybe one could optimise it further.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabsetPanel(
tabPanel(
title = "landing",
"Stuff"
),
tabPanel(
title = "UI",
uiOutput("select")
)
),
textOutput("out")
)
server <- function(input, output, session) {
output$select <- renderUI({
selectInput(
"select", "Selector:", choices = c("a", "b"), selected = "a"
)
})
output$out <- renderText(input$select)
outputOptions(output, "select", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)
This is the minimum reproducible example needed to help:
ui.R
library(shiny)
fluidPage(
title = 'DataTables Information',
tabsetPanel(id = "tabs",
tabPanel("Cars overview",
h1("Cars overview"),
div("Click any cell"),
br(),
DT::dataTableOutput("x4")
)
)
)
Server script:
server.R
library(shiny)
library(DT)
shinyServer(function(input, output, session) {
output$x4 = DT::renderDataTable({
DT::datatable(mtcars, selection = 'single')
}, server = TRUE)
observeEvent(input$x4_cells_clicked, {
print("Trigger")
value <- x4_cells_clicked$value
details <- mtcars %>%
filter(mpg == value)
appendTab(inputId = "tabs",
tabPanel(
DT::renderDataTable(DT::datatable(details), server = TRUE)
)
)
# Focus on newly created tab
updateTabsetPanel(session, "tabs", selected = "Car details")
})
})
What I am trying to accomplish is to trigger an event through a cell click on the mtcars dataframe. I want to append a tab upon a click and filter the dataframe that is produced by the value within the cell that is clicked. I know in this case I am only accounting for a click on the mpg column but I just need to see how a click on a cell is registered through observeEvent and how to use the value of the cell clicked to filter the dataframe that is produced in the new tab.
library(shiny)
library(DT)
ui <- fluidPage(
title = 'DataTables Information',
tabsetPanel(id = "tabs",
tabPanel("Cars overview",
h1("Cars overview"),
div("Click any cell"),
br(),
DTOutput("x4")
)
)
)
server <- function(input, output, session) {
output$x4 = renderDT({
datatable(mtcars, selection = 'single')
}, server = TRUE)
observeEvent(input$x4_cell_clicked, {
cell <- input$x4_cell_clicked
if(length(cell)){
details <- mtcars[mtcars[[cell$col]]==cell$value,]
appendTab(inputId = "tabs",
tabPanel(
"Cars details",
renderDT(datatable(details), server = TRUE)
),
select = TRUE # Focus on newly created tab
)
}
})
}
shinyApp(ui, server)