strict = TRUE

R/all-equal.r

@@ -34,7 +34,8 @@ all_equal <- function(target, current, ignore_col_order = TRUE,
 
   res <- equal_data_frame(target, current,
     ignore_col_order = ignore_col_order,
-    ignore_row_order = ignore_row_order, convert = convert)
+    ignore_row_order = ignore_row_order, convert = convert
+  )
 
   if (res) {
     TRUE

R/count-tally.R

@@ -98,7 +98,6 @@ n_name <- function(x) {
   }
 
   name
-
 }
 
 #' @export

R/dataframe.R

@@ -15,7 +15,8 @@
 add_rownames <- function(df, var = "rowname") {
   warning(
     "Deprecated, use tibble::rownames_to_column() instead.",
-    call. = FALSE)
+    call. = FALSE
+  )
 
   stopifnot(is.data.frame(df))
 
@@ -168,16 +169,16 @@ anti_join.data.frame <- function(x, y, by = NULL, copy = FALSE, ...) {
 intersect.data.frame <- function(x, y, ...) intersect_data_frame(x, y)
 
 #' @export
-union.data.frame <-     function(x, y, ...) union_data_frame(x, y)
+union.data.frame <- function(x, y, ...) union_data_frame(x, y)
 
 #' @export
 union_all.data.frame <- function(x, y, ...) bind_rows(x, y)
 
 #' @export
-setdiff.data.frame <-   function(x, y, ...) setdiff_data_frame(x, y)
+setdiff.data.frame <- function(x, y, ...) setdiff_data_frame(x, y)
 
 #' @export
-setequal.data.frame <-  function(x, y, ...) equal_data_frame(x, y)
+setequal.data.frame <- function(x, y, ...) equal_data_frame(x, y)
 
 #' @export
 distinct.data.frame <- function(.data, ..., .keep_all = FALSE) {

R/error.R

@@ -1,9 +1,9 @@
 check_pkg <- function(name, reason, install = TRUE) {
-  if (is_installed(name))
+  if (is_installed(name)) {
     return(invisible(TRUE))
+  }
 
-  glubort(NULL,
-    "The {name} package is required to {reason}.",
+  glubort(NULL, "The {name} package is required to {reason}.",
     if (install) '\nPlease install it with `install.packages("{name}")`' else ""
   )
 }

R/grouped-df.r

@@ -97,7 +97,6 @@ ungroup.grouped_df <- function(x, ...) {
   } else {
     grouped_df(y, group_names)
   }
-
 }
 
 #' @method rbind grouped_df

R/location.R

@@ -73,12 +73,11 @@ changes <- function(x, y) {
     cat("Changed attributes:\n")
     print(attr, quote = FALSE)
   }
-
 }
 
 match_up <- function(x, y) {
-  both <-    intersect(names(x), names(y))
-  added <-   setdiff(names(x), names(y))
+  both <- intersect(names(x), names(y))
+  added <- setdiff(names(x), names(y))
   deleted <- setdiff(names(y), names(x))
 
   out <- cbind(

R/progress.R

@@ -127,7 +127,6 @@ Progress <- R6::R6Class("Progress",
 
       invisible(self)
     }
-
   )
 )
 

R/rbind.R

@@ -20,33 +20,40 @@ list_or_dots <- function(...) {
 }
 
 is_dataframe_like <- function(x) {
-  if (is_null(x))
+  if (is_null(x)) {
     return(FALSE)
+  }
 
   # data frames are not data lists
-  if (is.data.frame(x))
+  if (is.data.frame(x)) {
     return(FALSE)
+  }
 
   # Must be a list
-  if (!is_list(x))
+  if (!is_list(x)) {
     return(FALSE)
+  }
 
   # 0 length named list (#1515)
-  if (!is_null(names(x)) && length(x) == 0)
+  if (!is_null(names(x)) && length(x) == 0) {
     return(TRUE)
+  }
 
   # With names
-  if (!is_named(x))
+  if (!is_named(x)) {
     return(FALSE)
+  }
 
   # Where each element is an 1d vector or list
-  if (!every(x, is_1d))
+  if (!every(x, is_1d)) {
     return(FALSE)
+  }
 
   # All of which have the same length
   n <- map_int(x, length)
-  if (any(n != n[1]))
+  if (any(n != n[1])) {
     return(FALSE)
+  }
 
   TRUE
 }

R/recode.R

@@ -170,7 +170,6 @@ recode.factor <- function(.x, ..., .default = NULL, .missing = NULL) {
   } else {
     out[as.integer(.x)]
   }
-
 }
 
 find_template <- function(values, .default = NULL, .missing = NULL) {

R/sets.r

@@ -40,10 +40,10 @@ setequal <- function(x, y, ...) UseMethod("setequal")
 #' @export
 intersect.default <- function(x, y, ...) base::intersect(x, y, ...)
 #' @export
-union.default <-     function(x, y, ...) base::union(x, y, ...)
+union.default <- function(x, y, ...) base::union(x, y, ...)
 #' @export
 union_all.default <- function(x, y, ...) combine(x, y, ...)
 #' @export
-setdiff.default <-   function(x, y, ...) base::setdiff(x, y, ...)
+setdiff.default <- function(x, y, ...) base::setdiff(x, y, ...)
 #' @export
-setequal.default <-  function(x, y, ...) base::setequal(x, y, ...)
+setequal.default <- function(x, y, ...) base::setequal(x, y, ...)

R/tbl-cube.r

@@ -406,7 +406,8 @@ summarise.tbl_cube <- function(.data, ...) {
   for (i in seq_len(nrow(slices))) {
     index <- as_list(slices[i, , drop = FALSE])
     mets <- map(
-      .data$mets, subs_index, i = .data$groups, val = index,
+      .data$mets, subs_index,
+      i = .data$groups, val = index,
       drop = TRUE
     )
 

R/utils-replace-with.R

@@ -31,8 +31,11 @@ check_length_val <- function(length_x, n, header, reason = NULL, .abort = abort)
     return()
   }
 
-  if (is.null(reason)) reason <- ""
-  else reason <- glue(" ({reason})")
+  if (is.null(reason)) {
+    reason <- ""
+  } else {
+    reason <- glue(" ({reason})")
+  }
 
   if (n == 1) {
     glubort(header, "must be length 1{reason}, not {commas(length_x)}", .abort = .abort)

R/utils.r

@@ -77,8 +77,9 @@ succeeds <- function(x, quiet = FALSE) {
       TRUE
     },
     error = function(e) {
-      if (!quiet)
+      if (!quiet) {
         inform(paste0("Error: ", e$message))
+      }
       FALSE
     }
   )

R/zzz.r

@@ -12,9 +12,11 @@
 .onAttach <- function(libname, pkgname) {
   setHook(packageEvent("plyr", "attach"), function(...) {
     packageStartupMessage(rule())
-    packageStartupMessage("You have loaded plyr after dplyr - this is likely ",
+    packageStartupMessage(
+      "You have loaded plyr after dplyr - this is likely ",
       "to cause problems.\nIf you need functions from both plyr and dplyr, ",
-      "please load plyr first, then dplyr:\nlibrary(plyr); library(dplyr)")
+      "please load plyr first, then dplyr:\nlibrary(plyr); library(dplyr)"
+    )
     packageStartupMessage(rule())
   })
 }

data-raw/storms.R

@@ -21,10 +21,12 @@ headers_df <- headers %>%
   select(name, skip, n_obs)
 
 # Read in the sub-datasets as data frames
-df_names <- c("date", "time", "record_type", "status", "lat", "long", "wind", "pressure",
-  "extent_34_NE",  "extent_34_SE",  "extent_34_SW",  "extent_34_NW",
-  "extent_50_NE",  "extent_50_SE",  "extent_50_SW",  "extent_50_NW",
-  "extent_64_NE",  "extent_64_SE",  "extent_64_SW",  "extent_64_NW", "nas")
+df_names <- c(
+  "date", "time", "record_type", "status", "lat", "long", "wind", "pressure",
+  "extent_34_NE", "extent_34_SE", "extent_34_SW", "extent_34_NW",
+  "extent_50_NE", "extent_50_SE", "extent_50_SW", "extent_50_NW",
+  "extent_64_NE", "extent_64_SE", "extent_64_SW", "extent_64_NW", "nas"
+)
 
 storm_dfs <- vector("list", nrow(headers_df))
 names(storm_dfs) <- headers_df$name
@@ -50,7 +52,8 @@ for (i in seq_along(headers_df$name)) {
       extent_64_SE = col_integer(),
       extent_64_SW = col_integer(),
       extent_64_NW = col_integer()
-  ))
+    )
+  )
 }
 
 # Combine and clean the data sets
