Merge branch 'master' into error-enhance

Author: Divendra2006

NEWS.md

@@ -6,6 +6,10 @@
 
 1. New `sort_by()` method for data.tables, [#6662](https://github.com/Rdatatable/data.table/issues/6662). It uses `forder()` to improve upon the data.frame method and also match `DT[order(...)]` behavior with respect to locale. Thanks @rikivillalba for the suggestion and PR.
 
+## BUG FIXES
+
+1. Custom binary operators from the `lubridate` package now work with objects of class `IDate` as with a `Date` subclass, [#6839](https://github.com/Rdatatable/data.table/issues/6839). Thanks @emallickhossain for the report and @aitap for the fix.
+
 # data.table [v1.17.0](https://github.com/Rdatatable/data.table/milestone/34)  (20 Feb 2025)
 
 ## POTENTIALLY BREAKING CHANGES

R/AllS4.R

@@ -3,7 +3,6 @@ if ("package:data.table" %in% search()) stopf("data.table package loaded. When d
 
 ## Allows data.table to be defined as an object of an S4 class,
 ## or even have data.table be a super class of an S4 class.
-methods::setOldClass(c('data.frame'))
 methods::setOldClass(c('data.table', 'data.frame'))
 
 ## as(some.data.frame, "data.table")
@@ -16,7 +15,7 @@ methods::setAs("data.table", "data.frame", function(from) {
   as.data.frame(from)
 })
 
-methods::setOldClass("IDate")
+methods::setOldClass(c("IDate", "Date"))
 methods::setOldClass("ITime")
 
 methods::setAs("character", "IDate", function(from) as.IDate(from))

R/data.table.R

@@ -1939,7 +1939,7 @@ replace_dot_alias = function(e) {
       if (inherits(x, 'data.table')) .Call(C_unlock, x)
       else return(lapply(x, runlock, current_depth = current_depth + 1L))
     }
-    return(invisible())
+    invisible()
   }
   runlock(ans)
   if (verbose) {cat(timetaken(last.started.at),"\n"); flush.console()}
@@ -3130,7 +3130,7 @@ is_constantish = function(q, check_singleton=FALSE) {
     return(FALSE)
   }
   # calls are allowed <=> there's no SYMBOLs in the sub-AST
-  return(length(all.vars(q, max.names=1L, unique=FALSE)) == 0L)
+  length(all.vars(q, max.names=1L, unique=FALSE)) == 0L
 }
 .gshift_ok = function(q) {
   q = match.call(shift, q)
@@ -3204,7 +3204,7 @@ is_constantish = function(q, check_singleton=FALSE) {
     stopf("It looks like you re-used `:=` in argument %d a functional assignment call -- use `=` instead: %s(col1=val1, col2=val2, ...)", jj-1L, call_name)
 }
 
-.prepareFastSubset = function(isub, x, enclos, notjoin, verbose = FALSE){
+.prepareFastSubset = function(isub, x, enclos, notjoin, verbose=FALSE) {
   ## helper that decides, whether a fast binary search can be performed, if i is a call
   ## For details on the supported queries, see \code{\link{datatable-optimize}}
   ## Additional restrictions are imposed if x is .SD, or if options indicate that no optimization
@@ -3354,14 +3354,9 @@ is_constantish = function(q, check_singleton=FALSE) {
     setkeyv(i, idxCols)
     on = on[idxCols] ## make sure 'on' is in the correct order. Otherwise the logic won't recognise that a key / index already exists.
   }
-  return(list(i  = i,
-              on = on,
-              notjoin = notjoin
-              )
-         )
+  list(i=i, on=on, notjoin=notjoin)
 }
 
-
 .parse_on = function(onsub, isnull_inames) {
   ## helper that takes the 'on' string(s) and extracts comparison operators and column names from it.
   #' @param onsub the substituted on

R/fcast.R

@@ -214,42 +214,42 @@ dcast.data.table = function(data, formula, fun.aggregate = NULL, sep = "_", ...,
   # 'dat' != 'data'? then setkey to speed things up (slightly), else ad-hoc (for now). Still very fast!
   if (!is.null(fun.call) || !is.null(subset))
     setkeyv(dat, varnames)
-  if (length(rhsnames)) {
-    lhs = shallow(dat, lhsnames); rhs = shallow(dat, rhsnames); val = shallow(dat, valnames)
-    # handle drop=TRUE/FALSE - Update: Logic moved to R, AND faster than previous version. Take that... old me :-).
-    if (all(drop)) {
-      map = setDT(lapply(list(lhsnames, rhsnames), function(cols) frankv(dat, cols=cols, ties.method="dense", na.last=FALSE))) # #2202 fix
-      maporder = lapply(map, order_)
-      mapunique = lapply(seq_along(map), function(i) .Call(CsubsetVector, map[[i]], maporder[[i]]))
-      lhs = .Call(CsubsetDT, lhs, maporder[[1L]], seq_along(lhs))
-      rhs = .Call(CsubsetDT, rhs, maporder[[2L]], seq_along(rhs))
-    } else {
-      lhs_ = if (!drop[1L]) cj_uniq(lhs) else setkey(unique(lhs, by=names(lhs)))
-      rhs_ = if (!drop[2L]) cj_uniq(rhs) else setkey(unique(rhs, by=names(rhs)))
-      map = vector("list", 2L)
-      .Call(Csetlistelt, map, 1L, lhs_[lhs, which=TRUE])
-      .Call(Csetlistelt, map, 2L, rhs_[rhs, which=TRUE])
-      setDT(map)
-      mapunique = vector("list", 2L)
-      .Call(Csetlistelt, mapunique, 1L, seq_len(nrow(lhs_)))
-      .Call(Csetlistelt, mapunique, 2L, seq_len(nrow(rhs_)))
-      lhs = lhs_; rhs = rhs_
-    }
-    maplen = lengths(mapunique)
-    idx = do.call(CJ, mapunique)[map, 'I' := .I][["I"]] # TO DO: move this to C and avoid materialising the Cross Join.
-    some_fill = anyNA(idx)
-    fill.default = if (run_agg_funs && is.null(fill) && some_fill) dat_for_default_fill[, maybe_err(eval(fun.call))]
-    if (run_agg_funs && is.null(fill) && some_fill) {
-      fill.default = dat_for_default_fill[0L][, maybe_err(eval(fun.call))]
-    }
-    ans = .Call(Cfcast, lhs, val, maplen[[1L]], maplen[[2L]], idx, fill, fill.default, is.null(fun.call), some_fill)
-    allcols = do.call(paste, c(rhs, sep=sep))
-    if (length(valnames) > 1L)
-      allcols = do.call(paste, if (identical(".", allcols)) list(valnames, sep=sep)
-            else c(CJ(valnames, allcols, sorted=FALSE), sep=sep))
-      # removed 'setcolorder()' here, #1153
-    setattr(ans, 'names', c(lhsnames, allcols))
-    setDT(ans); setattr(ans, 'sorted', lhsnames)
-  } else internal_error("empty rhsnames") # nocov
-  return(ans)
+  if (!length(rhsnames)) internal_error("empty rhsnames") # nocov
+  lhs = shallow(dat, lhsnames); rhs = shallow(dat, rhsnames); val = shallow(dat, valnames)
+  # handle drop=TRUE/FALSE - Update: Logic moved to R, AND faster than previous version. Take that... old me :-).
+  if (all(drop)) {
+    map = setDT(lapply(list(lhsnames, rhsnames), function(cols) frankv(dat, cols=cols, ties.method="dense", na.last=FALSE))) # #2202 fix
+    maporder = lapply(map, order_)
+    mapunique = lapply(seq_along(map), function(i) .Call(CsubsetVector, map[[i]], maporder[[i]]))
+    lhs = .Call(CsubsetDT, lhs, maporder[[1L]], seq_along(lhs))
+    rhs = .Call(CsubsetDT, rhs, maporder[[2L]], seq_along(rhs))
+  } else {
+    lhs_ = if (!drop[1L]) cj_uniq(lhs) else setkey(unique(lhs, by=names(lhs)))
+    rhs_ = if (!drop[2L]) cj_uniq(rhs) else setkey(unique(rhs, by=names(rhs)))
+    map = vector("list", 2L)
+    .Call(Csetlistelt, map, 1L, lhs_[lhs, which=TRUE])
+    .Call(Csetlistelt, map, 2L, rhs_[rhs, which=TRUE])
+    setDT(map)
+    mapunique = vector("list", 2L)
+    .Call(Csetlistelt, mapunique, 1L, seq_len(nrow(lhs_)))
+    .Call(Csetlistelt, mapunique, 2L, seq_len(nrow(rhs_)))
+    lhs = lhs_; rhs = rhs_
+  }
+  maplen = lengths(mapunique)
+  idx = do.call(CJ, mapunique)[map, 'I' := .I][["I"]] # TO DO: move this to C and avoid materialising the Cross Join.
+  some_fill = anyNA(idx)
+  fill.default = if (run_agg_funs && is.null(fill) && some_fill) dat_for_default_fill[, maybe_err(eval(fun.call))]
+  if (run_agg_funs && is.null(fill) && some_fill) {
+    fill.default = dat_for_default_fill[0L][, maybe_err(eval(fun.call))]
+  }
+  ans = .Call(Cfcast, lhs, val, maplen[[1L]], maplen[[2L]], idx, fill, fill.default, is.null(fun.call), some_fill)
+  allcols = do.call(paste, c(rhs, sep=sep))
+  if (length(valnames) > 1L)
+    allcols = do.call(paste, if (identical(".", allcols)) list(valnames, sep=sep)
+          else c(CJ(valnames, allcols, sorted=FALSE), sep=sep))
+    # removed 'setcolorder()' here, #1153
+  setattr(ans, 'names', c(lhsnames, allcols))
+  setDT(ans)
+  setattr(ans, 'sorted', lhsnames)
+  ans
 }

R/fdroplevels.R

@@ -5,7 +5,7 @@ fdroplevels = function(x, exclude = if (anyNA(levels(x))) NULL else NA, ...) {
   ans = match(as.integer(x), lev)
   setattr(ans, 'levels', levels(x)[lev])
   setattr(ans, 'class', class(x))
-  return(ans)
+  ans
 }
 
 droplevels.data.table = function(x, except=NULL, exclude, in.place=NULL, ...){

R/foverlaps.R

@@ -181,23 +181,22 @@ foverlaps = function(x, y, by.x=if (!is.null(key(x))) key(x) else key(y), by.y=k
   if (which) {
     if (mult %chin% c("first", "last"))
       return(olaps$yid)
-    else if (!is.na(nomatch))
-      return(.Call(CsubsetDT, olaps, which(olaps$yid > 0L), seq_along(olaps)))
-    else return(olaps)
-  } else {
     if (!is.na(nomatch))
-      olaps = .Call(CsubsetDT, olaps, which(olaps$yid > 0L), seq_along(olaps))
-    ycols = setdiff(names(origy), head(by.y, -2L))
-    idx = chmatch(ycols, names(origx), nomatch=0L)
-    ans = .Call(CsubsetDT, origx, olaps$xid, seq_along(origx))
-    if (any(idx>0L))
-      setnames(ans, names(ans)[idx], paste0("i.", names(ans)[idx]))
-    xcols1 = head(by.x, -2L)
-    xcols2 = setdiff(names(ans), xcols1)
-    ans[, (ycols) := .Call(CsubsetDT, origy, olaps$yid, chmatch(ycols, names(origy)))]
-    setcolorder(ans, c(xcols1, ycols, xcols2))
-    return(ans[])
+      return(.Call(CsubsetDT, olaps, which(olaps$yid > 0L), seq_along(olaps)))
+    return(olaps)
   }
+  if (!is.na(nomatch))
+    olaps = .Call(CsubsetDT, olaps, which(olaps$yid > 0L), seq_along(olaps))
+  ycols = setdiff(names(origy), head(by.y, -2L))
+  idx = chmatch(ycols, names(origx), nomatch=0L)
+  ans = .Call(CsubsetDT, origx, olaps$xid, seq_along(origx))
+  if (any(idx > 0L))
+    setnames(ans, names(ans)[idx], paste0("i.", names(ans)[idx]))
+  xcols1 = head(by.x, -2L)
+  xcols2 = setdiff(names(ans), xcols1)
+  ans[, (ycols) := .Call(CsubsetDT, origy, olaps$yid, chmatch(ycols, names(origy)))]
+  setcolorder(ans, c(xcols1, ycols, xcols2))
+  ans[]
 }
 
 # Notes: (If there's a better way than the solution I propose here, I'd be glad to apply it.)

R/setkey.R

@@ -12,7 +12,7 @@ setindex = function(...) setkey(..., physical=FALSE)
 setindexv = function(x, cols, verbose=getOption("datatable.verbose")) {
   if (is.list(cols)) {
     sapply(cols, setkeyv, x=x, verbose=verbose, physical=FALSE)
-    return(invisible(x))
+    invisible(x)
   } else {
     setkeyv(x, cols, verbose=verbose, physical=FALSE)
   }
@@ -207,23 +207,21 @@ forder = function(..., na.last=TRUE, decreasing=FALSE, method="radix")
 fsort = function(x, decreasing=FALSE, na.last=FALSE, internal=FALSE, verbose=FALSE, ...)
 {
   containsNAs = FALSE
-  if (typeof(x)=="double" && !decreasing && !(containsNAs <- anyNA(x))) {
-      if (internal) stopf("Internal code should not be being called on type double")
-      return(.Call(Cfsort, x, verbose))
+  if (typeof(x) == "double" && !decreasing && !(containsNAs <- anyNA(x))) {
+    if (internal) stopf("Internal code should not be being called on type double")
+    return(.Call(Cfsort, x, verbose))
   }
-  else {
-    # fsort is now exported for testing. Trying to head off complaints "it's slow on integer"
-    # The only places internally we use fsort internally (3 calls, all on integer) have had internal=TRUE added for now.
-    # TODO: implement integer and character in Cfsort and remove this branch and warning
-    if (!internal){
-      if (typeof(x)!="double") warningf("Input is not a vector of type double. New parallel sort has only been done for double vectors so far. Using one thread.")
-      if (decreasing)  warningf("New parallel sort has not been implemented for decreasing=TRUE so far. Using one thread.")
-      if (containsNAs) warningf("New parallel sort has not been implemented for vectors containing NA values so far. Using one thread.")
-    }
-    orderArg = if (decreasing) -1L else 1L
-    o = forderv(x, order=orderArg, na.last=na.last)
-    return( if (length(o)) x[o] else x )
+  # fsort is now exported for testing. Trying to head off complaints "it's slow on integer"
+  # The only places internally we use fsort internally (3 calls, all on integer) have had internal=TRUE added for now.
+  # TODO: implement integer and character in Cfsort and remove this branch and warning
+  if (!internal) {
+    if (typeof(x) != "double") warningf("Input is not a vector of type double. New parallel sort has only been done for double vectors so far. Using one thread.")
+    if (decreasing)  warningf("New parallel sort has not been implemented for decreasing=TRUE so far. Using one thread.")
+    if (containsNAs) warningf("New parallel sort has not been implemented for vectors containing NA values so far. Using one thread.")
   }
+  orderArg = if (decreasing) -1L else 1L
+  o = forderv(x, order=orderArg, na.last=na.last)
+  if (length(o)) x[o] else x
 }
 
 setorder = function(x, ..., na.last=FALSE)

R/xts.R

@@ -25,6 +25,6 @@ as.xts.data.table = function(x, numeric.only = TRUE, ...) {
     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]]
   }
-  return(xts::xts(as.matrix(r), order.by = if (inherits(x[[1L]], "IDate")) as.Date(x[[1L]]) else x[[1L]]))
+  xts::xts(as.matrix(r), order.by = if (inherits(x[[1L]], "IDate")) as.Date(x[[1L]]) else x[[1L]])
 }
 # nocov end

inst/tests/S4.Rraw

@@ -118,3 +118,11 @@ test(7.1, is.data.table(DF@x))
 # Similar code for under-allocated data.tables in S4 slots, #6704
 setClass("DataTable", slots=c(x="data.table"))
 test(7.2, options=c(datatable.alloccol=0L), {DT = new("DataTable", x=data.table(a=1)); DT@x[, b := 2L]; DT@x$b}, 2L) # NB: requires assigning DT to test assignment back to that object
+
+# IDate was not visible as Date to S4 dispatch, #6839
+CustomDurationClass <- setClass("CustomDurationClass", contains = "integer")
+setGeneric("%foo%", function(e1, e2) stop("dispatch to default method"))
+setMethod(`%foo%`, c("Date", "CustomDurationClass"), function (e1, e2) e1 - [email protected])
+test(8, as.IDate("2025-03-01") %foo% CustomDurationClass(1), as.IDate("2025-02-28"))
+removeGeneric("%foo%")
+removeClass("CustomDurationClass")

inst/tests/tests.Rraw

@@ -12716,7 +12716,8 @@ x = runif(1e3)
 test(1888.6, y<-fsort(x,verbose=TRUE), output="nth=.*Top 20 MSB counts")
 test(1888.7, !base::is.unsorted(y))
 test(1888.8, fsort(x,verbose=1), error="verbose must be TRUE or FALSE")
-rm(x)
+test(1888.9, fsort(c(1L, 2L, 3L, 4L), internal = TRUE), c(1L, 2L, 3L, 4L))
+rm(x, y)
 
 # doubling of savetl buffer (currently starts with 100)
 x = as.character(as.hexmode(1:1000))