diff --git a/DESCRIPTION b/DESCRIPTION index cebd548..46be950 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -64,8 +64,7 @@ Imports: RcppArmadillo, ggcorrplot, shinyjs, - emmeans, - visdat + emmeans Suggests: styler, devtools, diff --git a/NAMESPACE b/NAMESPACE index 2e38070..34c6092 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ S3method(cut_var,default) S3method(cut_var,hms) S3method(plot,tbl_regression) +export(FreesearchR_palette) export(add_class_icon) export(add_sparkline) export(align_axes) @@ -32,6 +33,7 @@ export(data_correlations_ui) export(data_description) export(data_missings_server) export(data_missings_ui) +export(data_summary_gather) export(data_summary_server) export(data_summary_ui) export(data_type) @@ -121,12 +123,15 @@ export(supported_plots) export(symmetrical_scale_x_log10) export(tbl_merge) export(type_icons) +export(unique_short) export(update_factor_server) export(update_factor_ui) export(update_variables_server) export(update_variables_ui) export(vectorSelectInput) export(vertical_stacked_bars) +export(visual_summary) +export(visual_summary_ui) export(wide2long) export(winbox_create_column) export(winbox_update_factor) diff --git a/NEWS.md b/NEWS.md index 3ac90ee..a92e676 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # FreesearchR 25.6.3 -- *NEW* First go at introducing more options to evaluate missings. This has introduced a new dependency to use the visdat package and visualisation. The solution includes the option to visualise data classes and missingness as well as comparisons of variables by missing outcome variable or not to determine the nature of missingness. +- *NEW* Introducing more options to evaluate missing observations. Inspired by the [visdat()] function from the {visdat} package, a specialised function has been introduced to easily visualise data classes and missing observations in the data set. This highly increases the options to visually get an overview of the data and to assess the pattern of missing data. Also under Evaluate, a comparison module has been introduced to compare the distribution of observations across variables depending on the missing vs non-missing in a specified variable. - *FIX* The REDCap import module has been updated visually and the PAI token is now hidden as a password. This module should still only be used when running locally if you are accessing sensitive data. diff --git a/R/hosted_version.R b/R/hosted_version.R index 9c90096..8e4a70d 100644 --- a/R/hosted_version.R +++ b/R/hosted_version.R @@ -1 +1 @@ -hosted_version <- function()'v25.6.3-250625' +hosted_version <- function()'v25.6.3-250626' diff --git a/R/sysdata.rda b/R/sysdata.rda index 4350625..95b8842 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/SESSION.md b/SESSION.md index e63210e..7df8447 100644 --- a/SESSION.md +++ b/SESSION.md @@ -43,6 +43,7 @@ |cardx |0.2.4 |2025-04-12 |CRAN (R 4.4.1) | |caTools |1.18.3 |2024-09-04 |CRAN (R 4.4.1) | |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | +|cffr |1.2.0 |2025-01-25 |CRAN (R 4.4.1) | |checkmate |2.3.2 |2024-07-29 |CRAN (R 4.4.0) | |class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | @@ -112,6 +113,7 @@ |iterators |1.0.14 |2022-02-05 |CRAN (R 4.4.1) | |jquerylib |0.1.4 |2021-04-26 |CRAN (R 4.4.0) | |jsonlite |2.0.0 |2025-03-27 |CRAN (R 4.4.1) | +|jsonvalidate |1.5.0 |2025-02-07 |CRAN (R 4.4.1) | |KernSmooth |2.23-26 |2025-01-01 |CRAN (R 4.4.1) | |keyring |1.3.2 |2023-12-11 |CRAN (R 4.4.0) | |knitr |1.50 |2025-03-16 |CRAN (R 4.4.1) | @@ -167,6 +169,7 @@ |R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | |ragg |1.4.0 |2025-04-10 |CRAN (R 4.4.1) | |rankinPlot |1.1.0 |2023-01-30 |CRAN (R 4.4.0) | +|rappdirs |0.3.3 |2021-01-31 |CRAN (R 4.4.1) | |rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) | |RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) | |Rcpp |1.0.14 |2025-01-12 |CRAN (R 4.4.1) | @@ -220,6 +223,7 @@ |urlchecker |1.0.1 |2021-11-30 |CRAN (R 4.4.1) | |usethis |3.1.0 |2024-11-26 |CRAN (R 4.4.1) | |uuid |1.2-1 |2024-07-29 |CRAN (R 4.4.1) | +|V8 |6.0.3 |2025-03-26 |CRAN (R 4.4.1) | |vctrs |0.6.5 |2023-12-01 |CRAN (R 4.4.0) | |visdat |0.6.0 |2023-02-02 |CRAN (R 4.4.0) | |vroom |1.6.5 |2023-12-05 |CRAN (R 4.4.0) | diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index 8fbf742..993bbae 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -3996,7 +3996,7 @@ simple_snake <- function(data){ #### Current file: /Users/au301842/FreesearchR/R//hosted_version.R ######## -hosted_version <- function()'v25.6.3-250625' +hosted_version <- function()'v25.6.3-250626' ######## @@ -4695,7 +4695,8 @@ data_missings_server <- function(id, variabler <- if (is.reactive(variable)) variable else reactive(variable) rv <- shiny::reactiveValues( - data = NULL + data = NULL, + table = NULL ) rv$data <- shiny::reactive({ @@ -4726,15 +4727,25 @@ data_missings_server <- function(id, shiny::req(variabler) if (is.null(variabler()) || variabler() == "" || !variabler() %in% names(datar())) { + if (anyNA(datar())){ + title <- "No variable chosen for analysis" + } else { title <- "No missing observations" + } } else { - title <- paste("Missing vs non-missing observations in", variabler()) + title <- glue::glue("Missing vs non-missing observations in the variable **'{variabler()}'**") } - rv$data() |> + out <- rv$data() |> gtsummary::as_gt() |> gt::tab_header(title = gt::md(title)) + + rv$table <- out + + out }) + + return(reactive(rv$table)) } ) } @@ -4761,10 +4772,12 @@ missing_demo_app <- function() { data_missings_server(id = "data", data = data_demo, variable = shiny::reactive(input$missings_var)) + visual_summary_server(id = "visual", data = data_demo) + observeEvent(input$modal_missings, { tryCatch( { - modal_visual_missings(data = data_demo, id = "modal_missings") + modal_visual_summary(id = "visual") }, error = function(err) { showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err") @@ -4778,140 +4791,12 @@ missing_demo_app <- function() { missing_demo_app() -modal_visual_missings <- function(data, - title = "Visual overview of data classes and missing observations", - easyClose = TRUE, - size = "xl", - footer = NULL, - ...) { - datar <- if (is.reactive(data)) data else reactive(data) - - showModal(modalDialog( - title = tagList(title, datamods:::button_close_modal()), - tags$div( - # apexcharter::renderApexchart({ - # missings_apex_plot(datar(), ...) - # }) - shiny::renderPlot({ - visdat::vis_dat(datar(),sort_type = FALSE) + - ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) + - # ggplot2::theme_void() + - ggplot2::theme( - # legend.position = "none", - panel.grid.major = ggplot2::element_blank(), - panel.grid.minor = ggplot2::element_blank(), - # axis.text.y = element_blank(), - # axis.title.y = element_blank(), - text = ggplot2::element_text(size = 18), - # axis.text = ggplot2::element_blank(), - # panel.background = ggplot2::element_rect(fill = "white"), - # plot.background = ggplot2::element_rect(fill = "white"), - # panel.border = ggplot2::element_blank() - plot.title = ggplot2::element_blank() - ) - }) - ), - easyClose = easyClose, - size = size, - footer = footer - )) -} -## Slow with many observations... - -#' Plot missings and class with apexcharter -#' -#' @param data data frame -#' -#' @returns An [apexchart()] `htmlwidget` object. -#' @export -#' -#' @examples -#' data_demo <- mtcars -#' data_demo[2:4, "cyl"] <- NA -#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot() -#' data_demo |> missings_apex_plot() -#' mtcars |> missings_apex_plot(animation = TRUE) -#' # dplyr::storms |> missings_apex_plot() -#' visdat::vis_dat(dplyr::storms) -missings_apex_plot <- function(data, animation = FALSE, ...) { - browser() - - df_plot <- purrr::map_df(data, \(x){ - ifelse(is.na(x), - yes = NA, - no = glue::glue_collapse(class(x), - sep = "\n" - ) - ) - }) %>% - dplyr::mutate(rows = dplyr::row_number()) %>% - tidyr::pivot_longer( - cols = -rows, - names_to = "variable", values_to = "valueType", values_transform = list(valueType = as.character) - ) %>% - dplyr::arrange(rows, variable, valueType) - df_plot$valueType_num <- df_plot$valueType |> - forcats::as_factor() |> - as.numeric() - df_plot$valueType[is.na(df_plot$valueType)] <- "NA" - df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1 - - labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType)) - - if (any(df_plot$valueType == "NA")) { - colors <- setNames(c(viridisLite::viridis(n = length(labels) - 1), "#999999"), names(labels)) - } else { - colors <- setNames(viridisLite::viridis(n = length(labels)), names(labels)) - } - - - label_list <- labels |> - purrr::imap(\(.x, .i){ - list( - from = .x, - to = .x, - color = colors[[.i]], - name = .i - ) - }) |> - setNames(NULL) - - out <- apexcharter::apex( - data = df_plot, - type = "heatmap", - mapping = apexcharter::aes(x = variable, y = rows, fill = valueType_num), - ... - ) %>% - apexcharter::ax_stroke(width = NULL) |> - apexcharter::ax_plotOptions( - heatmap = apexcharter::heatmap_opts( - radius = 0, - enableShades = FALSE, - colorScale = list( - ranges = label_list - ), - useFillColorAsStroke = TRUE - ) - ) %>% - apexcharter::ax_dataLabels(enabled = FALSE) |> - apexcharter::ax_tooltip( - enabled = FALSE, - intersect = FALSE - ) - - if (!isTRUE(animation)) { - out <- out |> - apexcharter::ax_chart(animations = list(enabled = FALSE)) - } - - out -} ######## @@ -8278,7 +8163,7 @@ FreesearchR_colors <- function(choose = NULL) { secondary = "#FF6F61", success = "#00C896", warning = "#FFB100", - danger = "#FF3A2F", + danger = "#CC2E25", extra = "#8A4FFF", info = "#11A0EC", bg = "#FFFFFF", @@ -8292,7 +8177,18 @@ FreesearchR_colors <- function(choose = NULL) { } } - +#' Use the FreesearchR colors +#' +#' @param n number of colors +#' +#' @returns character vector +#' @export +#' +#' @examples +#' FreesearchR_palette(n=7) +FreesearchR_palette <- function(n){ + rep_len(FreesearchR_colors(),n) +} @@ -9443,6 +9339,303 @@ clean_date <- function(data) { } +######## +#### Current file: /Users/au301842/FreesearchR/R//visual_summary.R +######## + +#' Data correlations evaluation module +#' +#' @param id Module id +#' +#' @name data-missings +#' @returns Shiny ui module +#' @export +visual_summary_ui <- function(id) { + ns <- shiny::NS(id) + + shiny::tagList( + shiny::plotOutput(outputId = ns("visual_plot"), height = "70vh") + ) +} + +visual_summary_server <- function(id, + data_r=shiny::reactive(NULL), + ...) { + shiny::moduleServer( + id = id, + module = function(input, output, session) { + # ns <- session$ns + rv <- shiny::reactiveValues(data = NULL) + + shiny::bindEvent(shiny::observe({ + data <- data_r() + rv$data <- data + # vars_num <- vapply(data, \(.x){ + # is.numeric(.x) || is_datetime(.x) + # }, logical(1)) + # vars_num <- names(vars_num)[vars_num] + # shinyWidgets::updateVirtualSelect( + # inputId = "variable", + # choices = vars_num, + # selected = if (isTruthy(input$variable)) input$variable else vars_num[1] + # ) + }), data_r(), input$hidden) + + # datar <- if (is.reactive(data)) data else reactive(data) + + + # apexcharter::renderApexchart({ + # missings_apex_plot(datar(), ...) + # }) + output$visual_plot <- shiny::renderPlot(expr = { + visual_summary(data = rv$data,...) + }) + } + ) +} + +visual_summary_demo_app <- function() { + ui <- shiny::fluidPage( + shiny::actionButton( + inputId = "modal_missings", + label = "Visual summary", + width = "100%", + disabled = FALSE + ) + ) + server <- function(input, output, session) { + data_demo <- mtcars + data_demo[sample(1:32, 10), "cyl"] <- NA + data_demo[sample(1:32, 8), "vs"] <- NA + + visual_summary_server(id = "data", data = shiny::reactive(data_demo)) + + observeEvent(input$modal_missings, { + tryCatch( + { + modal_visual_summary(id = "data") + }, + error = function(err) { + showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err") + } + ) + }) + } + shiny::shinyApp(ui, server) +} + +visual_summary_demo_app() + + +modal_visual_summary <- function(id, + title = "Visual overview of data classes and missing observations", + easyClose = TRUE, + size = "xl", + footer = NULL, + ...) { + showModal(modalDialog( + title = tagList(title, datamods:::button_close_modal()), + visual_summary_ui(id = id), + easyClose = easyClose, + size = size, + footer = footer + )) +} + + +## Slow with many observations... + +#' Plot missings and class with apexcharter +#' +#' @param data data frame +#' +#' @returns An [apexchart()] `htmlwidget` object. +#' @export +#' +#' @examples +#' data_demo <- mtcars +#' data_demo[2:4, "cyl"] <- NA +#' rbind(data_demo, data_demo, data_demo, data_demo) |> missings_apex_plot() +#' data_demo |> missings_apex_plot() +#' mtcars |> missings_apex_plot(animation = TRUE) +#' # dplyr::storms |> missings_apex_plot() +#' visdat::vis_dat(dplyr::storms) +missings_apex_plot <- function(data, animation = FALSE, ...) { + l <- data_summary_gather(data, ...) + + df_plot <- l$data + + out <- apexcharter::apex( + data = df_plot, + type = "heatmap", + mapping = apexcharter::aes(x = variable, y = rows, fill = valueType_num), + ... + ) |> + apexcharter::ax_stroke(width = NULL) |> + apexcharter::ax_plotOptions( + heatmap = apexcharter::heatmap_opts( + radius = 0, + enableShades = FALSE, + colorScale = list( + ranges = l$labels + ), + useFillColorAsStroke = TRUE + ) + ) |> + apexcharter::ax_dataLabels(enabled = FALSE) |> + apexcharter::ax_tooltip( + enabled = FALSE, + intersect = FALSE + ) + + if (!isTRUE(animation)) { + out <- out |> + apexcharter::ax_chart(animations = list(enabled = FALSE)) + } + + out +} + + + +#' Ggplot2 data summary visualisation based on visdat::vis_dat. +#' +#' @param data data +#' @param ... optional arguments passed to data_summary_gather() +#' +#' @returns ggplot2 object +#' @export +#' +#' @examples +#' data_demo <- mtcars +#' data_demo[sample(1:32, 10), "cyl"] <- NA +#' data_demo[sample(1:32, 8), "vs"] <- NA +#' visual_summary(data_demo) +#' visual_summary(data_demo, palette.fun = scales::hue_pal()) +#' visual_summary(dplyr::storms) +#' visual_summary(dplyr::storms, summary.fun = data_type) +visual_summary <- function(data, legend.title = "Data class", ...) { + l <- data_summary_gather(data, ...) + + df <- l$data + + df$valueType <- factor(df$valueType, levels = names(l$colors)) + df$variable <- factor(df$variable, levels = unique_short(names(data))) + + ggplot2::ggplot(data = df, ggplot2::aes(x = variable, y = rows)) + + ggplot2::geom_raster(ggplot2::aes(fill = valueType)) + + ggplot2::theme_minimal() + + ggplot2::theme(axis.text.x = ggplot2::element_text( + angle = 45, + vjust = 1, hjust = 1 + )) + + ggplot2::scale_fill_manual(values = l$colors) + + ggplot2::labs(x = "", y = "Observations") + + ggplot2::scale_y_reverse() + + ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0.5)) + + ggplot2::guides(colour = "none") + + ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title)) + + # change the limits etc. + ggplot2::guides(fill = ggplot2::guide_legend(title = "Type")) + + # add info about the axes + ggplot2::scale_x_discrete(position = "top") + + ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0)) + + ggplot2::theme( + panel.grid.major = ggplot2::element_blank(), + panel.grid.minor = ggplot2::element_blank(), + text = ggplot2::element_text(size = 18), + plot.title = ggplot2::element_blank() + ) +} + +#' Data summary for printing visual summary +#' +#' @param data data.frame +#' @param fun summary function. Default is "class" +#' @param palette.fun optionally use specific palette functions. First argument +#' has to be the length. +#' +#' @returns data.frame +#' @export +#' +#' @examples +#' mtcars |> data_summary_gather() +data_summary_gather <- function(data, summary.fun = class, palette.fun = viridisLite::viridis) { + df_plot <- setNames(data, unique_short(names(data))) |> + purrr::map_df(\(x){ + ifelse(is.na(x), + yes = NA, + no = glue::glue_collapse(summary.fun(x), + sep = "\n" + ) + ) + }) |> + dplyr::mutate(rows = dplyr::row_number()) |> + tidyr::pivot_longer( + cols = -rows, + names_to = "variable", values_to = "valueType", values_transform = list(valueType = as.character) + ) |> + dplyr::arrange(rows, variable, valueType) + + + df_plot$valueType_num <- df_plot$valueType |> + forcats::as_factor() |> + as.numeric() + + df_plot$valueType[is.na(df_plot$valueType)] <- "NA" + df_plot$valueType_num[is.na(df_plot$valueType_num)] <- max(df_plot$valueType_num, na.rm = TRUE) + 1 + + labels <- setNames(unique(df_plot$valueType_num), unique(df_plot$valueType)) |> sort() + + if (any(df_plot$valueType == "NA")) { + colors <- setNames(c(palette.fun(length(labels) - 1), "#999999"), names(labels)) + } else { + colors <- setNames(palette.fun(length(labels)), names(labels)) + } + + + label_list <- labels |> + purrr::imap(\(.x, .i){ + list( + from = .x, + to = .x, + color = colors[[.i]], + name = .i + ) + }) |> + setNames(NULL) + + list(data = df_plot, colors = colors, labels = label_list) +} + + + +#' Create unique short names of character vector items based on index +#' +#' @description +#' The function will prefer original names, and only append index to long +#' strings. +#' +#' +#' @param data character vector +#' @param max maximum final name length +#' +#' @returns character vector +#' @export +#' +#' @examples +#' c("kahdleidnsallskdj", "hej") |> unique_short() +unique_short <- function(data, max = 15) { + purrr::imap(data, \(.x, .i){ + if (nchar(.x) > max) { + glue::glue("{substr(.x,1,(max-(nchar(.i)+1)))}_{.i}") + } else { + .x + } + }) |> unlist() +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//wide2long.R ######## @@ -9796,7 +9989,7 @@ ui_elements <- list( shiny::column( width = 3, shiny::actionButton( - inputId = "modal_missings", + inputId = "modal_visual_overview", label = "Visual overview", width = "100%", disabled = TRUE @@ -10323,6 +10516,7 @@ server <- function(input, output, session) { rv <- shiny::reactiveValues( list = list(), regression = NULL, + missings = NULL, ds = NULL, local_temp = NULL, ready = NULL, @@ -10342,28 +10536,6 @@ server <- function(input, output, session) { ######### ############################################################################## - ## This does not render correctly apparently due to css and load order - # output$source <- shiny::renderUI({ - # - # choices <- c( - # "File upload" = "file", - # "REDCap server export" = "redcap", - # "Local or sample data" = "env" - # ) - # - # if (isTRUE(is_local)){ - # choices <- choices[c(1,3)] - # } - # - # shinyWidgets::radioGroupButtons( - # inputId = "source", - # selected = "file", - # choices = choices, - # size = "lg" - # ) - # }) - - data_file <- import_file_server( id = "file_import", show_data_in = "popup", @@ -10386,16 +10558,6 @@ server <- function(input, output, session) { rv$code <- modifyList(x = rv$code, list(import = from_redcap$code())) }) - ## This is used to ensure the reactive data is retrieved - # output$redcap_prev <- DT::renderDT( - # { - # DT::datatable(head(from_redcap$data(), 5), - # caption = "First 5 observations" - # ) - # }, - # server = TRUE - # ) - from_env <- datamods::import_globalenv_server( id = "env", trigger_return = "change", @@ -10410,11 +10572,20 @@ server <- function(input, output, session) { rv$code <- modifyList(x = rv$code, list(import = from_env$name())) }) + visual_summary_server( + id = "initial_summary", + data_r = shiny::reactive({ + shiny::req(rv$data_temp) + default_parsing(rv$data_temp) + }), + palette.fun = FreesearchR_palette + ) + observeEvent(input$modal_initial_view, { tryCatch( { - modal_visual_missings( - data = default_parsing(rv$data_temp), + modal_visual_summary( + id = "initial_summary", footer = NULL, size = "xl" ) @@ -10497,12 +10668,12 @@ server <- function(input, output, session) { if (is.null(rv$data_original) | NROW(rv$data_original) == 0) { shiny::updateActionButton(inputId = "act_start", disabled = TRUE) shiny::updateActionButton(inputId = "modal_browse", disabled = TRUE) - shiny::updateActionButton(inputId = "modal_missings", disabled = TRUE) + shiny::updateActionButton(inputId = "modal_visual_overview", disabled = TRUE) shiny::updateActionButton(inputId = "act_eval", disabled = TRUE) } else { shiny::updateActionButton(inputId = "act_start", disabled = FALSE) shiny::updateActionButton(inputId = "modal_browse", disabled = FALSE) - shiny::updateActionButton(inputId = "modal_missings", disabled = FALSE) + shiny::updateActionButton(inputId = "modal_visual_overview", disabled = FALSE) shiny::updateActionButton(inputId = "act_eval", disabled = FALSE) } }) @@ -10548,7 +10719,6 @@ server <- function(input, output, session) { ) }) - ######### ######### Modifications ######### @@ -10741,11 +10911,20 @@ server <- function(input, output, session) { ) }) - observeEvent(input$modal_missings, { + visual_summary_server( + id = "visual_overview", + data_r = shiny::reactive({ + shiny::req(rv$data_filtered) + REDCapCAST::fct_drop(rv$data_filtered) + }), + palette.fun = FreesearchR_palette + ) + + observeEvent(input$modal_visual_overview, { tryCatch( { - modal_visual_missings( - data = REDCapCAST::fct_drop(rv$data_filtered), + modal_visual_summary( + id = "visual_overview", footer = "Here is an overview of how your data is interpreted, and where data is missing. Use this information to consider if data is missing at random or if some observations are missing systematically wich may be caused by an observation bias.", size = "xl" ) @@ -10756,7 +10935,6 @@ server <- function(input, output, session) { ) }) - output$original_str <- renderPrint({ str(rv$data_original) }) @@ -10779,7 +10957,6 @@ server <- function(input, output, session) { shiny::req(rv$data_filtered) rv$list$table1 <- NULL - # rv$regression <- NULL } ) @@ -10904,7 +11081,7 @@ server <- function(input, output, session) { rv$list$table1 <- rlang::exec(create_baseline, !!!append_list(rv$list$data, parameters, "data")) }) - rv$code$table1 <- glue::glue("FreesearchR::create_baseline(data,{list2str(parameters)})") + rv$code$table1 <- glue::glue("FreesearchR::create_baseline(df,{list2str(parameters)})") } ) @@ -10951,12 +11128,12 @@ server <- function(input, output, session) { label = "Select variable to stratify analysis", data = shiny::reactive({ shiny::req(rv$data_filtered) - rv$data_filtered[apply(rv$data_filtered,2,anyNA)] + rv$data_filtered[apply(rv$data_filtered, 2, anyNA)] })() ) }) - data_missings_server( + rv$missings <- data_missings_server( id = "missingness", data = shiny::reactive(rv$data_filtered), variable = shiny::reactive(input$missings_var) @@ -10979,22 +11156,6 @@ server <- function(input, output, session) { rv$regression <- regression_server("regression", data = shiny::reactive(rv$list$data)) - # shiny::observeEvent(rv$regression, { - # browser() - # if (shiny::is.reactive(rv$regression)) { - # rv$list$regression <- rv$regression() - # } else { - # rv$list$regression <- rv$regression - # } - # # rv$list$regression <- rv$regression() - # }) - - # output$regression_models <- renderText({ - # req(rv$list$regression) - # browser() - # names(rv$list$regression) - # }) - ############################################################################## ######### ######### Page navigation @@ -11051,6 +11212,7 @@ server <- function(input, output, session) { format <- ifelse(type == "docx", "word_document", "odt_document") rv$list$regression <- rv$regression() + rv$list$missings <- rv$missings() shiny::withProgress(message = "Generating the report. Hold on for a moment..", { tryCatch( diff --git a/inst/apps/FreesearchR/www/web_data.rds b/inst/apps/FreesearchR/www/web_data.rds index a3256d4..d81c8b2 100644 Binary files a/inst/apps/FreesearchR/www/web_data.rds and b/inst/apps/FreesearchR/www/web_data.rds differ