diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd index fcce4ea68f..75ce6d184f 100644 --- a/doc/NEWS.Rd +++ b/doc/NEWS.Rd @@ -274,6 +274,10 @@ \item Printing \code{ls.str()} now shows \code{""} 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. } } } diff --git a/src/library/grDevices/R/calc.R b/src/library/grDevices/R/calc.R index 80175e2577..ac94d8a0b1 100644 --- a/src/library/grDevices/R/calc.R +++ b/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() diff --git a/src/library/grDevices/man/xyTable.Rd b/src/library/grDevices/man/xyTable.Rd index d638e980ec..f045a35b32 100644 --- a/src/library/grDevices/man/xyTable.Rd +++ b/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)) diff --git a/src/library/grDevices/tests/xyTable.R b/src/library/grDevices/tests/xyTable.R new file mode 100644 index 0000000000..21a5b71993 --- /dev/null +++ b/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) diff --git a/src/library/grDevices/tests/xyTable.Rout.save b/src/library/grDevices/tests/xyTable.Rout.save new file mode 100755 index 0000000000..8bf3c9fa56 --- /dev/null +++ b/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 diff --git a/tests/Examples/grDevices-Ex.Rout.save b/tests/Examples/grDevices-Ex.Rout.save index 077b67d4b3..ebe9f0bbf6 100644 --- a/tests/Examples/grDevices-Ex.Rout.save +++ b/tests/Examples/grDevices-Ex.Rout.save @@ -1,5 +1,5 @@ -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 @@ -7,6 +7,8 @@ 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