fix 18654

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

doc/NEWS.Rd

@@ -274,6 +274,10 @@
 
  \item Printing \code{ls.str()} now shows \code{"<missing>"} even when
  \R's language setting is not English.
+
+ \item \code{xyTable()} now handles and reports \code{NA}s
+ fixing \PR{18654}.
+ Thanks to Heather Turner and Zhian Kamvar for report and patch.
  }
  }
 }

src/library/grDevices/R/calc.R

@@ -131,10 +131,12 @@ xyTable <- function(x, y = NULL, digits)
  orderxy <- order(x, y)
  x <- x[orderxy]
  y <- y[orderxy]
- first <- c(TRUE, (x[-1L] != x[-n]) | (y[-1L] != y[-n]))
+ first <- which(c(TRUE,
+ (x[-1L] != x[-n]) | xor(is.na(x[-1L]), is.na(x[-n])) |
+ (y[-1L] != y[-n]) | xor(is.na(y[-1L]), is.na(y[-n]))))
  x <- x[first]
  y <- y[first]
- diff(c((1L:n)[first], n + 1L))
+ diff(c(first, n + 1L))
  }
  else integer()
 

src/library/grDevices/man/xyTable.Rd

@@ -30,12 +30,22 @@ xyTable(x, y = NULL, digits)
  \item{number}{multiplicities (positive integers); i.e.,
  \code{number[i]} is the multiplicity of \code{(x[i], y[i])}.}
 }
