Replace table by plot on tm_missing_data

DESCRIPTION

@@ -69,6 +69,7 @@ Imports:
     tools,
     utils
 Suggests:
+    formatters (>= 0.5.11),
     knitr (>= 1.42),
     logger (>= 0.4.0),
     nestcolor (>= 0.1.0),

R/tm_a_pca.R

@@ -440,7 +440,7 @@ srv_a_pca <- function(id, data, dat, plot_height, plot_width, ggplot2_args, deco
           teal.reporter::teal_card(obj),
           teal.reporter::teal_card("## Module's code")
         )
-      teal.code::eval_code(obj, 'library("ggplot2");library("dplyr");library("tidyr")') # nolint: quotes
+      teal.code::eval_code(obj, 'library("ggplot2");library("dplyr");library("tidyr")') # nolint: quotes_lintr
     })
     anl_merged_q <- reactive({
       req(anl_merged_input())

R/tm_a_regression.R

@@ -37,9 +37,9 @@
 #'     It takes the form of `c(value, min, max)` and it is passed to the `value_min_max`
 #'     argument in `teal.widgets::optionalSliderInputValMinMax`.
 #'
-# nolint start: line_length.
+# nolint start: line_length
 #' @param ggplot2_args `r roxygen_ggplot2_args_param("Response vs Regressor", "Residuals vs Fitted", "Scale-Location", "Cook's distance", "Residuals vs Leverage", "Cook's dist vs Leverage")`
-# nolint end: line_length.
+# nolint end: line_length
 #'
 #' @inherit shared_params return
 #'
@@ -465,7 +465,7 @@ srv_a_regression <- function(id,
           teal.reporter::teal_card(obj),
           teal.reporter::teal_card("## Module's code")
         )
-      teal.code::eval_code(obj, 'library("ggplot2");library("dplyr")') # nolint: quotes
+      teal.code::eval_code(obj, 'library("ggplot2");library("dplyr")') # nolint: quotes_lintr
     })
 
     anl_merged_q <- reactive({

R/tm_data_table.R

@@ -309,7 +309,7 @@ srv_data_table <- function(id,
       teal::validate_has_data(df, min_nrow = 1L, msg = paste("data", dataname, "is empty"))
       qenv <- teal.code::eval_code(
         data(),
-        'library("dplyr");library("DT")' # nolint: quotes.
+        'library("dplyr");library("DT")' # nolint: quotes_lintr.
       )
       teal.code::eval_code(
         qenv,

R/tm_g_association.R

@@ -151,8 +151,8 @@ tm_g_association <- function(label = "Association",
                              show_association = TRUE,
                              plot_height = c(600, 400, 5000),
                              plot_width = NULL,
-                             distribution_theme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), # nolint: line_length.
-                             association_theme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), # nolint: line_length.
+                             distribution_theme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), # nolint line_length_lintr.
+                             association_theme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), # nolint line_length_lintr.
                              pre_output = NULL,
                              post_output = NULL,
                              ggplot2_args = teal.widgets::ggplot2_args(),
@@ -349,7 +349,7 @@ srv_tm_g_association <- function(id,
           teal.reporter::teal_card(obj),
           teal.reporter::teal_card("## Module's code")
         )
-      teal.code::eval_code(obj, 'library("ggplot2");library("dplyr");library("ggmosaic")') # nolint: quotes
+      teal.code::eval_code(obj, 'library("ggplot2");library("dplyr");library("ggmosaic")') # nolint: quotes_lintr
     })
     anl_merged_q <- reactive({
       req(anl_merged_input())

R/tm_g_bivariate.R

@@ -565,7 +565,7 @@ srv_g_bivariate <- function(id,
       obj %>%
         teal.code::eval_code(
           c(
-            'library("ggplot2");library("dplyr")', # nolint: quotes
+            'library("ggplot2");library("dplyr")', # nolint: quotes_lintr
             as.expression(anl_merged_input()$expr)
           )
         )

R/tm_g_distribution.R

@@ -524,7 +524,7 @@ srv_distribution <- function(id,
     )
 
     qenv <- reactive(
-      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes
+      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes_lintr
     )
 
     anl_merged_q <- reactive({
@@ -665,7 +665,7 @@ srv_distribution <- function(id,
             "Group by variable must be `factor`, `character`, or `integer`"
           )
         )
-        qenv <- teal.code::eval_code(qenv, 'library("forcats")') # nolint quotes
+        qenv <- teal.code::eval_code(qenv, 'library("forcats")') # nolint quotes_lintr
         qenv <- teal.code::eval_code(
           qenv,
           substitute(
@@ -683,7 +683,7 @@ srv_distribution <- function(id,
           )
         )
 
-        qenv <- teal.code::eval_code(qenv, 'library("forcats")') # nolint quotes
+        qenv <- teal.code::eval_code(qenv, 'library("forcats")') # nolint quotes_lintr
         qenv <- teal.code::eval_code(
           qenv,
           substitute(
@@ -893,7 +893,7 @@ srv_distribution <- function(id,
         }
 
         if (length(t_dist) != 0 && main_type_var == "Density" && length(g_var) == 0 && length(s_var) == 0) {
-          qenv <- teal.code::eval_code(qenv, 'library("ggpp")') # nolint quotes
+          qenv <- teal.code::eval_code(qenv, 'library("ggpp")') # nolint quotes_lintr
           qenv <- teal.code::eval_code(
             qenv,
             substitute(
@@ -1039,7 +1039,7 @@ srv_distribution <- function(id,
         )
 
         if (length(t_dist) != 0 && length(g_var) == 0 && length(s_var) == 0) {
-          qenv <- teal.code::eval_code(qenv, 'library("ggpp")') # nolint quotes
+          qenv <- teal.code::eval_code(qenv, 'library("ggpp")') # nolint quotes_lintr
           qenv <- teal.code::eval_code(
             qenv,
             substitute(
@@ -1235,7 +1235,7 @@ srv_distribution <- function(id,
         qenv <- common_q()
 
         if (length(s_var) == 0 && length(g_var) == 0) {
-          qenv <- teal.code::eval_code(qenv, 'library("generics")') # nolint quotes
+          qenv <- teal.code::eval_code(qenv, 'library("generics")') # nolint quotes_lintr
           qenv <- teal.code::eval_code(
             qenv,
             substitute(
@@ -1249,7 +1249,7 @@ srv_distribution <- function(id,
             )
           )
         } else {
-          qenv <- teal.code::eval_code(qenv, 'library("tidyr")') # nolint quotes
+          qenv <- teal.code::eval_code(qenv, 'library("tidyr")') # nolint quotes_lintr
           qenv <- teal.code::eval_code(
             qenv,
             substitute(

R/tm_g_response.R

@@ -390,7 +390,7 @@ srv_g_response <- function(id,
     )
 
     qenv <- reactive(
-      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes
+      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes_lintr
     )
 
     anl_merged_q <- reactive({
@@ -524,7 +524,7 @@ srv_g_response <- function(id,
             resp_cl = resp_cl,
             hjust_value = if (swap_axes) "left" else "middle",
             vjust_value = if (swap_axes) "middle" else -1,
-            position_anl2_value = if (!freq) quote(position_fill(0.5)) else quote(position_stack(0.5)), # nolint: line_length.
+            position_anl2_value = if (!freq) quote(position_fill(0.5)) else quote(position_stack(0.5)), # nolint line_length_lintr
             anl3_y = if (!freq) 1.1 else as.name("ns"),
             position_anl3_value = if (!freq) "fill" else "stack"
           )

R/tm_g_scatterplot.R

@@ -591,7 +591,7 @@ srv_g_scatterplot <- function(id,
         teal.reporter::teal_card(obj),
         teal.reporter::teal_card("## Module's code")
       )
-      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes
+      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes_lintr
     })
 
     anl_merged_q <- reactive({

R/tm_g_scatterplotmatrix.R

@@ -334,7 +334,7 @@ srv_g_scatterplotmatrix <- function(id,
         teal.reporter::teal_card(obj),
         teal.reporter::teal_card("## Module's code")
       )
-      qenv <- teal.code::eval_code(obj, 'library("dplyr");library("lattice")') # nolint quotes
+      qenv <- teal.code::eval_code(obj, 'library("dplyr");library("lattice")') # nolint quotes_lintr
       teal.code::eval_code(qenv, as.expression(anl_merged_input()$expr))
     })
 

R/tm_missing_data.R

@@ -22,6 +22,7 @@
 #' This module generates the following objects, which can be modified in place using decorators:
 #' - `summary_plot` (`ggplot`)
 #' - `combination_plot` (`grob` created with [ggplot2::ggplotGrob()])
+#' - `by_variable_plot` (`ggplot`)
 #' - `by_subject_plot` (`ggplot`)
 #'
 #' A Decorator is applied to the specific output using a named list of `teal_transform_module` objects.
@@ -34,6 +35,7 @@
 #'    decorators = list(
 #'      summary_plot = teal_transform_module(...), # applied only to `summary_plot` output
 #'      combination_plot = teal_transform_module(...), # applied only to `combination_plot` output
+#'      by_variable_plot = teal_transform_module(...) # applied only to `by_variable_plot` output
 #'      by_subject_plot = teal_transform_module(...) # applied only to `by_subject_plot` output
 #'    )
 #' )
@@ -328,8 +330,7 @@ ui_missing_data <- function(id, by_subject_plot = FALSE) {
     ),
     tabPanel(
       "By Variable Levels",
-      teal.widgets::get_dt_rows(ns("levels_table"), ns("levels_table_rows")),
-      DT::dataTableOutput(ns("levels_table"))
+      teal.widgets::plot_with_settings_ui(id = ns("by_variable_plot")),
     )
   )
   if (isTRUE(by_subject_plot)) {
@@ -1069,7 +1070,7 @@ srv_missing_data <- function(id,
       })
     })
 
-    summary_table_q <- reactive({
+    by_variable_plot_q <- reactive({
       req(
         input$summary_type == "By Variable Levels", # needed to trigger show r code update on tab change
         common_code_q()
@@ -1079,7 +1080,7 @@ srv_missing_data <- function(id,
       # extract the ANL dataset for use in further validation
       anl <- common_code_q()[["ANL"]]
 
-      group_var <- input$group_by_var
+      group_var <- req(input$group_by_var)
       validate(
         need(
           is.null(group_var) ||
@@ -1107,7 +1108,6 @@ srv_missing_data <- function(id,
 
       qenv <- common_code_q()
       teal.reporter::teal_card(qenv) <- c(teal.reporter::teal_card(qenv), "## Summary Table")
-
       qenv <- if (!is.null(group_var)) {
         common_code_libraries_q <- teal.code::eval_code(
           qenv,
@@ -1151,10 +1151,87 @@ srv_missing_data <- function(id,
         )
       }
 
-      within(qenv, {
-        table <- rtables::df_to_tt(summary_data)
-        table
-      })
+      dev_ggplot2_args <- teal.widgets::ggplot2_args(
+        labs = list(
+          fill = if (input$count_type == "counts") "Missing counts" else "Missing percentage",
+          y = quote(ggplot2::element_blank())
+        )
+      )
+
+      all_ggplot2_args <- teal.widgets::resolve_ggplot2_args(
+        user_plot = ggplot2_args[["By Variable Levels"]],
+        user_default = ggplot2_args$default,
+        module_plot = dev_ggplot2_args
+      )
+
+      parsed_ggplot2_args <- teal.widgets::parse_ggplot2_args(
+        all_ggplot2_args,
+        ggtheme = input$ggtheme
+      )
+
+      # convert to ggplot
+      if (!is.null(group_vals)) {
+        ANL_q <- within(qenv, # nolint object_name_linter
+          {
+            keep_columns <- intersect(c(keys, group_var), colnames(ANL))
+            labels <- vapply(ANL, formatters::obj_label, character(1L))
+            ANL <- ANL %>%
+              filter(group_var_name %in% group_vals) %>%
+              pivot_longer(-keep_columns, values_transform = is.na) %>%
+              summarise(
+                .by = c(group_var_name, name),
+                value = sum(value), perc = value / n()
+              ) %>%
+              mutate(label = labels[name])
+          },
+          keys = join_keys(qenv) |> unlist() |> unique(),
+          group_var_name = as.name(group_var),
+          group_var = group_var,
+          group_vals = group_vals
+        )
+      } else {
+        ANL_q <- within(qenv, # nolint object_name_linter
+          {
+            keep_columns <- intersect(c(keys, group_var), colnames(ANL))
+            labels <- vapply(ANL, formatters::obj_label, character(1L))
+            ANL <- ANL %>%
+              pivot_longer(-keep_columns, values_transform = is.na) %>%
+              summarise(
+                .by = c(group_var_name, name),
+                value = sum(value), perc = value / n()
+              ) %>%
+              mutate(label = labels[name])
+          },
+          keys = join_keys(qenv) |> unlist() |> unique(),
+          group_var_name = as.name(group_var),
+          group_var = group_var
+        )
+      }
+      req(NROW(ANL_q$ANL) > 0)
+      browser(expr = group_var == "RACE")
+      tile <- within(ANL_q,
+        {
+          by_variable_plot <- ggplot(ANL, aes(group_var_name, label)) +
+            geom_tile(aes(fill = column)) +
+            geom_text(aes(label = scales::percent(perc)),
+              data = . %>% filter(perc > 0), color = "white"
+            ) +
+            scale_x_discrete(expand = expansion()) +
+            scale_fill_gradient(high = "#ff2951ff", low = "grey90", labels = labels) +
+            labs +
+            ggthemes
+        },
+        group_var_name = as.name(group_var),
+        column = if (input$count_type == "counts") {
+          as.name("value")
+        } else {
+          as.name("perc")
+        },
+        labs = parsed_ggplot2_args$labs,
+        labels = if (input$count_type == "counts") quote(ggplot2::waiver()) else quote(scales::label_percent()),
+        ggthemes = parsed_ggplot2_args$ggtheme
+      )
+      tile
     })
 
     by_subject_plot_q <- reactive({
@@ -1300,11 +1377,11 @@ srv_missing_data <- function(id,
       })
     )
 
-    decorated_summary_table_q <- srv_decorate_teal_data(
-      id = "dec_summary_table",
-      data = summary_table_q,
-      decorators = select_decorators(decorators, "table"),
-      expr = quote(table)
+    decorated_by_variable_plot_q <- srv_decorate_teal_data(
+      id = "dec_by_variable_plot",
+      data = by_variable_plot_q,
+      decorators = select_decorators(decorators, "by_variable_plot"),
+      expr = quote(by_variable_plot)
     )
 
     decorated_by_subject_plot_q <- srv_decorate_teal_data(
@@ -1324,22 +1401,8 @@ srv_missing_data <- function(id,
       req(decorated_combination_plot_q())[["combination_plot"]]
     })
 
-    summary_table_r <- reactive({
-      q <- req(decorated_summary_table_q())
-
-      if (length(input$variables_select) == 0) {
-        # so that zeroRecords message gets printed
-        # using tibble as it supports weird column names, such as " "
-        DT::datatable(
-          tibble::tibble(` ` = logical(0)),
-          options = list(
-            language = list(zeroRecords = "No variable selected."),
-            pageLength = input$levels_table_rows
-          )
-        )
-      } else {
-        DT::datatable(q[["summary_data"]])
-      }
+    by_variable_plot_r <- reactive({
+      req(decorated_by_variable_plot_q())[["by_variable_plot"]]
     })
 
     by_subject_plot_r <- reactive({
@@ -1361,9 +1424,14 @@ srv_missing_data <- function(id,
       width = plot_width
     )
 
-    output$levels_table <- DT::renderDataTable(summary_table_r())
-
     pws3 <- teal.widgets::plot_with_settings_srv(
+      id = "by_variable_plot",
+      plot_r = by_variable_plot_r,
+      height = plot_height,
+      width = plot_width
+    )
+
+    pws4 <- teal.widgets::plot_with_settings_srv(
       id = "by_subject_plot",
       plot_r = by_subject_plot_r,
       height = plot_height,
@@ -1375,8 +1443,11 @@ srv_missing_data <- function(id,
     decorated_combination_plot_dims_q <- # nolint: object_length_linter.
       set_chunk_dims(pws2, decorated_combination_plot_q)
 
+    decorated_by_variable_plot_dims_q <- # nolint: object_length_linter.
+      set_chunk_dims(pws3, decorated_by_variable_plot_q)
+
     decorated_by_subject_plot_dims_q <- # nolint: object_length_linter.
-      set_chunk_dims(pws3, decorated_by_subject_plot_q)
+      set_chunk_dims(pws4, decorated_by_subject_plot_q)
 
     decorated_final_q <- reactive({
       sum_type <- req(input$summary_type)
@@ -1385,7 +1456,7 @@ srv_missing_data <- function(id,
       } else if (sum_type == "Combinations") {
         decorated_combination_plot_dims_q()
       } else if (sum_type == "By Variable Levels") {
-        decorated_summary_table_q()
+        decorated_by_variable_plot_dims_q()
       } else if (sum_type == "Grouped by Subject") {
         decorated_by_subject_plot_dims_q()
       }