#' Big number arithmetic
#'
#' Basic operations for working with large integers. The `bignum`
#' function converts a positive integer, string or raw vector into a bignum type.
#' All basic [Arithmetic] and [Comparison] operators such as
#' `+`, `-`, `*`, `^`, `%%`, `%/%`, `==`,
#' `!=`, `<`, `<=`, `>` and `>=` are implemented for
#' bignum objects. The
#' [Modular exponent](https://en.wikipedia.org/wiki/Modular_exponentiation)
#' (`a^b %% m`) can be calculated using [bignum_mod_exp()]
#' when `b` is too large for calculating `a^b` directly.
#'
#' @export
#' @name bignum
#' @rdname bignum
#' @param x an integer, string (hex or dec) or raw vector
#' @param a bignum value for `(a^b %% m)`
#' @param b bignum value for `(a^b %% m)`
#' @param m bignum value for `(a^b %% m)`
#' @param hex set to TRUE to parse strings as hex rather than decimal notation
#' @useDynLib openssl R_parse_bignum
#' @examples # create a bignum
#' x <- bignum(123L)
#' y <- bignum("123456789123456789")
#' z <- bignum("D41D8CD98F00B204E9800998ECF8427E", hex = TRUE)
#'
#' # Basic arithmetic
#' div <- z %/% y
#' mod <- z %% y
#' z2 <- div * y + mod
#' stopifnot(z2 == z)
#' stopifnot(div < z)
bignum <- function(x, hex = FALSE){
if(inherits(x, "bignum"))
return(x)
stopifnot(is.raw(x) || is.character(x) || is.numeric(x))
if(is.numeric(x)){
if(is_positive_integer(x)){
x <- formatC(x, format = "fg")
} else {
stop("Cannot convert to bignum: x must be positive integer, character or raw", call. = FALSE)
}
}
if(is.character(x)){
if(identical(x, "0")){
# special case always valid
} else if(isTRUE(hex)){
if(!grepl("^([a-fA-F0-9]{2})+$", x))
stop("Value '", x, "' is not valid hex string", call. = FALSE)
} else {
if(!grepl("^[0-9]+$", x))
stop("Value '", x, "' is not valid integer", call. = FALSE)
}
}
.Call(R_parse_bignum, x, hex)
}
bn <- bignum
#' @export
print.bignum <- function(x, hex = FALSE, ...){
cat("[b]", as.character.bignum(x, hex = hex))
}
#' @export
#' @useDynLib openssl R_bignum_as_character
as.character.bignum <- function(x, hex = FALSE, ...){
.Call(R_bignum_as_character, x, hex)
}
#' @export
as.double.bignum <- function(x, ...){
if(any(x > bignum("9007199254740992")))
warning("loss of precision for coersing bignum to double")
as.numeric(as.character(x))
}
#' @export
#' @useDynLib openssl R_bignum_as_integer
as.integer.bignum <- function(x, ...){
.Call(R_bignum_as_integer, x)
}
#' @export
#' @useDynLib openssl R_bignum_add
`+.bignum` <- function(x, y){
.Call(R_bignum_add, bn(x), bn(y))
}
#' @export
#' @useDynLib openssl R_bignum_subtract
`-.bignum` <- function(x, y){
x <- bn(x)
y <- bn(y)
stopifnot(x >= y)
.Call(R_bignum_subtract, x, y)
}
#' @export
#' @useDynLib openssl R_bignum_multiply
`*.bignum` <- function(x, y){
.Call(R_bignum_multiply, bn(x), bn(y))
}
#' @export
#' @useDynLib openssl R_bignum_exp
`^.bignum` <- function(x, y){
.Call(R_bignum_exp, bn(x), bn(y))
}
#' @export
#' @useDynLib openssl R_bignum_devide
`%/%.bignum` <- function(x, y){
.Call(R_bignum_devide, bn(x), bn(y))
}
# Doesn't help because R always evaluates 'x' to determine dispatch method
#' @export
`%%.bignum` <- function(x, y){
xcall = substitute(x)
if(length(xcall) == 3 && identical(xcall[[1]], quote(`^`))){
a <- eval(xcall[[2]])
b <- eval(xcall[[3]])
bignum_mod_exp(a, b, y)
} else {
bignum_mod(x, y)
}
}
#' @export
#' @useDynLib openssl R_bignum_compare
`>.bignum` <- function(x, y){
identical(1L, .Call(R_bignum_compare, bn(x), bn(y)));
}
#' @export
#' @useDynLib openssl R_bignum_compare
`<.bignum` <- function(x, y){
identical(-1L, .Call(R_bignum_compare, bn(x), bn(y)));
}
#' @export
#' @useDynLib openssl R_bignum_compare
`==.bignum` <- function(x, y){
identical(0L, .Call(R_bignum_compare, bn(x), bn(y)));
}
#' @export
`!=.bignum` <- function(x, y){
!identical(0L, .Call(R_bignum_compare, bn(x), bn(y)));
}
#' @export
`>=.bignum` <- function(x, y){
.Call(R_bignum_compare, bn(x), bn(y)) > -1L;
}
#' @export
`<=.bignum` <- function(x, y){
.Call(R_bignum_compare, bn(x), bn(y)) < 1L;
}
#' @export
`/.bignum` <- function(x, y){
stop("Use integer division %/% and modulo %% for dividing bignum objects", call. = FALSE)
}
#' @useDynLib openssl R_bignum_mod
bignum_mod <- function(x, y){
.Call(R_bignum_mod, x, y)
}
#' @export
#' @rdname bignum
#' @useDynLib openssl R_bignum_mod_exp
bignum_mod_exp <- function(a, b, m){
.Call(R_bignum_mod_exp, a, b, m)
}
#' @export
#' @rdname bignum
#' @useDynLib openssl R_bignum_mod_inv
bignum_mod_inv <- function(a, m){
.Call(R_bignum_mod_inv, a, m)
}
#' @useDynLib openssl R_bignum_bits
bignum_bits <- function(x){
.Call(R_bignum_bits, x)
}
is_positive_integer <- function(x) {
if(x < 0)
return(FALSE)
if(is.integer(x))
return(TRUE)
tol <- sqrt(.Machine$double.eps)
if(x < 2^53 && abs(x - round(x)) < tol)
return(TRUE)
return(FALSE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.