[.table no longer loses other classes

git-svn-id: https://svn.r-project.org/R/trunk@88279 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: maechler

doc/NEWS.Rd

@@ -110,6 +110,9 @@
       \item The \code{Pair(x,y)} construction in the formula interface to
       paired tests did not work with the \code{subset} argument, due to the
       absence of a \code{[.Pair} method, which has now been added.
+
+      \item Subsetting \code{"table"} objects keeps S3 classes more
+      consistently, fixing \PR{18845}.
     }
   }
 }

src/library/base/R/table.R

@@ -1,7 +1,7 @@
 #  File src/library/base/R/table.R
 #  Part of the R package, https://www.R-project.org
 #
-#  Copyright (C) 1995-2023 The R Core Team
+#  Copyright (C) 1995-2025 The R Core Team
 #
 #  This program is free software; you can redistribute it and/or modify
 #  it under the terms of the GNU General Public License as published by
@@ -319,12 +319,13 @@ margin.table <- marginSums
 ##     z
 ## }
 
+
 `[.table` <-
 function(x, i, j, ..., drop = TRUE)
 {
     ret <- NextMethod()
     ldr <- length(dim(ret))
-    if((ldr > 1L) || (ldr == length(dim(x))))
-        class(ret) <- "table"
+    if((ldr > 1L || ldr == length(dim(x))) && !inherits(ret, "table"))
+        class(ret) <- if(any((cl <- oldClass(x)) == "table")) cl else c("table", cl)
     ret
 }

tests/reg-tests-1e.R

@@ -1968,6 +1968,19 @@ stopifnot(identical(p1[2], substr(zp,1,1)),
 ## p2 gave warning too, and was the same as p1, erronously in  R <= 4.5.0
 
 
+## `[.table` consistency, PR#18845
+T <- table(c(0:3,3:1,1:0), c(0:4,3:0)) ; class(T) <- c("myT", class(T))
+T1 <- T[,3 , drop=FALSE]; dim(T1) <- length(T1); str(T1) # 1d table
+stopifnot(exprs = {
+    identical(T, T[TRUE,]) # [..]  had lost "myT" class
+    identical(T, T[,TRUE])
+    identical(T1, T1[TRUE]) # (worked before)
+    identical(class(T1), class(T)) # failed
+    identical(T1, T1[TRUE])
+})
+## subsetting only kept "table" class in R <= 4.5.x
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,