Style package

R/compat-purrr.R

@@ -138,13 +138,17 @@ transpose <- function(.l) {
 
 every <- function(.x, .p, ...) {
   for (i in seq_along(.x)) {
-    if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE)
+    if (!rlang::is_true(.p(.x[[i]], ...))) {
+      return(FALSE)
+    }
   }
   TRUE
 }
 some <- function(.x, .p, ...) {
   for (i in seq_along(.x)) {
-    if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE)
+    if (rlang::is_true(.p(.x[[i]], ...))) {
+      return(TRUE)
+    }
   }
   FALSE
 }

R/ctl_pillar.R

@@ -25,7 +25,7 @@
 #' @param ... Passed on to [pillar_shaft()].
 #' @export
 #' @examples
-#' x <- 123456789 * (10 ^ c(-1, -3, -5, NA, -8, -10))
+#' x <- 123456789 * (10^c(-1, -3, -5, NA, -8, -10))
 #' pillar(x)
 #' pillar(-x)
 #' pillar(runif(10))

R/multi.R

@@ -52,7 +52,7 @@ flatten_colonnade <- function(x) {
 
   vctrs::vec_rbind(
     !!!out,
-    #.ptype = vctrs::data_frame(names = list(), data = list())
+    # .ptype = vctrs::data_frame(names = list(), data = list())
     .ptype = vctrs::data_frame(names = character(), data = list())
   )
 }
@@ -68,7 +68,7 @@ flatten_column <- function(x, name) {
     flatten_matrix_column(x, name)
   } else {
     # Length-one list, will be unlist()ed afterwards
-    #vctrs::data_frame(names = list(name), data = list(x))
+    # vctrs::data_frame(names = list(name), data = list(x))
     vctrs::data_frame(names = name, data = list(x))
   }
 }
