Commit a62f3298 by Martin Maechler

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

parent d23b0086
 2020-07-29 Martin Maechler * R/bigq.R (roundQ): use simpler *vectorized* version; * tests/arith-ex.R: check it works. 2020-07-23 Martin Maechler * R/bigq.R (round, round0, roundQ): round0(): "round to even"; make ... ...
 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 , Sylvain Jasson , ... ...
 ... ... @@ -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", ... ...
 ... ... @@ -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} ... ...
 ... ... @@ -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} ... ...
 ... ... @@ -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) })
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!