small code and docu improvements

NEWS.md

@@ -4,7 +4,7 @@
 * Added `setCols` method: allows for setting the values of columns, adding columns to and/or removing columns from a `DTSg` object
 * Added `[` extract operator: acts as a shortcut for the `getCol` method
 * Added examples to the documentation of the `colapply` method showing how to calculate moving averages with the help of the `runner` package instead of the `rollapply` method
-* `aggregate` method can benefit from `data.table`'s *GForce* optimisation now
+* `aggregate` method can benefit from `data.table`'s *GForce* optimisation now if its `fun` argument is provided with a character vector specifying summary functions
 * Greatly sped up `nas` method
 * Temporal aggregation level functions supplied to the `funby` argument of the `colapply` method are not forced to return a `POSIXct` timestamp any longer. They are, however, forced to return an atomic mode (the same goes for the `subset` method).
 * `getCol` method now is capable of also querying the *.dateTime* column

R/ClassDTSg.R

@@ -117,9 +117,9 @@
 #'      time series. When set, the series is converted to the specified time
 #'      zone. Only names from \code{\link{OlsonNames}} are accepted.
 #'    \item \emph{unit:} Same as \code{unit} argument. It is added to the label
-#'      of the primary axis of plots if the \emph{parameter} field is set.
+#'      of the primary axis of plots when the \emph{parameter} field is set.
 #'    \item \emph{variant:} Same as \code{variant} argument. It is added to the
-#'      label of the primary axis of plots if the \emph{parameter} field is set.
+#'      label of the primary axis of plots when the \emph{parameter} field is set.
 #'  }
 #'
 #' The \emph{parameter}, \emph{unit} and \emph{variant} fields are especially
@@ -344,7 +344,7 @@ DTSg <- R6Class(
       ))
     },
 