+\note{
+ Missing values in the coordinates are counted towards the multiplicities. The
+ sum of the multiplicities will equal the number of coordinates.
+}
 \seealso{\code{\link{sunflowerplot}} which typically uses
  \code{xyTable()}; \code{\link{signif}}.
 }
 \examples{
 xyTable(iris[, 3:4], digits = 6)
 
+## If missing coordinates exist, they are also counted
+iris2 <- iris[1:10, 3:4]
+iris2[4, 2] <- NA
+iris2[c(3, 5), ] <- NA
+xyTable(iris2)
+
 ## Discretized uncorrelated Gaussian:
 \dontshow{set.seed(1)}
 xy <- data.frame(x = round(sort(stats::rnorm(100))), y = stats::rnorm(100))

src/library/grDevices/tests/xyTable.R

@@ -0,0 +1,33 @@
+## [Bug 18654] xyTable fails when both x and y are NA (2024-01-16)
+## https://bugs.r-project.org/show_bug.cgi?id=18654
+## Attachment 3292 https://bugs.r-project.org/attachment.cgi?id=3292
+## Scenarios authored by Heather Turner in comments #1 and #5
+
+## Case 2: one variable has NA - works fine
+## (first combination from Case 1 now has NA)
+iris2 <- iris[1:10, 3:4]
+iris2[3, 1] <- NA
+xyTable(iris2)
+
+## Case 3: both x and y are NA for one case - no good
+## (`number` should be the same as for Case 2)
+iris3 <- iris[1:10, 3:4]
+iris3[3, ] <- NA
+xyTable(iris3)
+
+
+## Case 4: both x and y are NA for >1 case - no good
+## (records with both NA are not aggregated)
+iris4 <- iris[1:10, 3:4]
+iris4[c(3, 5), ] <- NA
+xyTable(iris4)
+
+## Case 5: NA in y when x is duplicated
+iris5 <- iris[1:10, 3:4]
+iris5[4, 2] <- NA
+xyTable(iris5)
+
+## Case 6: NA in y when x is duplicated
+iris6 <- iris[1:10, 3:4]
+iris6[] <- NA
+xyTable(iris6)

src/library/grDevices/tests/xyTable.Rout.save

@@ -0,0 +1,99 @@
+
+R Under development (unstable) (2024-09-12 r87143) -- "Unsuffered Consequences"
+Copyright (C) 2024 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> ## [Bug 18654] xyTable fails when both x and y are NA (2024-01-16)
+> ## https://bugs.r-project.org/show_bug.cgi?id=18654
+> ## Attachment 3292 https://bugs.r-project.org/attachment.cgi?id=3292
+> ## Scenarios authored by Heather Turner in comments #1 and #5
+> 
+> ## Case 2: one variable has NA - works fine
+> ## (first combination from Case 1 now has NA)
+> iris2 <- iris[1:10, 3:4]
+> iris2[3, 1] <- NA
+> xyTable(iris2)
+$x
+[1] 1.4 1.4 1.5 1.5 1.7 NA
+
+$y
+[1] 0.2 0.3 0.1 0.2 0.4 0.2
+
+$number
+[1] 4 1 1 2 1 1
+
+> 
+> ## Case 3: both x and y are NA for one case - no good
+> ## (`number` should be the same as for Case 2)
+> iris3 <- iris[1:10, 3:4]
+> iris3[3, ] <- NA
+> xyTable(iris3)
+$x
+[1] 1.4 1.4 1.5 1.5 1.7 NA
+
+$y
+[1] 0.2 0.3 0.1 0.2 0.4 NA
+
+$number
+[1] 4 1 1 2 1 1
+
+> 
+> 
+> ## Case 4: both x and y are NA for >1 case - no good
+> ## (records with both NA are not aggregated)
+> iris4 <- iris[1:10, 3:4]
+> iris4[c(3, 5), ] <- NA
+> xyTable(iris4)
+$x
+[1] 1.4 1.4 1.5 1.5 1.7 NA
+
+$y
+[1] 0.2 0.3 0.1 0.2 0.4 NA
+
+$number
+[1] 3 1 1 2 1 2
+
+> 
+> ## Case 5: NA in y when x is duplicated
+> iris5 <- iris[1:10, 3:4]
+> iris5[4, 2] <- NA
+> xyTable(iris5)
+$x
+[1] 1.3 1.4 1.4 1.5 1.5 1.5 1.7
+
+$y
+[1] 0.2 0.2 0.3 0.1 0.2 NA 0.4
+
+$number
+[1] 1 4 1 1 1 1 1
+
+> 
+> ## Case 6: NA in y when x is duplicated
+> iris6 <- iris[1:10, 3:4]
+> iris6[] <- NA
+> xyTable(iris6)
+$x
+[1] NA
+
+$y
+[1] NA
+
+$number
+[1] 10
+
+> 
+> proc.time()
+ user system elapsed 
+ 0.156 0.015 0.168 

tests/Examples/grDevices-Ex.Rout.save

@@ -1,12 +1,14 @@
 
-R Under development (unstable) (2024-02-26 r85989) -- "Unsuffered Consequences"
+R Under development (unstable) (2024-08-29 r87078) -- "Unsuffered Consequences"
 Copyright (C) 2024 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu
 
 R is free software and comes with ABSOLUTELY NO WARRANTY.
 You are welcome to redistribute it under certain conditions.
 Type 'license()' or 'licence()' for distribution details.
 
+ Natural language support but running in an English locale
+
 R is a collaborative project with many contributors.
 Type 'contributors()' for more information and
 'citation()' on how to cite R or R packages in publications.
@@ -3651,15 +3653,15 @@ attr(,"class")
 > 
 > ## IGNORE_RDIFF_BEGIN
 > pretty(Sys.Date())
-[1] "2024-02-24" "2024-02-25" "2024-02-26" "2024-02-27" "2024-02-28"
-[6] "2024-02-29"
+[1] "2024-08-28" "2024-08-29" "2024-08-30" "2024-08-31" "2024-09-01"
+[6] "2024-09-02"
 > pretty(Sys.time(), n = 10)
- [1] "2024-02-26 13:27:03 CET" "2024-02-26 13:27:04 CET"
- [3] "2024-02-26 13:27:05 CET" "2024-02-26 13:27:06 CET"
- [5] "2024-02-26 13:27:07 CET" "2024-02-26 13:27:08 CET"
- [7] "2024-02-26 13:27:09 CET" "2024-02-26 13:27:10 CET"
- [9] "2024-02-26 13:27:11 CET" "2024-02-26 13:27:12 CET"
-[11] "2024-02-26 13:27:13 CET"
+ [1] "2024-08-30 15:57:05 NZST" "2024-08-30 15:57:06 NZST"
+ [3] "2024-08-30 15:57:07 NZST" "2024-08-30 15:57:08 NZST"
+ [5] "2024-08-30 15:57:09 NZST" "2024-08-30 15:57:10 NZST"
+ [7] "2024-08-30 15:57:11 NZST" "2024-08-30 15:57:12 NZST"
+ [9] "2024-08-30 15:57:13 NZST" "2024-08-30 15:57:14 NZST"
+[11] "2024-08-30 15:57:15 NZST"
 > ## IGNORE_RDIFF_END
 > pretty(as.Date("2000-03-01")) # R 1.0.0 came in a leap year
 [1] "2000-02-28" "2000-02-29" "2000-03-01" "2000-03-02" "2000-03-03"
@@ -4297,6 +4299,21 @@ $number
  [38] 2 1 2 1 1 2 1 5 1 1 1 1 1 1 2 1 1 1 3 2 2 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1
  [75] 1 1 2 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 
+> 
+> ## If missing coordinates exist, they are also counted
+> iris2 <- iris[1:10, 3:4]
+> iris2[4, 2] <- NA
+> iris2[c(3, 5), ] <- NA
+> xyTable(iris2)
+$x
+[1] 1.4 1.4 1.5 1.5 1.5 1.7 NA
+
+$y
+[1] 0.2 0.3 0.1 0.2 NA 0.4 NA
+
+$number
+[1] 3 1 1 1 1 1 2
+
 > 
 > ## Discretized uncorrelated Gaussian:
 > ## Don't show: 
@@ -4449,7 +4466,7 @@ NULL
 > cleanEx()
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 29.951 0.398 30.64 0 0 
+Time elapsed: 29.539 0.389 31.994 0 0 
 > grDevices::dev.off()
 null device 
  1