From 2cd016b4cde5b160861efc8d95e70561f6cbb291 Mon Sep 17 00:00:00 2001 From: David C Hall Date: Fri, 6 Nov 2026 15:50:49 -0600 Subject: [PATCH 1/4] Fix PDG rounding for 950-999 uncertainty values Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- R/print.R | 9 ++++++++- R/utils.R | 10 +++++++++- tests/testthat/test-print.R | 2 +- 3 files changed, 18 insertions(+), 3 deletions(-) diff --git a/R/print.R b/R/print.R index e01f24a..6671b91 100644 --- a/R/print.R +++ b/R/print.R @@ -42,13 +42,20 @@ format.errors = function(x, stopifnot(notation %in% c("parenthesis", "plus-minus")) if (is.null(digits)) digits <- getOption("errors.digits", 1) - digits <- if (digits == "pdg") digits_pdg(.e(x)) else rep(digits, length(x)) + is_pdg <- identical(digits, "pdg") + digits <- if (is_pdg) digits_pdg(.e(x)) else rep(digits, length(x)) scipen <- getOption("scipen", 0) prepend <- rep("", length(x)) append <- rep("", length(x)) e <- signif(.e(x), digits) + if (is_pdg) { + pdg_round <- pdg_round_to_1000(.e(x)) + if (any(pdg_round)) { + e[pdg_round] <- round(.e(x[pdg_round]), digits = -get_exponent(.e(x[pdg_round]))) + } + } nulle <- e == 0 & !is.na(e) eexp <- get_exponent(e) xexp <- ifelse(.v(x) == 0, eexp + 1, get_exponent(x)) diff --git a/R/utils.R b/R/utils.R index 3e74f64..571fa8e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -16,13 +16,21 @@ zstd <- function(x, op) { get_exponent <- function(x) ifelse(.v(x), floor(log10(abs(.v(x)))), 0) +pdg_round_to_1000 <- function(x) { + x <- ifelse(is.finite(x), x, 0) + x_sci <- formatC(abs(x), digits=2, format="e", decimal.mark=".") + x_hod <- as.integer(gsub("(\\.|e.*)", "", x_sci)) + + x_hod >= 950 & x_hod < 1000 +} + digits_pdg <- function(x) { # extract 3 highest order digits x <- ifelse(is.finite(x), x, 0) x_sci <- formatC(abs(x), digits=2, format="e", decimal.mark=".") x_hod <- as.integer(gsub("(\\.|e.*)", "", x_sci)) - ifelse(x_hod < 355, 2, ifelse(x_hod < 950, 1, 0)) + ifelse(x_hod < 355, 2, ifelse(x_hod < 950, 1, 2)) } propagate <- function(xx, x, y, dx, dy, method=getOption("errors.propagation", "taylor-first-order")) { diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index 6281e28..a1690ea 100644 --- a/tests/testthat/test-print.R +++ b/tests/testthat/test-print.R @@ -47,7 +47,7 @@ test_that("error formatting works properly", { x <- set_errors(rep(0.827, 3), c(0.119, 0.367, 0.962)) expect_equal(format(x, notation="plus-minus", digits="pdg"), sapply(list( - c("0.83", "0.12"), c("0.8", "0.4"), c("1", "1")), + c("0.83", "0.12"), c("0.8", "0.4"), c("0.8", "1.0")), paste, collapse=paste("", .pm, ""))) x <- set_errors(10, 1) From 19d8c24fff1696efeb29bfad96509192475b702c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?I=C3=B1aki=20=C3=9Acar?= Date: Sat, 7 Nov 2026 11:07:26 +0100 Subject: [PATCH 2/4] Fix PDG 950-999 boundary rounding, refactor helpers, add tests - Round 950-999 uncertainties up to the next power of ten explicitly, since round() rounded e.g. 0.95 down to 0.9 - Share the highest-order-digit extraction via pdg_hod() and round once - Add tests for the boundary, other magnitudes and both notations - Add NEWS entry under a new devel header Co-Authored-By: Claude Opus 5.5 --- NEWS.md | 6 ++++++ R/print.R | 19 ++++++++++--------- R/utils.R | 16 ++++------------ tests/testthat/test-print.R | 10 ++++++++++ 4 files changed, 30 insertions(+), 21 deletions(-) diff --git a/NEWS.md b/NEWS.md index 9848db3..197c87a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# errors devel + +- Fix PDG rounding (`digits="pdg"`) for uncertainties whose three highest + order digits are 950-999, which are now rounded up to 1000 and keep two + significant digits (@davidchall #70 addressing #65). + # errors 0.4.5 - Fix `print()` method, which now correctly returns the object invisibly (#64). diff --git a/R/print.R b/R/print.R index 6671b91..0cb7de5 100644 --- a/R/print.R +++ b/R/print.R @@ -42,20 +42,21 @@ format.errors = function(x, stopifnot(notation %in% c("parenthesis", "plus-minus")) if (is.null(digits)) digits <- getOption("errors.digits", 1) - is_pdg <- identical(digits, "pdg") - digits <- if (is_pdg) digits_pdg(.e(x)) else rep(digits, length(x)) + ee <- .e(x) + if (identical(digits, "pdg")) { + hod <- pdg_hod(ee) + digits <- digits_pdg(hod) + # PDG: 950-999 round up to 1000 and keep two significant digits + e <- ifelse(hod >= 950, 10^(get_exponent(ee) + 1), signif(ee, digits)) + } else { + digits <- rep(digits, length(x)) + e <- signif(ee, digits) + } scipen <- getOption("scipen", 0) prepend <- rep("", length(x)) append <- rep("", length(x)) - e <- signif(.e(x), digits) - if (is_pdg) { - pdg_round <- pdg_round_to_1000(.e(x)) - if (any(pdg_round)) { - e[pdg_round] <- round(.e(x[pdg_round]), digits = -get_exponent(.e(x[pdg_round]))) - } - } nulle <- e == 0 & !is.na(e) eexp <- get_exponent(e) xexp <- ifelse(.v(x) == 0, eexp + 1, get_exponent(x)) diff --git a/R/utils.R b/R/utils.R index 571fa8e..4615441 100644 --- a/R/utils.R +++ b/R/utils.R @@ -16,23 +16,15 @@ zstd <- function(x, op) { get_exponent <- function(x) ifelse(.v(x), floor(log10(abs(.v(x)))), 0) -pdg_round_to_1000 <- function(x) { - x <- ifelse(is.finite(x), x, 0) - x_sci <- formatC(abs(x), digits=2, format="e", decimal.mark=".") - x_hod <- as.integer(gsub("(\\.|e.*)", "", x_sci)) - - x_hod >= 950 & x_hod < 1000 -} - -digits_pdg <- function(x) { +pdg_hod <- function(x) { # extract 3 highest order digits x <- ifelse(is.finite(x), x, 0) x_sci <- formatC(abs(x), digits=2, format="e", decimal.mark=".") - x_hod <- as.integer(gsub("(\\.|e.*)", "", x_sci)) - - ifelse(x_hod < 355, 2, ifelse(x_hod < 950, 1, 2)) + as.integer(gsub("(\\.|e.*)", "", x_sci)) } +digits_pdg <- function(hod) ifelse(hod < 355, 2, ifelse(hod < 950, 1, 2)) + propagate <- function(xx, x, y, dx, dy, method=getOption("errors.propagation", "taylor-first-order")) { # if y not defined, use a vector of NAs if (length(y) == 1 && is.na(y)) diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index a1690ea..0b35821 100644 --- a/tests/testthat/test-print.R +++ b/tests/testthat/test-print.R @@ -50,6 +50,16 @@ test_that("error formatting works properly", { c("0.83", "0.12"), c("0.8", "0.4"), c("0.8", "1.0")), paste, collapse=paste("", .pm, ""))) + # PDG 950-999 rounding up to 1000: boundary, magnitudes, notations + x <- set_errors(c(1, 1, 0.827, 827, 1e-5), c(0.95, 0.9495, 0.962, 96.2, 9.62e-6)) + expect_equal(format(x, notation="plus-minus", digits="pdg"), c(sapply(list( + c("1.0", "1.0"), c("1.0", "1.0"), c("0.8", "1.0"), c("830", "100")), + paste, collapse=paste("", .pm, "")), paste0("(1.0 ", .pm, " 1.0)e-5"))) + expect_equal(format(x, notation="parenthesis", digits="pdg"), + c("1.0(10)", "1.0(10)", "0.8(10)", "830(100)", "1.0(10)e-5")) + expect_equal(format(x, notation="parenthesis", digits="pdg", scientific=TRUE), + c("1.0(10)e0", "1.0(10)e0", "8(10)e-1", "8.3(10)e2", "1.0(10)e-5")) + x <- set_errors(10, 1) expect_equal(format(x - set_errors(10)), "0(1)") expect_equal(format(x - x), "0(0)") From 21e5d9075cb61287c7af3bedf9985bc534775e62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?I=C3=B1aki=20=C3=9Acar?= Date: Sat, 7 Nov 2026 11:14:28 +0100 Subject: [PATCH 3/4] bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e465302..bc0b166 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: errors Type: Package Title: Uncertainty Propagation for R Vectors -Version: 0.4.5 +Version: 0.4.5.1 Authors@R: c( person("Iñaki", "Ucar", email="iucar@fedoraproject.org", role=c("aut", "cph", "cre"), comment=c(ORCID="0000-0001-6403-5550")), From e4e79a532f5f20abf2134bf23ba6d6904cee33dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?I=C3=B1aki=20=C3=9Acar?= Date: Sat, 7 Nov 2026 11:17:43 +0100 Subject: [PATCH 4/4] Add PDG band-edge and special-value tests Cover the 100/354/355/949/950/999 edges, 0.9996 rolling over to the next power of ten, the rounded (not truncated) three highest digits, zero/negative values and zero/NA/Inf errors with digits="pdg". Co-Authored-By: Claude Opus 5.5 --- tests/testthat/test-print.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index 0b35821..446e23a 100644 --- a/tests/testthat/test-print.R +++ b/tests/testthat/test-print.R @@ -60,6 +60,20 @@ test_that("error formatting works properly", { expect_equal(format(x, notation="parenthesis", digits="pdg", scientific=TRUE), c("1.0(10)e0", "1.0(10)e0", "8(10)e-1", "8.3(10)e2", "1.0(10)e-5")) + # PDG band edges (three highest order digits are rounded, not truncated) + x <- set_errors(rep(0.827, 7), c(0.100, 0.354, 0.3549, 0.355, 0.949, 0.999, 0.9996)) + expect_equal(format(x, notation="plus-minus", digits="pdg"), sapply(list( + c("0.83", "0.10"), c("0.83", "0.35"), c("0.8", "0.4"), c("0.8", "0.4"), + c("0.8", "0.9"), c("0.8", "1.0"), c("0.8", "1.0")), + paste, collapse=paste("", .pm, ""))) + + # PDG with zero/negative values and zero/non-finite errors + x <- set_errors(c(0, 0, -0.827, 0.827, 1, 1), c(0.962, 0.119, 0.962, 0, NA, Inf)) + expect_equal(format(x, notation="plus-minus", digits="pdg"), sapply(list( + c("0.0", "1.0"), c("0.00", "0.12"), c("-0.8", "1.0"), c("0.827", "0"), + c("1", "NA"), c("1", "Inf")), + paste, collapse=paste("", .pm, ""))) + x <- set_errors(10, 1) expect_equal(format(x - set_errors(10)), "0(1)") expect_equal(format(x - x), "0(0)")