Coding style upkeep

.lintr.R

@@ -1,16 +1,15 @@
 linters = all_linters(
   packages = "lintr",
+  implicit_assignment_linter(allow_lazy=TRUE, allow_scoped=TRUE),
   implicit_integer_linter(allow_colon=TRUE),
-  semicolon_linter(allow_compound = TRUE),
+  semicolon_linter(allow_compound=TRUE),
   assignment_linter = NULL,
   brace_linter = NULL,
   commas_linter = NULL,
   commented_code_linter = NULL,
   condition_call_linter = NULL,
   cyclocomp_linter = NULL,
   function_argument_linter = NULL,
-  function_left_parentheses_linter = NULL,
-  implicit_assignment_linter = NULL,
   indentation_linter = NULL,
   infix_spaces_linter = NULL,
   library_call_linter = NULL,
@@ -19,8 +18,6 @@ linters = all_linters(
   object_name_linter = NULL,
   paren_body_linter = NULL,
   quotes_linter = NULL,
-  spaces_inside_linter = NULL,
-  spaces_left_parentheses_linter = NULL,
   todo_comment_linter = NULL,
   undesirable_function_linter = NULL,
   undesirable_operator_linter = NULL

R/cache.R

@@ -355,7 +355,7 @@ is.sorted.integer64 <- function(x, ...){
 #' @export
 nunique.integer64 <- function(x, ...){
     env <- cache(x)
-    if(is.null(env))
+    if (is.null(env))
         has.cache <- FALSE
     else if (exists("nunique", envir=env, inherits=FALSE))
         return(get("nunique", envir=env, inherits=FALSE))

R/highlevel64.R

@@ -176,15 +176,15 @@ benchmark64 <- function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time)
   })[3L]
   message('OK, for some of these values I want to see the complete ROW, so I need their positions in the data.frame')
   tim1[i] <- tim1[i] + timefun({
-   if(i==1L)order(b) else order.integer64(b)
+   if (i==1L) order(b) else order.integer64(b)
   })[3L]
   message('check if any values are duplicated')
   tim1[i] <- tim1[i] + timefun({
    anyDuplicated(b)
   })[3L]
   message('since not unique, then check distribution of frequencies')
   tim1[i] <- tim1[i] + timefun({
-   if(i==1L)tabulate(table(b, exclude=NULL)) else tabulate(table.integer64(b, return='list')$counts)
+   if (i==1L) tabulate(table(b, exclude=NULL)) else tabulate(table.integer64(b, return='list')$counts)
   })[3L]
   message("OK, let's plot the percentiles of unique values versus the percentiles allowing for duplicates")
   tim1[i] <- tim1[i] + timefun({
@@ -193,29 +193,29 @@ benchmark64 <- function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time)
   })[3L]
   message('check whether we find a match for each fact in the dimension table')
   tim1[i] <- tim1[i] + timefun({
-   all(if(i==1L) b %in% s else "%in%.integer64"(b, s))
+   all(if (i==1L) b %in% s else "%in%.integer64"(b, s))
   })[3L]
   message('check whether there are any dimension table entries not in the fact table')
   tim1[i] <- tim1[i] + timefun({
-   all(if(i==1L) s %in% b else "%in%.integer64"(s, b))
+   all(if (i==1L) s %in% b else "%in%.integer64"(s, b))
   })[3L]
   message('check whether we find a match for each fact in a parallel fact table')
   tim1[i] <- tim1[i] + timefun({
-   all(if(i==1L) b %in% b2 else "%in%.integer64"(b, b2))
+   all(if (i==1L) b %in% b2 else "%in%.integer64"(b, b2))
   })[3L]
   message('find positions of facts in dimension table for joining')
   tim1[i] <- tim1[i] + timefun({
-   if(i==1L) match(b, s) else match.integer64(b, s)
+   if (i==1L) match(b, s) else match.integer64(b, s)
   })[3L]
   message('find positions of facts in parallel fact table for joining')
   tim1[i] <- tim1[i] + timefun({
-   if(i==1L) match(b, b2) else match.integer64(b, b2)
+   if (i==1L) match(b, b2) else match.integer64(b, b2)
   })[3L]
   message('out of curiosity: how well rank-correlated are fact and parallel fact table?')
   tim1[i] <- tim1[i] + timefun({
-   if (i==1L){
+   if (i==1L) {
     cor(rank(b, na.last="keep"), rank(b2, na.last="keep"), use="na.or.complete")
-   }else{
+   } else {
     cor(rank.integer64(b), rank.integer64(b2), use="na.or.complete")
    }
   })[3L]
@@ -307,7 +307,7 @@ benchmark64 <- function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time)
 
   message(colnames(tim2)[i], " table(b)")
   tim2["table(b)",i] <- timefun({
-   if(i==1L) table(b) else table.integer64(b, return='list')
+   if (i==1L) table(b) else table.integer64(b, return='list')
   })[3L]
 
   message(colnames(tim2)[i], " sort(b)")