@@ -64,23 +67,26 @@ storms <- storm_dfs %>%
     month = month(date),
     day = day(date),
     hour = as.numeric(str_sub(time, 1, 2)),
-    lat_hemisphere =  str_sub(lat, -1),
+    lat_hemisphere = str_sub(lat, -1),
     lat_sign = if_else(lat_hemisphere == "N", 1, -1),
     lat = as.numeric(str_sub(lat, 1, -2)) * lat_sign,
-    long_hemisphere =  str_sub(long, -1),
+    long_hemisphere = str_sub(long, -1),
     long_sign = if_else(long_hemisphere == "E", 1, -1),
     long = as.numeric(str_sub(long, 1, -2)) * long_sign,
-    category = cut(wind, breaks = c(0, 34, 64, 83, 96, 113, 137, 500),
-    labels = c(-1, 0, 1, 2, 3, 4, 5),
-    include.lowest = TRUE, ordered = TRUE),
+    category = cut(wind,
+      breaks = c(0, 34, 64, 83, 96, 113, 137, 500),
+      labels = c(-1, 0, 1, 2, 3, 4, 5),
+      include.lowest = TRUE, ordered = TRUE
+    ),
     # wind = wind * 1.15078, # transforms knots to mph,
     TSradius1 = extent_34_NE + extent_34_SW,
     TSradius2 = extent_34_NW + extent_34_SE,
     ts_diameter = pmax(TSradius1, TSradius2) * 1.15078, # to convert from nautical miles to miles
     HUradius1 = extent_64_NE + extent_64_SW,
     HUradius2 = extent_64_NW + extent_64_SE,
     hu_diameter = pmax(HUradius1, HUradius2) * 1.15078, # to convert from nautical miles to miles
