Merge branch 'master' into issue6964

Author: venom1204

NAMESPACE

@@ -61,6 +61,7 @@ export(.Last.updated)
 export(fcoalesce)
 export(substitute2)
 #export(DT)  # mtcars |> DT(i,j,by)  #4872 #5472
+export(fctr)
 
 S3method("[", data.table)
 S3method("[<-", data.table)

NEWS.md

@@ -18,6 +18,28 @@
 
 6. `between()` gains the argument `ignore_tzone=FALSE`. Normally, a difference in time zone between `lower` and `upper` will produce an error, and a difference in time zone between `x` and either of the others will produce a message. Setting `ignore_tzone=TRUE` bypasses the checks, allowing both comparisons to proceed without error or message about time zones.
 
+7. New helper function `fctr` as an extended version of `factor()`, [#4837](https://github.com/Rdatatable/data.table/issues/4837). Most notably, it supports (1) retaining input level ordering by default, i.e. `levels=unique(x)` as opposed to `levels = sort(unique(x))`; (2) `rev=` to reverse the levels; and (3) `sort=` to allow more feature parity with `factor()`. The choice of default is motivated by convenience in the common case when order of elements needs be preserved, for example when using `dcast` or adding a legend to a plot. This also matches the default sort ordering of groups in `by=`.
+
+    ```r
+    d = data.table(id1=rep(1:2, each=3L), id2=letters[c(4:3,5L,3:5)], v1=1:6)
+    dcast(d, id1 ~ factor(id2))
+    #      id1     c     d     e
+    # 1:     1     2     1     3
+    # 2:     2     4     5     6
+    dcast(d, id1 ~ fctr(id2))
+    #      id1     d     c     e
+    # 1:     1     1     2     3
+    # 2:     2     5     4     6
+    dcast(d, id1 ~ fctr(id2, sort=TRUE)) # same as factor()
+    #      id1     c     d     e
+    # 1:     1     2     1     3
+    # 2:     2     4     5     6
+    dcast(d, id1 ~ fctr(id2, rev=TRUE))
+    #      id1     e     c     d
+    # 1:     1     3     2     1
+    # 2:     2     6     4     5
+    ```
+
 ### 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.
@@ -48,7 +70,9 @@
 
 14. `data.table()` function is now more aligned with `data.frame()` with respect to the names of the output when one of its inputs is a single-column matrix object, [#4124](https://github.com/Rdatatable/data.table/issues/4124). Thanks @PavoDive for the report and @jangorecki for the PR.
 
-15. `cube()`, `rollup()`, and `groupingsets()` no longer produce a spurious warning when using `min()` or `max()` as aggregations, [#6964](https://github.com/Rdatatable/data.table/issues/6964). Thanks @ferenci-tamas for the report and @venom1204 for the fix.
+15. Including an `ITime` object as a named input to `data.frame()` respects the provided name, i.e. `data.frame(a = as.ITime(...))` will have column `a`, [#4673](https://github.com/Rdatatable/data.table/issues/4673). Thanks @shrektan for the report and @MichaelChirico for the fix.
+
+16. `cube()`, `rollup()`, and `groupingsets()` no longer produce a spurious warning when using `min()` or `max()` as aggregations, [#6964](https://github.com/Rdatatable/data.table/issues/6964). Thanks @ferenci-tamas for the report and @venom1204 for the fix.
 
 ### NOTES
 

R/IDateTime.R

@@ -209,7 +209,7 @@ as.character.ITime = format.ITime = function(x, ...) {
   res
 }
 
-as.data.frame.ITime = function(x, ...) {
+as.data.frame.ITime = function(x, ..., optional=FALSE) {
   # This method is just for ggplot2, #1713
   # Avoids the error "cannot coerce class '"ITime"' into a data.frame", but for some reason
   # ggplot2 doesn't seem to call the print method to get axis labels, so still prints integers.
@@ -219,7 +219,8 @@ as.data.frame.ITime = function(x, ...) {
   # ans = list(as.POSIXct(x,tzone=""))  # ggplot2 gives "Error: Discrete value supplied to continuous scale"
   setattr(ans, "class", "data.frame")
   setattr(ans, "row.names", .set_row_names(length(x)))
-  setattr(ans, "names", "V1")
+  # require 'optional' support for passing back to e.g. data.frame() without overriding names there
+  if (!optional) setattr(ans, "names", "V1")
   ans
 }
 

R/bmerge.R

@@ -27,6 +27,13 @@ coerce_col = function(dt, col, from_type, to_type, from_name, to_name, from_deta
 
 bmerge = function(i, x, icols, xcols, roll, rollends, nomatch, mult, ops, verbose)
 {
+  if (roll != 0.0 && length(icols)) {
+    last_x_idx = tail(xcols, 1L)
+    last_i_idx = tail(icols, 1L)
+    if (is.factor(x[[last_x_idx]]) || is.factor(i[[last_i_idx]]))
+      stopf("Attempting roll join on factor column when joining x.%s to i.%s. Only integer, double or character columns may be roll joined.", names(x)[last_x_idx], names(i)[last_i_idx])
+  }
+
   callersi = i
   i = shallow(i)
   # Just before the call to bmerge() in [.data.table there is a shallow() copy of i to prevent coercions here
@@ -64,9 +71,8 @@ bmerge = function(i, x, icols, xcols, roll, rollends, nomatch, mult, ops, verbos
     iname = paste0("i.", names(i)[icol])
     if (!x_merge_type %chin% supported) stopf("%s is type %s which is not supported by data.table join", xname, x_merge_type)
     if (!i_merge_type %chin% supported) stopf("%s is type %s which is not supported by data.table join", iname, i_merge_type)
+    # we check factors first because they might have different levels
     if (x_merge_type=="factor" || i_merge_type=="factor") {
-      if (roll!=0.0 && a==length(icols))
-        stopf("Attempting roll join on factor column when joining %s to %s. Only integer, double or character columns may be roll joined.", xname, iname)
       if (x_merge_type=="factor" && i_merge_type=="factor") {
         if (verbose) catf("Matching %s factor levels to %s factor levels.\n", iname, xname)
         set(i, j=icol, value=chmatch(levels(i[[icol]]), levels(x[[xcol]]), nomatch=0L)[i[[icol]]])  # nomatch=0L otherwise a level that is missing would match to NA values
@@ -86,7 +92,6 @@ bmerge = function(i, x, icols, xcols, roll, rollends, nomatch, mult, ops, verbos
       }
       stopf("Incompatible join types: %s (%s) and %s (%s). Factor columns must join to factor or character columns.", xname, x_merge_type, iname, i_merge_type)
     }
-    # we check factors first to cater for the case when trying to do rolling joins on factors
     if (x_merge_type == i_merge_type) {
       if (verbose) catf("%s has same type (%s) as %s. No coercion needed.\n", iname, x_merge_type, xname)
       next

R/data.table.R

@@ -221,7 +221,7 @@ replace_dot_alias = function(e) {
     }
     return(x)
   }
-  if (!mult %chin% c("first","last","all")) stopf("mult argument can only be 'first', 'last' or 'all'")
+  if (!mult %chin% c("first", "last", "all")) stopf("mult argument can only be 'first', 'last' or 'all'")
   missingroll = missing(roll)
   if (length(roll)!=1L || is.na(roll)) stopf("roll must be a single TRUE, FALSE, positive/negative integer/double including +Inf and -Inf or 'nearest'")
   if (is.character(roll)) {

R/test.data.table.R

@@ -229,8 +229,9 @@ test.data.table = function(script="tests.Rraw", verbose=FALSE, pkg=".", silent=F
   # notranslate start
   cat("\n", date(),   # so we can tell exactly when these tests ran on CRAN to double-check the result is up to date
     "  endian==", .Platform$endian,
-    ", sizeof(long double)==", .Machine$sizeof.longdouble,
-    ", longdouble.digits==", .Machine$longdouble.digits, # 64 normally, 53 for example under valgrind where some high accuracy tests need turning off, #4639
+    ", sizeof(long double)==", format(.Machine$sizeof.longdouble),
+    ", capabilities('long.double')==", capabilities('long.double'), # almost certainly overkill, but that's OK; see #6154
+    ", longdouble.digits==", format(.Machine$longdouble.digits), # 64 normally, 53 for example under valgrind where some high accuracy tests need turning off, #4639
     ", sizeof(pointer)==", .Machine$sizeof.pointer,
     ", TZ==", if (is.na(tz)) "unset" else paste0("'",tz,"'"),
     ", Sys.timezone()=='", suppressWarnings(Sys.timezone()), "'",

R/utils.R

@@ -219,6 +219,17 @@ rss = function() {  #5515 #5517
   # nocov end
 }
 
+# convert char to factor retaining order #4837
+fctr = function(x, levels=unique(x), ..., sort=FALSE, rev=FALSE) {
+  if (!isTRUEorFALSE(sort))
+    stopf("argument 'sort' must be TRUE or FALSE")
+  if (!isTRUEorFALSE(rev))
+    stopf("argument 'rev' must be TRUE or FALSE")
+  if (sort) levels = sort(levels)
+  if (rev) levels = rev(levels)
+  factor(x, levels=levels, ...)
+}
+
 formula_vars = function(f, x) { # .formula2varlist is not API and seems to have appeared after R-4.2, #6841
   terms <- terms(f)
   setNames(

inst/tests/other.Rraw

@@ -18,6 +18,7 @@ if (exists("test.data.table",.GlobalEnv,inherits=FALSE) ||
 }
 
 test = data.table:::test
+coerceAs = data.table:::coerceAs
 INT = data.table:::INT
 
 if (anyDuplicated(pkgs)) stop("Packages defined to be loaded for integration tests in 'inst/tests/other.Rraw' contains duplicates.")

inst/tests/tests.Rraw

@@ -21237,3 +21237,18 @@ test(2321.4, names(DT), names(data.frame(a=integer(), b=matrix(1L, nrow=0L, ncol
 ## but respect named column vectors
 test(2321.5, DT <- data.table(a=1:2, cbind(b=3:4)), data.table(a=1:2, b=3:4))
 test(2321.6, names(DT), names(data.frame(a=1:2, cbind(b=3:4))))
+
+# New fctr() helper: like factor() but retaining order by default #4837
+test(2322.01, levels(fctr(c("b","a","c"))), c("b","a","c"))
+test(2322.02, levels(fctr(c(3,1,2))), c("3","1","2"))
+test(2322.11, levels(fctr(c("b","a","c"), rev=TRUE)), c("c","a","b"))
+test(2322.12, levels(fctr(c("b","a","c"), rev=NA)), error="TRUE or FALSE")
+test(2322.21, levels(fctr(c("b","a","c"), sort=TRUE)), c("a","b","c"))
+test(2322.22, levels(fctr(c("b","a","c"), sort=NA)), error="TRUE or FALSE")
+test(2322.31, levels(fctr(c("b","a","c"), rev=TRUE, sort=TRUE)), c("c","b","a"))
+
+# data.frame() uses provided names of ITime inputs
+it <- as.ITime('00:00:00')
+test(2323.1, names(data.frame(COL = it)), "COL")
+test(2323.2, names(data.frame(b = 1, COL = it)), c("b", "COL"))
+test(2323.3, names(as.data.frame(it, optional=TRUE)), NULL)

man/fctr.Rd

@@ -0,0 +1,30 @@
+\name{fctr}
+\alias{fctr}
+\alias{factor}
+\title{Create a factor retaining original ordering}
+\description{
+  Creates a code{\link[base:factor]{factor}}.
+
+  By default, the output will have its levels in the original order, i.e., \code{levels = unique(x)}, as opposed to \code{factor}'s default where \code{levels = sort(unique(x))}.
+}
+\usage{
+fctr(x, levels=unique(x), ..., sort=FALSE, rev=FALSE)
+}
+\arguments{
+  \item{x}{ Object to be turned into a factor. }
+  \item{levels}{ Levels for the new factor; \code{unique(x)} by default. }
+  \item{\dots}{ Other arguments passed to code{\link[base:factor]{factor}}. }
+  \item{sort}{ Logical, default \code{FALSE}. Should \code{levels} be sorted? }
+  \item{rev}{ Logical, default \code{FALSE}. Should \code{levels} be reversed? Applied \emph{after} \code{sort}. }
+}
+\value{
+  Factor vector having levels ordered according to the order of elements in input and arguments \code{sort}, \code{rev}.
+}
+\examples{
+levels(factor(c("b","a","c")))
+levels(fctr(c("b","a","c")))
+levels(fctr(c("b","a","c"), rev=TRUE))
+levels(fctr(c("b","a","c"), sort=TRUE))
+levels(fctr(c("b","a","c"), sort=TRUE, rev=TRUE))
+}
+\keyword{ data }