@@ -317,12 +317,12 @@ benchmark64 <- function(nsmall=2L^16L, nbig=2L^25L, timefun=repeat.time)
 
   message(colnames(tim2)[i], " order(b)")
   tim2["order(b)",i] <- timefun({
-   if(i==1L) order(b) else order.integer64(b)
+   if (i==1L) order(b) else order.integer64(b)
   })[3L]
 
   message(colnames(tim2)[i], " rank(b)")
   tim2["rank(b)",i] <- timefun({
-   if(i==1L) rank(b) else rank.integer64(b)
+   if (i==1L) rank(b) else rank.integer64(b)
   })[3L]
 
   message(colnames(tim2)[i], " quantile(b)")
@@ -2510,15 +2510,10 @@ rank.integer64 <- function(x
 prank <- function(x, ...) UseMethod("prank")
 #' @rdname prank
 #' @export
-prank.integer64 <- function(x
-, method = NULL
-, ...
-)
-{
-    n <- nvalid(x)
-    if (n<2L)
-        return(rep(as.integer64(NA), length(x)))
-    (rank.integer64(x, method=method, ...)-1L)/(n-1L)
+prank.integer64 <- function(x, method = NULL, ...) {
+  n <- nvalid(x)
+  if (n<2L) return(rep(as.integer64(NA), length(x)))
+  (rank.integer64(x, method=method, ...)-1L) / (n-1L)
 }
 
 #' (Q)uan(Tile)s
@@ -2680,7 +2675,7 @@ mean.integer64 <- function(x, na.rm=FALSE, ...) {
 #' @rdname qtile
 #' @param object a integer64 vector
 #' @export
-summary.integer64 <- function (object, ...) {
+summary.integer64 <- function(object, ...) {
     nas <- na.count(object)
     qq <- quantile(object, na.rm=TRUE)
     qq <- c(qq[1L:3L], mean(object, na.rm=TRUE), qq[4L:5L])

R/integer64.R

@@ -441,17 +441,13 @@ setOldClass("integer64")
 #' @rdname all.equal.integer64
 #' @method all.equal integer64
 #' @exportS3Method all.equal integer64
-all.equal.integer64  <- function (
-  target
-, current
-, tolerance = sqrt(.Machine$double.eps)
-, scale = NULL
-, countEQ = FALSE
-, formatFUN = function(err, what) format(err)
-, ...
-, check.attributes = TRUE
-)
-{
+all.equal.integer64  <- function(target, current,
+                                 tolerance = sqrt(.Machine$double.eps),
+                                 scale = NULL,
+                                 countEQ = FALSE,
+                                 formatFUN = function(err, what) format(err),
+                                 ...,
+                                 check.attributes = TRUE) {
   if (!is.numeric(tolerance))
     stop("'tolerance' should be numeric")
   if (!is.numeric(scale) && !is.null(scale))
@@ -512,7 +508,7 @@ all.equal.integer64  <- function (
     keep <- which(!out)
     target  <- target [keep]
     current <- current[keep]
-    if(!is.null(scale) && length(scale) > 1L) {
+    if (!is.null(scale) && length(scale) > 1L) {
       # TODO(R>=4.0.0): Try removing this ocl part when rep() dispatching WAI on all versions (#100)
       ocl = class(scale)
       scale = rep_len(scale, length(out))[keep]
@@ -535,7 +531,7 @@ all.equal.integer64  <- function (
     else
       "scaled"
   }
-  xy <- sum(abs(target - current)/(N*scale))
+  xy <- sum(abs(target - current) / (N*scale))
   if (is.na(xy) || xy > tolerance)
     msg <- c(msg, paste("Mean", what, "difference:", formatFUN(xy, what)))
   if (is.null(msg)) {
@@ -569,37 +565,27 @@ identical(x=x, y=y
 
 #' @rdname as.integer64.character
 #' @export
-as.integer64 <- function (x, ...)
-UseMethod("as.integer64")
+as.integer64 <- function(x, ...) UseMethod("as.integer64")
 
 #' @rdname as.character.integer64
 #' @export
-as.bitstring <- function(x, ...)
-UseMethod("as.bitstring")
+as.bitstring <- function(x, ...) UseMethod("as.bitstring")
 
 #' @rdname plusclass
 #' @export
 minusclass <- function(class, whichclass){
-  if (length(class)){
-      i <- whichclass==class
-      if (any(i))
-        class[!i]
-      else
-        class
-  }else
+  if (!length(class)) return(class)
+  i <- whichclass == class
+  if (any(i))
+    class[!i]
+  else
     class
 }
 
 #' @export
-plusclass <- function(class, whichclass){
-  if (length(class)){
-      i <- whichclass==class
-      if (any(i))
-        class
-      else
-        c(class, whichclass)
-  }else
-    whichclass
+plusclass <- function(class, whichclass) {
+  if (!length(class)) return(whichclass)
+  c(class, if (!any(whichclass == class)) whichclass)
 }
 
 # Version of Leonardo Silvestri
@@ -696,7 +682,7 @@ is.integer64 <- function(x) inherits(x, "integer64")
 
 #' @rdname as.integer64.character
 #' @export
-as.integer64.NULL <- function (x, ...){
+as.integer64.NULL <- function(x, ...) {
   ret <- double()
   oldClass(ret) <- "integer64"
   ret
@@ -857,18 +843,23 @@ print.integer64 <- function(x, quote=FALSE, ...) {
 #' @param object an integer64 vector
 #' @param vec.len,give.head,give.length see [utils::str()]
 #' @export
-str.integer64 <- function(object
-, vec.len  = strO$vec.len
-, give.head = TRUE
-, give.length = give.head
-, ...
-){
+str.integer64 <- function(object,
+                          vec.len  = strO$vec.len,
+                          give.head = TRUE,
+                          give.length = give.head,
+                          ...) {
   strO <- strOptions()
   vec.len <- 2L*vec.len
   n <- length(object)
-  if (n>vec.len)
+  if (n > vec.len)
     object <- object[seq_len(vec.len)]
-  cat(if (give.head)paste0("integer64 ", if (give.length && n>1L) paste0("[1:",n,"] ")), paste(as.character(object), collapse=" "),if(n>vec.len)" ...", " \n", sep="")
+  cat(
+    if (give.head) paste0("integer64 ", if (give.length && n>1L) paste0("[1:", n, "] ")),
+    paste(as.character(object), collapse=" "),
+    if (n > vec.len) " ...",
+    " \n",
+    sep=""
+  )
   invisible()
 }
 
@@ -963,26 +954,23 @@ str.integer64 <- function(object
 
 #' @rdname c.integer64
 #' @export
-c.integer64 <-
-function (..., recursive = FALSE)
-{
-    l <- list(...)
-    K <- length(l)
-    for (k in 1:K){
-        if (recursive && is.list(l[[k]])){
-            l[[k]] <- do.call(c.integer64, c(l[[k]], list(recursive = TRUE)))
-        }else{
-            if (!is.integer64(l[[k]])) {
-                nam <- names(l[[k]])
-                l[[k]] <- as.integer64(l[[k]])
-                names(l[[k]]) <- nam
-            }
-            oldClass(l[[k]]) <- NULL
-        }
+c.integer64 <- function(..., recursive = FALSE) {
+  l <- list(...)
+  for (k in seq_along(l)) {
+    if (recursive && is.list(l[[k]])) {
+      l[[k]] <- do.call(c.integer64, c(l[[k]], list(recursive = TRUE)))
+    } else {
+      if (!is.integer64(l[[k]])) {
+        nam <- names(l[[k]])
+        l[[k]] <- as.integer64(l[[k]])
+        names(l[[k]]) <- nam
+      }
+      oldClass(l[[k]]) <- NULL
     }
-    ret <- do.call(c, l)
-    oldClass(ret) <- "integer64"
-    ret
+  }
+  ret <- do.call(c, l)
+  oldClass(ret) <- "integer64"
+  ret
 }
 
 #' @rdname c.integer64
@@ -1068,14 +1056,14 @@ seq.integer64 <- function(from=NULL, to=NULL, by=NULL, length.out=NULL, along.wi
     else
       length.out <- as.integer(length.out)
 
-    if (is.null(by)){
+    if (is.null(by)) {
       if (is.null(from) || is.null(to))
         by <- as.integer64(1L)
       else
         by <- as.integer64(if (to < from) -1L else 1L)
-    }else{
+    } else {
       by <- as.integer64(by)
-      if ((!is.null(from)) && (!is.null(to)) && sign(by)!=(if (to < from) -1L else 1L))
+      if (!is.null(from) && !is.null(to) && (sign(by) != (if (to < from) -1L else 1L)))
         stop("wrong sign of 'by' argument")
     }
 
@@ -1289,11 +1277,11 @@ log.integer64 <- function(x, base=NULL){
   l.base <- length(base)
   l <- if (l.x==0L || (!is.null(base) && l.base==0L)) 0L else max(l.base,l.x)
   ret <- double(l)
-  if (is.null(base)){
-      .Call(C_log_integer64, x, ret)
-  }else if(length(base)==1L){
+  if (is.null(base)) {
+    .Call(C_log_integer64, x, ret)
+  } else if (length(base)==1L) {
     .Call(C_logbase_integer64, x, as.double(base), ret)
-  }else{
+  } else {
     .Call(C_logvect_integer64, x, as.double(base), ret)
   }
   a$class <- minusclass(a$class, "integer64")
@@ -1532,17 +1520,17 @@ diff.integer64 <- function(x, lag=1L, differences=1L, ...){
   lag <- as.integer(lag)
   n <- length(x)
   d <- differences <- as.integer(differences)
-  while(d > 0L){
+  while (d > 0L) {
     n <- n - lag
-    if (n <= 0L){
+    if (n <= 0L) {
       ret <- double()
       break
     }
     # not assigning ret<-.Call in the following is intended because faster
-    if (d==differences){
+    if (d==differences) {
       ret <- double(n)
       .Call(C_diff_integer64, x, as.integer64(lag), as.integer64(n), ret)
-    }else{
+    } else {
       .Call(C_diff_integer64, ret, as.integer64(lag), as.integer64(n), ret)
     }
     d <- d - 1L
@@ -1754,18 +1742,13 @@ xor.integer64 <- function(x, y){
 #' @exportS3Method is.vector integer64
 is.vector.integer64 <- function(x, mode="any"){
   cl <- minusclass(oldClass(x), "integer64")
-  a <- attributes(x)
-  a$class <- NULL
-  a$names <- NULL
-  if (is.na(match(mode, c("any","integer64"))) || length(cl) || length(a) )
-    FALSE
-  else
-    TRUE
+  a <- setdiff(names(attributes(x)), c("class", "names"))
+  is.na(match(mode, c("any", "integer64"))) && !length(cl) && !length(a)
 }
 
 #' @rdname as.character.integer64
 #' @export
-as.list.integer64 <- function (x, ...) {
+as.list.integer64 <- function(x, ...) {
   ret <- NextMethod("as.list", x, ...)
   .Call(C_as_list_integer64, ret)
 }