consistently use "=" for assignment

.ci/.lintr.R

@@ -26,7 +26,8 @@ linters = c(dt_linters, all_linters(
   #   setwd = NULL
   # )),
   undesirable_operator_linter(),
-  # TODO(lintr#2441): Use upstream implementation.
+  # TODO(lintr#2765): Use upstream implementation.
+  # assignment_linter(operator = "="),
   assignment_linter = NULL,
   absolute_path_linter = NULL, # too many false positives
   # TODO(lintr#2442): Use this once x[ , j, by] is supported.
@@ -84,7 +85,8 @@ exclusions = c(local({
       infix_spaces_linter = Inf,
       undesirable_function_linter = Inf
     )),
-    exclusion_for_dir(c("vignettes", "vignettes/fr"), list(
+    exclusion_for_dir(c("vignettes", "vignettes/fr", "vignettes/ru"), list(
+      # assignment_linter = Inf,
       implicit_integer_linter = Inf,
       quotes_linter = Inf,
       sample_int_linter = Inf

R/IDateTime.R

@@ -235,15 +235,15 @@ rep.ITime = function(x, ...)
   y
 }
 
-round.ITime <- function(x, digits = c("hours", "minutes"), ...)
+round.ITime = function(x, digits = c("hours", "minutes"), ...)
 {
   (setattr(switch(match.arg(digits),
                   hours = as.integer(round(unclass(x)/3600.0)*3600.0),
                   minutes = as.integer(round(unclass(x)/60.0)*60.0)),
            "class", "ITime"))
 }
 
-trunc.ITime <- function(x, units = c("hours", "minutes"), ...)
+trunc.ITime = function(x, units = c("hours", "minutes"), ...)
 {
   (setattr(switch(match.arg(units),
                   hours = as.integer(unclass(x)%/%3600.0*3600.0),

R/as.data.table.R

@@ -63,7 +63,7 @@ as.data.table.matrix = function(x, keep.rownames=FALSE, key=NULL, ...) {
     for (i in ic) value[[i]] = x[, i]                  # <strike>for efficiency.</strike> For consistency - data.table likes and prefers "character"
   }
   else {
-    for (i in ic) value[[i]] <- as.vector(x[, i])       # to drop any row.names that would otherwise be retained inside every column of the data.table
+    for (i in ic) value[[i]] = as.vector(x[, i])       # to drop any row.names that would otherwise be retained inside every column of the data.table
   }
   col_labels = dimnames(x)[[2L]]
   setDT(value)

R/between.R

@@ -60,7 +60,7 @@ between = function(x, lower, upper, incbounds=TRUE, NAbounds=TRUE, check=FALSE)
     y = eval.parent(ysub)
   }
   if ((l <- length(y)) != 2L) {
-    suggestion <- if (ysub %iscall% 'c') gettextf("Perhaps you meant %s? ", capture.output(print(`[[<-`(ysub, 1L, quote(list))))) else ""
+    suggestion = if (ysub %iscall% 'c') gettextf("Perhaps you meant %s? ", capture.output(print(`[[<-`(ysub, 1L, quote(list))))) else ""
     stopf("RHS has length() %d; expecting length 2. %sThe first element should be the lower bound(s); the second element should be the upper bound(s).", l, suggestion)
   }
   between(x, y[[1L]], y[[2L]], incbounds=TRUE)

R/cedta.R

@@ -28,11 +28,11 @@ cedta.pkgEvalsUserCode = c("gWidgetsWWW","statET","FastRWeb","slidify","rmarkdow
 
 # nocov start: very hard to reach this within our test suite -- the call stack within a call generated by e.g. knitr
 # for loop, not any(vapply_1b(.)), to allow early exit
-.any_eval_calls_in_stack <- function() {
+.any_eval_calls_in_stack = function() {
   calls = sys.calls()
   # likelier to be close to the end of the call stack, right?
   for (ii in length(calls):1) { # nolint: seq_linter. rev(seq_len(length(calls)))? See https://bugs.r-project.org/show_bug.cgi?id=18406.
-    the_call <- calls[[ii]][[1L]]
+    the_call = calls[[ii]][[1L]]
     if (is.name(the_call) && (the_call %chin% c("eval", "evalq"))) return(TRUE)
   }
   FALSE

R/data.table.R

@@ -108,7 +108,7 @@
     # eval(parse()) to avoid "no visible binding for global variable" note from R CMD check
     # names starting with _ don't parse, so no leading _ in the name
   )
-  idx <- regexpr(missing_obj_fmt, err$message, perl=TRUE)
+  idx = regexpr(missing_obj_fmt, err$message, perl=TRUE)
   if (idx > 0L) {
     start = attr(idx, "capture.start", exact=TRUE)[ , "obj_name"]
     used = substr(
@@ -703,7 +703,7 @@
         names(..syms) = ..syms
         j = eval(jsub, lapply(substr(..syms, 3L, nchar(..syms)), get, pos=parent.frame()), parent.frame())
       }
-      if (is.logical(j)) j <- which(j)
+      if (is.logical(j)) j = which(j)
       if (!length(j) && !notj) return( null.data.table() )
       if (is.factor(j)) j = as.character(j)  # fix for FR: #358
       if (is.character(j)) {
@@ -1138,7 +1138,7 @@
           if (!all(named_idx <- nzchar(lhs))) {
             # friendly error for common case: trailing terminal comma
             n_lhs = length(lhs)
-            this_call <- if (root == "let") "let" else "`:=`"
+            this_call = if (root == "let") "let" else "`:=`"
             .check_nested_walrus(jsub, which(!named_idx)+1L, this_call)
             if (!named_idx[n_lhs] && all(named_idx[-n_lhs])) {
               stopf("In %s(col1=val1, col2=val2, ...) form, all arguments must be named, but the last argument has no name. Did you forget a trailing comma?", this_call)
@@ -1183,7 +1183,7 @@
         } else {
           # Adding new column(s). TO DO: move after the first eval in case the jsub has an error.
           newnames=setdiff(lhs, names_x)
           m[is.na(m)] = ncol(x)+seq_len(length(newnames))
           cols = as.integer(m)
           # don't pass verbose to selfrefok here -- only activated when
           #   ok=-1 which will trigger setalloccol with verbose in the next
@@ -1288,7 +1288,7 @@
       # warningf(sym," in j is looking for ",getName," in calling scope, but a column '", sym, "' exists. Column names should not start with ..")
     }
     getName = substr(sym, 3L, nchar(sym))
-    getNameVal <- get0(getName, parent.frame())
+    getNameVal = get0(getName, parent.frame())
     if (is.null(getNameVal)) {
       if (exists(sym, parent.frame())) next  # user did 'manual' prefix; i.e. variable in calling scope has .. prefix
       stopf("Variable '%s' is not found in calling scope. Looking in calling scope because this symbol was prefixed with .. in the j= parameter.", getName)
@@ -2166,8 +2166,8 @@
       internal_error("length(X)==%d but a dimension is zero", length(X))  # nocov
     return(array(if (is.null(X)) NA else X, dim = dm, dimnames = list(rownames.value, cn)))
   }
-  dim(X) <- c(n, length(X)/n)
-  dimnames(X) <- list(rownames.value, unlist(collabs, use.names = FALSE))
+  dim(X) = c(n, length(X)/n)
+  dimnames(X) = list(rownames.value, unlist(collabs, use.names = FALSE))
   X
 }
 
@@ -2380,7 +2380,7 @@
       ## Set the key on the returned data.table as long as the key
       ## columns that "remain" are the same as the original, or a
       ## prefix of it.
       is.prefix = all(key(x)[seq_len(length(key.cols))] == key.cols)
       if (is.prefix) {
         setattr(ans, "sorted", key.cols)
       }
@@ -2454,7 +2454,7 @@
     # same as split.data.frame - handling all exceptions, factor orders etc, in a single stream of processing was a nightmare in factor and drop consistency
     # evaluate formula mirroring split.data.frame #5392. Mimics base::.formula2varlist.
     if (inherits(f, "formula"))
-        f <- eval(attr(terms(f), "variables"), x, environment(f))
+        f = eval(attr(terms(f), "variables"), x, environment(f))
     # be sure to use x[ind, , drop = FALSE], not x[ind], in case downstream methods don't follow the same subsetting semantics (#5365)
     return(lapply(split(x = seq_len(nrow(x)), f = f, drop = drop, ...), function(ind) x[ind, , drop = FALSE]))
   }
@@ -2559,7 +2559,7 @@
     ## get correct key if cols are present
     cols = names(x)[cols]
     keylength = which.first(!key(ans) %chin% cols) - 1L
-    if (is.na(keylength)) keylength <- length(key(ans))
+    if (is.na(keylength)) keylength = length(key(ans))
     if (!keylength) {
       setattr(ans, "sorted", NULL) ## no key remaining
     } else {
@@ -2867,7 +2867,7 @@
       stopf("All elements in argument 'x' to 'setDF' must be of same length")
     xn = names(x)
     if (is.null(xn)) {
       setattr(x, "names", paste0("V",seq_len(length(x))))
     } else {
       idx = !nzchar(xn) # NB: keepNA=FALSE intentional
       if (any(idx)) {
@@ -3086,9 +3086,9 @@
   if (missing(w)) gmean(x, na.rm)
   else {
     if (na.rm) { # take those indices out of the equation by setting them to 0
-      ix <- is.na(x)
-      x[ix] <- 0.0
-      w[ix] <- 0.0
+      ix = is.na(x)
+      x[ix] = 0.0
+      w[ix] = 0.0
     }
     gsum((w!=0.0)*x*w, na.rm=FALSE)/gsum(w, na.rm=FALSE)
   }
@@ -3157,7 +3157,7 @@
 
 # Check for na.rm= in expr in the expected slot; allows partial matching and
 #   is robust to unnamed expr. Note that NA names are not possible here.
-.arg_is_narm <- function(expr, which=3L) !is.null(nm <- names(expr)[which]) && startsWith(nm, "na")
+.arg_is_narm = function(expr, which=3L) !is.null(nm <- names(expr)[which]) && startsWith(nm, "na")
 
 .gforce_ok = function(q, x) {
   if (is.N(q)) return(TRUE) # For #334

R/fcast.R

@@ -8,7 +8,7 @@ guess = function(x) {
   var
 }
 
-dcast <- function(
+dcast = function(
   data, formula, fun.aggregate = NULL, ..., margins = NULL,
   subset = NULL, fill = NULL, value.var = guess(data)
 ) {
@@ -115,7 +115,7 @@ aggregate_funs = function(funs, vals, sep="_", ...) {
     if (is.null(nm) || !nzchar(nm)) {
       nm = all.names(funs[[i]], max.names=1L, functions=TRUE)
     }
-    if (!length(nm)) nm <- paste0("fun", i)
+    if (!length(nm)) nm = paste0("fun", i)
     construct_funs(funs[i], nm, vals[[i]])
   })
   as.call(c(quote(list), unlist(ans)))
@@ -185,7 +185,7 @@ dcast.data.table = function(data, formula, fun.aggregate = NULL, sep = "_", ...,
     fun.call = aggregate_funs(fun.call, lvals, sep, ...)
     maybe_err = function(list.of.columns) {
       if (!all(lengths(list.of.columns) == 1L)) {
-        msg <- gettext("Aggregating functions should take a vector as input and return a single value (length=1), but they do not, so the result is undefined. Please fix by modifying your function so that a single value is always returned.")
+        msg = gettext("Aggregating functions should take a vector as input and return a single value (length=1), but they do not, so the result is undefined. Please fix by modifying your function so that a single value is always returned.")
         if (is.null(fill)) { # TODO change to always stopf #6329
           stop(msg, domain=NA, call. = FALSE)
         } else {

R/fmelt.R

@@ -72,7 +72,7 @@ measurev = function(fun.list, sep="_", pattern, cols, multiple.keyword="value.na
   if (!is.character(cols)) {
     stopf("cols must be a character vector of column names")
   }
-  prob.i <- if (is.null(names(fun.list))) {
+  prob.i = if (is.null(names(fun.list))) {
     seq_along(fun.list)
   } else {
     which(!nzchar(names(fun.list)))
@@ -101,7 +101,7 @@ measurev = function(fun.list, sep="_", pattern, cols, multiple.keyword="value.na
       stopf("number of elements of fun.list (%d) must be the same as the number of capture groups in pattern (%d)", length(fun.list), ncol(start))
     }
     end = attr(match.vec, "capture.length")[measure.vec.i,]+start-1L
-    measure.vec <- cols[measure.vec.i]
+    measure.vec = cols[measure.vec.i]
     names.mat = matrix(measure.vec, nrow(start), ncol(start))
     substr(names.mat, start, end)
   } else { #pattern not specified, so split using sep.

R/fread.R

@@ -317,9 +317,9 @@ yaml=FALSE, autostart=NULL, tmpdir=tempdir(), tz="UTC")
       warning = fun <- function(c) {
         # NB: branch here for translation purposes (e.g. if error/warning have different grammatical gender)
         if (inherits(c, "warning")) {
-          msg_fmt <- gettext("Column '%s' was requested to be '%s' but fread encountered the following warning:\n\t%s\nso the column has been left as type '%s'")
+          msg_fmt = gettext("Column '%s' was requested to be '%s' but fread encountered the following warning:\n\t%s\nso the column has been left as type '%s'")
         } else {
-          msg_fmt <- gettext("Column '%s' was requested to be '%s' but fread encountered the following error:\n\t%s\nso the column has been left as type '%s'")
+          msg_fmt = gettext("Column '%s' was requested to be '%s' but fread encountered the following error:\n\t%s\nso the column has been left as type '%s'")
         }
         warningf(msg_fmt, names(ans)[j], new_class, conditionMessage(c), typeof(v), domain=NA)
         v

R/fwrite.R

@@ -80,7 +80,7 @@ fwrite = function(x, file="", append=FALSE, quote="auto",
   }
   if (NCOL(x)==0L && file!="") {
     if (file.exists(file)) {
-      suggested <- if (append) "" else gettextf("\nIf you intended to overwrite the file at %s with an empty one, please use file.remove first.", file)
+      suggested = if (append) "" else gettextf("\nIf you intended to overwrite the file at %s with an empty one, please use file.remove first.", file)
       warningf("Input has no columns; doing nothing.%s", suggested)
       return(invisible())
     } else {

R/groupingsets.R

@@ -129,13 +129,13 @@ groupingsets.data.table = function(x, j, by, sets, .SDcols, id = FALSE, jj, labe
       by.vars.not.in.label = setdiff(by, names(label))
       by.vars.not.in.label.class1 = classes1(x, use.names=TRUE)[by.vars.not.in.label]
       labels.by.vars.not.in.label = label[by.vars.not.in.label.class1[by.vars.not.in.label.class1 %in% label.names.not.in.by]]
-      names(labels.by.vars.not.in.label) <- by.vars.not.in.label[by.vars.not.in.label.class1 %in% label.names.not.in.by]
+      names(labels.by.vars.not.in.label) = by.vars.not.in.label[by.vars.not.in.label.class1 %in% label.names.not.in.by]
       label.expanded = c(label[label.names.in.by], labels.by.vars.not.in.label)
       label.expanded = label.expanded[intersect(by, names(label.expanded))] # reorder
     } else {
       by.vars.matching.scalar.class1 = by[classes1(x, use.names=TRUE)[by] == class1(label)]
       label.expanded = as.list(rep(label, length(by.vars.matching.scalar.class1)))
-      names(label.expanded) <- by.vars.matching.scalar.class1
+      names(label.expanded) = by.vars.matching.scalar.class1
     }
     label.use = label.expanded[intersect(total.vars, names(label.expanded))]
     if (any(idx <- vapply_1b(names(label.expanded), function(u) label.expanded[[u]] %in% x[[u]]))) {

R/print.data.table.R

@@ -66,8 +66,8 @@ print.data.table = function(x, topn=getOption("datatable.print.topn"),
     if (is.null(indices(x))) {
       show.indices = FALSE
     } else {
-      index_dt <- as.data.table(attributes(attr(x, 'index')))
-      print_names <- paste0("index", if (ncol(index_dt) > 1L) seq_len(ncol(index_dt)) else "", ":", sub("^__", "", names(index_dt)))
+      index_dt = as.data.table(attributes(attr(x, 'index')))
+      print_names = paste0("index", if (ncol(index_dt) > 1L) seq_len(ncol(index_dt)) else "", ":", sub("^__", "", names(index_dt)))
       setnames(index_dt, print_names)
     }
   }
@@ -121,7 +121,7 @@ print.data.table = function(x, topn=getOption("datatable.print.topn"),
     # When nrow(toprint) = 1, attributes get lost in the subset,
     #   function below adds those back when necessary
     toprint = toprint_subset(toprint, cols_to_print)
-    trunc.cols <- length(not_printed) > 0L
+    trunc.cols = length(not_printed) > 0L
   }
   print_default = function(x) {
     if (col.names != "none") cut_colnames = identity
@@ -289,7 +289,7 @@ trunc_cols_message = function(not_printed, abbs, class, col.names){
 }
 
 # Maybe add a method for repr::repr_text.  See https://github.com/Rdatatable/data.table/issues/933#issuecomment-220237965
-knit_print.data.table <- function(x, ...) {
+knit_print.data.table = function(x, ...) {
   if (!shouldPrint(x)) return(invisible(x))
   NextMethod()
 }

R/test.data.table.R

@@ -413,19 +413,19 @@ test = function(num,x,y=TRUE,error=NULL,warning=NULL,message=NULL,output=NULL,no
   actual = list2env(list(warning=NULL, error=NULL, message=NULL))
   wHandler = function(w) {
     # Thanks to: https://stackoverflow.com/a/4947528/403310
-    actual$warning <- c(actual$warning, conditionMessage(w))
+    actual$warning = c(actual$warning, conditionMessage(w))
     invokeRestart("muffleWarning")
   }
   eHandler = function(e) {
-    actual$error <- conditionMessage(e)
+    actual$error = conditionMessage(e)
     e
   }
   mHandler = function(m) {
-    actual$message <- c(actual$message, conditionMessage(m))
+    actual$message = c(actual$message, conditionMessage(m))
     m
   }
   if (!is.null(options)) {
-    old_options <- do.call(base::options, as.list(options)) # as.list(): allow passing named character vector for convenience
+    old_options = do.call(base::options, as.list(options)) # as.list(): allow passing named character vector for convenience
     on.exit(base::options(old_options), add=TRUE)
   }
   if (is.null(output) && is.null(notOutput)) {
@@ -439,7 +439,7 @@ test = function(num,x,y=TRUE,error=NULL,warning=NULL,message=NULL,output=NULL,no
     # some of the options passed to test() may break internal data.table use below (e.g. invalid datatable.alloccol), so undo them ASAP
     base::options(old_options)
     # this is still registered for on.exit(), keep empty
-    old_options <- list()
+    old_options = list()
   }
   fail = FALSE
   if (.test.data.table && num>0.0) {
@@ -527,8 +527,8 @@ test = function(num,x,y=TRUE,error=NULL,warning=NULL,message=NULL,output=NULL,no
         xc=copy(x)
         yc=copy(y)  # so we don't affect the original data which may be used in the next test
         # drop unused levels in factors
-        if (length(x)) for (i in which(vapply_1b(x,is.factor))) {.xi=x[[i]];xc[[i]]<-factor(.xi)}
-        if (length(y)) for (i in which(vapply_1b(y,is.factor))) {.yi=y[[i]];yc[[i]]<-factor(.yi)}
+        if (length(x)) for (i in which(vapply_1b(x,is.factor))) {.xi = x[[i]]; xc[[i]] = factor(.xi)}
+        if (length(y)) for (i in which(vapply_1b(y,is.factor))) {.yi = y[[i]]; yc[[i]] = factor(.yi)}
         if (is.data.table(xc)) setattr(xc,"row.names",NULL)  # for test 165+, i.e. x may have row names set from inheritance but y won't, consider these equal
         if (is.data.table(yc)) setattr(yc,"row.names",NULL)
         setattr(xc,"index",NULL)   # too onerous to create test RHS with the correct index as well, just check result

R/wrappers.R

@@ -8,8 +8,8 @@ setcoalesce = function(...) .Call(Ccoalesce, list(...), TRUE)
 fifelse = function(test, yes, no, na=NA) .Call(CfifelseR, test, yes, no, na)
 fcase   = function(..., default=NA) {
   # TODO(R>=3.5.0): Use ...length() to avoid the need for suppressWarnings() here
-  default_condition <- suppressWarnings(rep(TRUE, length(switch(1L, ...)))) # better than ..1/..elt(1): won't fail for empty fcase()
-  arg_list <- as.list(substitute(list(..., default_condition, default)))[-1L]
+  default_condition = suppressWarnings(rep(TRUE, length(switch(1L, ...)))) # better than ..1/..elt(1): won't fail for empty fcase()
+  arg_list = as.list(substitute(list(..., default_condition, default)))[-1L]
   .Call(CfcaseR, parent.frame(), arg_list)
 }
 

R/xts.R

@@ -19,11 +19,11 @@ as.data.table.xts = function(x, keep.rownames = TRUE, key=NULL, ...) {
 as.xts.data.table = function(x, numeric.only = TRUE, ...) {
   stopifnot(requireNamespace("xts"), !missing(x), is.data.table(x))
   if (!xts::is.timeBased(x[[1L]])) stopf("data.table must have a time based column in first position, use `setcolorder` function to change the order, or see ?timeBased for supported types")
-  r <- x[, -1L]# exclude first col, xts index
+  r = x[, -1L]# exclude first col, xts index
   if (numeric.only) {
     colsNumeric = vapply_1b(r, is.numeric)
     if (!all(colsNumeric)) warningf("Following columns are not numeric and will be omitted: %s", brackify(names(colsNumeric)[!colsNumeric]))
-    r <- r[, .SD, .SDcols = names(colsNumeric)[colsNumeric]]
+    r = r[, .SD, .SDcols = names(colsNumeric)[colsNumeric]]
   }
   return(xts::xts(as.matrix(r), order.by = if (inherits(x[[1L]], "IDate")) as.Date(x[[1L]]) else x[[1L]]))
 }

tests/autoprint.R

@@ -57,9 +57,9 @@ local({
 })
 
 # child class of data.table doesn't induce unintended print, #3029
-dt <- data.table(x = 1)
-class(dt) <- c("foo", "data.table", "data.frame")
-print.foo <- function(x, ...) {
+dt = data.table(x = 1)
+class(dt) = c("foo", "data.table", "data.frame")
+print.foo = function(x, ...) {
   NextMethod("print")
 }
 dt[, y := 1]                          # no

tests/autoprint.Rout.save

@@ -171,9 +171,9 @@ NULL
 > DT[, `:=`(a, 1)]
 > 
 > # child class of data.table doesn't induce unintended print, #3029
-> dt <- data.table(x = 1)
-> class(dt) <- c("foo", "data.table", "data.frame")
-> print.foo <- function(x, ...) {
+> dt = data.table(x = 1)
+> class(dt) = c("foo", "data.table", "data.frame")
+> print.foo = function(x, ...) {
 +   NextMethod("print")
 + }
 > dt[, y := 1]                          # no