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)
# 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)
