>=
f(as.brob(10)^1000)
@
\noindent showing a further degradation of precision. However,
observe that conventional double precision arithmetic cannot deal with
numbers this big, and the package returns about 12 correct significant
figures.
\section{A practical example}
In the field of population dynamics, and especially the modelling of
biodiversity~\citep{hankin2007b,hubbell2001}, complicated
combinatorial formulae often arise.
\citet{etienne2005}, for example, considers a sample of~$N$
individual organisms taken from some natural population; the sample
includes~$S$ distinct species, and each individual is assigned a label
in the range~$1$ to~$S$. The sample comprises~$n_i$ members of
species~$i$, with~$1\leq i\leq S$ and~$\sum n_i=N$. For a given
sample~$D$ Etienne defines, amongst other terms, $K(D,A)$ for $1\leq
A\leq N-S+1$ as
\begin{equation}
\sum_{
\left\{
a_1,\ldots,a_S\left|
\sum_{i=1}^S a_i=A\right.
\right\}}
\prod_{i=1}^S
\frac{
\overline{s}(n_i,a_i)
\overline{s}(a_i,1)}{
\overline{s}(n_i,1)}
\end{equation}
\noindent
where~$\overline{s}(n,a)$ is the Stirling number of the second
kind~\citep{abramowitz1965}. The summation is over~$a_i=1,\ldots,n_i$
with the restriction that the~$a_i$ sum to~$A$, as carried out by
\code{blockparts()} of the \pkg{partitions}
package~\citep{hankin2006,hankin2007}.
Taking an intermediate-sized dataset due to Saunders\footnote{The
dataset comprises species counts on kelp holdfasts;
here \code{saunders.exposed.tot} of package
\pkg{untb}~\citep{hankin2007b}, is used.} of only~5903 individuals---a
relatively small dataset in this context---the maximal element
of~$K(D,A)$ is about~$1.435\times 10^{1165}$. The accuracy of package
\pkg{Brobdingnag} in this context may be assessed by comparing it with
that computed by \proglang{PARI/GP}~\citep{batut2000} with a working precision
of~100 decimal places; the natural logs of the two values
are~$2682.8725605988689$ and~$2682.87256059887$ respectively:
identical to 14 significant figures.
%Pari with 100 decimal places gives 2682.872560598868918515209515642292607616628612201118344882119616522539674163937533805390351760715777.
% 2682.8725605988689
%and with R: 2682.87256059887
\section{Conclusions}
The \pkg{Brobdingnag} package allows representation and manipulation
of numbers larger than those covered by standard double precision
arithmetic, although accuracy is eroded for very large numbers. This
facility is useful in several contexts, including combinatorial
computations such as encountered in theoretical modelling of
biodiversity.
\subsubsection*{Acknowledgments}
I would like to acknowledge the many stimulating and helpful comments
made by the \proglang{R}-help list over the years.
\bibliography{brob}
\end{document}
Brobdingnag/vignettes/brobmat.Rmd 0000644 0001762 0000144 00000006634 14176571204 016610 0 ustar ligges users ---
title: "Brobdingnagian matrices"
author: "Robin K. S. Hankin"
date: "`r Sys.Date()`"
vignette: >
%\VignetteIndexEntry{brobmat}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r set-options, echo = FALSE}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", dev = "png", fig.width = 7, fig.height = 3.5, message = FALSE, warning = FALSE)
options(width = 80, tibble.width = Inf)
```
# Brobdgingnagian matrices
R package `Brobdingnag` has basic functionality for matrices. It
includes matrix multiplication and addition, but determinants and
matrix inverses are not implemented. First load the package:
```{r}
library("Brobdingnag")
```
The standard way to create a Brobdgingnagian matrix (a `brobmat`) is
to use function `brobmat()` which takes arguments similar to
`matrix()` and returns a matrix of entries created with `brob()`:
```{r}
M1 <- brobmat(-10:13,4,6)
colnames(M1) <- state.abb[1:6]
M1
```
Function `brobmat()` takes an argument `positive` which specifies the sign:
```{r}
M2 <- brobmat(
c(1,104,-66,45,1e40,-2e40,1e-200,232.2),2,4,
positive=c(T,F,T,T,T,F,T,T))
M2
```
Standard matrix arithmetic is implemented, thus:
```{r}
rownames(M2) <- c("a","b")
colnames(M2) <- month.abb[1:4]
M2
M2[2,3] <- 0
M2
M2+1000
```
We can also do matrix multiplication, although it is slow:
```{r}
M2 %*% M1
```
## Numerical verification: matrix multiplication
We will verify matrix multiplication by carrying out the same
operation in two different ways. First, create two largish
Brobdingnagian matrices:
```{r}
nrows <- 11
ncols <- 18
M3 <- brobmat(rnorm(nrows*ncols),nrows,ncols,positive=sample(c(T,F),nrows*ncols,replace=T))
M4 <- brobmat(rnorm(nrows*ncols),ncols,nrows,positive=sample(c(T,F),nrows*ncols,replace=T))
M3[1:3,1:3]
```
Now calculate the matrix product by coercing to numeric matrices and
multiplying:q
```{r}
p1 <- as.matrix(M3) %*% as.matrix(M4)
```
and then by using Brobdingnagian matrix multiplying, and then coercing
to numeric:
```{r}
p2 <- as.matrix(M3 %*% M4)
```
The difference:
```{r}
max(abs(p1-p2))
```
is small. Now the other way:
```{r}
q1 <- M3 %*% M4
q2 <- as.brobmat(as.matrix(M3) %*% as.matrix(M4))
max(abs(as.brob(q1-q2)))
```
## Numerical verification: integration with the `cubature` package
The matrix functionality of the `Brobdingnag` package was originally
written to leverage the functionality of the `cubature` package. Here
I give some numerical verification for this.
Suppose we wish to evaluate
\[
\int_{x=0}^{x=4}(x^2-4)\,dx
\]
using numerical methods. See how the integrand includes positive and
negative values; the theoretical value is $\frac{16}{3}=5.33\ldots$.
The `cubature` idiom for this would be
```{r,label = numericalintegration}
library("cubature")
f.numeric <- function(x){x^2 - 4}
out.num <- cubature::hcubature(f = f.numeric, lowerLimit = 0, upperLimit = 4, vectorInterface = TRUE)
out.num
```
and the Brobdingnagian equivalent would be
```{r,label = numericalintegrationbrob}
f.brob <- function(x) {
x <- as.brob(x[1, ])
as.matrix( brobmat(x^2 - 4, ncol = length(x)))
}
out.brob <- cubature::hcubature(f = f.brob, lowerLimit = 0, upperLimit = 4, vectorInterface = TRUE)
out.brob
```
We may compare the two methods:
```{r,label=comparebrobandnumeric}
out.brob$integral - out.num$integral
```
Brobdingnag/R/ 0000755 0001762 0000144 00000000000 14220452662 012672 5 ustar ligges users Brobdingnag/R/aaa_allclasses.R 0000644 0001762 0000144 00000000532 14220452662 015745 0 ustar ligges users setClass("brobmat", slots = c(x="matrix",positive="logical"))
setClass("swift",
representation = "VIRTUAL"
)
setClass("brob",
slots = c(x="numeric",positive="logical"),
contains = "swift"
)
setClass("glub",
slots = c(real="brob",imag="brob"),
contains = "swift"
)
Brobdingnag/R/matrix.R 0000644 0001762 0000144 00000021345 14207324737 014334 0 ustar ligges users `.brobmat.valid` <- function(object){
if(length(object@x) != length(object@positive)){
return("length mismatch")
} else {
return(TRUE)
}
}
setValidity("brobmat", .Brob.valid)
`newbrobmat` <- function(x,positive){
new("brobmat", x=x, positive=c(positive)) # this is the only use of new() here
}
`brobmat` <- function(..., positive){
data <- list(...)[[1]]
if(is.matrix(data)){
M <- data
} else if(is.brob(data)){
jj <- list(...)
jj[[1]] <- getX(data)
M <- do.call(matrix,jj) # signs not accounted for
return(newbrobmat(M,positive=getP(data)))
} else {
M <- matrix(...)
}
if(missing(positive)){positive <- rep(TRUE,length(M))}
positive <- cbind(c(M),positive)[,2]>0
return(newbrobmat(M,positive=positive))
}
`is.brobmat` <- function(x){is(x,"brobmat")}
setMethod("getX","brobmat",function(x){x@x})
setMethod("getX","numeric",function(x){x})
setMethod("getP","brobmat",function(x){
out <- getX(x)
storage.mode(out) <- "logical"
out[] <- x@positive
## No occurrences of '@' after this line
return(out)
})
setMethod("getP","numeric",function(x){x>0})
setMethod("length","brobmat",function(x){length(getX(x))})
`as.brobmat` <- function(x){
if(is.brob(x)){
return(newbrobmat(matrix(getX(x)),matrix(getP(x)))) # n-by-1
} else if(is.numeric(x)){
x <- as.matrix(x)
return(newbrobmat(log(abs(x)), c(x>=0)))
}
}
`is.brobmat` <- function(x){is(x,"brobmat")}
setAs("brobmat", "matrix", function(from){
out <- exp(getX(from))
negs <- !getP(from)
out[negs] <- -out[negs]
return(out)
} )
`brobmat_to_brob` <- function(x){ brob(c(getX(x)),c(getP(x))) }
setMethod("as.matrix",signature(x="brobmat"),function(x){as(x,"matrix")})
setGeneric("nrow")
setGeneric("ncol")
setMethod("nrow",signature(x="brobmat"),function(x){nrow(getX(x))})
setMethod("ncol",signature(x="brobmat"),function(x){ncol(getX(x))})
`.brobmat.print` <- function(x, digits=5){
out <- getX(x)
out[] <- paste(c("-","+")[1+getP(x)],"exp(",signif(out,digits),")",sep="")
noquote(out)
}
`print.brobmat` <- function(x, ...){
jj <- .brobmat.print(x, ...)
print(jj)
return(invisible(jj))
}
setMethod("show", "brobmat", function(object){print.brobmat(object)})
setMethod("Math", "brobmat",
function(x){
switch(.Generic,
abs = brobmat(getX(x)),
log = {
out <- getX(x)
out[!getP(x)] <- NaN
out # numeric matrix
},
log10 = {
out <- getX(x)
out[!getP(x)] <- NaN
out/log(10) # numeric matrix
},
log2 = {
out <- getX(x)
out[!getP(x)] <- NaN
out/log(2) # numeric matrix
},
exp =,
cosh =,
sinh =,
acos =,
acosh =,
asin =,
asinh =,
atan =,
atanh =,
cos =,
sin =,
tan =,
tanh =,
trunc =,
lgamma =,
cumsum =,
gamma =,
ceiling=,
floor =,
stop(gettextf("Function %s not implemented on brobmat objects", dQuote(.Generic)))
)
} )
setMethod("Arith",signature(e1 = "brobmat", e2="missing"),
function(e1,e2){
switch(.Generic,
"+" = e1,
"-" = newbrobmat(getX(e1),positive=!getP(e1)),
stop(gettextf("unary operator %s not implemented on brobmat objects", dQuote(.Generic)))
)
} )
"brobmat.arith" <- function(e1,e2){
switch(.Generic,
"+" = brobmat.add (e1, e2),
"-" = brobmat.add (e1, -e2),
"*" = brobmat.mult (e1, e2),
"/" = brobmat.mult (e1, brobmat.inverse(e2)),
"^" = brobmat.power(e1, e2),
stop(gettextf("binary operator %s not implemented on Brobdingnagian numbers", dQuote(.Generic)))
) }
setMethod("Arith", signature(e1 = "brobmat", e2="brob" ), brobmat.arith)
setMethod("Arith", signature(e1 = "brob" , e2="brobmat"), brobmat.arith)
setMethod("Arith", signature(e1 = "brobmat", e2="ANY" ), brobmat.arith)
setMethod("Arith", signature(e1 = "ANY" , e2="brobmat"), brobmat.arith)
setMethod("Arith", signature(e1 = "brobmat", e2="brobmat"), brobmat.arith)
`getat` <- function(e1,e2=e1){
if(length(e1)>=length(e2)){
return(attributes(getX(e1)))
} else {
return(attributes(getX(e2)))
}
}
`brobmat.add` <- function(e1,e2){
out <- as.brob(e1) + as.brob(e2)
jj <- getX(out)
attributes(jj) <- getat(e1,e2)
return(newbrobmat(jj,getP(out)))
}
`brobmat.mult` <- function(e1,e2){
out <- as.brob(e1) * as.brob(e2)
jj <- getX(out)
attributes(jj) <- getat(e1,e2)
return(newbrobmat(jj,getP(out)))
}
`brobmat.inverse` <- function(e1){
if(is.brobmat(e1)){
out <- 1/as.brob(e1)
jj <- getX(out)
attributes(jj) <- getat(e1)
return(newbrobmat(jj,getP(out)))
} else {
return(1/e1)
}
}
`brobmat.power` <- function(e1,e2){
out <- as.brob(e1) ^ as.brob(e2)
jj <- getX(out)
attributes(jj) <- getat(e1,e2)
return(newbrobmat(jj,getP(out)))
}
"brobmat.equal" <- function(e1,e2){
out <- as.brob(e1) == as.brob(e2)
attributes(out) <- getat(e1,e2)
return(out)
}
"brobmat.greater" <- function(e1,e2){
out <- as.brob(e1) > as.brob(e2)
attributes(out) <- getat(e1,e2)
return(out)
}
"brobmat.compare" <- function(e1,e2){
if( (length(e1) == 0) | (length(e2)==0)) {
return(logical(0))
}
switch(.Generic,
"==" = brobmat.equal(e1,e2),
"!=" = !brobmat.equal(e1,e2),
">" = brobmat.greater(e1,e2),
"<" = !brobmat.greater(e1,e2) & !brobmat.equal(e1,e2),
">=" = brobmat.greater(e1,e2) | brobmat.equal(e1,e2),
"<=" = !brobmat.greater(e1,e2) | brobmat.equal(e1,e2),
stop(gettextf("comparison operator %s not implemented on brobmat objects", dQuote(.Generic)))
)
}
setMethod("Compare", signature(e1="brobmat", e2="ANY" ), brobmat.compare)
setMethod("Compare", signature(e1="ANY" , e2="brobmat"), brobmat.compare)
setMethod("Compare", signature(e1="brobmat", e2="brobmat"), brobmat.compare)
`brobmat_matrixprod` <- function(x,y){
stopifnot(ncol(x)==nrow(y))
out <- brobmat(NA,nrow(x),ncol(y))
for(i in seq_len(nrow(x))){
for(j in seq_len(ncol(y))){
out[i,j] <- sum(x[i,,drop=TRUE]*y[,j,drop=TRUE])
} # j loop closes
} # i loop closes
if(!is.null(rownames(x))){rownames(out) <- rownames(x)}
if(!is.null(colnames(x))){colnames(out) <- colnames(y)}
return(out)
}
setMethod("%*%", signature(x="brobmat", y="ANY" ), brobmat_matrixprod)
setMethod("%*%", signature(x="ANY" , y="brobmat"), brobmat_matrixprod)
setMethod("%*%", signature(x="brobmat", y="brobmat"), brobmat_matrixprod)
setGeneric("as.vector")
setMethod("as.vector", signature(x="brobmat"), function(x){as.brob(x)})
setMethod("as.vector", signature(x="brob"), function(x){x})
setGeneric("rownames")
setMethod("rownames", signature(x="brobmat"), function(x){rownames(getX(x))})
setGeneric("colnames")
setMethod("colnames", signature(x="brobmat"), function(x){colnames(getX(x))})
setGeneric("dimnames")
setMethod("dimnames", signature(x="brobmat"), function(x){dimnames(getX(x))})
setGeneric("rownames<-")
setMethod("rownames<-", signature(x="brobmat"),
function(x,value){
jj <- getX(x)
rownames(jj) <- value
return(brobmat(jj,getP(x)))
} )
setGeneric("colnames<-")
setMethod("colnames<-", signature(x="brobmat"),
function(x,value){
jj <- getX(x)
colnames(jj) <- value
return(brobmat(jj,getP(x)))
} )
setGeneric("dimnames<-")
setMethod("dimnames<-", signature(x="brobmat"),
function(x,value){
jj <- getX(x)
dimnames(jj) <- value
return(brobmat(jj,getP(x)))
} )
setGeneric("diag", function(x, ...){standardGeneric("diag")})
setMethod("diag", signature(x="brobmat"),function(x,...){brob(diag(getX(x)),diag(getP(x)))})
setMethod("diag", signature(x="ANY"), function(x,...){base::diag(x)})
setGeneric("t", function(x, ...) standardGeneric("t"))
setMethod("t", signature(x="brobmat"),function(x,...){brob(t(getX(x)),t(getP(x)))})
setMethod("t", signature(x="ANY"),function(x,...){base::t(x)})
Brobdingnag/R/brob.R 0000644 0001762 0000144 00000025704 14207324123 013744 0 ustar ligges users
".Brob.valid" <- function(object){
len <- length(object@positive)
if(len != length(object@x)){
return("length mismatch")
} else {
return(TRUE)
}
}
setValidity("brob", .Brob.valid)
"brob" <- function(x=double(),positive){
if(missing(positive)){
positive <- rep(TRUE,length(x))
}
if(length(positive)==1){
positive <- rep(positive,length(x))
}
new("brob",x=as.numeric(x),positive=positive)
}
"is.brob" <- function(x){is(x,"brob")}
"is.glub" <- function(x){is(x,"glub")}
"as.brob" <- function(x){
if(is.brob(x)){
return(x)
} else if(is.complex(x)) {
warning("imaginary parts discarded")
return(Recall(Re(x)))
} else if(is.glub(x)){
warning("imaginary parts discarded")
return(Re(x))
} else if(is.brobmat(x)){
return(brobmat_to_brob(x))
} else {
return(brob(log(abs(c(x))), c(x)>=0))
}
}
setAs("brob", "numeric", function(from){
out <- exp(from@x)
out[!from@positive] <- -out[!from@positive]
return(out)
} )
setMethod("as.numeric",signature(x="brob"),function(x){as(x,"numeric")})
setAs("brob", "complex", function(from){
return(as.numeric(from)+ 0i)
} )
setMethod("as.complex",signature(x="brob"),function(x){as(x,"complex")})
".Brob.print" <- function(x, digits=5){
noquote( paste(c("-","+")[1+x@positive],"exp(",signif(x@x,digits),")",sep=""))
}
"print.brob" <- function(x, ...){
jj <- .Brob.print(x, ...)
print(jj)
return(invisible(jj))
}
setMethod("show", "brob", function(object){print.brob(object)})
setGeneric("getX",function(x){standardGeneric("getX")})
setGeneric("getP",function(x){standardGeneric("getP")})
setMethod("getX","brob",function(x){x@x})
setMethod("getP","brob",function(x){x@positive})
setMethod("length","brob",function(x){length(x@x)})
setMethod("is.infinite","brob",function(x){x@x == +Inf})
setMethod("is.finite" ,"brob",function(x){x@x != +Inf})
setGeneric("sign<-",function(x,value){standardGeneric("sign<-")})
setMethod("sign<-","brob",function(x,value){
brob(x@x,value)
} )
setMethod("[", "brob",
function(x, i, j, drop){
if(!missing(j)){
warning("second argument to extractor function ignored")
}
brob(x@x[i], x@positive[i])
} )
setReplaceMethod("[",signature(x="brob"),
function(x,i,j,value){
jj.x <- x@x
jj.pos <- x@positive
if(is.brob(value)){
jj.x[i] <- value@x
jj.pos[i] <- value@positive
return(brob(x=jj.x,positive=jj.pos))
} else {
x[i] <- as.brob(value)
return(x)
}
} )
setGeneric(".cPair", function(x,y){standardGeneric(".cPair")})
setMethod(".cPair", c("brob", "brob"), function(x,y){.Brob.cPair(x,y)})
setMethod(".cPair", c("brob", "ANY"), function(x,y){.Brob.cPair(x,as.brob(y))})
setMethod(".cPair", c("ANY", "brob"), function(x,y){.Brob.cPair(as.brob(x),y)})
setMethod(".cPair", c("ANY", "ANY"), function(x,y){c(x,y)})
"cbrob" <- function(x, ...) {
if(nargs()<3)
.cPair(x,...)
else
.cPair(x, Recall(...))
}
".Brob.cPair" <- function(x,y){
x <- as.brob(x)
y <- as.brob(y)
brob(c(x@x,y@x),c(x@positive,y@positive))
}
setGeneric("log")
setMethod("sqrt","brob", function(x){
brob(ifelse(x@positive,x@x/2, NaN),TRUE)
} )
setMethod("Math", "brob",
function(x){
switch(.Generic,
abs = brob(x@x),
log = {
out <- x@x
out[!x@positive] <- NaN
out
},
log10 = {
out <- x@x/log(10)
out[!x@positive] <- NaN
out
},
log2 = {
out <- x@x/log(2)
out[!x@positive] <- NaN
out
},
exp = brob(x),
cosh = {(brob(x) + brob(-x))/2},
sinh = {(brob(x) - brob(-x))/2},
acos =,
acosh =,
asin =,
asinh =,
atan =,
atanh =,
cos =,
sin =,
tan =,
tanh =,
trunc = callGeneric(as.numeric(x)),
lgamma =,
cumsum =,
gamma =,
ceiling=,
floor = as.brob(callGeneric(as.numeric(x))),
stop(gettextf("Function %s not implemented on Brobdingnagian numbers", dQuote(.Generic)))
)
} )
".Brob.negative" <- function(e1){
brob(e1@x,!e1@positive)
}
".Brob.ds" <- function(e1,e2){ # "ds" == "different signs"
xor(e1@positive,e2@positive)
}
".Brob.add" <- function(e1,e2){
e1 <- as.brob(e1)
e2 <- as.brob(e2)
jj <- rbind(e1@x,e2@x)
x1 <- jj[1,]
x2 <- jj[2,]
out.x <- double(length(x1))
jj <- rbind(e1@positive,e2@positive)
p1 <- jj[1,]
p2 <- jj[2,]
out.pos <- p1
ds <- .Brob.ds(e1,e2)
ss <- !ds #ss == "Same Sign"
out.x[ss] <- pmax(x1[ss],x2[ss]) + log1p(+exp(-abs(x1[ss]-x2[ss])))
out.x[ds] <- pmax(x1[ds],x2[ds]) + log1p(-exp(-abs(x1[ds]-x2[ds])))
# Now special dispensation for 0+0:
out.x[ (x1 == -Inf) & (x2 == -Inf)] <- -Inf
out.pos <- p1
out.pos[ds] <- xor((x1[ds] > x2[ds]) , (!p1[ds]) )
return(brob(out.x,out.pos))
}
".Brob.mult" <- function(e1,e2){
e1 <- as.brob(e1)
e2 <- as.brob(e2)
return(brob(e1@x + e2@x, !.Brob.ds(e1,e2)))
}
".Brob.power"<- function(e1,e2){
stopifnot(is.brob(e1) | is.brob(e2))
if(is.brob(e2)){ # e2 a brob => answer a brob (ignore signs)
return(brob(log(e1) * brob(e2@x), TRUE))
} else { #e2 a non-brob (try to account for signs)
s <- as.integer(2*e1@positive-1) #s = +/-1
return(brob(e1@x*as.brob(e2), (s^as.numeric(e2))>0))
}
}
".Brob.inverse" <- function(b){brob(-b@x,b@positive)}
setMethod("Arith",signature(e1 = "brob", e2="missing"),
function(e1,e2){
switch(.Generic,
"+" = e1,
"-" = .Brob.negative(e1),
stop(gettextf("unary operator %s not implemented on Brobdingnagian numbers", dQuote(.Generic)))
)
} )
".Brob.arith" <- function(e1,e2){
switch(.Generic,
"+" = .Brob.add (e1, e2),
"-" = .Brob.add (e1, .Brob.negative(as.brob(e2))),
"*" = .Brob.mult (e1, e2),
"/" = .Brob.mult (e1, .Brob.inverse(as.brob(e2))),
"^" = .Brob.power(e1, e2),
stop(gettextf("binary operator %s not implemented on Brobdingnagian numbers", dQuote(.Generic)))
) }
setMethod("Arith", signature(e1 = "brob", e2="ANY"), .Brob.arith)
setMethod("Arith", signature(e1 = "ANY", e2="brob"), .Brob.arith)
setMethod("Arith", signature(e1 = "brob", e2="brob"), .Brob.arith)
".Brob.equal" <- function(e1,e2){
(e1@x==e2@x) & (e1@positive==e2@positive)
}
".Brob.greater" <- function(e1,e2){
jj.x <- rbind(e1@x,e2@x)
jj.p <- rbind(e1@positive,e2@positive)
ds <- .Brob.ds(e1,e2)
ss <- !ds #ss == "Same Sign"
greater <- logical(length(ss))
greater[ds] <- jj.p[1,ds]
greater[ss] <- jj.p[1,ss] & (jj.x[1,ss] > jj.x[2,ss])
return(greater)
}
".Brob.compare" <- function(e1,e2){
if( (length(e1) == 0) | (length(e2)==0)) {
return(logical(0))
}
e1 <- as.brob(e1)
e2 <- as.brob(e2)
switch(.Generic,
"==" = .Brob.equal(e1,e2),
"!=" = !.Brob.equal(e1,e2),
">" = .Brob.greater(e1,e2),
"<" = !.Brob.greater(e1,e2) & !.Brob.equal(e1,e2),
">=" = .Brob.greater(e1,e2) | .Brob.equal(e1,e2),
"<=" = !.Brob.greater(e1,e2) | .Brob.equal(e1,e2),
stop(gettextf("comparison operator %s not implemented on Brobdingnagian numbers", dQuote(.Generic)))
)
}
setMethod("Compare", signature(e1="brob", e2="ANY" ), .Brob.compare)
setMethod("Compare", signature(e1="ANY" , e2="brob"), .Brob.compare)
setMethod("Compare", signature(e1="brob", e2="brob"), .Brob.compare)
".Brob.logic" <- function(e1,e2){
stop("No logic currently implemented for Brobdingnagian numbers")
}
setMethod("Logic",signature(e1="swift",e2="ANY"), .Brob.logic)
setMethod("Logic",signature(e1="ANY",e2="swift"), .Brob.logic)
setMethod("Logic",signature(e1="swift",e2="swift"), .Brob.logic)
if(!isGeneric("max")){
setGeneric("max", function(x, ..., na.rm = FALSE)
{
standardGeneric("max")
},
useAsDefault = function(x, ..., na.rm = FALSE)
{
base::max(x, ..., na.rm = na.rm)
},
group = "Summary")
}
if(!isGeneric("min")){
setGeneric("min", function(x, ..., na.rm = FALSE)
{
standardGeneric("min")
},
useAsDefault = function(x, ..., na.rm = FALSE)
{
base::min(x, ..., na.rm = na.rm)
},
group = "Summary")
}
if(!isGeneric("range")){
setGeneric("range", function(x, ..., na.rm = FALSE)
{
standardGeneric("range")
},
useAsDefault = function(x, ..., na.rm = FALSE)
{
base::range(x, ..., na.rm = na.rm)
},
group = "Summary")
}
if(!isGeneric("prod")){
setGeneric("prod", function(x, ..., na.rm = FALSE)
{
standardGeneric("prod")
},
useAsDefault = function(x, ..., na.rm = FALSE)
{
base::prod(x, ..., na.rm = na.rm)
},
group = "Summary")
}
if(!isGeneric("sum")){
setGeneric("sum", function(x, ..., na.rm = FALSE)
{
standardGeneric("sum")
},
useAsDefault = function(x, ..., na.rm = FALSE)
{
base::sum(x, ..., na.rm = na.rm)
},
group = "Summary")
}
".Brob.max" <- function(x, ..., na.rm=FALSE){
p <- x@positive
val <- x@x
if(any(p)){
return(brob(max(val[p])))
} else {
# all negative
return(brob(min(val),FALSE))
}
}
".Brob.prod" <- function(x){
p <- x@positive
val <- x@x
return(brob(sum(val),(sum(!p)%%2)==0))
}
".Brob.sum" <- function(x){
.Brob.sum.allpositive( x[x>0]) -
.Brob.sum.allpositive(-x[x<0])
}
".Brob.sum.allpositive" <- function(x){
if(length(x)<1){return(as.brob(0))}
val <- x@x
p <- x@positive
mv <- max(val)
return(brob(mv + log1p(sum(exp(val[-which.max(val)]-mv))),TRUE))
}
setMethod("Summary", "brob",
function(x, ..., na.rm=FALSE){
switch(.Generic,
max = .Brob.max( x, ..., na.rm=na.rm),
min = -.Brob.max(-x, ..., na.rm=na.rm),
range = cbrob(min(x,na.rm=na.rm),max(x,na.rm=na.rm)),
prod = .Brob.prod(x),
sum = .Brob.sum(x),
stop(gettextf("Function %s not implemented on Brobdingnagian numbers", dQuote(.Generic)))
)
}
)
setMethod("plot",signature(x="brob",y="missing"),function(x, ...){plot.default(as.numeric(x), ...)})
setMethod("plot",signature(x="brob",y="ANY" ),function(x, y, ...){plot.default(as.numeric(x), as.numeric(y), ...)})
setMethod("plot",signature(x="ANY" ,y="brob"),function(x, y, ...){plot.default(as.numeric(x), as.numeric(y), ...)})
Brobdingnag/R/glub.R 0000644 0001762 0000144 00000020702 14207324466 013754 0 ustar ligges users
".Glub.valid" <- function(object){
if(length(object@real) == length(object@imag)){
return(TRUE)
} else {
return("length mismatch")
}
}
setValidity("glub", .Glub.valid)
setAs("glub", "complex", function(from){
complex(real=as.numeric(from@real), imaginary=as.numeric(from@imag))
} )
setMethod("as.complex",signature(x="glub"),function(x){as(x,"complex")})
setAs("glub", "numeric", function(from){
warning("imaginary parts discarded in coercion; use as.complex() to retain them")
as.numeric(Re(from))
} )
setMethod("as.numeric",signature(x="glub"),function(x){as(x,"numeric")})
setMethod("is.infinite",signature(x="glub"),function(x){is.infinite(Re(x)) | is.infinite(Im(x))})
setMethod("is.finite",signature(x="glub"),function(x){is.finite(Re(x)) & is.finite(Im(x))})
"glub" <- function(real=double(), imag=double()){
if(missing(imag)){
imag <- 0
}
real <- as.brob(real)
imag <- as.brob(imag)
jj.x <- cbind(real@x,imag@x)
jj.p <- cbind(real@positive,imag@positive)
new("glub",
real = brob(jj.x[,1],jj.p[,1]),
imag = brob(jj.x[,2],jj.p[,2])
)
}
setMethod("Re","glub",function(z){z@real})
setMethod("Im","glub",function(z){z@imag})
setMethod("length","glub",function(x){length(Re(x))})
setMethod("Mod", "glub", function(z){sqrt(Re(z)*Re(z) + Im(z)*Im(z))})
".Brob.arg" <- function(z){
atan2(as.numeric(Im(z)),as.numeric(Re(z)))
}
".Glub.complex" <- function(z){
switch(.Generic,
Arg = .Brob.arg(z),
Conj = glub(Re(z),-Im(z)),
stop(gettextf("Complex operator %s not implemented on glub numbers", dQuote(.Generic)))
)
}
setMethod("Complex","glub", .Glub.complex)
setGeneric("Re<-",function(z,value){standardGeneric("Re<-")})
setGeneric("Im<-",function(z,value){standardGeneric("Im<-")})
setMethod("Re<-","glub",function(z,value){
return(glub(real=value, imag=Im(z)))
} )
setMethod("Im<-","glub",function(z,value){
z <- as.glub(z)
return(glub(real=z@real, imag=value))
} )
setMethod("Im<-","brob",function(z,value){
return(glub(real=z, imag=value))
} )
"as.glub" <- function(x){
if(is.glub(x)){
return(x)
} else if (is.brob(x)) {
return(glub(real=as.brob(x),imag=as.brob(0)))
} else {
return(glub(real=as.brob(Re(x)),imag=as.brob(Im(x))))
}
}
setMethod("[", "glub",
function(x, i, j, drop){
if(!missing(j)){warning("second argument (j) ignored")}
glub(x@real[i], x@imag[i])
}
)
setReplaceMethod("[",signature(x="glub"),
function(x,i,j,value){
if(!missing(j)){warning("second argument (j) ignored")}
value <- as.glub(value)
x@real[i] <- Re(value)
x@imag[i] <- Im(value)
return(x)
}
)
setMethod(".cPair", c("glub", "glub"), function(x,y).Glub.cPair(x,y))
setMethod(".cPair", c("glub", "ANY"), function(x,y).Glub.cPair(x,as.glub(y)))
setMethod(".cPair", c("ANY", "glub"), function(x,y).Glub.cPair(as.glub(x),y))
setMethod(".cPair", c("complex", "brob"), function(x,y).Glub.cPair(as.glub(x),y))
setMethod(".cPair", c("brob", "complex"), function(x,y).Glub.cPair(as.glub(x),y))
setMethod(".cPair", c("glub", "brob"), function(x,y).Glub.cPair(as.glub(x),y))
setMethod(".cPair", c("brob", "glub"), function(x,y).Glub.cPair(as.glub(x),y))
".Glub.cPair" <- function(x,y){
x <- as.glub(x)
y <- as.glub(y)
return(glub(.Brob.cPair(Re(x),Re(y)), .Brob.cPair(Im(x),Im(y))))
}
"print.glub" <- function(x,...){
real <- .Brob.print(Re(x),...)
imag <- .Brob.print(Im(x),...)
jj <- noquote(paste(real,imag,"i ",sep=""))
print(jj)
}
setMethod("show", "glub", function(object){print.glub(object)})
setMethod("Math", "glub",
function(x){
switch(.Generic,
abs = Mod(x),
log = { glub(log(Mod(x)),Arg(x)) },
log10 = { glub(log10(Mod(x)),Arg(x)/log(10)) },
log2 = { glub(log2 (Mod(x)),Arg(x)/log( 2)) },
exp = { exp(Re(x))*exp(1i*as.numeric(Im(x)))},
sqrt = { exp(log(x)/2)},
cosh = { (exp(x)+exp(-x))/2},
sinh = { (exp(x)-exp(-x))/2},
tanh = { (exp(x)-exp(-x))/(exp(x)+exp(-x))},
cos = { (exp(1i*x)+exp(-1i*x))/(2 )},
sin = { (exp(1i*x)-exp(-1i*x))/(2i)},
tan = { (exp(1i*x)-exp(-1i*x))/(exp(1i*x)+exp(-1i*x))},
acos = { -1i*log( x + 1i*sqrt( 1-x*x)) },
acosh = { log( x + sqrt(-1+x*x)) },
asin = { -1i*log(1i*x + sqrt( 1-x*x)) },
asinh = { log( x + sqrt( 1+x*x)) },
atan = { 0.5i*log((1i+x)/(1i-x)) },
atanh = { 0.5 *log((1 +x)/(1 -x)) },
trunc = callGeneric(as.complex(x)),
lgamma =,
cumsum =,
gamma =,
ceiling=,
floor = as.glub(callGeneric(as.complex(x))),
stop(gettextf("function %s not implemented on glub numbers", dQuote(.Generic)))
)
}
)
".Glub.negative" <- function(e1){
glub(-Re(e1),-Im(e1))
}
".Glub.add" <- function(e1,e2){
e1 <- as.glub(e1)
e2 <- as.glub(e2)
glub(Re(e1)+Re(e2),Im(e1)+Im(e2))
}
".Glub.mult" <- function(e1,e2){
e1 <- as.glub(e1)
e2 <- as.glub(e2)
glub(Re(e1)*Re(e2)-Im(e1)*Im(e2), Re(e1)*Im(e2)+Im(e1)*Re(e2))
}
".Glub.power" <- function(e1,e2){
exp(e2*log(e1))
}
".Glub.inverse" <- function(e1){
jj <- Re(e1)*Re(e1) + Im(e1)*Im(e1)
glub(Re(e1)/jj, -Im(e1)/jj)
}
".Glub.arith" <- function(e1,e2){
switch(.Generic,
"+" = .Glub.add (e1, e2),
"-" = .Glub.add (e1, .Glub.negative(e2)),
"*" = .Glub.mult (e1, e2),
"/" = .Glub.mult (e1, .Glub.inverse(e2)),
"^" = .Glub.power(e1, e2),
stop(gettextf("binary operator %s not implemented on glub numbers", dQuote(.Generic)))
)
}
setMethod("Arith",signature(e1 = "glub", e2="missing"),
function(e1,e2){
switch(.Generic,
"+" = e1,
"-" = .Glub.negative(e1),
stop(gettextf("unary operator %s not implemented on glub objects", dQuote(.Generic)))
)
}
)
setMethod("Arith",signature(e1 = "glub", e2="glub"), .Glub.arith)
setMethod("Arith",signature(e1 = "glub", e2="ANY" ), .Glub.arith)
setMethod("Arith",signature(e1 = "ANY" , e2="glub"), .Glub.arith)
setMethod("Arith",signature(e1= "brob" , e2="complex"), .Glub.arith)
setMethod("Arith",signature(e1= "complex", e2="brob" ), .Glub.arith)
setMethod("Arith",signature(e1= "glub" , e2="complex"), .Glub.arith)
setMethod("Arith",signature(e1= "complex", e2="glub" ), .Glub.arith)
setMethod("Arith",signature(e1= "glub", e2="brob"), .Glub.arith)
setMethod("Arith",signature(e1= "brob", e2="glub"), .Glub.arith)
".Glub.equal" <- function(e1,e2){
(Re(e1) == Re(e2)) & ( Im(e1) == Im(e2))
}
".Glub.compare" <- function(e1,e2){
e1 <- as.glub(e1)
e2 <- as.glub(e2)
switch(.Generic,
"==" = .Glub.equal(e1,e2),
"!=" = !.Glub.equal(e1,e2),
stop(gettextf("comparison operator %s not implemented on glub numbers", dQuote(.Generic)))
)
}
setMethod("Compare", signature(e1="glub",e2="glub"), .Glub.compare)
setMethod("Compare", signature(e1="glub",e2="ANY" ), .Glub.compare)
setMethod("Compare", signature(e1="ANY", e2="glub"), .Glub.compare)
setMethod("Compare", signature(e1="brob", e2="glub"), .Glub.compare)
setMethod("Compare", signature(e1="glub", e2="brob"), .Glub.compare)
".Glub.prod" <- function(z){
out <- as.glub(1)
for(i in 1:length(z)){
out <- out * z[i]
}
return(out)
}
".Glub.sum" <- function(x){
glub(sum(Re(x)),sum(Im(x)))
}
setMethod("Summary", "glub",
function(x, ..., na.rm=FALSE){
switch(.Generic,
prod = .Glub.prod(x),
sum = .Glub.sum(x),
stop(gettextf("function %s not implemented on glub numbers", dQuote(.Generic)))
)
}
)
setMethod("plot",signature(x="glub",y="missing"),function(x, ...){plot.default(as.complex(x), ...)})
setMethod("plot",signature(x="glub",y="ANY" ),function(x, y, ...){plot.default(as.complex(x), as.complex(y), ...)})
setMethod("plot",signature(x="ANY" ,y="glub"),function(x, y, ...){plot.default(as.complex(x), as.complex(y), ...)})
Brobdingnag/R/extract.R 0000644 0001762 0000144 00000004310 13762776702 014503 0 ustar ligges users
## "x[]":
setMethod("[",
signature(x = "brobmat",
i = "missing", j = "missing",
drop = "ANY"),
function(x, i, j, ..., drop){
return(x)
} )
## select rows, x[i,]:
setMethod("[",
signature(x = "brobmat",
i = "index", j = "missing",
drop = "ANY"),
function(x,i,j, ..., drop) {
if(missing(drop)){drop <- TRUE}
xv <- getX(x)[i,,drop=drop]
if(drop & (!is.matrix(xv))){
return(brob(xv,getP(x)[i,]))
} else {
return(newbrobmat(xv, getP(x)[i,,drop=FALSE]))
}
} )
## select columns, x[,j]:
setMethod("[",
signature(x = "brobmat",
i = "missing", j = "index",
drop = "ANY"),
function(x,i,j, ..., drop) {
if(missing(drop)){drop <- TRUE}
xv <- getX(x)[,j,drop=drop]
if(drop & (!is.matrix(xv))){
return(brob(xv,getP(x)[,j]))
} else {
return(newbrobmat(xv, getP(x)[,j,drop=FALSE]))
}
} )
## matrix indexing
setMethod("[",
signature(x = "brobmat",
i = "matrix", j = "missing",
drop = "ANY"),
function(x,i,j, ..., drop) {
xv <- getX(x)[i]
return(brobmat(getX(x)[i], getP(x)[i]))
} )
## select both rows *and* columns
setMethod("[",
signature(x = "brobmat",
i = "index", j = "index",
drop = "ANY"),
function(x,i,j, ..., drop) {
if(missing(drop)){drop <- TRUE}
xv <- getX(x)[i,j,drop=drop]
if(drop & (!is.matrix(xv))){
return(brob(xv,getP(x)[i,j]))
} else {
return(newbrobmat(xv, getP(x)[i,j,drop=FALSE]))
}
} )
## bail out if any of (i,j,drop) is "non-sense"
setMethod("[",
signature(x = "brobmat",
i = "ANY", j = "ANY",
drop = "ANY"),
function(x,i,j, ..., drop){
stop("invalid or not-yet-implemented brobmat subsetting")
} )
Brobdingnag/R/replace.R 0000644 0001762 0000144 00000005166 13762776702 014456 0 ustar ligges users ## x[] <- value
setReplaceMethod("[",
signature(x = "brobmat",
i = "missing", j = "missing",
value = "ANY"),
function (x, i, j, ..., value){
value <- as.brob(value)
jj.x <- getX(x)
jj.pos <- getP(x)
jj.x[] <- getX(value) # matrix or vector
jj.pos[] <- getP(value)
return(newbrobmat(x=jj.x,positive=jj.pos))
} )
## x[i,] <- value
setReplaceMethod("[",
signature(x = "brobmat",
i = "index", j = "missing",
value = "ANY"),
function (x, i, j, ..., value){
value <- as.brob(value)
jj.x <- getX(x)
jj.pos <- getP(x)
jj.x[i,] <- getX(value) # matrix or vector
jj.pos[i,] <- getP(value)
return(newbrobmat(x=jj.x,positive=jj.pos))
} )
## x[,j] <- value
setReplaceMethod("[",
signature(x = "brobmat",
i = "missing", j = "index",
value = "ANY"),
function (x, i, j, ..., value){
value <- as.brob(value)
jj.x <- getX(x)
jj.pos <- getP(x)
jj.x[,j] <- getX(value) # matrix or vector
jj.pos[,j] <- getP(value)
return(newbrobmat(x=jj.x,positive=jj.pos))
} )
## x[cbind(1:3,2:4)] <- value
setReplaceMethod("[",
signature(x = "brobmat",
i = "matrix", j = "missing",
value = "ANY"),
function (x, i, j, ..., value){
value <- as.brob(value)
jj.x <- getX(x)
jj.pos <- getP(x)
jj.x[i] <- getX(value) # matrix or vector
jj.pos[i] <- getP(value)
return(newbrobmat(x=jj.x,positive=jj.pos))
} )
## x[i,j] <- value
setReplaceMethod("[",
signature(x = "brobmat",
i = "index", j = "index",
value = "ANY"),
function (x, i, j, ..., value){
value <- as.brob(value)
jj.x <- getX(x)
jj.pos <- getP(x)
jj.x[i,j] <- getX(value) # matrix or vector
jj.pos[i,j] <- getP(value)
return(newbrobmat(x=jj.x,positive=jj.pos))
} )
Brobdingnag/MD5 0000644 0001762 0000144 00000004675 14323753132 013015 0 ustar ligges users 299e3b7bf0ebec2a9764e109049d8be6 *DESCRIPTION
3266087168f5edb40d5e055bde20de61 *NAMESPACE
08d41e9ee1bde3c883df2efacbaf6e7e *R/aaa_allclasses.R
030838f02cd5b65357b740fe046e8bfc *R/brob.R
145939bb79e6c45436aa97a24212c79b *R/extract.R
f4f808f9e9e147620c69e5ee8520d6fb *R/glub.R
af8a9c578897fab5101a10835111bbbc *R/matrix.R
1bd953f4ebc0a611cab32113d3ddcb20 *R/replace.R
fce5390eea91004c9afad9891e8c1353 *README.md
c6a7c5451929d72f8c0d483de0abb624 *build/partial.rdb
647944a3ce961724698623792b04aa94 *build/vignette.rds
5f9c8a3521284acab0ed92e3cf7dfb20 *inst/CITATION
426c73ab618aedf0c74bae824bb614fe *inst/doc/Brobdingnag.R
81ba84ba4278c35d8b2b4256663aa3bd *inst/doc/Brobdingnag.Rnw
ec5652b30a491c6901286d403d467b24 *inst/doc/Brobdingnag.pdf
a04f6dc95e6970446ab875b10d25afc2 *inst/doc/S4_brob.R
bf548afa5ac3694246cd3b92365cafaa *inst/doc/S4_brob.Rnw
bb4fc0ff0f347372605ba0bfbba2ddef *inst/doc/S4_brob.pdf
0d2def0996a161ecbc9a96ca9cd090d5 *man/Arith.Rd
85243eea5c0b8e74b1595f231bc62849 *man/Brobdingnag-package.Rd
302f297f098a7bbbddecc887df17de75 *man/Compare.Rd
7ca6539ccaee5c5094b0e6d20b09786c *man/Complex.Rd
7d23bf124cd0aab34a25235244890b15 *man/Extract.Rd
89303f2a4b86ddccd5d2932fa1750816 *man/Logic.Rd
0d7d612faf4826b5b6c0945ba2ae305f *man/Math.Rd
e787c21aeaeab370f76de321b1067fcf *man/Print.Rd
99e360c829510efe42b9715461235d35 *man/Summary.Rd
5009aaafb2e2906b3abb375582e48aa7 *man/as.numeric.Rd
eff4e4d01ab9ddc1470197bf4a5bdb93 *man/brob-class.Rd
729c51856bf6ec30a84578109b732e3a *man/brob.Rd
39b6473e2d9fd1ce3af16b0600a5eda1 *man/brobmat-arith.Rd
5b08389f2638d8790b8ad50ba8e5894d *man/brobmat-class.Rd
7ab6fa254d90051ab2ba88fc0189a9f2 *man/brobmat.Rd
aace3e63f8fbafd066356d5d14c2db3a *man/cbrob.Rd
8c5cabb210b66b4bfa021b558ee2bfc8 *man/figures/Brobdingnag.png
8a9c550cd6383e2fbe98c93122914f93 *man/getP.Rd
5a19831a55dc9eff9431fdd669ab500e *man/glub-class.Rd
ad5494dd3a2c6a36b0c5a6d20f10aac4 *man/glub.Rd
f13a73382f54d0518ee34f22d8606464 *man/index-class.Rd
b5ea9051be1307aa715e50609dbc7e6f *man/infinite.Rd
ea082304393290114fa77c7628715b1a *man/length.Rd
415843ee2c300b95e4b6462fd91684f8 *man/plot.Rd
fc63023acdb227d91b55ad8fe4c31737 *man/swift-class.Rd
50094a0d3a95f0db524eadde492d6b26 *tests/testthat.R
17eefbc8e9e2ab565f8141d7700a68af *tests/testthat/test_aaa.R
81ba84ba4278c35d8b2b4256663aa3bd *vignettes/Brobdingnag.Rnw
bf548afa5ac3694246cd3b92365cafaa *vignettes/S4_brob.Rnw
0e333c0d53899270ebf825c2d05b8f6a *vignettes/brob.bib
428a8158d30bad682c9cea7eedab404e *vignettes/brobmat.Rmd
Brobdingnag/inst/ 0000755 0001762 0000144 00000000000 14323731146 013447 5 ustar ligges users Brobdingnag/inst/doc/ 0000755 0001762 0000144 00000000000 14323731145 014213 5 ustar ligges users Brobdingnag/inst/doc/Brobdingnag.R 0000644 0001762 0000144 00000003410 14323731142 016545 0 ustar ligges users ### R code from vignette source 'Brobdingnag.Rnw'
###################################################
### code chunk number 1: googol_definition
###################################################
###################################################
### code chunk number 2: Brobdingnag.Rnw:76-77
###################################################
require(Brobdingnag)
###################################################
### code chunk number 3: Brobdingnag.Rnw:78-79
###################################################
googol <- as.brob(10)^100
###################################################
### code chunk number 4: define_f
###################################################
stirling <- function(n){n^n*exp(-n)*sqrt(2*pi*n)}
###################################################
### code chunk number 5: f_of_a_googol
###################################################
stirling(googol)
###################################################
### code chunk number 6: TwoToTheGoogolth
###################################################
2^(1/googol)
###################################################
### code chunk number 7: define_function_f
###################################################
f <- function(x){as.numeric( (pi*x -3*x -(pi-3)*x)/x)}
###################################################
### code chunk number 8: try.f.with.one.seventh
###################################################
f(1/7)
f(as.brob(1/7))
###################################################
### code chunk number 9: try.f.with.a.googol
###################################################
f(1e100)
f(as.brob(1e100))
###################################################
### code chunk number 10: try_f_with_bignumbers
###################################################
f(as.brob(10)^1000)
Brobdingnag/inst/doc/S4_brob.pdf 0000644 0001762 0000144 00000411533 14323731146 016210 0 ustar ligges users %PDF-1.5
%
1 0 obj
<< /Type /ObjStm /Length 4367 /Filter /FlateDecode /N 73 /First 605 >>
stream
x ks6
|k:ět2GbW؝~%f#D5-Ѷz7
M pA!( ED(!,! ,"aHE`P3B
./
Zk"avE
x3pa` b /pi$e )K` }&da).dBݘ $.\V Kc" ,*$-gJ$@VH
$ 梑LIa`I A#u8,̑ (р&l";,6\ փ y _~!4FQ6"h@~Xfd/llt
cB4#oX;>_n P<45#8bWŵ s
2GYGYL^ lY"Θ'&~ ~NFg5=9Ƿ85O+`l!zs ~ ?csż]wO&d9rp.x]B ぷK>葡om F47]@RZdfp¶W
"@ODxbL#z3qrw@Wt= CzD = szA?c:NNhL-zKooj [`CzG)x$& :3ж4)}$Lxr3Ʒ٪1`tA b|qL)]ҿW~Vaٽ`27P^3 ?N]2:Ez?z;d3+w,
e;YpKАj0[NAPJ44S$8x "(=B䃛aK%DL
gCX' wUHج3اH;.@rxh᰷t+-^ݷ6wEʟ |%Clȧʧj}wK^~WVZo8_;b:GF }-v
v(C%=Oa OZ&ܩ*UΡB{i/~Dw' !T{nnVҏ[- ^= }=Ҳ=ΧdۉN'4 er@ZV n&_d:w\* E y)uO=ES"Q]H;E=G ~5J&o7S/QōY0TSb<\1vYeM5e 1QT^{|`zo :. Z,d\˾vo ЏPK oSm~Ɲir| ˠh y+O7pw`4l"DGʣ_ n c5ӟﻞ6W!N [=2C{Ʀ݁XqaPq!Og(rH L76F=b YL
fڰuSs%!b
-d?)^mBN5b6;LvG Ve G>mS3@K[6uZ)ٵ= m
HI<-=`'Sdͦ*10X.@*: $(X1? "ű犖'Φ|9W2~-d>/ӶﯽOGἦ
[sRKy[Q|7 :/~d:@;|=hRUH7PyhԽjEviLՄ0@-nh' ]]Gd-WwM3aM J[f2HT"jgv8Uql2GܑlcLcɖݢnד 7jQNo?_1&{4a7STMRCmi; WeOFˁÝ xy՟80Zj n^諧 Lآޟ Ǹ(wcr"Cɺ{ eL/gkObN%h^6[o-n\jVDMVU]`UzŨ 4%)镠3T~.̓7&ǧϿ?ܤDJT
k]#ڂ Yb1ʦ6|=:3J܌+f|XNqGd s<$@(̘+dzcF@j.0ke}l>94>/ms!Uhх홙3 yt-3g;] h6z
PvPmo0gF+[ J 4Yqc^ ]Q!"UZ]IfƆy%GoU{:-PuS;Hѕs tT|@\<&$N @.SuYfZ}c /.RiPhYVu'P͚<2Wy}AmMԙ~s{q,ϧ?/P͢eD- ϯXY0۫WפtC<*_$Vթ<ϰ&t'8+mʸ+uyJK%SpJ˔N"DsuY[**cM&o \F-z,kk"sFjք&kiبUFrM&YVOZ
*38 t_kTF$W6C+ n/G짉_/1kIWk0Z
V ?'rx czue?S7y?~ I:YuA9JVVk&`C >[D8~ ~ ~%,~4&o@J.ta* r :[ YmJxOnocC,Ǖ+H~r 'goA=ЈJ(>l+G]?Moil[ucqy蹯I ۩#[m#Ղ u:}K 1U `XAaZ64ST;Ͷc.A
xendstream
endobj
75 0 obj
<< /Subtype /XML /Type /Metadata /Length 1459 >>
stream
GPL Ghostscript 9.55.0
S4 methods, Brobdingnag, R
2022-10-19T21:16:37+13:00
2022-10-19T21:16:37+13:00
LaTeX with hyperref
Brobdingnagian numbers in S4Robin K. S. Hankin
endstream
endobj
76 0 obj
<< /Type /ObjStm /Length 2656 /Filter /FlateDecode /N 72 /First 622 >>
stream
xZms6~ ۹1N&3yOڤi4 y>N RiӖ< Yc g, YKpD2E #J 8 48I8ך8E_
#8!+ψP\ω,F/qaH)"["Hz 1"YapZ&bXPDi̓Rʂ LǙ%)P9=:LjvZ@`xzJq. эRΆ :[(H c 8 F @L=b$֢^ .3 037
t Ʒ$ZM r p p( xv 3ǀ 2\Z0Q Bb` +0Xֱ k`do` X `2tG(+E@.xdMEM ݄d/4 yArIHt*bn jG|`L wfE,l ǏD+N5S,=t{;m=_W0Cħu_L " [YAZm-IbjDzX/#6A %3Z G E)]v%#Zp$J
OF%-c]4a9= j&6(KThm
.OV 2V oUw>- hiXϜBl ޓ|S^g /a+"4GSd= 8"g
_8y1D]im k49hƮcEl`6F@zAdLNc
PTmj#a".w1Øeh Hx7 Dߖ$hjpT
tQ$k;lF#X)Z@-# `5xmd~/Z`y
Hi$; E1@~8apmh{ZvGsRcay}$ǭsC"O%Y?L=zbs3DC:> p-՚pAL2* 'c9dwT/zF:+s\pZ;Y
u%e;aWƁ}A
t~ ]Pۡ0?La-\Pt4G_ >tdӇc-q~P@9S}7 j%n(x1.sQ5Ѥ/料9@AvABXԁNf Ϗ:N
[S/ӄlqϬ:rnmNfX0B ub51=Ew=9v KoCO P ˶iOYB)*WOIT+j?%1x..ӫO<@/>SxrNY9/V$T6ESΜ]LD l]\V:VnϢB'~ӫU%IzOżDkFgDg3 gK Lyq~ A* lcDFe|\5pe%)ê__!XTe1{: b0
*w-ZYo}|
L/웯u:iHAn驩i>,GA0Qooԏ[xM, Yʳu6|mʪoeu@:a;4 ]0H~*-T:Fb1fVԒZTH\4' {
`wǫƩhèqI3Y( P 5
$TW& 쯤Lkzf!2 (;HHvxJ%427 ne .2}aIՖz^\WNi ^ S,S~A+ǤCxކ4 :ζRLKeAҙ(N^&]-8_m@+x XGlpij;t%\!Pr G!_L}\\L%pHZb$ -ٱunC|Ҽ|ͬtJҕjU$ȾdBU]ZE9Dvզ.L넇2]] ^J^ wZ{KFSROSgQFQm1IF
Ks)]d (\VuE*wfJOQ-ul,Q) 5 ݙ9ќTIyxʽRcil ޕli;\[g!- M*(Crd18NM 7g.x768 #G;N u$D0BdRCP6Dl7U$ ix Y{$ pJ?&orV媮ᢪ.ʲo߾Q,˓KNycrxKۛ
x@pZ $z1GɺaeAyg\~rT0(c[z}`So8&TBj,%Є]=:C9nK{#nwf~Te?<3 3;3= 3Q1 "5 ? &OEʖew;ǒbh-\9jЂcO!Qm~P+d E BQendstream
endobj
149 0 obj
<< /Filter /FlateDecode /Length 4137 >>
stream
x[sܶS[q C|Sܴ&j;3ѝ(/Hd7~oUYUr;{*wyX!qW_e8LRKvo\Q
Tq^Pu=
V>ex@Y*UE)4 7j}LJI%E6 JbQUm*ﯮ}{E4Qzö?g"jG dHjDa<[]vm˾+ގ?+M}X0x%f8\Ն?)v_*R{68j%;M~mJ 7\W@5 lʅf[ϋ81
> ~ck])'of)/=4 RŅ5`!mX_'ZoҰ@r-4
~I+Mt[:LU!᳝ɖN{L7L M&2eTQ=VQk9C.J*#XP.ȩ `J
Y`J
JifRf:
c=io
hBEjRl6H>e%ػ.n̷M*uJk/&:jGz3٤}[xf^*[gqSDwc~8B'YJ`ܨB97uj`,dO R,)݉e-~ *>@@kY0.z]$:+ [`K 40 ,ʱ҅2EخL37$E\ t+ J ,0뫤/b%F_:j*KԻ뱀gt((FRKyd)B3ORKRFFXI XC: CMrh#x =aVY*XV) 8풩#yj;'I-!gj ,1Ң
؝3JX&}xx "ssnl7 y1 HGvw)ې'Qg8;z;L`f))Sгe~iM!*6ROؓfA*)V(:Y@T$o B3`` _%,F+!r+P+Ĭ# }Bҁ T
BolME}X}&j4y= ?HĠ٥jآmTz̨C@?@ՁD/c @WawȕJ\*e@eCkX<} Qp'Hr1 Lwv~RL9g&!eYJ2Aeֆs}҇f/]Hn im!Y
P^31r9>.Rc
Gjм }34ӄL+y!ok%
uj&{r>Y
e~(@ثKʁꤣy9Y\>WWb)l 1 <9ѣK
|P @"A:hMZ]?]
g&[}z H: ms - *rEo.{E#_N#1ʹ7cmNR8agHa>ϳiԔJ(^-ݔRc r%^{(P4Zd⟮Jyp.
m۰T֫ 8^Yr`~K$u
nON.ˮGLY u^KD`[;4+:pZtZj
K0~x^A:/ 4
aNpzs2k
ŁL Ṵ39xnLg#ztS}Z_xh7Nߜ
ɟgz,>q .En6LzBǮF.c)dPI
SB0=~jmtM'[,m`H_
6jݍv$e+w1 ID:i"R.1lY <
- ]:i47?s SMBw 4:J{XQ:n
}'ZNe>o[O*PeV*>K-EyiY\ b:Y3g4O ⊐|t|ggCCbV,1~UVPL )D
d;壎h_Qn~&C
l'' XjS }r*zBhqe<*xfL;[=FOӼ$mQ\w>?BI6H S6| #a
_ q:4u>j* M傱{saS*`J $+|t:x(@7ؓN=xp<i CNfnOx5GO
zq:&#^~$=4N!`"74l,\0R, F-Q<|5OLHp#Z=+PD) eZ< TA +1])q3No!?HM:N~ 3cuX dv8/xѕ.
Mq&E>^I"E@f2(0ޭQ8BLE94~ۦHI=^ 2QIz"r^8^+
[kZ] M
0?^>a땮T$ӊ}8'̪do@FB!$lث xD(]^MzP6ܨc'{9uV*
6ho\Mtm
dQ9 gwS!L%taFu,U Us^M!|0| \nE觢,˓~
[ N@
pDҟ?g>
,Y^43Pwg1lYH2_ (LhladF@Afw)`k:^ jv0@\rm8]lxÈl ¶Ϻ#!̾- w|.P"Nq% QyPԈHeE%Dd穴xfCC\QZyÏ(pMpڶBn(](ǖem<e{zfB: (h=1)ai/wȚ /%-^)nYzc ;_DTzK #hsv,^|:en1 }qç2endstream
endobj
150 0 obj
<< /Filter /FlateDecode /Length 4431 >>
stream
x[Ko 7 |q:4ߤ/ց 9Xґdy2ݶHv b h "=6 ߌ4 S# ^?5 8i$ph ? g xϩO`(626l=hhkPaT#Spr`
~)N2as8ʌ.4Ԏ4`M8vqO%8}Zy5'MЖIDU6k >M7y Vฯn!xA~.tcGV=W, 9 E0!]ͷfr?r,p
xyIbB""o \lhp 9lV%r3% _',q =3 5%sV7;ϑBJI?sq%d[j;<"=кH3ٯ>ہ{T
H@=x%-PIM|1߶E
\'\ f%NE +Lk8 DuuMPZS+-kB,D@@ S;px: X:Oįe|!& ! Gx
xx x"X qYf0` FϥjCPH65h ի H:G2_{p$ p)leU5_W)2\Ѻ O5_A\|B>!vNcެyW^c.*$ϐAP в*>玆 l^^LvC|MyτL Gv0#o\Wa&`QMJƕ&$ &,M y"" {LDmP9!URLYJpV\y&npxhx sDW;&A
N`5.|iEuO&lxO
?P!:DZW(]m /AI;]p)@~Ɗ$T!0 A&} #&RU:7JC\)e=]< xjͭ`D\yt4}:L- !\|KOICs1")DK6`.Y\ٹ1͒͑#e 0(c 4V1{CYW yg'/xyd䠼ixyQez'ewz <$xPz5hmG0'!7YŹ ڳ98?ҭq1H# -I4 iBBj5 f!d F BWe=H # D/]?f
1`pm Z`& Qu/=dDpn/]x-0#]]E0u8 p cMNng`x.=prHJ< fΆ&1GK<1!NCPF.zԱtMmDVZHy;!RY YUj [ ib'ۼݬ^? CՀq^.XQ\}<*ً~~H[ j坠|F!n.v_o;wC`:kOEw~&U{W]Iryôei-lkukof^g=bcC O! ~L"28YXxL`*u>vdy XFY =x`r"/X6F%F"0@qnUvθ m^"
{G$3n8F
Py8TjET.IP0Fj || FIi]_e9T`g7Ę%CMBZ%fd9jYh>mc>Ep_JEw]X'sHxM)LBYj[ x6
5TTK!BJ]uH}1 _Ť
f70iZ&rkv1/_}IE7=05Xq[ E#
?( !~é)0A#t6/@4GO˔r+yT%s݁W D鋖{b _nԀ !3'9\!2x lڽvy]})p,o2|^<C=h W]fR#lVǥݧ+umKL]jЙviqЉPhno@M +\6Rfِ6*&?ҁT}wޅB iCnqU3F +#;qcGp.6î e]} 3U[q[x/(@p)Ub[
3/==j&$}?2ɪQW?u2>mP["},[D:lhߛnC.獯=GQr3bMu#ktHm.zI@7Kh\|=֩J[)LEWjm;~H3Dw`JpO7W/
cIǤtwKy d{/֘#"' ,SYY0<!6R'4 eyK 7wNJͽDw!0_Řۢ !䯄 -5lcT8RYgЄ:@5$hiSS8C~ zQNo( 嬿K#yF D m\W 䤜.7UeI'V`ƛQ(2ɣش罻0d:
}w#i?H[$bRY7A\^]FKɥ3k>|.+l',]RRaevօo7ny^,8m3ӇWYkoi 77B^
O KY69f4 >o?~b3);T4 'L6)9}UNNL]" 5'>̟UrI \;A8~ǧ\-f,9WZS-ŊFsHҞB-"$bU*4zcEJ?\,|;gغ
a*?/v9 9Os Pm^`A]A~~ qi)Hr{`Tb#Ӽ{`{] pKO۱3$ }O>ZLF_sB vKKy_>
stream
xZKd_tI0w A@v,@ݕ49#٩ vc
p _}U=?./kldׇT|yt KUŵXZm+/dx \YYsZK)*ؿ+v"-=˲b\f?hoߟ P&C[9@ ^˵ԕ3o{Zka=./N'|? .^j4.++˵ +<α/ހ ּV Kb|I/%=dƗ\V /
)/X;XQ|ڔ$+8E_d U- /V
*/ ~`]~Y(Q\v'ԀXvIڰyJ(ԕPr=|MWMƽ>={mV2Y ji07JȡE[1AQt0$d]Vl4nDvӶGed'%$h/1G=xu )@p
0FR.GAj# /]) ȔX؉iWm7f7erq Yr7| /O:_J3=8R e`* f" _#RB Y\=t{u \Cyidطg#߀d&S{v"~F 27K7
[Ϯ
g7
-?6C+
Njtyk$|!jNP˔}?"*LM"4Py5"69h0f^ Y6K R
ƸU&R.J7P:R W[VH(ڃߍTH ;YI$/$)?Ԕy[
n N7gvCk?cibt"7 B`1++(yUB>^vvf~C#Hm hmōt$| >@9&ӅweΛ<!Tka=G)4
u_AS 8ܙl)S6mM\ TZz3,DPenZiMwkpyA_~m'!pΫPNzwK/'s}^)lÓ;86 Cg`Hw{3 K>J6x&!${X
ړ$PU-զ6-:)3]MBvwْBjr
B<uiVFa2l*=Q -O1taD
Bܤms>D
3bH-PXI3#bBLcSĤ컕Wvyӭ$V4*s9dZb
Mz R&nMIt2/= Y$,mWeCǛ НJbd t(M]BzCy])t b^d 2ԇ%J9`쥁|S[zT > aF[
9M{L%ڪ&O6uf Lͣ0ZS!D٦ g9ײ`[W!7Q4),qdsӥ1W^¶Dm*1|̞' ~qVχpAъs8%⳯ q ɣWӴ6Bkv9<`ԚE f? ]P\N
@Y6g"iDB7t %)ZqA%0PR`U(0% ҮK " 93b]!8NPgΏ%-
e
\ LŷmJ>^( HfW"C'ݪ XMHJk*C:Goh%B̀fp A9 A |N(=}uyHgE$ Bס
rys AްU\ષƵ
趸>XCBȏi
# Overview
The Brobdingnag package provides R-centric functionality for working
with very large numbers. It represents a number
 as its logarithm
together with a logical that indicates whether
 is positive. The
vignette functions as a “hello world” for S4 methods.
The package has functionality to represent Brobdingnagian matrices, and
complex numbers.
# Installation
You can install the released version of Brobdingnag from
[CRAN](https://CRAN.R-project.org) with:
``` r
# install.packages("Brobdingnag") # uncomment this to use the package
library("Brobdingnag")
#>
#> Attaching package: 'Brobdingnag'
#> The following objects are masked from 'package:base':
#>
#> diag, max, min, prod, range, sum, t
```
The package is maintained on
[github](https://github.com/RobinHankin/Brobdingnag).
# The `Brobdingnag` package in use
Consider a googol, conventionally defined as
.
In standard arithmetic we may evaluate this as follows:
``` r
10^100
#> [1] 1e+100
```
But a googolplex,
,
is beyond floating-point representation:
``` r
10^(10^100)
#> [1] Inf
```
We may represent a googol straightforwardly using Brobdingnagian
arithmetic, specifically by working with `brob` objects.
``` r
as.brob(10)
#> [1] +exp(2.3026)
googol <- as.brob(10)^100
googol
#> [1] +exp(230.26)
10^googol
#> [1] +exp(2.3026e+100)
```
In the above, we coerce `10` to Brobdingnagian form (that is, an object
of class `brob`) using `as.brob()`. Most arithmetic methods work
transparently with Brobdingnagian numbers:
``` r
googol
#> [1] +exp(230.26)
googol + googol
#> [1] +exp(230.95)
googol/10
#> [1] +exp(227.96)
1/googol
#> [1] +exp(-230.26)
sqrt(googol)
#> [1] +exp(115.13)
exp(googol)
#> [1] +exp(1e+100)
```
Note that precision may be adversely affected for very large numbers:
``` r
gplex <- 10^googol
gplex
#> [1] +exp(2.3026e+100)
gplex - gplex/10
#> [1] -exp(-Inf)
```
The last line looks odd \[the return value is package idiom for zero\]
but symbolically we have
.
The package is vectorised and allows Brobdingnagian arithmetic:
``` r
googol/(1:20)
#> [1] +exp(230.26) +exp(229.57) +exp(229.16) +exp(228.87) +exp(228.65)
#> [6] +exp(228.47) +exp(228.31) +exp(228.18) +exp(228.06) +exp(227.96)
#> [11] +exp(227.86) +exp(227.77) +exp(227.69) +exp(227.62) +exp(227.55)
#> [16] +exp(227.49) +exp(227.43) +exp(227.37) +exp(227.31) +exp(227.26)
```
Signed quantities operate as expected:
``` r
as.brob(5) - 1:10
#> [1] +exp(1.3863) +exp(1.0986) +exp(0.69315) +exp(-2.2204e-16)
#> [5] -exp(-Inf) -exp(4.4409e-16) -exp(0.69315) -exp(1.0986)
#> [9] -exp(1.3863) -exp(1.6094)
```
It is a semi-nonobvious fact that, in addition to large numbers (that
is,
and small numbers
(),
the package can deal with numbers very close to 1 (that is,
).
Suppose we wish to deal with
.
In the package:
``` r
a <- brob(1e-100)
a
#> [1] +exp(1e-100)
a^googol
#> [1] +exp(1)
```
The last line being numerical verification of the fact that
.
The package also includes some functionality for Brobdingnagian
matrices:
``` r
brobmat(1:9,3,3)
#> [,1] [,2] [,3]
#> [1,] +exp(1) +exp(4) +exp(7)
#> [2,] +exp(2) +exp(5) +exp(8)
#> [3,] +exp(3) +exp(6) +exp(9)
brobmat(1:9,3,3) %*% 10^brobmat(9:1,3,3)
#> [,1] [,2] [,3]
#> [1,] +exp(18659) +exp(929.93) +exp(47.249)
#> [2,] +exp(18660) +exp(930.93) +exp(48.249)
#> [3,] +exp(18661) +exp(931.93) +exp(49.249)
```
Brobdingnag/man/ 0000755 0001762 0000144 00000000000 14316743725 013255 5 ustar ligges users Brobdingnag/man/brob.Rd 0000644 0001762 0000144 00000004766 13762776702 014512 0 ustar ligges users \name{brob}
\alias{brob}
\alias{as.brob}
\alias{is.brob}
\title{Brobdingnagian numbers}
\description{
Create, coerce to or test for a Brobdingnagian object
}
\usage{
brob(x = double(), positive)
as.brob(x)
is.brob(x)
}
\arguments{
\item{x}{Quantity to be tested, coerced in to Brobdingnagian form}
\item{positive}{In function \code{brob()}, logical indicating whether
the number is positive (actually, positive or zero)}
}
\details{
Function \code{as.brob()} is the user's workhorse: use this to coerce
numeric vectors to \code{brob}s.
Function \code{is.brob()} tests for its arguments being of class
\code{brob}.
Function \code{brob()} takes argument \code{x} and returns a \code{brob}
formally equal to \eqn{e^x}{exp(x)}; set argument \code{positive} to
\code{FALSE} to return \eqn{-e^x}{-exp(x)}. Thus calling function
\code{exp(x)} simply returns \code{brob(x)}. This function is not
really intended for the end user: it is confusing and includes no
argument checking. In general numerical work, use function
\code{as.brob()} instead, although be aware that if you really really
want \eqn{e^{10^7}}{e^1e7}, you should use \code{brob(1e7)};
this would be an \strong{exact} representation.
}
\note{
Real numbers are represented by two objects: a real, holding the
logarithm of their absolute values; and a logical, indicating the
sign. Multiplication and exponentiation are easy: the challenge is
addition. This is achieved using the (trivial) identity
\eqn{\log(e^x+e^y)=x+\log(1+e^{y-x})}{log(e^x+e^y)=x+log(1+e^(y-x))}
where, WLOG, \eqn{y