I have shiny code similar to the contrived example below. My intention is that in the server
part, I pass on inputSelect values dynamically as arguments to the table_Server function like below (does not work):
# Line 94 of code
server = function(input,output,session){
table_Server("ER", input$region_choice)
}
Instead, I have to hard code the region as shown next:
# Line 94 of code
server = function(input,output,session){
table_Server("ER", "Morogoro)
}
The full running code (hardcoded) is as below, any suggestions appreciated.
library(shiny)
library(shinydashboard)
#>
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#>
#> box
get_dataset = function(region){
if(region=="Morogoro"){
mtcars
}else{
iris
}
}
get_reg_rate = function(region){
data.frame(
region="Morogoro",
numerator=459,
denominator=541,
green_gap=80,
yellow_gap=77,
message="Regional Performance"
)
}
table_UI <- function(id) {
ns <- NS(id)
tagList(
sidebarLayout(
sidebarPanel(width = 2,
uiOutput(ns("selector")),
),
mainPanel(
valueBoxOutput(ns('regional_value')),
valueBoxOutput(ns('green_gap_value')),
valueBoxOutput(ns('yellow_gap_value')),
DT::dataTableOutput(ns('table'))
)
)
)
}
table_Server <- function(id, region) {
moduleServer(id,function(input, output, session) {
ds=get_dataset(region)
rate=get_reg_rate(region)
output$table = DT::renderDataTable({
ds
})
output$regional_value <- renderValueBox({
valueBox(
rate$rate,
rate$message
)
})
if(!id %in% c("DE","Score_district","DE_district")){
output$green_gap_value <- renderValueBox({
valueBox(
rate$green_gap,
"Green Gap"
)
})
output$yellow_gap_value <- renderValueBox({
valueBox(
rate$yellow_gap,
"Yellow Gap"
)
})
}
output$selector=renderUI({
selectInput(inputId=NS(id,"region_choice"),
label="Region",
choices = c("Morogoro","Lindi","Mtwara","Njombe","Ruvuma",
"Iringa"),selected = "Morogoro" )
})
}
)
}
ui = fluidPage(
tabsetPanel(id = 'cqi_indicators',
tabPanel('Region',
tabsetPanel(
id='region_indicators',
tabPanel("Early Retention",table_UI("ER"))
)
)
)
)
server = function(input,output,session){
table_Server("ER", "Morogoro")
}
shinyApp(ui,server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Shiny applications not supported in static R Markdown documents
Created on 2023-06-17 by the reprex package (v2.0.1)
After calling table_Server("ER", input$region_choice)
the value of input$region_choice
does not exist yet ->
Access input$region_choice
from inside the module server function.
Use observeEvent
to make the renderDataTable
and renderValueBox
reactive to input$region_choice
when it changes:
library(shiny)
library(shinydashboard)
get_dataset = function(region){
if(region=="Morogoro"){
mtcars
}else{
iris
}
}
get_reg_rate = function(region){
data.frame(
region="Morogoro",
numerator=459,
denominator=541,
green_gap=80,
yellow_gap=77,
message="Regional Performance"
)
}
table_UI <- function(id) {
ns <- NS(id)
tagList(
sidebarLayout(
sidebarPanel(width = 2,
uiOutput(ns("selector")),
),
mainPanel(
valueBoxOutput(ns('regional_value')),
valueBoxOutput(ns('green_gap_value')),
valueBoxOutput(ns('yellow_gap_value')),
DT::dataTableOutput(ns('table'))
)
)
)
}
table_Server <- function(id, input) {
moduleServer(id,function(input, output, session) {
observeEvent(input$region_choice,{
ds = get_dataset(input$region_choice)
rate = get_reg_rate(input$region_choice)
output$table = DT::renderDataTable({
ds
})
output$regional_value <- renderValueBox({
valueBox(
rate$rate,
rate$message
)
})
if(!id %in% c("DE","Score_district","DE_district")){
output$green_gap_value <- renderValueBox({
valueBox(
rate$green_gap,
"Green Gap"
)
})
output$yellow_gap_value <- renderValueBox({
valueBox(
rate$yellow_gap,
"Yellow Gap"
)
})
}
})
output$selector=renderUI({
selectInput(inputId=NS(id,"region_choice"),
label="Region",
choices = c("Morogoro","Lindi","Mtwara","Njombe","Ruvuma",
"Iringa"),selected = "Morogoro" )
})
})
}
ui = fluidPage(
tabsetPanel(id = 'cqi_indicators',
tabPanel('Region',
tabsetPanel(
id='region_indicators',
tabPanel("Early Retention",table_UI("ER"))
)
)
)
)
server = function(input,output,session){
table_Server("ER", input)
}
shinyApp(ui,server)