@@ -79,7 +79,7 @@ flatten_df_column <- function(x, name) {
     vctrs::data_frame(names = name, data = list(new_empty_col_sentinel(x)))
   } else {
     x <- flatten_colonnade(unclass(x))
-    #x$names <- map(x$names, function(.x) c(name, .x))
+    # x$names <- map(x$names, function(.x) c(name, .x))
     x$names <- paste0("$", x$names)
     x$names[[1]] <- paste0(name, x$names[[1]])
     x
@@ -89,12 +89,12 @@ flatten_df_column <- function(x, name) {
 flatten_matrix_column <- function(x, name) {
   if (ncol(x) == 0) {
     vctrs::data_frame(
-      #names = list(c(name, "[,0]")),
+      # names = list(c(name, "[,0]")),
       names = name,
       data = list(new_empty_col_sentinel(x))
     )
   } else {
-    x_list <- map(seq_len(ncol(x)), function(i) x[,i])
+    x_list <- map(seq_len(ncol(x)), function(i) x[, i])
 
     idx <- colnames(x)
     if (is.null(idx)) {
@@ -103,7 +103,7 @@ flatten_matrix_column <- function(x, name) {
       idx <- encodeString(idx, quote = '"')
     }
 
-    #names <- map(idx, function(.x) c(name, .x))
+    # names <- map(idx, function(.x) c(name, .x))
     names <- paste0("[,", idx, "]")
     names[[1]] <- paste0(name, names[[1]])
 
@@ -365,13 +365,17 @@ colonnade_compute_tiered_col_widths_df <- function(col_df, tier_widths, fixed_ti
   #' `option(tibble.width = Inf)` or narrow colonnade).
   max_fit <- distribute_pillars(col_df$max_widths, tier_widths)
   #' If yes, this is the resulting fit, no more work needs to be done.
-  if (all_pillars_fit(max_fit)) return(max_fit)
+  if (all_pillars_fit(max_fit)) {
+    return(max_fit)
+  }
 
   #' Otherwise, if the maximum width is too wide, the same test
   #' is carried out with the minimum width.
   #' If this is still too wide, this is the resulting fit.
   min_fit <- distribute_pillars(col_df$min_widths, tier_widths)
-  if (!all_pillars_fit(min_fit)) return(min_fit)
+  if (!all_pillars_fit(min_fit)) {
+    return(min_fit)
+  }
 
   #' Otherwise, some tiers from the start
   #' will contain pillars with their maximum width, and the remaining tiers
@@ -475,11 +479,15 @@ colonnade_distribute_space_df <- function(col_widths_df, tier_widths) {
 #' @usage NULL
 #' @aliases NULL
 colonnade_distribute_space <- function(col_widths, max_widths, width) {
-  if (any(is.na(col_widths))) return(col_widths)
+  if (any(is.na(col_widths))) {
+    return(col_widths)
+  }
 
   missing_space <- max_widths - col_widths
   # Shortcut to avoid division by zero
-  if (all(missing_space == 0L)) return(rep_along(col_widths, 0L))
+  if (all(missing_space == 0L)) {
+    return(rep_along(col_widths, 0L))
+  }
 
   #' @details
   #' The remaining space is distributed from left to right.

R/scientific.R

@@ -19,7 +19,9 @@ supernum <- function(x) {
   stopifnot(is.integer(x))
 
   num <- !is.na(x)
-  if (!any(num)) return(rep_along(x, ""))
+  if (!any(num)) {
+    return(rep_along(x, ""))
+  }
 
   neg <- num & x < 0
   if (any(neg)) {

R/shaft-.R

@@ -234,7 +234,8 @@ pillar_shaft.pillar_vertical <- function(x, ..., min_width = NULL, na_indent = 0
   width <- get_max_extent(x)
 
   new_pillar_shaft_simple(
-    x, width = width, align = "left", min_width = min(width, min_width),
+    x,
+    width = width, align = "left", min_width = min(width, min_width),
     na = pillar_na(use_brackets_if_no_color = TRUE),
     na_indent = na_indent
   )

R/sigfig.R

@@ -84,7 +84,9 @@ get_decimal_width <- function(x) {
 }
 
 safe_signif <- function(x, digits) {
-  if (length(x) == 0L) return(numeric())
+  if (length(x) == 0L) {
+    return(numeric())
+  }
   signif(x, digits)
 }
 
@@ -274,7 +276,9 @@ assemble_decimal <- function(x) {
 
 #' @export
 format.pillar_shaft_decimal <- function(x, width, ...) {
-  if (length(x$dec$num) == 0L) return(character())
+  if (length(x$dec$num) == 0L) {
+    return(character())
+  }
 
   if (width < get_min_width(x)) {
     stop(

R/tbl-format.R

@@ -47,7 +47,8 @@ print.tbl <- function(x, width = NULL, ..., n = NULL, n_extra = NULL) {
 format.tbl <- function(x, width = NULL, ..., n = NULL, n_extra = NULL) {
   check_dots_empty(action = signal)
 
-  setup <- tbl_format_setup(x, width = width, ...,
+  setup <- tbl_format_setup(x,
+    width = width, ...,
     n = n,
     max_extra_cols = n_extra
   )
@@ -59,7 +60,9 @@ format.tbl <- function(x, width = NULL, ..., n = NULL, n_extra = NULL) {
 }
 
 format_comment <- function(x, width) {
-  if (length(x) == 0L) return(character())
+  if (length(x) == 0L) {
+    return(character())
+  }
   map_chr(x, wrap, prefix = "# ", width = min(width, cli::console_width()))
 }
 

R/testthat.R

@@ -35,14 +35,12 @@
 #' # Good: Use tidyeval to defer construction
 #' pillar_quo <- rlang::quo(pillar(1:3))
 #' expect_known_display(!!pillar_quo, file, crayon = FALSE)
-#'
 #' \dontrun{
 #' # Bad: Options set in the active session may affect the display
 #' integer_pillar <- pillar(1:3)
 #' expect_known_display(integer_pillar, file, crayon = FALSE)
 #' }
 expect_known_display <- function(object, file, ..., width = 80L, crayon = TRUE) {
-
   object <- enquo(object)
 
   if (crayon) {

R/title.R

@@ -38,18 +38,24 @@ get_min_title_width <- function(width) {
     stop("Option pillar.min_title_chars must be a nonnegative number", call. = FALSE)
   }
 
-  if (is.infinite(title_chars)) return(width)
+  if (is.infinite(title_chars)) {
+    return(width)
+  }
 
   # We don't use the ellipsis if we don't truncate, a solution with min()
   # is difficult to make work in all corner cases (and slower too)
-  if (width <= title_chars) return(width)
+  if (width <= title_chars) {
+    return(width)
+  }
   title_chars + get_extent(get_ellipsis())
 }
 
 #' @export
 format.pillar_title <- function(x, width = NULL, ...) {
   title <- x[[1]]
-  if (is.null(title)) return(character())
+  if (is.null(title)) {
+    return(character())
+  }
 
   if (is.null(width)) {
     width <- get_width(x)

R/type-sum.R

@@ -26,7 +26,9 @@ type_sum.factor <- function(x) {
 
 #' @export
 type_sum.default <- function(x) {
-  if (is.object(x) || vctrs::vec_is(x)) return(vctrs::vec_ptype_abbr(x))
+  if (is.object(x) || vctrs::vec_is(x)) {
+    return(vctrs::vec_ptype_abbr(x))
+  }
 
   switch(typeof(x),
     builtin = ,
@@ -97,7 +99,9 @@ size_sum <- function(x) {
 
 #' @export
 size_sum.default <- function(x) {
-  if (!vctrs::vec_is(x)) return("")
+  if (!vctrs::vec_is(x)) {
+    return("")
+  }
 
   paste0("[", dim_desc(x), "]")
 }

R/utils.R

@@ -5,7 +5,9 @@ cat_line <- function(...) {
 #' @importFrom utf8 utf8_width
 #' @importFrom fansi strip_sgr substr_ctl
 str_trunc <- function(x, width) {
-  if (all(is.infinite(width))) return(x)
+  if (all(is.infinite(width))) {
+    return(x)
+  }
 
   str_width <- utf8_width(strip_sgr(x), encode = FALSE)
 
@@ -38,7 +40,9 @@ slice <- function(df, index) {
 }
 
 bind_rows <- function(x) {
-  if (length(x) == 0) return(data.frame())
+  if (length(x) == 0) {
+    return(data.frame())
+  }
   eval_tidy(quo(rbind(!!!x)))
 }
 
@@ -47,12 +51,16 @@ get_ellipsis <- function() {
 }
 
 is_latex_output <- function() {
-  if (!("knitr" %in% loadedNamespaces())) return(FALSE)
+  if (!("knitr" %in% loadedNamespaces())) {
+    return(FALSE)
+  }
   get("is_latex_output", asNamespace("knitr"))()
 }
 
 remove_as_is_class <- function(x) {
-  if (all(class(x) == "AsIs")) return(unclass(x))
+  if (all(class(x) == "AsIs")) {
+    return(unclass(x))
+  }
   class(x) <- setdiff(class(x), "AsIs")
   x
 }

R/width.R

@@ -9,7 +9,9 @@ get_width <- function(x) {
 # @param x Input to which assign a width or minimum width
 # @param width,min_width The new width
 set_width <- function(x, width) {
-  if (is.null(width)) return(x)
+  if (is.null(width)) {
+    return(x)
+  }
   if (is.infinite(width)) {
     attr(x, "width") <- NA_integer_
   } else {
@@ -28,7 +30,9 @@ get_min_width <- function(x) {
 
 # @rdname set_width
 set_min_width <- function(x, min_width) {
-  if (is.null(min_width)) return(x)
+  if (is.null(min_width)) {
+    return(x)
+  }
   attr(x, "min_width") <- as.integer(min_width)
   x
 }

R/zzz.R

@@ -24,7 +24,7 @@ NULL
 
   # Necessary to re-parse environment variable
   if (requireNamespace("debugme", quietly = TRUE)) {
-    #activate_debugme()
+    # activate_debugme()
     debugme::debugme()
     debug_info()
   }

data-raw/create-chr-tests.R

@@ -9,11 +9,11 @@ width <- sample.int(1200, N) + 300L
 output_width <- sample.int(30, N, replace = TRUE) + 30L
 
 code <- paste0(
-  'expect_pillar_output(\n',
-  '  xf = colonnade(df_str[', order, '], width = ', width, '),\n',
-  '  output_width = ', output_width, ',\n',
-  '  filename = "str-', sprintf("%.2d", idx), '-', width, '-', output_width, '.txt"\n',
-  ')'
+  "expect_pillar_output(\n",
+  "  xf = colonnade(df_str[", order, "], width = ", width, "),\n",
+  "  output_width = ", output_width, ",\n",
+  '  filename = "str-', sprintf("%.2d", idx), "-", width, "-", output_width, '.txt"\n',
+  ")"
 )
 
 cat(code, sep = "\n")

tests/testthat/setup.R

@@ -1,5 +1,7 @@
 rlang::with_options(
-  crayon.enabled = FALSE, crayon.colors = 1L, cli.num_colors = 1L,
+  crayon.enabled = FALSE,
+  crayon.colors = 1L,
+  cli.num_colors = 1L,
   {
     num_colors(forget = TRUE)
   }

tests/testthat/test-ctl_colonnade.R

@@ -10,12 +10,30 @@ test_that("tests from tibble", {
   expect_snapshot(ctl_colonnade(iris[1:3, ], width = 20))
   expect_snapshot(ctl_colonnade(df_all, width = 30))
   expect_snapshot(ctl_colonnade(df_all, width = 300))
-  expect_snapshot({ options(width = 70); ctl_colonnade(df_all, width = 300) })
-  expect_snapshot({ options(width = 60); ctl_colonnade(df_all, width = 300) })
-  expect_snapshot({ options(width = 50); ctl_colonnade(df_all, width = 300) })
-  expect_snapshot({ options(width = 40); ctl_colonnade(df_all, width = 300) })
-  expect_snapshot({ options(width = 30); ctl_colonnade(df_all, width = 300) })
-  expect_snapshot({ options(width = 20); ctl_colonnade(df_all, width = 300) })
+  expect_snapshot({
+    options(width = 70)
+    ctl_colonnade(df_all, width = 300)
+  })
+  expect_snapshot({
+    options(width = 60)
+    ctl_colonnade(df_all, width = 300)
+  })
+  expect_snapshot({
+    options(width = 50)
+    ctl_colonnade(df_all, width = 300)
+  })
+  expect_snapshot({
+    options(width = 40)
+    ctl_colonnade(df_all, width = 300)
+  })
+  expect_snapshot({
+    options(width = 30)
+    ctl_colonnade(df_all, width = 300)
+  })
+  expect_snapshot({
+    options(width = 20)
+    ctl_colonnade(df_all, width = 300)
+  })
   expect_snapshot(ctl_colonnade(list(`\n` = c("\n", '"'), `\r` = factor("\n")), width = 30))
   expect_snapshot(ctl_colonnade(list(a = c("", " ", "a ", " a")), width = 30))
   expect_snapshot(ctl_colonnade(list("mean(x)" = 5, "var(x)" = 3), width = 30))