###-------- BETTER Re-Write this completely:
### Change internal representation to "trivial":
###  keep integer, just add "base" and class
### 1) New  as.character.baseint()   [should do  what baseint() does now]
### 2) print.baseint() must use as.character.*
###
### Advantage:  Ops.*  Math.* will all trivially work!

### However: Make sure that there are still tools F1() or F2()  for
### =======   F1(  "10101" ,   2) |-> 21
###           F2(c(1,0,1,0,1), 2) |-> 21
### (about what  as.integer.baseint() does now

### Consider doing the above IN ADDITION to the class below, using
### NEW class "basedInt"

baseint <- function(n, base = 8)
{
    ## Purpose: turn integers into 'octals', 'hexadecimals', 'bits', ...
    ## -----------------------------------------------------------------------
    ## Arguments: n:	non-negative integer vector
    ##		  base: integer >= 2
    ## -----------------------------------------------------------------------
    ## Author: Martin Maechler, Date: 25 Nov 1998, 14:59

    if(!is.numeric(n) ||
       any(n < 0, na.rm=TRUE) || any(n != trunc(n), na.rm=TRUE))
        stop("baseint only works for non-negative integers")
    att <- attributes(n)
    ll <- length(n)# no coercion to integer! Can have larger ones: 2^63
    if(any(n > .Machine$integer.max, na.rm=TRUE))
        warning("baseint:  possible precision loss for large 'n'")
    r <- character(ll)
    b <- as.integer(base[1])
    if(b <= 1) stop("base must be integer >= 2")
    maxdig <- 1 + floor(log(max(1,n, na.rm=TRUE), b))
    o.digits <- matrix(NA, ll, maxdig)
    mn0 <- m <- n
    m.non.0 <- rep(TRUE, ll)
    j <- 0
    while(j==0 || any(m != 0, na.rm=TRUE)) { ## && j < maxdig
        ## m.non.0: TRUE for indices k w/ m[k] > 0 ; mn0 == m[m.non.0]
        o.digits[ m.non.0, (j <- j+1)] <- rem <- mn0 %% b
        m[m.non.0] <- (mn0 - rem) %/% b
        m.non.0 <- m.non.0 & m != 0
        mn0 <- m[m.non.0]
    }
    if(j < maxdig) cat("\n\n*** baseint: didn't need all columns: j=",j,
                       " < maxdig =",maxdig,"\n\n")
    dig.code <-
    {
        if(b <= 10)
            function(d) paste(d, collapse="")
        else if(b <= 36)
            function(d) paste(c(paste(0:9),letters[1:(b-10)])[d+1], collapse="")
        else
            function(d) paste(d, collapse=",")
    }
    r <- apply(o.digits[,j:1, drop = FALSE], 1,
               function(v) dig.code(v[!is.na(v)]))
    if(any(ina <- is.na(n))) r[ina] <- NA
    attributes(r) <- att
    attr(r,"base") <- base
    class(r) <- c("baseint", class(r))
    r
}

as.integer.baseint  <- function(x)
{
  ## Purpose: Turn "baseint" object back to plain integer
  ## ----------------------------------------------------------------------
  ## Author: Martin Mächler, Date: 12 Aug 00, 09:33
  if(!is.baseint(x)) stop("argument is not \"baseint\" object")
  b <- attr(x,"base") ## stopifnot(b >= 2)
  code <- if(b > 36) "M" else if(b > 10) "A" else ""
  ch <- strsplit(x, if(code == "M")",")
  m.e1 <- max(if(code == "M")unlist(lapply(ch,length)) else nchar(x)) - 1
  trm <- b^(0:m.e1)
  if(code == "A") digs <- c(paste(0:9),letters[1:(b-10)])
  sapply(ch,
         if(code != "A")
         function(s) sum(as.integer(s) * trm[length(s):1])
         else # 10 < b <= 36 : 0..9 a..z
         function(s) sum((match(s,digs)-1) * trm[length(s):1]))
}

is.baseint <- function(i) inherits(i, "baseint")
as.baseint <- function(i) if(is.baseint(i)) i else baseint(i)

print.baseint <- function(bnum,..., base.sep = "{b}")
{
    if(!is.numeric(b <- attr(bnum,"base")))
        stop("invalid 'baseint' object")
    ch.b <-
        if(b == 8)	paste("0",bnum,sep="")
        else if(b == 16)paste("x",bnum,sep="")
        else paste(bnum,b, sep= base.sep)
    att <- attributes(bnum)
    attributes(ch.b) <- att[is.na(match(names(att), c("class","base")))]
    class(ch.b) <- class(bnum)[class(bnum) != "baseint"]
    print(ch.b, quote=FALSE, right=TRUE, ...)
    invisible(bnum)
}

"[.baseint" <- function (x, ...)
{
    attr <- attributes(x)
    r <- unclass(x)[...]
    attributes(r) <- c(attributes(r),
                       attr[is.na(match(names(attr), c("dim", "dimnames")))])
    r
}

cbind.baseint <- function(x, ...) {
    att <- attributes(x)
    ## now want : r <- cbind.default(x,...)   but cbind dispatches internally
    ##
    ## Both of these fail pretty funnily (and identically, looking at traceback)
    ##	  r <- NextMethod("cbind", x, ...)
       r <- NextMethod("cbind")
    ## The following is ugly, only correct when x has one class (can be corr.)
    ## and gives an  INFINITE LOOP for 2 or more "baseint" arguments
    ##    (since cbind then dispatches on the 2nd arg which is not unclassed...)
    ## r <- cbind(unclass(x),...)

    attributes(r) <- c(attributes(r),
                       att[is.na(match(names(att), c("dim","dimnames")))])
    r
}
