I am trying to create a ShinyApp with two tabs ( a "Home" tab and a "Info" tab, the second of which is hidden tab hat only gets activated or visible once the action button "Display Data" is clicked), and a sidebar that has got a dropdown menu. It is meant to just show a constant " Hello and Welcome" message in the home tab, and depending on the user option, display the data in the "Info" tab when and if action button is clicked (otherwise it won't display the second "Info" tab and just show the "Home" tab).
Now the problem is that the first time I run the app, it's working as desired and displaying the relevant rendered data table in the "Info" tab based on the user selection from the drop down menu and mainly clicking the "Display Data" button afterwards. However, if the user then selects another option from the drop down menu and clicks the "Display Data" action button, it's not updating or changing the rendered data table in the "Info" tab accordingly. That is basically what I need help with (being able to show updated rendered table every time user selects another option from the drop down menu), as I am new to Shiny and recently started learning it. Any help will be much appreciated and thanks in advance.
Here is the code I have so far for creating the data frame from which the table is rendered and the shiny global.R, ui.R and server.R code.
# global.R
cities <- data.frame("Continent" =
c('Europe','Europe', 'Europe', 'America', 'America', 'Africa', 'Africa', 'Asia', 'Asia'),
"City" = c('Berlin','London','Madrid','Washington DC', 'Los Angeles', 'Cairo', 'Pretoria', 'Shanghai', 'Dubai'),
"Population"= c(3620340,8821025,3223000,700000,3973000,9540000,2473000,26000000,3331000))
selection_function <- function(continent_choice) {
if (!continent_choice == "All"){
data <- cities[cities$Continent==continent_choice, ]
} else {
data <- cities
}
return (data)
}
# ui.R
library(shiny)
library(shinyjs)
shinyUI(fluidPage(
# Application title
titlePanel(h1("My App")),
# Sidebar
sidebarLayout(
sidebarPanel(
selectInput(inputId = "id1",
label = HTML("Please select a continent"),
choices = c("All", sort(unique(cities$Continent)))
),
tags$br(), tags$br(),
actionButton("action1", "Display Data"),
tags$br(), tags$br()
),
# Main Panel
mainPanel(
tabsetPanel(id="the_id",
tabPanel("Home", br(),
h3("Hello and welcome, this is my App"),
tags$br(), tags$br(),
h5("Navigate through the options on the left")
)
)
)
))
)
server.R
library(shiny)
library(DT)
shinyServer(function(input, output) {
observeEvent(input$action1,{
the_continent <- selection_function(input$id1)
appendTab(inputId = "the_id",
tabPanel("Info", br(),
DT::renderDataTable({
the_continent
}) ))
}, once = TRUE )
})
Finally, I would also like to ask if there are any other better ways of trying to do what I am doing (like maybe doing this with conditionalPanel as opposed to the append tab option that I am doing)? I am saying so, because I think it's much better to handle things in the client side instead of the server side. Thanks once again.
CodePudding user response：
Edit
We can use dataTableProxy to create a proxy table and replace the data only when the button is pressed. This way we also prevent loosing the "state" of the table when new changes happen.
App:
# global.R
library(shiny)
library(shinyjs)
library(DT)
cities <- data.frame(
"Continent" =
c("Europe", "Europe", "Europe", "America", "America", "Africa", "Africa", "Asia", "Asia"),
"City" = c("Berlin", "London", "Madrid", "Washington DC", "Los Angeles", "Cairo", "Pretoria", "Shanghai", "Dubai"),
"Population" = c(3620340, 8821025, 3223000, 700000, 3973000, 9540000, 2473000, 26000000, 3331000)
)
selection_function <- function(continent_choice) {
if (!continent_choice == "All") {
data <- cities[cities$Continent == continent_choice, ]
} else {
data <- cities
}
return(data)
}
# ui.R
ui <- fluidPage(
# Application title
titlePanel(h1("My App")),
useShinyjs(),
# Sidebar
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "id1",
label = HTML("Please select a continent"),
choices = c("All", sort(unique(cities$Continent)))
),
tags$br(), tags$br(),
actionButton("action1", "Display Data"),
tags$br(), tags$br()
),
# Main Panel
mainPanel(
tabsetPanel(
id = "the_id",
tabPanel(
"Home", br(),
h3("Hello and welcome, this is my App"),
tags$br(), tags$br(),
h5("Navigate through the options on the left")
)
)
)
)
)
server <- function(input, output, session) {
table <- reactive({
the_continent <- selection_function(input$id1)
})
observeEvent(input$action1,
{
the_continent <- selection_function(input$id1)
appendTab(
inputId = "the_id",
tabPanel(
"Info", br(),
DT::DTOutput("dt_table")
)
)
output$dt_table <- DT::renderDT({
isolate(table())
})
updateTabsetPanel(
session = session,
inputId = "the_id",
selected = "Info"
)
},
once = TRUE
)
proxy <- dataTableProxy("dt_table")
observeEvent(input$action1, {
replaceData(
proxy = proxy,
data = table(),
resetPaging = FALSE,
clearSelection = FALSE
)
})
}
shinyApp(ui, server)
Another way to do it is to call DT::renderDT inside the observeEvent but outside the apendTab function. The downside is that the datatable will be reset every time the button is pressed.
# global.R
library(shiny)
library(shinyjs)
cities <- data.frame(
"Continent" =
c("Europe", "Europe", "Europe", "America", "America", "Africa", "Africa", "Asia", "Asia"),
"City" = c("Berlin", "London", "Madrid", "Washington DC", "Los Angeles", "Cairo", "Pretoria", "Shanghai", "Dubai"),
"Population" = c(3620340, 8821025, 3223000, 700000, 3973000, 9540000, 2473000, 26000000, 3331000)
)
selection_function <- function(continent_choice) {
if (!continent_choice == "All") {
data <- cities[cities$Continent == continent_choice, ]
} else {
data <- cities
}
return(data)
}
# ui.R
ui <- fluidPage(
# Application title
titlePanel(h1("My App")),
useShinyjs(),
# Sidebar
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "id1",
label = HTML("Please select a continent"),
choices = c("All", sort(unique(cities$Continent)))
),
tags$br(), tags$br(),
actionButton("action1", "Display Data"),
tags$br(), tags$br()
),
# Main Panel
mainPanel(
tabsetPanel(
id = "the_id",
tabPanel(
"Home", br(),
h3("Hello and welcome, this is my App"),
tags$br(), tags$br(),
h5("Navigate through the options on the left")
)
)
)
)
)
server <- function(input, output) {
table <- reactive({
the_continent <- selection_function(input$id1)
})
observeEvent(input$action1,
{
the_continent <- selection_function(input$id1)
appendTab(
inputId = "the_id",
tabPanel(
"Info", br(),
DT::DTOutput("dt_table")
)
)
output$dt_table <- DT::renderDT({
input$action1
isolate(table())
})
},
once = TRUE
)
}
shinyApp(ui, server)