Harmonize error messages [#202]

R/000.DEPRECATION.R

@@ -9,7 +9,7 @@ validateScalarCenter <- function(center, n, dimname) {
   ## Nothing to do?
   if (is.null(fcn)) return()
 
-  msg <- sprintf("Argument 'center' should be of the same length as number of %s of 'x'. Use of a scalar value is deprecated: %s != %s", dimname, length(center), n)
+  msg <- sprintf("Argument '%s' should be of the same length as number of %s of '%s'. Use of a scalar value is deprecated: %s != %s", "center", dimname, "x", length(center), n)
   fcn(msg = msg, package = .packageName)
 }
 
@@ -51,7 +51,7 @@ centerOnUse <- function(fcnname, calls = sys.calls(), msg = NULL) {
   fcn <- switch(value, deprecated = .Deprecated, defunct = .Defunct)
 
   if (is.null(msg)) {
-    msg <- sprintf("Argument 'center' of %s::%s() is %s: %s",
+    msg <- sprintf("Argument '%s' of %s::%s() is %s: %s", "center",
                    .packageName, fcnname, value, deparse(calls[[1]])[1])
   }
 

R/benchmark.R

@@ -1,6 +1,6 @@
 benchmark <- function(fcn, tags = NULL, path = NULL, workdir = "reports",
                       envir = parent.frame(), ...) {
-  requireNamespace("R.rsp") || stop("R.rsp not installed")
+  requireNamespace("R.rsp") || stop(sprintf("Package %s is not installed", "R.rsp"))
 
   if (is.function(fcn)) {
     fcn <- deparse(substitute(fcn))

R/binCounts.R

@@ -50,18 +50,18 @@ binCounts <- function(x, idxs = NULL, bx, right = FALSE, ...) {
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Argument 'x':
   if (!is.numeric(x)) {
-    stop(sprintf("Argument 'x' is not numeric: %s", mode(x)))
+    stop(sprintf("Argument '%s' is not numeric: %s", "x", mode(x)))
   }
 
   # Argument 'bx':
   if (!is.numeric(bx)) {
-    stop(sprintf("Argument 'bx' is not numeric: %s", mode(bx)))
+    stop(sprintf("Argument '%s' is not numeric: %s", "bx", mode(bx)))
   }
   if (any(is.infinite(bx))) {
-    stop("Argument 'bx' must not contain Inf values")
+    stop(sprintf("Argument '%s' must not contain Inf values", "bx"))
   }
   if (is.unsorted(bx)) {
-    stop("Argument 'bx' is not ordered")
+    stop(sprintf("Argument '%s' is not ordered", "bx"))
   }
 
   # Apply subset

R/binMeans.R

@@ -59,41 +59,40 @@ binMeans <- function(y, x, idxs = NULL, bx, na.rm = TRUE, count = TRUE,
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Argument 'y':
   if (!is.numeric(y) && !is.logical(y)) {
-    stop(sprintf("Argument 'y' is neither numeric nor logical: %s", mode(y)))
+    stop(sprintf("Argument '%s' is neither numeric nor logical: %s", "y", mode(y)))
   }
   if (is.numeric(y) && !is.integer(y) && any(is.infinite(y))) {
-    stop("Argument 'y' must not contain infinite values")
+    stop(sprintf("Argument '%s' must not contain infinite values", "y"))
   }
   n <- length(y)
 
   # Argument 'x':
   if (!is.numeric(x)) {
-    stop(sprintf("Argument 'x' is not numeric: %s", mode(x)))
+    stop(sprintf("Argument '%s' is not numeric: %s", "x", mode(x)))
   }
   if (length(x) != n) {
-    stop(sprintf("Argument 'y' and 'x' are of different lengths: %.0f != %.0f",
-         length(y), length(x)))
+    stop(sprintf("Argument '%s' and '%s' are of different lengths: %.0f != %.0f", "y", "x", length(y), length(x)))
   }
 
   # Argument 'bx':
   if (!is.numeric(bx)) {
-    stop(sprintf("Argument 'bx' is not numeric: %s", mode(bx)))
+    stop(sprintf("Argument '%s' is not numeric: %s", "bx", mode(bx)))
   }
   if (any(is.infinite(bx))) {
-    stop("Argument 'bx' must not contain Inf values")
+    stop(sprintf("Argument '%s' must not contain Inf values", "bx"))
   }
   if (is.unsorted(bx)) {
-    stop("Argument 'bx' is not ordered")
+    stop(sprintf("Argument '%s' is not ordered", "bx"))
   }
 
   # Argument 'na.rm':
   if (!is.logical(na.rm)) {
-    stop(sprintf("Argument 'na.rm' is not logical: %s", mode(na.rm)))
+    stop(sprintf("Argument '%s' is not logical: %s", "na.rm", mode(na.rm)))
   }
 
   # Argument 'count':
   if (!is.logical(count)) {
-    stop(sprintf("Argument 'count' is not logical: %s", mode(count)))
+    stop(sprintf("Argument '%s' is not logical: %s", "count", mode(count)))
   }
 
   # Apply subset

R/diff2.R

@@ -33,12 +33,12 @@ diff2 <- function(x, idxs = NULL, lag = 1L, differences = 1L, ...) {
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Argument 'lag':
   if (length(lag) != 1L) {
-    stop(sprintf("Argument 'lag' is not a scalar: %.0f", length(lag)))
+    stop(sprintf("Argument '%s' is not a scalar: %.0f", "lag", length(lag)))
   }
 
   # Argument 'differences':
   if (length(differences) != 1L) {
-    stop(sprintf("Argument 'differences' is not a scalar: %.0f", length(differences)))
+    stop(sprintf("Argument '%s' is not a scalar: %.0f", "differences", length(differences)))
   }
 
   lag <- as.integer(lag)

R/mean2.R

@@ -46,17 +46,17 @@ mean2 <- function(x, idxs = NULL, na.rm = FALSE, refine = TRUE, ...) {
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Argument 'x':
   if (!is.numeric(x) && !is.logical(x)) {
-    stop(sprintf("Argument 'x' is neither numeric nor logical: %s", mode(x)))
+    stop(sprintf("Argument '%s' is neither numeric nor logical: %s", "x", mode(x)))
   }
 
   # Argument 'na.rm':
   if (!is.logical(na.rm)) {
-    stop(sprintf("Argument 'na.rm' is not logical: %s", mode(na.rm)))
+    stop(sprintf("Argument '%s' is not logical: %s", "na.rm", mode(na.rm)))
   }
 
   # Argument 'refine':
   if (!is.logical(refine)) {
-    stop(sprintf("Argument 'refine' is not logical: %s", mode(refine)))
+    stop(sprintf("Argument '%s' is not logical: %s", "refine", mode(refine)))
   }
 
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

R/rowAvgsPerColSet.R

@@ -56,35 +56,35 @@ rowAvgsPerColSet <- function(X, W = NULL, rows = NULL, S,
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Argument 'X':
   if (!is.matrix(X)) {
-    stop(sprintf("Argument 'X' is not a matrix: %s", class(X)[1L]))
+    stop(sprintf("Argument '%s' is not a matrix: %s", "X", class(X)[1L]))
   }
   dimX <- dim(X)
 
   # Argument 'W':
   hasW <- !is.null(W)
   if (hasW) {
     if (!is.matrix(W)) {
-      stop(sprintf("Argument 'W' is not a matrix: %s", class(W)[1L]))
+      stop(sprintf("Argument '%s' is not a matrix: %s", "W", class(W)[1L]))
     }
     if (any(dim(W) != dimX)) {
-      stop(sprintf("Argument 'W' does not have the same dimension as 'X': %s != %s",
-           paste(dim(W), collapse = "x"), paste(dimX, collapse = "x")))
+      stop(sprintf("Argument '%s' does not have the same dimension as '%s': %s != %s",
+           "W", "X", paste(dim(W), collapse = "x"), paste(dimX, collapse = "x")))
     }
     if (!is.numeric(W)) {
-      stop(sprintf("Argument 'W' is not numeric: %s", mode(W)))
+      stop(sprintf("Argument '%s' is not numeric: %s", "W", mode(W)))
     }
   }
 
   # Argument 'S':
   if (!is.matrix(S)) {
-    stop(sprintf("Argument 'S' is not a matrix: %s", class(S)[1L]))
+    stop(sprintf("Argument '%s' is not a matrix: %s", "S", class(S)[1L]))
   }
   nbrOfSets <- ncol(S)
   setNames <- colnames(S)
 
   # Argument 'FUN':
   if (!is.function(FUN)) {
-    stop(sprintf("Argument 'FUN' is not a function: %s", mode(S)))
+    stop(sprintf("Argument '%s' is not a function: %s", "FUN", mode(S)))
   }
 
   # Apply subset
@@ -159,19 +159,19 @@ colAvgsPerRowSet <- function(X, W = NULL, cols = NULL, S,
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Argument 'X':
   if (!is.matrix(X)) {
-    stop(sprintf("Argument 'X' is not a matrix: %s", class(X)[1L]))
+    stop(sprintf("Argument '%s' is not a matrix: %s", "X", class(X)[1L]))
   }
 
   # Argument 'W':
 
   # Argument 'S':
   if (!is.matrix(S)) {
-    stop(sprintf("Argument 'S' is not a matrix: %s", class(S)[1L]))
+    stop(sprintf("Argument '%s' is not a matrix: %s", "S", class(S)[1L]))
   }
 
   # Argument 'FUN':
   if (!is.function(FUN)) {
-    stop(sprintf("Argument 'FUN' is not a function: %s", mode(S)))
+    stop(sprintf("Argument '%s' is not a function: %s", "FUN", mode(S)))
   }
 
   # Apply subset

R/rowCounts.R

@@ -43,15 +43,15 @@ rowCounts <- function(x, rows = NULL, cols = NULL, value = TRUE,
   if (is.matrix(x)) {
   } else if (is.vector(x)) {
   } else {
-    stop(sprintf("Argument 'x' must be a matrix or a vector: %s", mode(x)[1L]))
+    stop(sprintf("Argument '%s' must be a matrix or a vector: %s", "x", mode(x)[1L]))
   }
 
   # Argument 'dim.':
   dim. <- as.integer(dim.)
 
   # Argument 'value':
   if (length(value) != 1L) {
-    stop(sprintf("Argument 'value' has to be a single value: %.0f", length(value)))
+    stop(sprintf("Argument '%s' has to be a single value: %.0f", "value", length(value)))
   }
 
   # Coerce 'value' to matrix
@@ -97,15 +97,15 @@ colCounts <- function(x, rows = NULL, cols = NULL, value = TRUE,
   if (is.matrix(x)) {
   } else if (is.vector(x)) {
   } else {
-    stop(sprintf("Argument 'x' must be a matrix or a vector: %s", mode(x)[1L]))
+    stop(sprintf("Argument '%s' must be a matrix or a vector: %s", "x", mode(x)[1L]))
   }
 
   # Argument 'dim.':
   dim. <- as.integer(dim.)
 
   # Argument 'value':
   if (length(value) != 1L) {
-    stop(sprintf("Argument 'value' has to be a single value: %.0f", length(value)))
+    stop(sprintf("Argument '%s' has to be a single value: %.0f", "value", length(value)))
   }
 
   # Coerce 'value' to matrix
@@ -148,12 +148,12 @@ colCounts <- function(x, rows = NULL, cols = NULL, value = TRUE,
 count <- function(x, idxs = NULL, value = TRUE, na.rm = FALSE, ...) {
   # Argument 'x':
   if (!is.vector(x)) {
-    stop(sprintf("Argument 'x' must be a vector: %s", mode(x)[1L]))
+    stop(sprintf("Argument '%s' must be a vector: %s", "x", mode(x)[1L]))
   }
 
   # Argument 'value':
   if (length(value) != 1L) {
-    stop(sprintf("Argument 'value' has to be a single value: %.0f", length(value)))
+    stop(sprintf("Argument '%s' has to be a single value: %.0f", "value", length(value)))
   }
 
   # Coerce 'value' to matrix

R/rowMads.R

@@ -23,7 +23,7 @@ rowMads <- function(x, rows = NULL, cols = NULL, center = NULL,
       if (length(center) == 1L && is.null(rows)) {
         validateScalarCenter(center, nrow(x), "rows")
       } else {
-        stop(sprintf("Argument 'center' should be of the same length as number of rows of 'x': %d != %d", length(center), nrow(x)))
+        stop(sprintf("Argument '%s' should be of the same length as number of rows of '%s': %d != %d", "center", "x", length(center), nrow(x)))
       }
     }
     if (!is.null(rows)) center <- center[rows]
@@ -67,7 +67,7 @@ colMads <- function(x, rows = NULL, cols = NULL, center = NULL,
       if (length(center) == 1L && is.null(cols)) {
         validateScalarCenter(center, ncol(x), "columns")
       } else {
-        stop(sprintf("Argument 'center' should be of the same length as number of columns of 'x': %d != %d", length(center), ncol(x)))
+        stop(sprintf("Argument '%s' should be of the same length as number of columns of '%s': %d != %d", "center", "x", length(center), ncol(x)))
       }
     }
     if (!is.null(cols)) center <- center[cols]

R/rowOrderStats.R

@@ -43,7 +43,7 @@ rowOrderStats <- function(x, rows = NULL, cols = NULL, which,
 
   # Check missing values
   if (anyMissing(x)) {
-    stop("Argument 'x' must not contain missing value")
+    stop(sprintf("Argument '%s' must not contain missing value", "x"))
   }
 
   which <- as.integer(which)
@@ -59,7 +59,7 @@ colOrderStats <- function(x, rows = NULL, cols = NULL, which,
 
   # Check missing values
   if (anyMissing(x)) {
-    stop("Argument 'x' must not contain missing value")
+    stop(sprintf("Argument '%s' must not contain missing value", "x"))
   }
 
   which <- as.integer(which)

R/rowProds.R

@@ -65,7 +65,7 @@ rowProds <- function(x, rows = NULL, cols = NULL, na.rm = FALSE,
     prod <- product
   } else if (method == "direct") {
   } else {
-    stop(sprintf("Unknown value of argument 'method': %s", method))
+    stop(sprintf("Unknown value of argument '%s': %s", "method", method))
   }
 
   for (ii in seq_len(n)) {
@@ -105,7 +105,7 @@ colProds <- function(x, rows = NULL, cols = NULL, na.rm = FALSE,
     prod <- product
   } else if (method == "direct") {
   } else {
-    stop(sprintf("Unknown value of argument 'method': %s", method))
+    stop(sprintf("Unknown value of argument '%s': %s", "method", method))
   }
 
   for (ii in seq_len(n)) {

R/rowQuantiles.R

@@ -48,11 +48,11 @@ rowQuantiles <- function(x, rows = NULL, cols = NULL,
 
   # Argument 'probs':
   if (anyMissing(probs)) {
-    stop("Argument 'probs' contains missing values")
+    stop(sprintf("Argument '%s' contains missing values", "probs"))
   }
   eps <- 100 * .Machine$double.eps
   if (any((probs < -eps | probs > 1 + eps))) {
-    stop("Argument 'probs' is out of range [0-eps, 1+eps]")
+    stop(sprintf("Argument '%s' is out of range [0-eps, 1+eps]", "probs"))
   }
 
   # Apply subset
@@ -168,11 +168,11 @@ colQuantiles <- function(x, rows = NULL, cols = NULL,
 
   # Argument 'probs':
   if (anyMissing(probs)) {
-    stop("Argument 'probs' contains missing values")
+    stop(sprintf("Argument '%s' contains missing values", "probs"))
   }
   eps <- 100 * .Machine$double.eps
   if (any((probs < -eps | probs > 1 + eps))) {
-    stop("Argument 'probs' is out of range [0-eps, 1+eps]")
+    stop(sprintf("Argument '%s' is out of range [0-eps, 1+eps]", "probs"))
   }
 
   # Apply subset

R/rowRanks.R

@@ -106,7 +106,7 @@ rowRanks <- function(x, rows = NULL, cols = NULL,
   ties_method <- charmatch(ties.method, c("average", "first", "last", "random",
                                           "max", "min", "dense"), nomatch = 0L)
   if (ties_method == 0L) {
-    stop(sprintf("Unknown value of argument 'ties.method': %s", ties.method))
+    stop(sprintf("Unknown value of argument '%s': %s", "ties.method", ties.method))
   }
 
   dim. <- as.integer(dim.)
@@ -131,7 +131,7 @@ colRanks <- function(x, rows = NULL, cols = NULL,
   ties_method <- charmatch(ties.method, c("average", "first", "last", "random",
                                           "max", "min", "dense"), nomatch = 0L)
   if (ties_method == 0L) {
-    stop(sprintf("Unknown value of argument 'ties.method': %s", ties.method))
+    stop(sprintf("Unknown value of argument '%s': %s", "ties.method", ties.method))
   }
 
   dim. <- as.integer(dim.)

R/rowTabulates.R

@@ -41,7 +41,7 @@ rowTabulates <- function(x, rows = NULL, cols = NULL, values = NULL, ...) {
   } else if (is.logical(x)) {
   } else if (is.raw(x)) {
   } else {
-    stop(sprintf("Argument 'x' must be of type integer, logical, or raw: %s", class(x)[1]))
+    stop(sprintf("Argument '%s' must be of type integer, logical, or raw: %s", "x", class(x)[1]))
   }
 
   # Apply subset
@@ -98,7 +98,7 @@ colTabulates <- function(x, rows = NULL, cols = NULL, values = NULL, ...) {
   } else if (is.logical(x)) {
   } else if (is.raw(x)) {
   } else {
-    stop(sprintf("Argument 'x' must be of type integer, logical, or raw: %s", class(x)[1]))
+    stop(sprintf("Argument '%s' must be of type integer, logical, or raw: %s", "x", class(x)[1]))
   }
 
   # Apply subset

R/rowVars.R

@@ -59,7 +59,7 @@ rowVars <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL,
       validateScalarCenter(center, nrow(x), "rows")
       center <- rep(center, times = nrow(x))
     } else {
-      stop(sprintf("Argument 'center' should be of the same length as number of rows of 'x': %d != %d", length(center), nrow(x)))
+      stop(sprintf("Argument '%s' should be of the same length as number of rows of '%s': %d != %d", "center", "x", length(center), nrow(x)))
     }
   }
   if (!is.null(rows)) center <- center[rows]
@@ -170,7 +170,7 @@ colVars <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL,
       validateScalarCenter(center, ncol(x), "columns")
       center <- rep(center, times = ncol(x))
     } else {
-      stop(sprintf("Argument 'center' should be of the same length as number of columns of 'x': %d != %d", length(center), ncol(x)))
+      stop(sprintf("Argument '%s' should be of the same length as number of columns of '%s': %d != %d", "center", "x", length(center), ncol(x)))
     }
   }
   if (!is.null(cols)) center <- center[cols]