-    optiLapply = function(funs, cols, ...) {
+    optiLapply = function(funs, cols, n, ...) {
       funs <- rep(funs, length(cols))
       cols <- rep(cols, each = length(funs) / length(cols))
       if (!is.null(names(funs))) {
@@ -363,10 +363,16 @@ DTSg <- R6Class(
         }
       }
 
-      paste(
+      text <- paste(
         sprintf("%s = %s(%s%s)", resultCols, funs, cols, dotsToCharacter(...)),
         collapse = ", "
       )
+
+      if (n) {
+        sprintf(".(%s, %s)", text, ".n = .N")
+      } else {
+        sprintf(".(%s)", text)
+      }
     },
 
     rmGlobalReferences = function(addr) {
@@ -423,22 +429,12 @@ DTSg <- R6Class(
         ))
       }
 
-      if (is.character(fun)) {
-        text <- private$optiLapply(fun, cols, ...)
-
-        if (n) {
-          text <- sprintf(".(%s, %s)", text, ".n = .N")
-        } else {
-          text <- sprintf(".(%s)", text)
-        }
-      }
-
       if (n) {
         if (length(cols) > 1L) {
           if (is.character(fun)) {
             private$.values <- private$.values[
               ,
-              eval(str2expression(text)),
+              eval(parse(text = private$optiLapply(fun, cols, n, ...))),
               keyby = .(.dateTime = funby(.dateTime, .funbyHelpers))
             ]
           } else {
@@ -455,7 +451,7 @@ DTSg <- R6Class(
           if (is.character(fun)) {
             private$.values <- private$.values[
               !is.na(get(cols)),
-              eval(str2expression(text)),
+              eval(parse(text = private$optiLapply(fun, cols, n, ...))),
               keyby = .(.dateTime = funby(.dateTime, .funbyHelpers))
             ]
           } else {
@@ -475,7 +471,7 @@ DTSg <- R6Class(
         if (is.character(fun)) {
           private$.values <- private$.values[
             ,
-            eval(str2expression(text)),
+            eval(parse(text = private$optiLapply(fun, cols, n, ...))),
             keyby = .(.dateTime = funby(.dateTime, .funbyHelpers))
           ]
         } else {
@@ -562,8 +558,7 @@ DTSg <- R6Class(
       }
 
       if (na.status == "implicit") {
-        allNA <- rowSums(is.na(private$.values[, -1L, with = FALSE])) ==
-          ncol(private$.values) - 1L
+        allNA <- rowSums(is.na(private$.values[, -1L])) == ncol(private$.values) - 1L
 
         if (any(allNA)) {
           private$.values <- private$.values[!allNA, ]
@@ -661,7 +656,7 @@ DTSg <- R6Class(
         qassert(class, "S+")
 
         classes <- vapply(
-          private$.values[, -1L, with = FALSE],
+          private$.values[, -1L],
           function(col) {class(col)[1L]},
           character(1L)
         )
@@ -1017,8 +1012,7 @@ DTSg <- R6Class(
 
           DT <- private$.values[DT, on = sprintf("%s == .dateTime", firstCol)]
           lags <- diff(DT[[1L]])
-          if (sum(!is.na(DT[, -1L, with = FALSE])) ==
-              sum(!is.na(private$.values[seqLen, -1L, with = FALSE])) &&
+          if (sum(!is.na(DT[, -1L])) == sum(!is.na(private$.values[seqLen, -1L])) &&
               all(lags >= private$.minLag) && all(lags <= private$.maxLag)) {
             private$.periodicity <- by
 

R/Swrappers.R

@@ -13,14 +13,15 @@ NULL
 #' @param funby One of the temporal aggregation level functions described in
 #'  \code{\link{TALFs}} or a user defined temporal aggregation level function.
 #'  See details for further information.
-#' @param fun A summary function, named \code{\link{list}} of summary functions
-#'  or named character vector specifying summary functions applied column-wise
-#'  to all the values of the same temporal aggregation level, for instance,
+#' @param fun A summary function, \code{\link{list}} of summary functions or
+#'  character vector specifying summary functions applied column-wise to all the
+#'  values of the same temporal aggregation level, for instance,
 #'  \code{\link{mean}}, \code{\link{list}(min = \link{min}, max = \link{max})}
-#'  or \code{c(sd = "\link{sd}", var = "\link{var}")}. Using a character vector
-#'  does not prevent \pkg{data.table} from using its
-#'  \emph{\link[data.table:datatable-optimize]{GForce}} optimisation. The return
-#'  value(s) must be of length one.
+#'  or \code{c(sd = "\link{sd}", var = "\link{var}")}. A list or character
+#'  vector must have names in case more than one summary function is provided.
+#'  The method can benefit from \pkg{data.table}'s
+#'  \emph{\link[data.table:datatable-optimize]{GForce}} optimisation in case a
+#'  character vector is used. The return value(s) must be of length one.
 #' @param \dots Further arguments passed on to \code{fun}.
 #' @param cols A character vector specifying the columns to aggregate.
 #' @param n A logical specifying if a column named \emph{.n} giving the number
@@ -730,7 +731,7 @@ setCols <- function(x, ...) {
 #' @param values A vector, \code{\link{list}} or list-like object (e.g.
 #'  \code{\link[data.table]{data.table}}) of replacement and/or new values
 #'  accepted by the \code{value} argument of \pkg{data.table}'s
-#'  \code{\link[data.table:assign]{set}} function. \code{\link{NULL}} as a value
+#'  \code{\link[data.table:assign]{set}} function. \code{NULL} as a value
 #'  removes a column.
 #' @param clone A logical specifying if the object is modified in place or if a
 #'  clone (copy) is made beforehand.
@@ -740,7 +741,7 @@ setCols <- function(x, ...) {
 #'
 #' @seealso \code{\link{DTSg}}, \code{\link[data.table]{data.table}},
 #'  \code{\link[data.table:special-symbols]{.N}}, \code{\link{cols}},
-#'  \code{\link{list}}, \code{\link[data.table:assign]{set}}, \code{\link{NULL}}
+#'  \code{\link{list}}, \code{\link[data.table:assign]{set}}
 #'
 #' @examples
 #' # new DTSg object

inst/tinytest/test_DTSg.R

@@ -144,8 +144,8 @@ expect_identical(
 )
 
 expect_identical(
-  DTSg$new(DT2[, -4L, with = FALSE])$alter(na.status = "implicit")$values(),
-  setkey(DT2[3L, -4L, with = FALSE], "date"),
+  DTSg$new(DT2[, -4L])$alter(na.status = "implicit")$values(),
+  setkey(DT2[3L, -4L], "date"),
   info = "values are altered correctly (multiple columns and implicitly missing values)"
 )
 
@@ -805,7 +805,7 @@ expect_error(
 #### summary method ####
 expect_identical(
   DTSg$new(DT1)$summary(),
-  summary(DT1[, -1L, with = FALSE]),
+  summary(DT1[, -1L]),
   info = "values are summarised correctly"
 )