138 lines
4.2 KiB
R
138 lines
4.2 KiB
R
## BalancedTernary in R (S3)
|
|
|
|
## Constructor helpers ----
|
|
new_BalancedTernary <- function(digits) {
|
|
# digits are least-significant first, values in {-1,0,1}
|
|
structure(list(digits = as.integer(digits)), class = "BalancedTernary")
|
|
}
|
|
|
|
BalancedTernary <- function(x = 0L) {
|
|
if (inherits(x, "BalancedTernary")) return(x)
|
|
if (is.character(x)) return(BalancedTernary_from_string(x))
|
|
if (length(x) != 1 || !is.finite(x)) stop("BalancedTernary: need a single finite number or a string.")
|
|
BalancedTernary_from_int(as.integer(x))
|
|
}
|
|
|
|
BalancedTernary_zero <- function() new_BalancedTernary(0L)
|
|
|
|
## Conversions ----
|
|
BalancedTernary_from_int <- function(n) {
|
|
n <- as.integer(n)
|
|
if (n == 0L) return(new_BalancedTernary(0L))
|
|
digs <- integer(0)
|
|
while (n != 0L) {
|
|
r <- n %% 3L
|
|
if (r == 0L) {
|
|
digs <- c(digs, 0L); n <- n %/% 3L
|
|
} else if (r == 1L) {
|
|
digs <- c(digs, 1L); n <- n %/% 3L
|
|
} else { # r == 2 -> digit -1 and carry +1 (i.e., add 1 then divide)
|
|
digs <- c(digs, -1L); n <- (n + 1L) %/% 3L
|
|
}
|
|
}
|
|
new_BalancedTernary(digs)
|
|
}
|
|
|
|
BalancedTernary_from_string <- function(s) {
|
|
# string is most-significant first with '-', '0', '+'
|
|
map <- c("-" = -1L, "0" = 0L, "+" = 1L)
|
|
chs <- strsplit(s, "", fixed = TRUE)[[1]]
|
|
if (!all(chs %in% names(map))) stop("String may only contain '-', '0', '+'.")
|
|
# reverse to least-significant first
|
|
new_BalancedTernary(unname(map[rev(chs)]))
|
|
}
|
|
|
|
bt <- function(s) BalancedTernary_from_string(s) # macro-ish convenience
|
|
|
|
## Printing & coercion ----
|
|
print.BalancedTernary <- function(x, ...) {
|
|
cat(as.character(x), "\n", sep = "")
|
|
invisible(x)
|
|
}
|
|
|
|
as.character.BalancedTernary <- function(x, ...) {
|
|
map <- c(`-1` = "-", `0` = "0", `1` = "+")
|
|
# display most-significant first
|
|
paste0(rev(map[as.character(x$digits)]), collapse = "")
|
|
}
|
|
|
|
as.integer.BalancedTernary <- function(x, ...) {
|
|
s <- x$digits
|
|
if (length(s) == 1L && s[1] == 0L) return(0L)
|
|
ex <- seq_along(s) - 1L
|
|
# use double accumulate then coerce to integer (safe for moderate sizes)
|
|
val <- sum((3 ^ ex) * s)
|
|
as.integer(val)
|
|
}
|
|
|
|
## Unary minus ----
|
|
`-.BalancedTernary` <- function(e1) new_BalancedTernary(-e1$digits)
|
|
|
|
## Core arithmetic helpers ----
|
|
# Addition table for (a1 + b1 + c) -> (digit, carry),
|
|
# indexed by 4 + a1 + b1 + c where a1,b1,c in {-1,0,1} gives 1..7
|
|
.bt_table_digit <- c( 0, 1, -1, 0, 1, -1, 0) # d
|
|
.bt_table_carry <- c(-1, -1, 0, 0, 0, 1, 1) # c
|
|
|
|
.bt_add <- function(a, b, c = 0L) {
|
|
# a,b are integer vectors of digits (LSB first) in {-1,0,1}
|
|
if (length(a) == 0L || length(b) == 0L) {
|
|
if (c == 0L) return(if (length(a) == 0L) b else a)
|
|
return(.bt_add(c(c), if (length(a) == 0L) b else a))
|
|
} else {
|
|
a1 <- a[1]; b1 <- b[1]
|
|
idx <- 4L + a1 + b1 + c
|
|
d <- .bt_table_digit[idx]
|
|
c2 <- .bt_table_carry[idx]
|
|
r <- .bt_add(a[-1], b[-1], c2)
|
|
if (length(r) != 0L || d != 0L) {
|
|
return(c(d, r)) # unshift
|
|
} else {
|
|
return(r)
|
|
}
|
|
}
|
|
}
|
|
|
|
.bt_mul <- function(a, b) {
|
|
# schoolbook recursion with balanced digits
|
|
if (length(a) == 0L || length(b) == 0L) return(integer(0))
|
|
a1 <- a[1]
|
|
if (a1 == -1L) x <- (-BalancedTernary(new_BalancedTernary(b)))$digits
|
|
else if (a1 == 0L) x <- integer(0)
|
|
else if (a1 == 1L) x <- b
|
|
# shift (multiply by 3) = prepend a 0 digit to recursive product
|
|
y <- c(0L, .bt_mul(a[-1], b))
|
|
.bt_add(x, y)
|
|
}
|
|
|
|
.normalize_zero <- function(v) if (length(v) == 0L) 0L else v
|
|
|
|
## Binary operators ----
|
|
`+.BalancedTernary` <- function(e1, e2) {
|
|
v <- .bt_add(e1$digits, e2$digits)
|
|
new_BalancedTernary(.normalize_zero(v))
|
|
}
|
|
|
|
`-.BalancedTernary` # already defined (unary)
|
|
|
|
`%minus_bt%` <- function(a, b) a + (-b) # internal helper if needed
|
|
|
|
`*.BalancedTernary` <- function(e1, e2) {
|
|
v <- .bt_mul(e1$digits, e2$digits)
|
|
new_BalancedTernary(.normalize_zero(v))
|
|
}
|
|
|
|
## Demo / tests ----
|
|
a <- bt("+-0++0+")
|
|
cat("a: ", as.integer(a), ", ", as.character(a), "\n", sep = "")
|
|
|
|
b <- BalancedTernary(-436L)
|
|
cat("b: ", as.integer(b), ", ", as.character(b), "\n", sep = "")
|
|
|
|
c <- BalancedTernary("+-++-")
|
|
cat("c: ", as.integer(c), ", ", as.character(c), "\n", sep = "")
|
|
|
|
r <- a * (b + (-c)) # a * (b - c)
|
|
cat("a * (b - c): ", as.integer(r), ", ", as.character(r), "\n", sep = "")
|
|
|
|
stopifnot(as.integer(r) == as.integer(a) * (as.integer(b) - as.integer(c)))
|