-    status = recode(status, "HU" = "hurricane", "TS" = "tropical storm", "TD" = "tropical depression")) %>%
+    status = recode(status, "HU" = "hurricane", "TS" = "tropical storm", "TD" = "tropical depression")
+  ) %>%
   select(name, year, month, day, hour, lat, long, status, category, wind, pressure, ts_diameter, hu_diameter)
 
 # Narrow to storms that have complete pressure record
@@ -93,7 +99,8 @@ completeish <- storms %>%
 storms <- storms %>%
   filter(
     status %in% c("hurricane", "tropical storm", "tropical depression"),
-    name %in% completeish) %>%
+    name %in% completeish
+  ) %>%
   mutate(name = if_else(str_sub(name, 1, 3) %in% c("AL0", "AL1"), name, str_to_title(name)))
 
 devtools::use_data(storms)

tests/testthat/test-arrange.r

@@ -41,9 +41,9 @@ test_that("local arrange sorts missing values to end", {
 test_that("two arranges equivalent to one", {
   df <- tribble(
     ~ x,  ~ y,
-    2,  1,
-    2,  -1,
-    1,  1
+    2,      1,
+    2,     -1,
+    1,      1
   )
 
   df1 <- df %>% arrange(x, y)
@@ -103,7 +103,6 @@ test_that("arrange handles complex vectors", {
 
   res <- arrange(d, desc(y))
   expect_true(all(is.na(res$y[9:10])))
-
 })
 
 test_that("arrange respects attributes #1105", {
@@ -131,7 +130,6 @@ test_that("arrange respects locale (#1280)", {
 
   res <- df2 %>% arrange(desc(words))
   expect_equal(res$words, sort(df2$words, decreasing = TRUE))
-
 })
 
 test_that("duplicated column name is explicit about which column (#996)", {

tests/testthat/test-binds.R

@@ -38,7 +38,8 @@ test_that("cbind uses shallow copies", {
     int = 1:10,
     num = rnorm(10),
     cha = letters[1:10],
-    stringsAsFactors = FALSE)
+    stringsAsFactors = FALSE
+  )
   df2 <- data.frame(
     log = sample(c(T, F), 10, replace = TRUE),
     dat = seq.Date(Sys.Date(), length.out = 10, by = "day"),
@@ -266,15 +267,19 @@ test_that("bind_rows preserves timezones #298", {
     ID = c("a", "b", "c"),
     dates = structure(c(-247320000, -246196800, -245073600),
       tzone = "GMT",
-      class = c("POSIXct", "POSIXt")),
-    stringsAsFactors = FALSE)
+      class = c("POSIXct", "POSIXt")
+    ),
+    stringsAsFactors = FALSE
+  )
 
   dates2 <- data.frame(
     ID = c("d", "e", "f"),
     dates = structure(c(-243864000, -242654400, -241444800),
       tzone = "GMT",
-      class = c("POSIXct", "POSIXt")),
-    stringsAsFactors = FALSE)
+      class = c("POSIXct", "POSIXt")
+    ),
+    stringsAsFactors = FALSE
+  )
 
   alldates <- bind_rows(dates1, dates2)
   expect_equal(attr(alldates$dates, "tzone"), "GMT")
@@ -296,7 +301,6 @@ test_that("bind_rows handles all NA columns (#493)", {
   res <- bind_rows(mydata)
   expect_true(is.na(res$x[1]))
   expect_is(res$x, "factor")
-
 })
 
 test_that("bind_rows handles complex. #933", {
@@ -384,7 +388,6 @@ test_that("bind handles POSIXct of different tz ", {
 
   res <- bind_rows(df1, df2, df3)
   expect_equal(attr(res$date, "tzone"), "UTC")
-
 })
 
 test_that("bind_rows() creates a column of identifiers (#1337)", {
@@ -563,7 +566,8 @@ test_that("bind_rows() handles rowwise vectors", {
       tibble(a = "foo", b = "bar"),
       c(a = "A", b = "B"),
       set_names(factor(c("B", "B")), c("a", "b"))
-    ))
+    )
+  )
   expect_identical(tbl, tibble(a = c("foo", "A", "B"), b = c("bar", "B", "B")))
 
   id_tbl <- bind_rows(a = c(a = 1, b = 2), b = c(a = 3, b = 4), .id = "id")