Merge branch 'master' into issue6556

Author: venom1204

NEWS.md

@@ -129,6 +129,10 @@ rowwiseDT(
 
 17. Assignment with `:=` to an S4 slot of an under-allocated data.table now works, [#6704](https://github.com/Rdatatable/data.table/issues/6704). Thanks @MichaelChirico for the report and fix.
 
+18. `as.data.table()` method for `data.frame`s (especially those with extended classes) is more consistent with `as.data.frame()` with respect to rention of attributes, [#5699](https://github.com/Rdatatable/data.table/issues/5699). Thanks @jangorecki for the report and fix.
+
+19. Grouped queries on keyed tables no longer return an incorrectly keyed result if the _ad hoc_ `by=` list has some function call (in particular, a function which happens to return a strictly decreasing function of the keys), e.g. `by=.(a = rev(a))`, [#5583](https://github.com/Rdatatable/data.table/issues/5583). Thanks @AbrJA for the report and @MichaelChirico for the fix.
+
 ## NOTES
 
 1. There is a new vignette on joins! See `vignette("datatable-joins")`. Thanks to Angel Feliz for authoring it! Feedback welcome. This vignette has been highly requested since 2017: [#2181](https://github.com/Rdatatable/data.table/issues/2181).

R/as.data.table.R

@@ -214,6 +214,7 @@ as.data.table.list = function(x,
 }
 
 as.data.table.data.frame = function(x, keep.rownames=FALSE, key=NULL, ...) {
+  if (!identical(class(x), "data.frame")) return(as.data.table(as.data.frame(x)))
   if (!isFALSE(keep.rownames)) {
     # can specify col name to keep.rownames, #575; if it's the same as key,
     #   kludge it to 'rn' since we only apply the new name afterwards, #4468

R/data.table.R

@@ -2014,8 +2014,8 @@ replace_dot_alias = function(e) {
     if (verbose) {last.started.at=proc.time();catf("setkey() afterwards for keyby=.EACHI ... ");flush.console()}
     setkeyv(ans,names(ans)[seq_along(byval)])
     if (verbose) {cat(timetaken(last.started.at),"\n"); flush.console()}
-  } else if (keyby || (haskey(x) && bysameorder && (byjoin || (length(allbyvars) && identical(allbyvars,head(key(x),length(allbyvars))))))) {
-    setattr(ans,"sorted",names(ans)[seq_along(grpcols)])
+  } else if (.by_result_is_keyable(x, keyby, bysameorder, byjoin, allbyvars, bysub)) {
+    setattr(ans, "sorted", names(ans)[seq_along(grpcols)])
   }
   setalloccol(ans)   # TODO: overallocate in dogroups in the first place and remove this line
 }
@@ -2987,6 +2987,12 @@ setDT = function(x, keep.rownames=FALSE, key=NULL, check.names=FALSE) {
     } else if (isS4(k)) {
       .Call(CsetS4elt, k, as.character(name[[3L]]), x)
     }
+  } else if (name %iscall% "get") { # #6725
+    # edit 'get(nm, env)' call to be 'assign(nm, x, envir=env)'
+    name = match.call(get, name)
+    name[[1L]] = quote(assign)
+    name$value = x
+    eval(name, parent.frame(), parent.frame())
   }
   .Call(CexpandAltRep, x)  # issue#2866 and PR#2882
   invisible(x)
@@ -3045,6 +3051,21 @@ rleidv = function(x, cols=seq_along(x), prefix=NULL) {
   ids
 }
 
+.by_result_is_keyable = function(x, keyby, bysameorder, byjoin, byvars, bysub) {
+  if (keyby) return(TRUE)
+  k = key(x)
+  if (is.null(k)) return(FALSE) # haskey(x) but saving 'k' for below
+  if (!bysameorder) return(FALSE)
+  if (byjoin) return(TRUE)
+  if (!length(byvars)) return(FALSE)
+  if (!identical(byvars, head(k, length(byvars)))) return(FALSE) # match key exactly, in order
+  # For #5583, we also ensure there are no function calls in by (which might break sortedness)
+  if (is.name(bysub)) return(TRUE)
+  if (identical(bysub[[1L]], quote(list))) bysub = bysub[-1L]
+  if (length(all.names(bysub)) > length(byvars)) return(FALSE)
+  TRUE
+}
+
 .is_withFALSE_range = function(e, x, root=root_name(e), vars=all.vars(e)) {
   if (root != ":") return(FALSE)
   if (!length(vars)) return(TRUE)              # e.g. 1:10

inst/tests/tests.Rraw

@@ -10581,7 +10581,11 @@ test(1702.1, isoweek(test_cases), test_values)
 #   but calculating from Date brings these into play, #2407
 test(1702.2, isoweek(as.Date(test_cases)), test_values)
 
-# *** OBSCURE ERROR WHEN Sys.timezone() = 'America/Argentina/Buenos_Aires' ***
+# *** OBSCURE DST ERROR WHEN Sys.timezone() = 'America/Argentina/Buenos_Aires' ***
+# *** 00:00 does not exist, h/t rikivillalba@ who worked through this  ***
+# *** https://techcommunity.microsoft.com/blog/dstblog/argentina-is-changing-their-daylight-saving-time-on-december-30/311020 ***
+# *** https://mm.icann.org/pipermail/tz/2007-December/014743.html ***
+# *** Official IANA sources: https://www.iana.org/time-zones ***
 test(1702.3, isoweek(as.POSIXct(test_cases)), test_values)
 
 # 1% sample of a 400-year cycle of dates for extra robustness
@@ -20659,6 +20663,18 @@ setDT(d2)
 test(2295.1, !is.data.table(d1))
 test(2295.2, rownames(d1), 'b')
 test(2295.3, is.data.table(d2))
+# Ensure against regression noted in #6725
+x = data.frame(a=1)
+e = environment()
+foo = function(nm, env) {
+  setDT(get(nm, envir=env))
+}
+foo('x', e)
+test(2295.4, is.data.table(x))
+e = new.env(parent=topenv())
+e$x = data.frame(a=1)
+foo('x', e)
+test(2295.5, is.data.table(e$x))
 
 # #6588: .checkTypos used to give arbitrary strings to stopf as the first argument
 test(2296, d2[x %no such operator% 1], error = '%no such operator%')
@@ -20736,3 +20752,21 @@ test(2301.1, DT[order(a, method="auto")], error="no support for sorting by metho
 test(2301.2, DT[order(a, b, decreasing=c(TRUE, FALSE))], DT[order(-a, b)])
 test(2301.3, DT[order(a, -b, decreasing=c(TRUE, TRUE))], error="Mixing '-' with vector decreasing")
 test(2301.4, DT[order(a, b, decreasing=c(TRUE, TRUE, FALSE))], error="decreasing= has length 3")
+
+# as.data.table should remove extra attributes from extended data.frames #5699
+x = data.frame(a=c(1,5,3), b=c(2,4,6))
+class(x) = c("tbl", "data.frame")
+attr(x, "t1") = "a"
+as.data.frame.tbl = function(x) {
+  attr(x, "t1") = NULL
+  class(x) = "data.frame"
+  x
+}
+test(2302, attr(as.data.table(y), "t1"), attr(as.data.frame(y), "t1"))
+
+# by=foo(KEY) does not retain key (no way to guarantee monotonic transformation), #5583
+DT = data.table(a=1:2, key='a')
+test(2303.1, DT[, .N, by=.(b=rev(a))], data.table(b=2:1, N=1L))
+test(2303.2, DT[, .(N=1L), by=.(b=rev(a))], data.table(b=2:1, N=1L)) # ensure no interaction with GForce
+DT = data.table(a=2:3, b=1:0, key=c('a', 'b'))
+test(2303.3, DT[, .N, by=.(ab=a^b, d=c(1L, 1L))], data.table(ab=c(2, 1), d=1L, N=1L))