Bugfixes and improvements to summary_rows()

NAMESPACE

@@ -8,6 +8,7 @@ export(as_raw_html)
 export(as_rtf)
 export(cells_column_labels)
 export(cells_data)
+export(cells_grand_summary)
 export(cells_group)
 export(cells_stub)
 export(cells_styles)

R/as_rtf.R

@@ -179,7 +179,9 @@ as_rtf <- function(data) {
 
   # Perform any necessary column merge operations
   col_merge_output <-
-    perform_col_merge(col_merge, data_df, output_df, boxh_df, columns_df)
+    perform_col_merge(
+      col_merge, data_df, output_df, boxh_df, columns_df, context
+    )
 
   # Rewrite `output_df`, `boxh_df`, and `columns_df` as a result of merging
   output_df <- col_merge_output$output_df
@@ -188,7 +190,7 @@ as_rtf <- function(data) {
 
   # Create the `list_of_summaries` list of lists
   list_of_summaries <-
-    create_summary_dfs(summary_list, data_df, stub_df, output_df)
+    create_summary_dfs(summary_list, data_df, stub_df, output_df, context)
 
   # Determine if there is a populated stub
   stub_available <- is_stub_available(stub_df)

R/build_data.R

@@ -156,7 +156,9 @@ build_data <- function(data, context) {
 
   # Perform any necessary column merge operations
   col_merge_output <-
-    perform_col_merge(col_merge, data_df, output_df, boxh_df, columns_df)
+    perform_col_merge(
+      col_merge, data_df, output_df, boxh_df, columns_df, context
+    )
 
   # Rewrite `output_df`, `boxh_df`, and `columns_df` as a result of merging
   output_df <- col_merge_output$output_df
@@ -165,7 +167,7 @@ build_data <- function(data, context) {
 
   # Create the `list_of_summaries` list of lists
   list_of_summaries <-
-    create_summary_dfs(summary_list, data_df, stub_df, output_df)
+    create_summary_dfs(summary_list, data_df, stub_df, output_df, context)
 
   # Determine if there is a populated stub
   stub_available <- is_stub_available(stub_df)

R/extract_summary.R

@@ -59,86 +59,23 @@
 #' @export
 extract_summary <- function(data) {
 
-  # Extract all attributes from the data object into `data_attr`
+  # Extract all attributes from the `data`
+  # object into `data_attr`
   data_attr <- attributes(data)
 
+  # Stop function if there are no
+  # directives to create summary rows
   if (is.null(data_attr$summary)) {
-    stop("There is no summary data frame to extract.", call. = FALSE)
+    stop("There is no summary list to extract.\n",
+         "Use the `summary_rows()` function to generate summaries.",
+         call. = FALSE)
   }
 
-  # Move original data frame to `data_df`
-  data_df <- as.data.frame(data)
+  # Build the `data` using the standard
+  # pipeline with the `html` context
+  built_data <- build_data(data = data, context = "html")
 
-  # Get the `boxh_df` data frame
-  boxh_df <- data_attr$boxh_df
-
-  # Get the `stub_df` data frame
-  stub_df <- data_attr$stub_df
-
-  # Get the `rows_df` data frame
-  rows_df <- data_attr$rows_df
-
-  # Get the `cols_df` data frame
-  cols_df <- data_attr$cols_df
-
-  # Get the `formats` list
-  formats <- data_attr$formats
-
-  # Get the `arrange_groups` vector
-  arrange_groups <- data_attr$arrange_groups
-
-  # Get the `others_group` vector
-  others_group <- data_attr$others_group[[1]] %||% NA_character_
-
-  # Get the `col_merge` object
-  col_merge <- data_attr$col_merge
-
-  # Get the `summary_list` object
-  summary_list <- data_attr$summary
-
-  # Initialize `output_df`
-  output_df <- initialize_output_df(data_df)
-
-  # Create `output_df` with rendered values
-  output_df <- render_formats(output_df, data_df, formats, context = "html")
-
-  # Move input data cells to `output_df` that didn't have
-  #   any rendering applied during `render_formats()`
-  output_df <- migrate_unformatted_to_output(data_df, output_df, context = "html")
-
-  # Get the reordering df (`rows_df`) for the data rows
-  rows_df <- get_row_reorder_df(arrange_groups, stub_df)
-
-  # Get the `columns_df` data frame for the data columns
-  columns_df <- get_column_reorder_df(cols_df, boxh_df)
-
-  # Reassemble the rows and columns of `data_df` in the correct order
-  output_df <- reassemble_output_df(output_df, rows_df, columns_df)
-
-  # Get the `groups_df` data frame, which is a rearranged representation
-  # of the stub `groupname` and `rowname` columns
-  groups_df <- get_groupnames_rownames_df(stub_df, rows_df)
-
-  # Replace NA values in the `groupname` column if there is a reserved
-  #   label for the unlabeled group
-  groups_df[is.na(groups_df[, "groupname"]), "groupname"] <- others_group
-
-  # Create the `groups_rows_df` data frame, which provides information
-  #   on which rows the group rows should appear above
-  groups_rows_df <- get_groups_rows_df(arrange_groups, groups_df)
-
-  # Perform any necessary column merge operations
-  col_merge_output <-
-    perform_col_merge(col_merge, data_df, output_df, boxh_df, columns_df)
-
-  # Rewrite `output_df`, `boxh_df`, and `columns_df` as a result of merging
-  output_df <- col_merge_output$output_df
-  boxh_df <- col_merge_output$boxh_df
-  columns_df <- col_merge_output$columns_df
-
-  # Create the `list_of_summaries` list of lists
-  list_of_summaries <-
-    create_summary_dfs(summary_list, data_df, stub_df, output_df)
-
-  list_of_summaries$summary_df_data_list
+  # Extract the list of summary data frames
+  # that contains tidy, unformatted data
+  built_data$list_of_summaries$summary_df_data_list
 }

R/format_data.R

@@ -1294,11 +1294,11 @@ fmt_missing <- function(data,
       fns = list(
         html = function(x) {
 
-          if (missing_text == "---") {
-            missing_text <- "\u2014"
-          } else if (missing_text == "--") {
-            missing_text <- "\u2013"
-          }
+          missing_text <-
+            context_missing_text(
+              missing_text = missing_text,
+              context = "html"
+            )
 
           # Any values of `x` that are `NA` get
           # `missing_text` as output; any values that

R/gt_options_default.R

@@ -33,12 +33,15 @@ gt_options_default <- function() {
     "table_body_border_bottom_style",     TRUE,  "table_body",          "solid",
     "table_body_border_bottom_width",     TRUE,  "table_body",          "2px",
     "table_body_border_bottom_color",     TRUE,  "table_body",          "#A8A8A8",
-    "row_padding",                        TRUE,  "row",                 "10px",
+    "row_padding",                        TRUE,  "row",                 "8px",
     "row_striping_include_stub",          TRUE,  "row",                 "TRUE",
     "row_striping_include_table_body",    TRUE,  "row",                 "TRUE",
     "summary_row_background_color",       TRUE,  "summary_row",         NA_character_,
-    "summary_row_padding",                TRUE,  "summary_row",         "6px",
+    "summary_row_padding",                TRUE,  "summary_row",         "8px",
     "summary_row_text_transform",         TRUE,  "summary_row",         "inherit",
+    "grand_summary_row_background_color", TRUE,  "grand_summary_row",   NA_character_,
+    "grand_summary_row_padding",          TRUE,  "grand_summary_row",   "8px",
+    "grand_summary_row_text_transform",   TRUE,  "grand_summary_row",   "inherit",
     "footnote_sep",                      FALSE,  "footnote",            "<br />",
     "footnote_glyph",                    FALSE,  "footnote",            "numbers",
     "footnote_font_size",                 TRUE,  "footnote",            "90%",

R/helpers.R

@@ -364,6 +364,30 @@ cells_summary <- function(groups = NULL,
   cells
 }
 
+#' @rdname location_cells
+#' @import rlang
+#' @export
+cells_grand_summary <- function(columns = NULL,
+                                rows = NULL) {
+
+  # Capture expressions for the `columns`
+  # and `rows` arguments
+  col_expr <- rlang::enquo(columns)
+  row_expr <- rlang::enquo(rows)
+
+  # Create the `cells_grand_summary` object
+  cells <-
+    list(
+      columns = col_expr,
+      rows = row_expr)
+
+  # Apply the `cells_grand_summary` and
+  # `location_cells` classes
+  class(cells) <- c("cells_grand_summary", "location_cells")
+
+  cells
+}
+
 #' Interpret input text as Markdown-formatted text
 #' @param text the text that is understood to contain Markdown formatting.
 #' @return a character object that is tagged for a Markdown-to-HTML

R/modify_columns.R

@@ -767,6 +767,7 @@ cols_merge <- function(data,
     attr(data, "col_merge") <-
       list(
         pattern = pattern,
+        sep = "",
         col_1 = col_1)
   }
 
@@ -885,6 +886,7 @@ cols_merge_uncert <- function(data,
     attr(data, "col_merge") <-
       list(
         pattern = pattern,
+        sep = "",
         col_1 = col_val)
   }
 
@@ -962,10 +964,11 @@ cols_merge_uncert <- function(data,
 #' @export
 cols_merge_range <- function(data,
                              col_begin,
-                             col_end) {
+                             col_end,
+                             sep = "---") {
 
   # Set the formatting pattern
-  pattern <- "{1} \u2014 {2}"
+  pattern <- "{1} {sep} {2}"
 
   col_begin <- enquo(col_begin)
   col_end <- enquo(col_end)
@@ -991,6 +994,9 @@ cols_merge_range <- function(data,
     attr(data, "col_merge")[["pattern"]] <-
       c(attr(data, "col_merge")[["pattern"]], pattern)
 
+    attr(data, "col_merge")[["sep"]] <-
+      c(attr(data, "col_merge")[["sep"]], sep)
+
     attr(data, "col_merge")[["col_1"]] <-
       c(attr(data, "col_merge")[["col_1"]], col_begin)
 
@@ -999,6 +1005,7 @@ cols_merge_range <- function(data,
     attr(data, "col_merge") <-
       list(
         pattern = pattern,
+        sep = sep,
         col_1 = col_begin)
   }