eke out small gains with optimized conditionals, subsetting, and loops

R/class_builder.R

@@ -397,10 +397,10 @@ builder_ensure_workspace <- function(target, pipeline, scheduler, meta) {
 
 builder_should_save_workspace <- function(target) {
   names <- c(target_get_name(target), target_get_parent(target))
-  because_named <- any(names %in% tar_options$get_workspaces())
-  has_error <- metrics_has_error(target$metrics)
-  if_error <- tar_options$get_workspace_on_error() ||
-    identical(target$settings$error, "workspace")
+  because_named <- any(names %in% .subset2(tar_options, "workspaces"))
+  has_error <- metrics_has_error(.subset2(target, "metrics"))
+  if_error <- .subset2(tar_options, "get_workspace_on_error")() ||
+    identical(.subset2(.subset2(target, "settings"), "error"), "workspace")
   because_error <- if_error && has_error
   because_named || because_error
 }

R/class_counter.R

@@ -80,9 +80,10 @@ counter_set_names <- function(counter, names) {
 }
 
 counter_del_name <- function(counter, name) {
-  if (counter_exists_name(counter, name)) {
-    remove(list = name, envir = counter$envir)
-    counter$count <- counter$count - 1L
+  envir <- .subset2(counter, "envir")
+  if (!is.null(.subset2(envir, name))) {
+    remove(list = name, envir = envir)
+    counter$count <- .subset2(counter, "count") - 1L
   }
 }
 

R/class_database.R

@@ -183,13 +183,15 @@ database_class <- R6::R6Class(
       if (fill_missing) {
         row <- select_cols(row)
       }
-      line <- produce_line(row)
-      buffer[[.subset2(row, "name")]] <- line
+      sublines <- produce_sublines(row)
+      buffer[[.subset2(row, "name")]] <- sublines
       self$buffer_length <- buffer_length + 1L
     },
     flush_rows = function() {
-      if (buffer_length) {
-        append_lines(as.character(as.list(buffer)))
+      if (buffer_length > 0L) {
+        lines_list <- eapply(buffer, paste, collapse = database_sep_outer)
+        lines <- as.character(lines_list)
+        append_lines(lines)
         self$buffer <- new.env(parent = emptyenv(), hash = FALSE)
         self$buffer_length <- 0L
         self$staged <- TRUE
@@ -255,7 +257,7 @@ database_class <- R6::R6Class(
       )
       file_move(from = tmp, to = self$path)
     },
-    produce_line = function(row) {
+    produce_sublines = function(row) {
       old <- options(OutDec = ".")
       on.exit(options(old))
       index <- 1L
@@ -265,6 +267,10 @@ database_class <- R6::R6Class(
         sublines[index] <- produce_subline(.subset2(row, index))
         index <- index + 1L
       }
+      sublines
+    },
+    produce_line = function(row) {
+      sublines <- produce_sublines(row)
       paste(sublines, collapse = database_sep_outer)
     },
     produce_subline = function(element) {

R/class_file.R

@@ -79,11 +79,22 @@ file_update_hash <- function(file) {
 }
 
 file_should_rehash <- function(file, time, size, trust_timestamps) {
-  if_any(
-    .subset2(tar_options, "trust_timestamps") %|||% trust_timestamps,
-    !identical(time, file$time) || !identical(size, file$size),
-    TRUE
-  )
+  trust <- .subset2(tar_options, "trust_timestamps")
+  if (is.null(trust)) {
+    trust <- trust_timestamps
+  }
+  if (trust) {
+    file_time <- .subset2(file, "time")
+    file_size <- .subset2(file, "size")
+    if (anyNA(file_time) || anyNA(file_size)) {
+      out <- TRUE
+    } else {
+      out <- (time != file_time) || (size != file_size)
+    }
+  } else {
+    out <- TRUE
+  }
+  out
 }
 
 file_repopulate <- function(file, path, data) {
@@ -111,7 +122,7 @@ file_ensure_hash <- function(file) {
 }
 
 file_has_correct_hash <- function(file) {
-  files <- file_list_files(file$path)
+  files <- file_list_files(.subset2(file, "path"))
   info <- file_info_runtime(files)
   time <- file_time(info)
   bytes <- file_bytes(info)
@@ -120,9 +131,19 @@ file_has_correct_hash <- function(file) {
     file = file,
     time = time,
     size = size,
-    trust_timestamps = all(info$trust_timestamps)
+    trust_timestamps = all(.subset2(info, "trust_timestamps"))
   )
-  if_any(do, identical(file$hash, file_hash(files)), TRUE)
+  if (do) {
+    file_hash <- .subset2(file, "hash")
+    if (anyNA(file_hash)) {
+      out <- FALSE
+    } else {
+      out <- file_hash == file_hash(files)
+    }
+  } else {
+    out <- TRUE
+  }
+  out
 }
 
 file_validate_path <- function(path) {

R/class_metrics.R

@@ -21,7 +21,7 @@ metrics_has_warnings <- function(metrics) {
 }
 
 metrics_has_error <- function(metrics) {
-  !is.null(metrics$error)
+  !is.null(.subset2(metrics, "error"))
 }
 
 metrics_has_cancel <- function(metrics) {

tests/testthat/test-class_database.R

@@ -398,10 +398,10 @@ tar_test("database buffer", {
   expect_false(file.exists(db$path))
   db$flush_rows()
   lines <- readLines(db$path)
-  expect_equal(lines, c("x", "y"))
+  expect_equal(sort(lines), sort(c("x", "y")))
   db$flush_rows()
   lines <- readLines(db$path)
-  expect_equal(lines, c("x", "y"))
+  expect_equal(sort(lines), sort(c("x", "y")))
 })
 
 tar_test("compare_working_directories()", {