Merge pull request #1956 from olivroy/lint2

Fix some lints + update visual tests

Author: rich-iannone

R/cols_merge.R

@@ -233,8 +233,8 @@ cols_merge <- function(
   # that `pattern` not be evaluated, for much the same reason as above.
 
   # Get the columns supplied in `hide_columns` as a character vector
-  suppressWarnings(
-    hide_columns <-
+  hide_columns <-
+    suppressWarnings(
       resolve_cols_c(
         expr = {{ hide_columns }},
         data = data

R/cols_width.R

@@ -129,7 +129,7 @@ cols_width <- function(
     all(
       vapply(
         widths_list,
-        FUN = function(width) rlang::is_formula(width),
+        FUN = rlang::is_formula,
         FUN.VALUE = logical(1L)
       )
     )

R/dt_boxhead.R

@@ -97,19 +97,19 @@ dt_boxhead_edit <- function(data, var, ...) {
   check_names_dt_boxhead_expr(expr = val_list)
 
   check_vars_dt_boxhead(var = var, dt_boxhead = dt_boxhead)
-  
+
   col_row_num <- which(dt_boxhead$var == var_name)
-  
+
   if (is.list(dt_boxhead[[names(val_list)]])) {
     dt_boxhead[[col_row_num, names(val_list)]] <- unname(val_list)
     # Fixup md() in column_label column
     # if a problem occurs. (preserve "from_markdown" class)
-    if ("column_label" %in% names(val_list) && 
+    if ("column_label" %in% names(val_list) &&
         is.list(dt_boxhead$column_label[[col_row_num]])) {
       # Remove one level of nesting
       dt_boxhead$column_label[[col_row_num]] <- dt_boxhead$column_label[[col_row_num]][[1]]
     }
-    
+
   } else {
     dt_boxhead[[col_row_num, names(val_list)]] <- unlist(val_list)
   }
@@ -224,8 +224,8 @@ dt_boxhead_get_vars <- function(data) {
 }
 
 dt_boxhead_get_vars_default <- function(data) {
-  df <- dt_boxhead_get(data = data)
-  df$var[df$type == "default"]
+  dat <- dt_boxhead_get(data = data)
+  dat$var[dat$type == "default"]
 }
 
 dt_boxhead_get_var_stub <- function(data) {

R/dt_groups_rows.R

@@ -71,10 +71,10 @@ dt_groups_rows_build <- function(data, context) {
   # values), build the `groups_rows` table
   for (i in seq_along(ordering)) {
 
-    if (!all(is.na(ordering[i]))) {
-      rows_matched <- which(stub_df$group_id == ordering[i])
-    } else {
+    if (all(is.na(ordering[i]))) {
       rows_matched <- which(is.na(stub_df$group_id))
+    } else {
+      rows_matched <- which(stub_df$group_id == ordering[i])
     }
 
     # If `rows_matched` is NA then go to next iteration

R/dt_summary.R

@@ -336,7 +336,7 @@ dt_summary_build <- function(data, context) {
 
             fmt_expr_components <- fmt_expr_values
             names(fmt_expr_components) <- fmt_expr_names
-            fmt_expr_components <- fmt_expr_components[fmt_expr_names != ""]
+            fmt_expr_components <- fmt_expr_components[nzchar(fmt_expr_names)]
 
             if ("rows" %in% names(fmt_expr_components)) {
 

R/export.R

@@ -409,7 +409,7 @@ as_rtf <- function(
       incl_close = incl_close
     )
 
-  if (isTRUE(getOption('knitr.in.progress'))) {
+  if (isTRUE(getOption("knitr.in.progress"))) {
     rtf_table <- knitr::raw_output(rtf_table)
   }
 
@@ -499,7 +499,7 @@ as_word <- function(
   # Perform input object validation
   stop_if_not_gt_tbl(data = data)
 
-  caption_location <- 
+  caption_location <-
     rlang::arg_match0(
       caption_location,
       values = c("top", "bottom", "embed")

R/extract.R

@@ -86,19 +86,19 @@
 #'   value for `build_stage` then the entire build for the table body (i.e., up
 #'   to and including the `"footnotes_attached"` stage) will be performed before
 #'   returning the data frame.
-#' 
+#'
 #' @param incl_hidden_cols *Should hidden columns be included?*
-#' 
+#'
 #'   `scalar<logical>` // *default:* `FALSE`
-#' 
+#'
 #'   Certain columns may be hidden from final display via [cols_hide()]. By
 #'   default, those columns won't be part of the extracted data frame. However,
 #'   we can choose to include them by using `incl_hidden_cols = TRUE`.
-#' 
+#'
 #' @param incl_stub_cols *Should stub columns be included?*
-#' 
+#'
 #'   `scalar<logical>` // *default:* `TRUE`
-#' 
+#'
 #'   Any stub columns in the **gt** object (which may consist of a grouping
 #'   column and a column for row labels) are included in the extracted data for
 #'   clarity but clearly marked with the names `"::group_id::"` and
@@ -114,7 +114,7 @@
 #'   `"html"` (the default), `"latex"`, `"rtf"`, or `"word"`.
 #'
 #' @return A data frame or tibble object containing the table body.
-#' 
+#'
 #' @section Examples:
 #'
 #' Use a modified version of [`sp500`] the dataset to create a **gt** table with
@@ -135,36 +135,36 @@
 #'   fmt_date(columns = date, date_style = "day_month_year") |>
 #'   fmt_currency(columns = c(open, high, low, close)) |>
 #'   cols_hide(columns = c(high, low))
-#' 
+#'
 #' ```
-#' 
+#'
 #' ```r
 #' gt_tbl
 #' ```
-#' 
+#'
 #' \if{html}{\out{
 #' `r man_get_image_tag(file = "man_extract_body_1.png")`
 #' }}
-#' 
+#'
 #' Using `extract_body()` on the **gt** object (`gt_tbl`) will provide us with
 #' a tibble that contains the fully built data cells for the `output` context
 #' (in this case, `"html"`).
-#' 
+#'
 #' ```{r}
 #' extract_body(gt_tbl)
 #' ```
-#' 
+#'
 #' To provide us with a better frame of reference, the grouping and row label
 #' values are provided as the first columns in the returned output. We could
-#' suppress those in the output by setting `incl_stub_cols = FALSE`. 
-#' 
+#' suppress those in the output by setting `incl_stub_cols = FALSE`.
+#'
 #' ```{r}
 #' extract_body(gt_tbl, incl_stub_cols = FALSE)
 #' ```
-#' 
+#'
 #' The `high` and `low` columns were hidden via [`cols_hide()`] and so they
 #' won't be shown in the returned data unless we use `incl_hidden_cols = TRUE`.
-#' 
+#'
 #' ```{r}
 #' extract_body(
 #'   gt_tbl,
@@ -195,7 +195,7 @@ extract_body <- function(
 
   # If `build_stage` is given a keyword value, check that value is valid
   if (!is.null(build_stage)) {
-    
+
     rlang::arg_match0(
       build_stage,
       values = c(
@@ -211,15 +211,15 @@ extract_body <- function(
       output,
       values = c("html", "latex", "rtf", "word", "grid")
     )
-  
+
   rlang::check_dots_empty()
 
-  # Generate vector of columns to include in output  
+  # Generate vector of columns to include in output
   if (isTRUE(incl_hidden_cols)) {
 
     boxhead_df <- dt_boxhead_get(data = data)
 
-    included_cols <- 
+    included_cols <-
       boxhead_df$var[boxhead_df$type %in% c("default", "hidden")]
 
   } else {
@@ -246,98 +246,98 @@ extract_body <- function(
   }
 
   data <- dt_body_build(data = data)
-    
+
   if (identical(build_stage, "init")) {
-    
-    out_df <- 
+
+    out_df <-
       assemble_body_extract(
         data = data,
         included_cols = included_cols,
         incl_stub_cols = incl_stub_cols,
         group_col = group_col,
         rowname_col = rowname_col
       )
-    
+
     return(out_df)
   }
 
   data <- render_formats(data = data, context = output)
 
   if (identical(build_stage, "fmt_applied")) {
-    
-    out_df <- 
+
+    out_df <-
       assemble_body_extract(
         data = data,
         included_cols = included_cols,
         incl_stub_cols = incl_stub_cols,
         group_col = group_col,
         rowname_col = rowname_col
       )
-    
+
     return(out_df)
   }
 
   data <- render_substitutions(data = data, context = output)
 
   if (identical(build_stage, "sub_applied")) {
-    
-    out_df <- 
+
+    out_df <-
       assemble_body_extract(
         data = data,
         included_cols = included_cols,
         incl_stub_cols = incl_stub_cols,
         group_col = group_col,
         rowname_col = rowname_col
       )
-    
+
     return(out_df)
   }
 
   data <- migrate_unformatted_to_output(data = data, context = output)
 
   if (identical(build_stage, "unfmt_included")) {
-    
-    out_df <- 
+
+    out_df <-
       assemble_body_extract(
         data = data,
         included_cols = included_cols,
         incl_stub_cols = incl_stub_cols,
         group_col = group_col,
         rowname_col = rowname_col
       )
-    
+
     return(out_df)
   }
 
   data <- perform_col_merge(data = data, context = output)
 
   if (identical(build_stage, "cols_merged")) {
-    
-    out_df <- 
+
+    out_df <-
       assemble_body_extract(
         data = data,
         included_cols = included_cols,
         incl_stub_cols = incl_stub_cols,
         group_col = group_col,
         rowname_col = rowname_col
       )
-    
+
     return(out_df)
   }
 
   data <- dt_body_reassemble(data = data)
 
   if (identical(build_stage, "body_reassembled")) {
-    
-    out_df <- 
+
+    out_df <-
       assemble_body_extract(
         data = data,
         included_cols = included_cols,
         incl_stub_cols = incl_stub_cols,
         group_col = group_col,
         rowname_col = rowname_col
       )
-    
+
     return(out_df)
   }
 
@@ -349,15 +349,15 @@ extract_body <- function(
 
   if (identical(build_stage, "text_transformed")) {
 
-    out_df <- 
+    out_df <-
       assemble_body_extract(
         data = data,
         included_cols = included_cols,
         incl_stub_cols = incl_stub_cols,
         group_col = group_col,
         rowname_col = rowname_col
       )
-    
+
     return(out_df)
   }
 
@@ -372,9 +372,9 @@ extract_body <- function(
   data <- resolve_footnotes_styles(data = data, tbl_type = "footnotes")
   data <- apply_footnotes_to_output(data = data, context = output)
 
-  if (is.null(build_stage) || identical(build_stage, "footnotes_attached")) {    
-    
-    out_df <- 
+  if (is.null(build_stage) || identical(build_stage, "footnotes_attached")) {
+
+    out_df <-
       assemble_body_extract(
         data = data,
         included_cols = included_cols,
@@ -394,21 +394,21 @@ assemble_body_extract <- function(
   group_col,
   rowname_col
 ) {
-  
+
   out_df <- data[["_body"]][, included_cols]
-  
+
   if (isTRUE(incl_stub_cols)) {
-  
+
     if (!is.null(group_col)) {
       names(out_df)[names(out_df) == group_col] <- "::group_id::"
     }
-  
+
     if (!is.null(rowname_col)) {
       # ::rowname::
       names(out_df)[names(out_df) == rowname_col] <- rowname_col_private
     }
   }
-  
+
   out_df
 }
 
@@ -618,7 +618,7 @@ extract_cells <- function(
   stop_if_not_gt_tbl(data = data)
 
   # Ensure that `output` is matched correctly to one option
-  output <- 
+  output <-
     rlang::arg_match0(
       output,
       values = c("auto", "plain", "html", "latex", "rtf", "word", "grid")