re-merge

R/data.table.R

@@ -1981,7 +1981,7 @@ replace_dot_alias = function(e) {
     attrs = attr(x, 'index', exact=TRUE)
     skeys = names(attributes(attrs))
     if (!is.null(skeys)) {
-      hits  = unlist(lapply(paste0("__", names_x[cols]), grep, skeys, fixed = TRUE))
+      hits  = unlist(lapply(paste0("__", names_x[cols]), function(x) grep(x, skeys, fixed = TRUE)))
       hits  = skeys[unique(hits)]
       for (i in seq_along(hits)) setattr(attrs, hits[i], NULL) # does by reference
     }
@@ -2145,7 +2145,7 @@ as.matrix.data.table = function(x, rownames=NULL, rownames.value=NULL, ...) {
     }
     if (!is.logical(xj))
       all.logical = FALSE
-    if (nlevels(xj) > 0L || !(is.numeric(xj) || is.complex(xj) || is.logical(xj)) ||
+    if (length(levels(xj)) > 0L || !(is.numeric(xj) || is.complex(xj) || is.logical(xj)) ||
         (!is.null(cl <- attr(xj, "class", exact=TRUE)) && any(cl %chin%
         c("Date", "POSIXct", "POSIXlt"))))
       non.numeric = TRUE
@@ -2165,7 +2165,7 @@ as.matrix.data.table = function(x, rownames=NULL, rownames.value=NULL, ...) {
       if (is.character(X[[j]])) next
       xj = X[[j]]
       miss = is.na(xj)
-      xj = if (nlevels(xj)) as.vector(xj) else format(xj)
+      xj = if (length(levels(xj))) as.vector(xj) else format(xj)
       is.na(xj) = miss
       X[[j]] = xj
     }

R/fdroplevels.R

@@ -1,7 +1,7 @@
 # 647 fast droplevels.data.table method
 fdroplevels = function(x, exclude = if (anyNA(levels(x))) NULL else NA, ...) {
   stopifnot(inherits(x, "factor"))
-  lev = which(tabulate(x, nlevels(x)) & (!match(levels(x), exclude, 0L)))
+  lev = which(tabulate(x, length(levels(x))) & (!match(levels(x), exclude, 0L)))
   ans = match(as.integer(x), lev)
   setattr(ans, 'levels', levels(x)[lev])
   setattr(ans, 'class', class(x))

R/fmelt.R

@@ -28,7 +28,7 @@ patterns = function(..., cols=character(0L)) {
     stopf("Input patterns must be of type character.")
   matched = lapply(p, grep, cols)
   # replace with lengths when R 3.2.0 dependency arrives
-  if (length(idx <- which(vapply_1i(matched, length) == 0L)))
+  if (length(idx <- which(sapply(matched, length) == 0L)))
     stopf('Pattern(s) not found: [%s]', brackify(p[idx]))
   matched
 }
@@ -123,7 +123,7 @@ measurev = function(fun.list, sep="_", pattern, cols, multiple.keyword="value.na
       stopf("sep must be character string")
     }
     list.of.vectors = strsplit(cols, sep, fixed=TRUE)
-    vector.lengths = vapply_1i(list.of.vectors, length)
+    vector.lengths = sapply(list.of.vectors, length)
     n.groups = max(vector.lengths)
     if (n.groups == 1) {
       stopf("each column name results in only one item after splitting using sep, which means that all columns would be melted; to fix please either specify melt on all columns directly without using measure, or use a different sep/pattern specification")

R/fread.R

@@ -31,8 +31,8 @@ yaml=FALSE, autostart=NA, tmpdir=tempdir(), tz="UTC")
   if (is.na(nrows) || nrows<0) nrows=Inf   # accept -1 to mean Inf, as read.table does
   if (identical(header,"auto")) header=NA
   stopifnot(
-    "header should be a logical scalar" = is.logical(header) && length(header)==1L,  # TRUE, FALSE or NA
-    "nThread should be a logical scalar" = is.numeric(nThread) && length(nThread)==1L
+    is.logical(header) && length(header)==1L,  # TRUE, FALSE or NA
+    is.numeric(nThread) && length(nThread)==1L
   )
   nThread=as.integer(nThread)
   stopifnot(nThread>=1L)
@@ -185,7 +185,7 @@ yaml=FALSE, autostart=NA, tmpdir=tempdir(), tz="UTC")
 
     yaml_comment_re = '^#'
     yaml_string = character(0L)
-    repeat {
+    while (TRUE) {
       this_line = readLines(f, n=1L)
       n_read = n_read + 1L
       if (!length(this_line)){

R/programming.R

@@ -18,7 +18,7 @@ list2lang = function(x) {
   char = vapply(x, is.character, FALSE)
   to.name = !asis & char
   if (any(to.name)) { ## turns "my_name" character scalar into `my_name` symbol, for convenience
-    if (any(non.scalar.char <- vapply_1i(x[to.name], length)!=1L)) {
+    if (any(non.scalar.char <- vapply(x[to.name], length, 0L)!=1L)) {
       stopf("Character objects provided in the input are not scalar objects, if you need them as character vector rather than a name, then wrap each into 'I' call: %s", brackify(names(non.scalar.char)[non.scalar.char]))
     }
     x[to.name] = lapply(x[to.name], as.name)

R/tables.R

@@ -12,7 +12,7 @@ type_size = function(DT) {
     tt = lookup[storage.mode(col)]
     if (is.na(tt)) tt = .Machine$sizeof.pointer
     tt = tt*nrow(DT)
-    if (is.factor(col)) tt = tt + nlevels(col)*.Machine$sizeof.pointer
+    if (is.factor(col)) tt = tt + length(levels(col))*.Machine$sizeof.pointer
     ans = ans + tt
   }
   ans + ncol(DT)*.Machine$sizeof.pointer  # column name pointers

R/test.data.table.R

@@ -243,7 +243,7 @@ INT = function(...) { as.integer(c(...)) }   # utility used in tests.Rraw
 gc_mem = function() {
   # nocov start
   # gc reports memory in MB
-  m = colSums(gc()[, c(2L, 4L, 6L)])
+  m = apply(gc()[, c(2L, 4L, 6L)], 2L, sum)
   names(m) = c("GC_used", "GC_gc_trigger", "GC_max_used")
   m
   # nocov end

tests/autoprint.R

@@ -14,24 +14,24 @@ print(DT[2,a:=4L])                    # no
 print(DT)                             # yes
 if (TRUE) DT[2,a:=5L]                 # no. used to print before v1.9.5
 if (TRUE) if (TRUE) DT[2,a:=6L]       # no. used to print before v1.9.5
-(function(){ DT[2,a:=5L]; NULL })()   # print NULL
+(function(){DT[2,a:=5L];NULL})()      # print NULL
 DT                                    # no (from v1.9.5+). := suppresses next auto print (can't distinguish just "DT" symbol alone at the prompt)
 DT                                    # yes. 2nd time needed, or solutions below
-(function(){ DT[2,a:=5L]; NULL })()   # print NULL
+(function(){DT[2,a:=5L];NULL})()      # print NULL
 DT[]                                  # yes. guaranteed print
-(function(){ DT[2,a:=5L]; NULL })()   # print NULL
+(function(){DT[2,a:=5L];NULL})()      # print NULL
 print(DT)                             # no. only DT[] is guaranteed print from v1.9.6 and R 3.2.0
-(function(){ DT[2,a:=5L][]; NULL })() # print NULL
+(function(){DT[2,a:=5L][];NULL})()    # print NULL
 DT                                    # yes. i) function needs to add [] after last one, so that "DT" alone is guaranteed anyway
-(function(){ DT[2,a:=5L]; DT[]; NULL })() # print NULL
+(function(){DT[2,a:=5L];DT[];NULL})() # print NULL
 DT                                    # yes. ii) or as a separate DT[] after the last := inside the function
 DT2 = data.table(b=3:4)               # no
-(function(){ DT[2,a:=6L]; DT2[1,b:=7L]; NULL })()
+(function(){DT[2,a:=6L];DT2[1,b:=7L];NULL})()
 DT                                    # yes. last := was on DT2 not DT
 {DT[2,a:=6L];invisible()}             # no
 print(DT)                             # no
-(function(){ print(DT[2,a:=7L]); print(DT); invisible() })()    # yes*2
-{ print(DT[2,a:=8L]); print(DT); invisible() }                  # yes*1  Not within function so as at prompt
+(function(){print(DT[2,a:=7L]);print(DT);invisible()})()    # yes*2
+{print(DT[2,a:=8L]);print(DT);invisible()}                  # yes*1  Not within function so as at prompt
 DT[1][,a:=9L]      # no (was too tricky to detect that DT[1] is a new object). Simple rule is that := always doesn't print
 DT[2,a:=10L][1]                       # yes
 DT[1,a:=10L][1,a:=10L]                # no
@@ -43,3 +43,4 @@ DT[1,a:=10L][]                        # yes. ...[] == oops, forgot print(...)
 tryCatch(DT[,foo:=ColumnNameTypo], error=function(e) e$message)         # error: not found.
 DT                                    # yes
 DT                                    # yes
+