Skip to content

Commit

Permalink
bug fixes: config (NULL assignment), show_if_custom
Browse files Browse the repository at this point in the history 
Was using config$show_if <- NULL, which erased it rather than stored it, so changed to:
config <- list(show_if = NULL)
  • Loading branch information
@jhelvy
jhelvy committed Aug 20, 2024
1 parent b097868 commit 3ecf037
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 75 deletions.
69 changes: 33 additions & 36 deletions R/config.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,17 +61,17 @@ sd_config <- function(
question_structure <- get_question_structure()
page_ids <- names(page_structure)
question_ids <- names(question_structure)
config <- list(
page_structure = page_structure,
question_structure = question_structure,
page_ids = page_ids,
question_ids = question_ids,
question_values = unname(unlist(lapply(question_structure, `[[`, "options"))),
question_required = if (all_questions_required) question_ids else required_questions
)
question_values <- unname(unlist(lapply(question_structure, `[[`, "options")))
question_required <- question_ids
if (! all_questions_required) {
question_required <- required_questions
}

# Check skip_if and show_if inputs
check_skip_show(config, skip_if, skip_if_custom, show_if, show_if_custom)
check_skip_show(
question_ids, question_values, page_ids, skip_if, skip_if_custom,
show_if, show_if_custom
)

# Check that start_page (if used) points to an actual page
if (!is.null(start_page)) {
Expand All @@ -83,26 +83,22 @@ sd_config <- function(
}
}

if (show_all_pages) {
for (page in page_ids) {
shinyjs::show(page)
}
}

if (admin_page) {
config$admin_page <- TRUE
} else {
config$admin_page <- FALSE
}

# Store remaining config settings
config$skip_if <- skip_if
config$skip_if_custom <- skip_if_custom
config$show_if <- show_if
config$show_if_custom <- show_if_custom
config$start_page <- start_page
config$show_all_pages <- show_all_pages
config$admin_page <- admin_page
# Store all config settings
config <- list(
page_structure = page_structure,
question_structure = question_structure,
page_ids = page_ids,
question_ids = question_ids,
question_values = question_values,
question_required = question_required,
skip_if_custom = skip_if_custom,
skip_if = skip_if,
show_if_custom = show_if_custom,
show_if = show_if,
start_page = start_page,
show_all_pages = show_all_pages,
admin_page = admin_page
)

return(config)
}
Expand Down Expand Up @@ -228,7 +224,8 @@ get_question_nodes <- function() {
#'
#' @return TRUE if all checks pass, otherwise stops with an error message
#' @keywords internal
check_skip_show <- function(config, skip_if, skip_if_custom,
check_skip_show <- function(
question_ids, question_values, page_ids, skip_if, skip_if_custom,
show_if, show_if_custom) {
required_names <- c("question_id", "question_value", "target")

Expand All @@ -239,13 +236,13 @@ check_skip_show <- function(config, skip_if, skip_if_custom,
if (!all(required_names %in% names(skip_if))) {
stop("skip_if must contain the columns: question_id, question_value, and target.")
}
if (!all(skip_if$question_id %in% config$question_ids)) {
if (!all(skip_if$question_id %in% question_ids)) {
stop("All question_id values in skip_if must be valid question IDs.")
}
if (!all(skip_if$target %in% config$page_ids)) {
if (!all(skip_if$target %in% page_ids)) {
stop("All target values in skip_if must be valid page IDs.")
}
if (!all(skip_if$question_value %in% config$question_values)) {
if (!all(skip_if$question_value %in% question_values)) {
stop("All question_value values in skip_if must be valid question values.")
}
}
Expand All @@ -257,13 +254,13 @@ check_skip_show <- function(config, skip_if, skip_if_custom,
if (!all(required_names %in% names(show_if))) {
stop("show_if must contain the columns: question_id, question_value, and target.")
}
if (!all(show_if$question_id %in% config$question_ids)) {
if (!all(show_if$question_id %in% question_ids)) {
stop("All question_id values in show_if must be valid question IDs.")
}
if (!all(show_if$target %in% config$question_ids)) {
if (!all(show_if$target %in% question_ids)) {
stop("All target values in show_if must be valid question IDs.")
}
if (!all(show_if$question_value %in% config$question_values)) {
if (!all(show_if$question_value %in% question_values)) {
stop("All question_value values in show_if must be valid question values.")
}
}
Expand Down
72 changes: 33 additions & 39 deletions R/server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -74,12 +74,13 @@ sd_server <- function(input, output, session, config, db = NULL) {
page_structure <- config$page_structure
page_ids <- config$page_ids
question_ids <- config$question_ids
show_if <- config$show_if
skip_if <- config$skip_if
skip_if_custom <- config$skip_if_custom
show_if <- config$show_if
show_if_custom <- config$show_if_custom
start_page <- config$start_page
show_all_pages <- config$show_all_pages
admin_page <- config$admin_page
question_required <- config$question_required

# Initial page setting ----
Expand All @@ -91,7 +92,14 @@ sd_server <- function(input, output, session, config, db = NULL) {
shinyjs::runjs("showFirstPage();")
}

# Load the functions for JS
# Show all pages if show_all_pages is TRUE
if (show_all_pages) {
for (page in page_ids) {
shinyjs::show(page)
}
}

# Load the JS function
load_js_file("required_questions.js")
load_js_file("update_progress.js")

Expand All @@ -106,7 +114,7 @@ sd_server <- function(input, output, session, config, db = NULL) {

# Admin Page Logic ----

if (config$admin_page) {
if (admin_page) {
admin_enable(input, output, session, db)
}

Expand All @@ -115,6 +123,7 @@ sd_server <- function(input, output, session, config, db = NULL) {
timestamps <- shiny::reactiveValues(data = initialize_timestamps(page_ids, question_ids))

# Conditional display (show_if conditions)

if (!is.null(show_if)) {
handle_basic_show_if_logic(input, show_if)
}
Expand Down Expand Up @@ -276,6 +285,7 @@ sd_server <- function(input, output, session, config, db = NULL) {
#' @param show_if Data frame of show-if conditions
#' @keywords internal
handle_basic_show_if_logic <- function(input, show_if) {

# Ensure show_if is a tibble or data frame
if (!is.data.frame(show_if)) {
stop("show_if must be a data frame or tibble.")
Expand Down Expand Up @@ -314,43 +324,27 @@ handle_basic_show_if_logic <- function(input, show_if) {
#' @param show_if_custom List of custom show-if conditions
#' @keywords internal
handle_custom_show_if_logic <- function(input, show_if_custom) {
# Group show_if_custom rules by target
show_if_custom_grouped <- split(show_if_custom, sapply(show_if_custom, function(x) x$target))

# Initially hide all conditional questions
unique_targets <- names(show_if_custom_grouped)
for (target in unique_targets) {
shinyjs::hide(target)
}

# Iterate over each group of show_if_custom rules
for (group in show_if_custom_grouped) {
target <- group[[1]]$target

# Collect all dependent questions and conditions for this target
dependent_questions <- unique(sapply(group, function(x) x$dependent_question))
conditions <- lapply(group, function(x) x$condition)

# Create a reactive expression to check all conditions
check_conditions <- shiny::reactive({
any(sapply(conditions, function(condition) condition(input)))
})

# Observe changes in any of the dependent questions
shiny::observe({
# Trigger the observer for changes in any dependent question
for (question in dependent_questions) {
input[[question]]
}

# Check if any condition is met to show/hide the question
if (check_conditions()) {
shinyjs::show(target)
} else {
shinyjs::hide(target)
}
})
# Initially hide all conditional questions
lapply(show_if_custom, function(x) shinyjs::hide(x$target))

# Create a reactive expression for each condition
condition_reactives <- lapply(show_if_custom, function(rule) {
shiny::reactive({ rule$condition(input) })
})

# Create a single observer to handle all conditions
shiny::observe({
for (i in seq_along(show_if_custom)) {
condition_result <- condition_reactives[[i]]()
condition_met <- isTRUE(condition_result)

if (condition_met) {
shinyjs::show(show_if_custom[[i]]$target)
} else {
shinyjs::hide(show_if_custom[[i]]$target)
}
}
})
}

#' Handle basic skip logic
Expand Down

0 comments on commit 3ecf037

Please sign in to comment.