Reactive select input to update table - r

Question

I am trying to understand the reactive part in R shiny. In that process I am trying to update an output table based on the input change while selecting values from the age drop down. It seems to do it by the first value but when I change any value from the age drop down it won't update my table. The input I am using is chooseage. Below is the code which I am using.
library(shiny)
library(shinydashboard)
library(shinyBS)
library(knitr)
library(kableExtra)
library(shiny)
library(shinythemes)
ui <- dashboardPage(
dashboardHeader(disable = F, title = "PATH Study"),
dashboardSidebar(sidebarMenu(
menuItem(
"Population Filter",
uiOutput("choose_age")
)
)),
dashboardBody(box(
width = 12,
tabBox(
width = 12,
id = "tabBox_next_previous",
tabPanel("Initiation",
fluidRow(
box(
width = 5,
solidHeader = TRUE,
status = "primary",
tableOutput("smoke"),
collapsible = F
)
))
),
uiOutput("Next_Previous")
))
)
server <- function(input, output, session) {
# Drop-down selection box for which Age bracket to be selected
age_levels <- c("18 to 24 years old","25 to 34 years old","35 to 44 years old")
output$choose_age <- renderUI({
selectInput("selected_age", "Age", as.list(age_levels))
})
myData <- reactive({
with_demo_vars %>%
filter(age == input$choose_age) %>%
pct_ever_user(type = "SM")
})
output$smoke <-
renderTable({
head(myData())
})
}
shinyApp(ui = ui, server = server)

Answer 1

Here is a quick prototype for your task
library(shiny)
library(tidyverse)
library(DT)
# 1. Dataset
df_demo <- data.frame(
age = c(16, 17, 18, 19, 20),
name = c("Peter", "Mary", "Mike", "Nick", "Phillipe"))
# 2. Server
server <- function(input, output, session) {
# 1. UI element 'Age'
output$ui_select_age <- renderUI({
selectInput("si_age", "Age", df_demo$age)
})
# 2. Reactive data set
df_data <- reactive({
# 1. Read UI element
age_selected <- input$si_age
# 2. Filter data
df <- df_demo %>%
filter(age == age_selected)
# 3. Return result
df
})
# 3. Datatable
output$dt_table <- renderDataTable({
datatable(df_data())
})
}
# 3. UI
ui <- fluidPage(
fluidRow(uiOutput("ui_select_age")),
fluidRow(dataTableOutput("dt_table"))
)
# 4. Run app
shinyApp(ui = ui, server = server)

Answer 2

I think youre shinyApp is over-reactive, as all functions in the server are executed straight away, without waiting for any selected input. So either it will break down or behave weird. So you have to delay the reactivity with req(), validate() / need() or with any observeEvent or eventReactive() function.
Maybe this snippet might help you, although there would be several ways to achieve the desired behaviour.
library(shiny)
library(shinydashboard)
library(dplyr)
data(mtcars)
mtcars$age <- sample(x = c(10,20,30,40,50), size = nrow(mtcars), replace = T)
with_demo_vars <- mtcars
ui <- dashboardPage(
dashboardHeader(disable = F, title = "PATH Study"),
dashboardSidebar(sidebarMenu(
menuItem(text = "Population Filter",
uiOutput("choose_age")
)
)
),
dashboardBody(
tableOutput("smoke")
)
)
server <- function(input, output, session) {
output$choose_age <- renderUI({
selectInput("selected_age", "Age", with_demo_vars$age)
})
myData <- reactive({
with_demo_vars %>%
dplyr::filter(age == input$selected_age)
})
output$smoke <- renderTable({
req(input$selected_age)
head(myData())
})
}
shinyApp(ui = ui, server = server)