diff --git a/R/missings-module.R b/R/missings-module.R index 53ea929..71791ac 100644 --- a/R/missings-module.R +++ b/R/missings-module.R @@ -34,7 +34,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({ @@ -65,15 +66,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)) } ) } @@ -100,10 +111,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") @@ -117,137 +130,9 @@ 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 -}