From ab994837726fba09d52f8589bd68b00b905dfe8c Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Wed, 25 Jun 2025 10:50:05 +0200 Subject: [PATCH] new missings module and function for plotting --- R/missings-module.R | 176 ++++++++++++++++++++++++++++++++++---- man/data-missings.Rd | 2 +- man/missings_apex_plot.Rd | 26 ++++++ 3 files changed, 185 insertions(+), 19 deletions(-) create mode 100644 man/missings_apex_plot.Rd diff --git a/R/missings-module.R b/R/missings-module.R index 451d4ab..53ea929 100644 --- a/R/missings-module.R +++ b/R/missings-module.R @@ -9,8 +9,7 @@ data_missings_ui <- function(id) { ns <- shiny::NS(id) shiny::tagList( - gt::gt_output(outputId = ns("missings_table")), - shiny::plotOutput(outputId = ns("missings_plot")) + gt::gt_output(outputId = ns("missings_table")) ) } @@ -24,20 +23,56 @@ data_missings_ui <- function(id) { #' @export data_missings_server <- function(id, data, + variable, ...) { shiny::moduleServer( id = id, module = function(input, output, session) { # ns <- session$ns + datar <- if (is.reactive(data)) data else reactive(data) + variabler <- if (is.reactive(variable)) variable else reactive(variable) + rv <- shiny::reactiveValues( data = NULL ) - rv$data <- if (is.reactive(data)) data else reactive(data) + rv$data <- shiny::reactive({ + df_tbl <- datar() + by_var <- variabler() - output$missings_plot <- shiny::renderPlot({ - visdat::vis_dat(rv$data(),palette = "cb_safe") + tryCatch( + { + if (!is.null(by_var) && by_var != "" && by_var %in% names(df_tbl)) { + df_tbl[[by_var]] <- ifelse(is.na(df_tbl[[by_var]]), "Missing", "Non-missing") + + out <- gtsummary::tbl_summary(df_tbl, by = by_var) |> + gtsummary::add_p() + } else { + out <- gtsummary::tbl_summary(df_tbl) + } + }, + error = function(err) { + showNotification(paste0("Error: ", err), type = "err") + } + ) + + out + }) + + output$missings_table <- gt::render_gt({ + shiny::req(datar) + shiny::req(variabler) + + if (is.null(variabler()) || variabler() == "" || !variabler() %in% names(datar())) { + title <- "No missing observations" + } else { + title <- paste("Missing vs non-missing observations in", variabler()) + } + + rv$data() |> + gtsummary::as_gt() |> + gt::tab_header(title = gt::md(title)) }) } ) @@ -51,17 +86,24 @@ missing_demo_app <- function() { label = "Browse data", width = "100%", disabled = FALSE - )#, - # data_missings_ui("data") + ), + shiny::selectInput( + inputId = "missings_var", + label = "Select variable to stratify analysis", choices = c("cyl", "vs") + ), + data_missings_ui("data") ) server <- function(input, output, session) { data_demo <- mtcars - data_demo[2:4, "cyl"] <- NA + data_demo[sample(1:32, 10), "cyl"] <- NA + data_demo[sample(1:32, 8), "vs"] <- NA + + data_missings_server(id = "data", data = data_demo, variable = shiny::reactive(input$missings_var)) observeEvent(input$modal_missings, { tryCatch( { - modal_data_missings(data = data_demo, id = "modal_missings") + modal_visual_missings(data = data_demo, id = "modal_missings") }, error = function(err) { showNotification(paste0("We encountered the following error browsing your data: ", err), type = "err") @@ -75,20 +117,22 @@ missing_demo_app <- function() { missing_demo_app() -modal_data_missings <- function(data, - title = "Show missing pattern", - easyClose = TRUE, - size = "xl", - footer = NULL, - ...) { - +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())+ + visdat::vis_dat(datar(),sort_type = FALSE) + ggplot2::guides(fill = ggplot2::guide_legend(title = "Data class")) + # ggplot2::theme_void() + ggplot2::theme( @@ -97,7 +141,7 @@ modal_data_missings <- function(data, panel.grid.minor = ggplot2::element_blank(), # axis.text.y = element_blank(), # axis.title.y = element_blank(), - text = ggplot2::element_text(size = 15), + 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"), @@ -111,3 +155,99 @@ modal_data_missings <- function(data, 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 +} diff --git a/man/data-missings.Rd b/man/data-missings.Rd index e79398f..510d78b 100644 --- a/man/data-missings.Rd +++ b/man/data-missings.Rd @@ -8,7 +8,7 @@ \usage{ data_missings_ui(id) -data_missings_server(id, data, ...) +data_missings_server(id, data, variable, ...) } \arguments{ \item{id}{Module id} diff --git a/man/missings_apex_plot.Rd b/man/missings_apex_plot.Rd new file mode 100644 index 0000000..c947453 --- /dev/null +++ b/man/missings_apex_plot.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/missings-module.R +\name{missings_apex_plot} +\alias{missings_apex_plot} +\title{Plot missings and class with apexcharter} +\usage{ +missings_apex_plot(data, animation = FALSE, ...) +} +\arguments{ +\item{data}{data frame} +} +\value{ +An \code{\link[=apexchart]{apexchart()}} \code{htmlwidget} object. +} +\description{ +Plot missings and class with apexcharter +} +\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) +}