How to run Javascript when a Crosstalk Shiny input was initialized?
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)
Solution
The 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)
- ECMAScript:Harmony / ES6 to JavaScript compiler
- DeepCopy Object in JavaScript using immer
- POST https://localhost:5000/stored net::ERR_SSL_PROTOCOL_ERROR
- How to define a dynamic route in NextJs 14 API?
- How to remain reactivity in SvelteMap between components
- lint-staged not running on precommit
- API returning one result instead of multiple 11ty/eleventy-fetch Promise.all call
- Swagger..Unable to render this definition The provided definition does not specify a valid version field
- How to get data from React native FormData Object
- Wrapping app component with contextProvider component makes the webpage empty
- How can I have multiple Swiper slideshows on a single page?
- Laravel Mix keeps compiling every second without stop with Tailwind v4
- How to write a type guard function that tests against null or undefined?
- `export const` vs. `export default` in ES6
- How can I create a JSON object that can handle conditionals?
- The following error originated from your application code, not from Cypress
- jquery-ui datepicker change z-index
- Get number of non-empty input elements
- How to write an inline IF statement in JavaScript?
- Cypress - Drag and drop not working on a react-based website
- How to check if the font has a symbol
- When using Actions2 in sails.js how do i validate the body object?
- ReactJS: React.render is not a function and React.createElement is not a function
- Node require returns undefined
- How do you organize your Javascript code?
- How can I throttle a ResizeObserver?
- ERESOLVE unable to resolve dependency tree while installing a pacakge
- Does GQL support spreading / composing objects (eg. input args)?
- Scroll the page on drag with jQuery
- How to disable the Material UI Link API component