I am trying to apply default value for Gender filter to be 'ALL'. I am using filter_select() to create the filters. When the run report button is pressed, the shared data is created, the filters are generated and the datatable is rendered. The table loads and the filters work but the default value is not set. I am using the JS solution from this post.
library(shiny)
library(DT)
library(crosstalk)
library(bslib)
# Sample data for demonstration
dat <- structure(list(`Disease-name` = c(4002L, 4002L, 4002L, 4002L,
4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L,
4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L,
4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L,
4002L, 4002L, 4002L, 4002L, 4002L), grp = c("TD", "PD", "ND",
"ND", "PD", "ND", "PD", "PD", "ND", "TD", "TD", "TD", "TD", "ND",
"ND", "ND", "PD", "ND", "PD", "ND", "PD", "ND", "PD", "TD", "TD",
"TD", "TD", "PD", "PD", "PD", "ND", "ND", "PD", "TD", "TD", "TD"
), Gender = c("ALL", "MALE", "MALE", "MALE", "MALE", "MALE",
"MALE", "MALE", "MALE", "MALE", "MALE", "MALE", "MALE", "ALL",
"ALL", "FEMALE", "FEMALE", "FEMALE", "FEMALE", "FEMALE", "FEMALE",
"FEMALE", "FEMALE", "FEMALE", "FEMALE", "FEMALE", "FEMALE", "ALL",
"ALL", "ALL", "ALL", "ALL", "ALL", "ALL", "ALL", "ALL"), u_numpat = c(8L,
5L, 0L, 6L, 46L, 54L, 206L, 257L, 60L, 5L, 52L, 260L, 317L, 2L,
12L, 6L, 55L, 66L, 304L, 2L, 1L, 74L, 360L, 61L, 370L, 3L, 434L,
6L, 617L, 510L, 134L, 120L, 101L, 630L, 113L, 751L), w_numpat = c(179.82524660264,
105.148541663513, 0, 258, 1686.50661547721, 847, 3077.00035384634,
4868.65551098707, 1105, 105.148541663513, 1944.50661547721, 3924.00035384634,
5973.65551098707, 53, 527, 269, 2229.29975337235, 1105, 4389.38128191602,
53, 21.676704939127, 1427, 6640.3577402275, 2498.29975337235,
5494.38128191602, 74.676704939127, 8067.3577402275, 126.82524660264,
11509.0132512146, 7466.38163576236, 2532, 1952, 3915.80636884956,
9418.38163576236, 4442.80636884956, 14041.0132512146), `Age-Group` = c("under 18",
"under 18", "under 18", "65 and over", "65 and over", "18 to 64",
"18 to 64", "ALL", "ALL", "under 18", "65 and over", "18 to 64",
"ALL", "under 18", "65 and over", "65 and over", "65 and over",
"18 to 64", "18 to 64", "under 18", "under 18", "ALL", "ALL",
"65 and over", "18 to 64", "under 18", "ALL", "under 18", "ALL",
"18 to 64", "ALL", "18 to 64", "65 and over", "18 to 64", "65 and over",
"ALL")), row.names = c(NA, 36L), class = "data.frame")
ui <- page_navbar(
tags$head(
#includeCSS(file.path('www', 'style2.css')),
shinyjs::useShinyjs(),
# Add JavaScript code to set default value for gender filter
tags$script(HTML("
$(document).ready(function() {
$('#filter_gender').find('.selectized').selectize()[0].selectize.setValue('ALL', false);
});
"))
),
navbarMenu("Batch Cohort Analysis", icon = icon('ranking-star'),
tabPanel("Cohort Selection",
layout_sidebar(
fillable = TRUE,
fill = TRUE,
full_screen = TRUE,
sidebar = sidebar(
width = 500,
id = 'sidebar',
bg = 'white',
accordion(
id = "myAccordion",
accordion_panel(
title = "User Inputs", icon = bsicons::bs_icon('menu-app'),
actionButton(inputId = "run_report", label = "Run Report"),
uiOutput("filtera")
)
)
),
mainPanel(
width = 12,
div(id='headingtxt', "Main Content Area"),
DTOutput("report_table") # Use DTOutput to render the table
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$run_report, {
req(SharedData)
shared_data <- SharedData$new(dat)
output$filtera <- renderUI({
tagList(
h4("Filters"), # Heading for the filters
fluidRow(
column(3, filter_select("filter_gender", "Select Gender", shared_data, ~Gender)), # Gender filter
column(3, filter_select("filter_disease", "Select Cohort", shared_data, ~`Disease-name`)), # Cohort filter
column(3, filter_select("filter_age", "Select Age Group", shared_data, ~`Age-Group`))
)
)
})
output$report_table <- renderDT({
filtered_data <- shared_data$data()
datatable(filtered_data, options = list(
pageLength = 10,
autoWidth = TRUE,
dom = 'bfrtip', # Add buttons and filtering
buttons = c('csv', 'excel'), # Add export buttons
columnDefs = list(
list(className = 'dt-left', targets = c(0, 1)) # Center align all columns
)
), rownames = FALSE) %>%
formatRound(columns = c(4:6), digits = 0) # Use dt for better table rendering
})
})
}
shinyApp(ui = ui, server = server)
I am trying to apply default value for Gender filter to be 'ALL'. I am using filter_select() to create the filters. When the run report button is pressed, the shared data is created, the filters are generated and the datatable is rendered. The table loads and the filters work but the default value is not set. I am using the JS solution from this post.
library(shiny)
library(DT)
library(crosstalk)
library(bslib)
# Sample data for demonstration
dat <- structure(list(`Disease-name` = c(4002L, 4002L, 4002L, 4002L,
4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L,
4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L,
4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L, 4002L,
4002L, 4002L, 4002L, 4002L, 4002L), grp = c("TD", "PD", "ND",
"ND", "PD", "ND", "PD", "PD", "ND", "TD", "TD", "TD", "TD", "ND",
"ND", "ND", "PD", "ND", "PD", "ND", "PD", "ND", "PD", "TD", "TD",
"TD", "TD", "PD", "PD", "PD", "ND", "ND", "PD", "TD", "TD", "TD"
), Gender = c("ALL", "MALE", "MALE", "MALE", "MALE", "MALE",
"MALE", "MALE", "MALE", "MALE", "MALE", "MALE", "MALE", "ALL",
"ALL", "FEMALE", "FEMALE", "FEMALE", "FEMALE", "FEMALE", "FEMALE",
"FEMALE", "FEMALE", "FEMALE", "FEMALE", "FEMALE", "FEMALE", "ALL",
"ALL", "ALL", "ALL", "ALL", "ALL", "ALL", "ALL", "ALL"), u_numpat = c(8L,
5L, 0L, 6L, 46L, 54L, 206L, 257L, 60L, 5L, 52L, 260L, 317L, 2L,
12L, 6L, 55L, 66L, 304L, 2L, 1L, 74L, 360L, 61L, 370L, 3L, 434L,
6L, 617L, 510L, 134L, 120L, 101L, 630L, 113L, 751L), w_numpat = c(179.82524660264,
105.148541663513, 0, 258, 1686.50661547721, 847, 3077.00035384634,
4868.65551098707, 1105, 105.148541663513, 1944.50661547721, 3924.00035384634,
5973.65551098707, 53, 527, 269, 2229.29975337235, 1105, 4389.38128191602,
53, 21.676704939127, 1427, 6640.3577402275, 2498.29975337235,
5494.38128191602, 74.676704939127, 8067.3577402275, 126.82524660264,
11509.0132512146, 7466.38163576236, 2532, 1952, 3915.80636884956,
9418.38163576236, 4442.80636884956, 14041.0132512146), `Age-Group` = c("under 18",
"under 18", "under 18", "65 and over", "65 and over", "18 to 64",
"18 to 64", "ALL", "ALL", "under 18", "65 and over", "18 to 64",
"ALL", "under 18", "65 and over", "65 and over", "65 and over",
"18 to 64", "18 to 64", "under 18", "under 18", "ALL", "ALL",
"65 and over", "18 to 64", "under 18", "ALL", "under 18", "ALL",
"18 to 64", "ALL", "18 to 64", "65 and over", "18 to 64", "65 and over",
"ALL")), row.names = c(NA, 36L), class = "data.frame")
ui <- page_navbar(
tags$head(
#includeCSS(file.path('www', 'style2.css')),
shinyjs::useShinyjs(),
# Add JavaScript code to set default value for gender filter
tags$script(HTML("
$(document).ready(function() {
$('#filter_gender').find('.selectized').selectize()[0].selectize.setValue('ALL', false);
});
"))
),
navbarMenu("Batch Cohort Analysis", icon = icon('ranking-star'),
tabPanel("Cohort Selection",
layout_sidebar(
fillable = TRUE,
fill = TRUE,
full_screen = TRUE,
sidebar = sidebar(
width = 500,
id = 'sidebar',
bg = 'white',
accordion(
id = "myAccordion",
accordion_panel(
title = "User Inputs", icon = bsicons::bs_icon('menu-app'),
actionButton(inputId = "run_report", label = "Run Report"),
uiOutput("filtera")
)
)
),
mainPanel(
width = 12,
div(id='headingtxt', "Main Content Area"),
DTOutput("report_table") # Use DTOutput to render the table
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$run_report, {
req(SharedData)
shared_data <- SharedData$new(dat)
output$filtera <- renderUI({
tagList(
h4("Filters"), # Heading for the filters
fluidRow(
column(3, filter_select("filter_gender", "Select Gender", shared_data, ~Gender)), # Gender filter
column(3, filter_select("filter_disease", "Select Cohort", shared_data, ~`Disease-name`)), # Cohort filter
column(3, filter_select("filter_age", "Select Age Group", shared_data, ~`Age-Group`))
)
)
})
output$report_table <- renderDT({
filtered_data <- shared_data$data()
datatable(filtered_data, options = list(
pageLength = 10,
autoWidth = TRUE,
dom = 'bfrtip', # Add buttons and filtering
buttons = c('csv', 'excel'), # Add export buttons
columnDefs = list(
list(className = 'dt-left', targets = c(0, 1)) # Center align all columns
)
), rownames = FALSE) %>%
formatRound(columns = c(4:6), digits = 0) # Use dt for better table rendering
})
})
}
shinyApp(ui = ui, server = server)
1 Answer
Reset to default 0The default value for the filter is not set because you have the JS inside a $(document).ready(...) such that it runs if the document is ready. But at this time the filter is not present in the DOM because it only gets constructed by the button click (input$run_report).
Instead, you need to trigger the Selectize event if the element is ready within the DOM. Shiny has some JavaScript events for this. Here, we can use shiny:bound: This gets triggered when an input or output is bound to Shiny. And within this we check whether it is the needed filter_gender crosstalk input:
$(document).on('shiny:bound', function(event) {
if (
event.binding.name == 'crosstalk.inputBinding' &&
event.target.id == 'filter_gender'
) {
// your JS
} else return;
});
library(shiny)
library(DT)
library(crosstalk)
library(bslib)
# Sample data for demonstration
dat <- structure(list(`Disease-name` = c(4002L, 4002L, 4002L, 4002L,
4002L, 4002L), grp = c("TD", "PD", "ND", "ND", "PD", "ND"), Gender = c("ALL",
"MALE", "MALE", "MALE", "MALE", "MALE"), u_numpat = c(8L, 5L,
0L, 6L, 46L, 54L), w_numpat = c(179.82524660264, 105.148541663513,
0, 258, 1686.50661547721, 847), `Age-Group` = c("under 18", "under 18",
"under 18", "65 and over", "65 and over", "18 to 64")), row.names = c(NA,
6L), class = "data.frame")
ui <- page_navbar(
header = tags$head(
# Add JavaScript code to set default value for gender filter
tags$script(HTML("
$(document).on('shiny:bound', function(event) {
if (
event.binding.name == 'crosstalk.inputBinding' &&
event.target.id == 'filter_gender'
) {
$('#filter_gender').find('.selectized').selectize()[0].selectize.setValue('ALL', false);
} else return;
});
"))
),
navbarMenu("Batch Cohort Analysis", icon = icon('ranking-star'),
tabPanel("Cohort Selection",
layout_sidebar(
fillable = TRUE,
fill = TRUE,
full_screen = TRUE,
sidebar = sidebar(
width = 500,
id = 'sidebar',
bg = 'white',
accordion(
id = "myAccordion",
accordion_panel(
title = "User Inputs", icon = bsicons::bs_icon('menu-app'),
actionButton(inputId = "run_report", label = "Run Report"),
uiOutput("filtera")
)
)
),
mainPanel(
width = 12,
div(id='headingtxt', "Main Content Area"),
DTOutput("report_table") # Use DTOutput to render the table
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$run_report, {
req(SharedData)
shared_data <- SharedData$new(dat)
output$filtera <- renderUI({
tagList(
h4("Filters"), # Heading for the filters
fluidRow(
column(3, filter_select("filter_gender", "Select Gender", shared_data, ~Gender)), # Gender filter
column(3, filter_select("filter_disease", "Select Cohort", shared_data, ~`Disease-name`)), # Cohort filter
column(3, filter_select("filter_age", "Select Age Group", shared_data, ~`Age-Group`))
)
)
})
output$report_table <- renderDT({
filtered_data <- shared_data$data()
datatable(filtered_data, options = list(
pageLength = 10,
autoWidth = TRUE,
dom = 'bfrtip', # Add buttons and filtering
buttons = c('csv', 'excel'), # Add export buttons
columnDefs = list(
list(className = 'dt-left', targets = c(0, 1)) # Center align all columns
)
), rownames = FALSE) %>%
formatRound(columns = c(4:6), digits = 0) # Use dt for better table rendering
})
})
}
shinyApp(ui = ui, server = server)