1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
|
#' Big number arithmetic
#'
#' Basic operations for working with large integers. The \code{bignum}
#' function converts a positive integer, string or raw vector into a bignum type.
#' All basic \link{Arithmetic} and \link{Comparison} operators such as
#' \code{+}, \code{-}, \code{*}, \code{^}, \code{\%\%}, \code{\%/\%}, \code{==},
#' \code{!=}, \code{<}, \code{<=}, \code{>} and \code{>=} are implemented for
#' bignum objects. The
#' \href{https://en.wikipedia.org/wiki/Modular_exponentiation}{Modular exponent}
#' (\code{a^b \%\% m}) can be calculated using \code{\link{bignum_mod_exp}}
#' when \code{b} is too large for calculating \code{a^b} directly.
#'
#' @export
#' @name bignum
#' @rdname bignum
#' @param x an integer, string (hex or dec) or raw vector
#' @param a bignum value for \code{(a^b \%\% m)}
#' @param b bignum value for \code{(a^b \%\% m)}
#' @param m bignum value for \code{(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)
}
|