diff --git a/.ci/.lintr.R b/.ci/.lintr.R index 8db90094e4..10adaa0f65 100644 --- a/.ci/.lintr.R +++ b/.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 diff --git a/R/IDateTime.R b/R/IDateTime.R index 7c12beb279..2f37a2b3e9 100644 --- a/R/IDateTime.R +++ b/R/IDateTime.R @@ -235,7 +235,7 @@ 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), @@ -243,7 +243,7 @@ round.ITime <- function(x, digits = c("hours", "minutes"), ...) "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), diff --git a/R/as.data.table.R b/R/as.data.table.R index 09c026aea5..905483495a 100644 --- a/R/as.data.table.R +++ b/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] # for efficiency. 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) diff --git a/R/between.R b/R/between.R index e35459f0db..a339e741c7 100644 --- a/R/between.R +++ b/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) diff --git a/R/cedta.R b/R/cedta.R index fcb24503c9..83d92ec9dd 100644 --- a/R/cedta.R +++ b/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 diff --git a/R/data.table.R b/R/data.table.R index 81ebd014ce..e896112bce 100644 --- a/R/data.table.R +++ b/R/data.table.R @@ -108,7 +108,7 @@ replace_dot_alias = function(e) { # 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 @@ replace_dot_alias = function(e) { 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 @@ replace_dot_alias = function(e) { 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) @@ -1288,7 +1288,7 @@ replace_dot_alias = function(e) { # 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 @@ as.matrix.data.table = function(x, rownames=NULL, rownames.value=NULL, ...) { 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 } @@ -2454,7 +2454,7 @@ split.data.table = function(x, f, drop = FALSE, by, sorted = FALSE, keep.by = TR # 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 @@ copy = function(x) { ## 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 { @@ -3086,9 +3086,9 @@ gweighted.mean = function(x, w, ..., na.rm=FALSE) { 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 @@ is_constantish = function(q, check_singleton=FALSE) { # 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 diff --git a/R/fcast.R b/R/fcast.R index c0dbfd4e3a..4a4235bbc4 100644 --- a/R/fcast.R +++ b/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 { diff --git a/R/fmelt.R b/R/fmelt.R index 7b912196fc..8f279263dd 100644 --- a/R/fmelt.R +++ b/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. diff --git a/R/fread.R b/R/fread.R index 550cc5b5d4..3e8aeb2079 100644 --- a/R/fread.R +++ b/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 diff --git a/R/fwrite.R b/R/fwrite.R index 077f09ac1b..7e7da40c95 100644 --- a/R/fwrite.R +++ b/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 { diff --git a/R/groupingsets.R b/R/groupingsets.R index 9167dc5dff..63e94d1b62 100644 --- a/R/groupingsets.R +++ b/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]]))) { diff --git a/R/print.data.table.R b/R/print.data.table.R index ad99fbaab6..7517a4f128 100644 --- a/R/print.data.table.R +++ b/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() } diff --git a/R/test.data.table.R b/R/test.data.table.R index 670c537adb..f7b05a93f3 100644 --- a/R/test.data.table.R +++ b/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 diff --git a/R/wrappers.R b/R/wrappers.R index f56b4ad8e8..d4ca3fbc15 100644 --- a/R/wrappers.R +++ b/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) } diff --git a/R/xts.R b/R/xts.R index bd4cb75b3c..05db1940d0 100644 --- a/R/xts.R +++ b/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]])) } diff --git a/tests/autoprint.R b/tests/autoprint.R index f6f0433dbe..ad60a2423c 100644 --- a/tests/autoprint.R +++ b/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 diff --git a/tests/autoprint.Rout.save b/tests/autoprint.Rout.save index 4052fbe303..f2f9581a13 100644 --- a/tests/autoprint.Rout.save +++ b/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