roundQ(): *vectorize* also in digits; return 'bigq'

ChangeLog

+2020-07-29  Martin Maechler  <maechler@stat.math.ethz.ch>
+
+	* R/bigq.R (roundQ): use simpler *vectorized* version;
+	* tests/arith-ex.R: check it works.
+
 2020-07-23  Martin Maechler  <maechler@stat.math.ethz.ch>
 
 	* R/bigq.R (round, round0, roundQ): round0(): "round to even"; make

DESCRIPTION

 Package: gmp
 Version: 0.6-1
-Date: 2020-07-24
+Date: 2020-07-29
 Title: Multiple Precision Arithmetic
 Author: Antoine Lucas, Immanuel Scholz, Rainer Boehme <rb-gmp@reflex-studio.de>,
   Sylvain Jasson <Sylvain.Jasson@inrae.fr>,

NAMESPACE

@@ -49,7 +49,7 @@ export(
        "ncol.bigq", "ncol.bigz", "nrow.bigq", "nrow.bigz",
        "nextprime",
        "numerator", "numerator<-",
-    outer, # our own
+    outer, # our own (= base's, but with our env.!)
        ## "pow",
        "pow.bigz", "powm", "pow.bigq",
        ## "print.bigq", "print.bigz",

R/bigq.R

@@ -220,14 +220,9 @@ round0 <- function(x) {
 }
 
 roundQ <- function(x, digits = 0, r0 = round0) {
-    ## round(x * 10^d) / 10^d
-    stopifnot(length(digits) == 1L)
-    if(digits == 0)
-        r0(x)
-    else {
-        p10 <- as.bigz(10) ^ digits # bigz iff digits >= 0,  bigq otherwise
-        r0(x * p10) / p10
-    }
+    ## round(x * 10^d) / 10^d --  vectorizing in both (x, digits)
+    p10 <- as.bigz(10) ^ digits # class: if(all(digits >= 0)) "bigz" else "bigq"
+    r0(x * p10) / p10
 }
 
 ##' round() method ==> signature = (x, digits)  {round0 *not* allowed as argument}

man/roundQ.Rd

@@ -53,17 +53,17 @@ roundQ(x, digits = 0, r0 = round0)
 \examples{
 qq <- as.bigq((-21:31), 10)
 noquote(cbind(as.character(qq), asNumeric(qq)))
-round0(qq)
+round0(qq) # Big Integer ("bigz")
 ## corresponds to R's own "round to even" :
 stopifnot(round0(qq) == round(asNumeric(qq)))
+round(qq) # == round(qq, 0): the same as round0(qq) *but* Big Rational ("bigq")
 
 halfs <- as.bigq(1,2) + -5:12
 \dontshow{q <- c(halfs, qq)
-stopifnot(identical(round0(q),
-                    round (q, 0))) ;  rm(q)
+stopifnot(round0(q) == round(q)) ;  rm(q)
 }
 
-\dontshow{if(FALSE)}
+\dontshow{if(FALSE)}% do not create it in user's globalenv
 ## round0() is simply
 round0 <- function (x) {
     nU <- as.bigz.bigq(xU <- x + as.bigq(1, 2)) # traditional round: .5 rounded up
@@ -80,15 +80,11 @@ round0s <- function(x) as.bigz.bigq(x + as.bigq(1, 2))
 cbind(halfs, round0s(halfs), round0(halfs))
 
 \dontshow{if(FALSE)}
-## roundQ() is also just
+## roundQ() is simply
 roundQ <- function(x, digits = 0, r0 = round0) {
-    ## round(x * 10^d) / 10^d
-    if(digits == 0)
-        r0(x)
-    else {
-        p10 <- as.bigz(10) ^ digits  # bigz iff digits >= 0,  bigq otherwise
-        r0(x * p10) / p10
-    }
+    ## round(x * 10^d) / 10^d --  vectorizing in both (x, digits)
+    p10 <- as.bigz(10) ^ digits # class: if(all(digits >= 0)) "bigz" else "bigq"
+    r0(x * p10) / p10
 }
 }
 \keyword{arith}

tests/arith-ex.R

@@ -264,3 +264,40 @@ sapply(eqA1, table)
 eqA <- lapply(sapply(opsA4, get), function(op) opEQ(op, x, xQ, eq=FALSE))
 lapply(eqA, symnum)
 
+
+## round(x, digits) -- should work *and* be vectorized in both  (x, digits)
+x1 <- as.bigq((-19:19), 10)
+stopifnot(round(x1, 1) == x1)
+
+half <- as.bigq(1, 2)
+i1 <- (-19:29)
+x <- half + i1
+cbind(x, round(x))
+rx1 <- round(x/10, 1)
+stopifnot(exprs = {
+    as.bigz(round(x)) %% 2 == 0
+    identical(round(x) > x, i1 %% 2 == 1)
+    (rx1 - x/10) * 20 == c(1,-1) # {recycling up/down}: perfect rounding to even
+    (round(x/100, 2) - x/100) * 200 == c(1,-1) #  (ditto)
+})
+(drx1 <- asNumeric(rx1))# shows perfect round to *even*
+## but double precision rounding cannot be perfect (as numbers are not exact!):
+dx   <- asNumeric(x/10)
+dx1  <- round(dx, 1)
+dmat <- cbind(x=dx, r.x = dx1, rQx = drx1)
+## shows "the picture" a bit {see Martin's vignette in CRAN package 'round'}:
+noquote(cbind(apply(dmat, 2, formatC),
+              ER = ifelse(abs(dx1 - drx1) > 1e-10, "*", "")))
+
+## standard R:
+rd <- round(pi*10^(-2:5), digits=7:0)
+formatC(rd, digits=12, width=1)
+## bigq -- show we vectorize in both x, digits
+(rQ <- round(as.bigq(pi*10^(-2:5)), digits=7:0))
+stopifnot(exprs = {
+    as.integer(numerator  (rQ)) == 314159L
+    as.integer(denominator(rQ)) == 10^(7:0)
+    all.equal(asNumeric(rQ), rd, tol = 1e-15)
+})
+
+