Commit a62f3298 authored by Martin Maechler's avatar Martin Maechler
Browse files

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

parent d23b0086
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
......
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>,
......
......@@ -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)
})
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment