[R] fixup for debug package and R2.4.0

[Mark.Bravington at csiro.au]

A number of users have spotted a terminal problem with the 'debug' package under R2.4.0, along the lines of 

> mtrace(x)
> x()
Error in attr(value, "row.names") <- rlabs :
 row names must be 'character' or 'integer', not 'double' 

This arose from a bug in 'rbind.data.frame' in R2.4.0 itself. The bug is fixed in R2.4.0 patched, so the best solution is to install the patched version. This is painless, at least for Windows, since a binary version of R-patched is available on CRAN (I hadn't realized this).

If for reason you desperately don't want to install R-patched, the following *ugly* bit of code can be run after loading the 'debug' library [so you could put this in your '.First' function]:

Thanks to all who reported the problem

Mark Bravington
mark.bravington at csiro.au

mvbutils:::assign.to.base( 'rbind.data.frame', function (..., deparse.level = 1) 
{
    match.names <- function(clabs, nmi) {
        if (all(clabs == nmi)) 
            NULL
        else if (length(nmi) == length(clabs) && all(nii <- match(nmi, 
            clabs, 0))) {
            m <- pmatch(nmi, clabs, 0)
            if (any(m == 0)) 
                stop("names do not match previous names")
            m
        }
        else stop("names do not match previous names:\n\t", paste(nmi[nii == 
            0], collapse = ", "))
    }
    Make.row.names <- function(nmi, ri, ni, nrow) {
        if (nchar(nmi) > 0) {
            if (ni == 0) 
                character(0)
            else if (ni > 1) 
                paste(nmi, ri, sep = ".")
            else nmi
        }
        else if (nrow > 0 && identical(ri, 1:ni)) 
            as.integer(seq.int(from = nrow + 1, length = ni))
        else ri
    }
    allargs <- list(...)
    allargs <- allargs[sapply(allargs, length) > 0]
    n <- length(allargs)
    if (n == 0) 
        return(structure(list(), class = "data.frame", row.names = integer()))
    nms <- names(allargs)
    if (is.null(nms)) 
        nms <- character(length(allargs))
    cl <- NULL
    perm <- rows <- rlabs <- vector("list", n)
    nrow <- 0
    value <- clabs <- NULL
    all.levs <- list()
    for (i in 1:n) {
        xi <- allargs[[i]]
        nmi <- nms[i]
        if (is.matrix(xi)) 
            allargs[[i]] <- xi <- as.data.frame(xi)
        if (inherits(xi, "data.frame")) {
            if (is.null(cl)) 
                cl <- oldClass(xi)
            ri <- attr(xi, "row.names")
            ni <- length(ri)
            if (is.null(clabs)) 
                clabs <- names(xi)
            else {
                pi <- match.names(clabs, names(xi))
                if (!is.null(pi)) 
                  perm[[i]] <- pi
            }
            rows[[i]] <- seq.int(from = nrow + 1, length = ni)
            rlabs[[i]] <- Make.row.names(nmi, ri, ni, nrow)
            nrow <- nrow + ni
            if (is.null(value)) {
                value <- unclass(xi)
                nvar <- length(value)
                all.levs <- vector("list", nvar)
                has.dim <- logical(nvar)
                facCol <- logical(nvar)
                ordCol <- logical(nvar)
                for (j in 1:nvar) {
                  xj <- value[[j]]
                  if (!is.null(levels(xj))) {
                    all.levs[[j]] <- levels(xj)
                    facCol[j] <- TRUE
                  }
                  else facCol[j] <- is.factor(xj)
                  ordCol[j] <- is.ordered(xj)
                  has.dim[j] <- length(dim(xj)) == 2
                }
            }
            else for (j in 1:nvar) {
                xij <- xi[[j]]
                if (is.null(pi) || is.na(jj <- pi[[j]])) 
                  jj <- j
                if (facCol[jj]) {
                  if (length(lij <- levels(xij)) > 0) {
                    all.levs[[jj]] <- unique(c(all.levs[[jj]], 
                      lij))
                    ordCol[jj] <- ordCol[jj] & is.ordered(xij)
                  }
                  else if (is.character(xij)) 
                    all.levs[[jj]] <- unique(c(all.levs[[jj]], 
                      xij))
                }
            }
        }
        else if (is.list(xi)) {
            ni <- range(sapply(xi, length))
            if (ni[1] == ni[2]) 
                ni <- ni[1]
            else stop("invalid list argument: all variables should have the same length")
            rows[[i]] <- ri <- as.integer(seq.int(from = nrow + 
                1, length = ni))
            nrow <- nrow + ni
            rlabs[[i]] <- Make.row.names(nmi, ri, ni, nrow)
            if (length(nmi <- names(xi)) > 0) {
                if (is.null(clabs)) 
                  clabs <- nmi
                else {
                  tmp <- match.names(clabs, nmi)
                  if (!is.null(tmp)) 
                    perm[[i]] <- tmp
                }
            }
        }
        else if (length(xi) > 0) {
            rows[[i]] <- nrow <- nrow + 1
            rlabs[[i]] <- if (nchar(nmi) > 0) 
                nmi
            else as.integer(nrow)
        }
    }
    nvar <- length(clabs)
    if (nvar == 0) 
        nvar <- max(sapply(allargs, length))
    if (nvar == 0) 
        return(structure(list(), class = "data.frame", row.names = integer()))
    pseq <- 1:nvar
    if (is.null(value)) {
        value <- list()
        value[pseq] <- list(logical(nrow))
    }
    names(value) <- clabs
    for (j in 1:nvar) if (length(lij <- all.levs[[j]]) > 0) 
        value[[j]] <- factor(as.vector(value[[j]]), lij, ordered = ordCol[j])
    if (any(has.dim)) {
        rmax <- max(unlist(rows))
        for (i in (1:nvar)[has.dim]) if (!inherits(xi <- value[[i]], 
            "data.frame")) {
            dn <- dimnames(xi)
            rn <- dn[[1]]
            if (length(rn) > 0) 
                length(rn) <- rmax
            pi <- dim(xi)[2]
            length(xi) <- rmax * pi
            value[[i]] <- array(xi, c(rmax, pi), list(rn, dn[[2]]))
        }
    }
    for (i in 1:n) {
        xi <- unclass(allargs[[i]])
        if (!is.list(xi)) 
            if (length(xi) != nvar) 
                xi <- rep(xi, length.out = nvar)
        ri <- rows[[i]]
        pi <- perm[[i]]
        if (is.null(pi)) 
            pi <- pseq
        for (j in 1:nvar) {
            jj <- pi[j]
            xij <- xi[[j]]
            if (has.dim[jj]) {
                value[[jj]][ri, ] <- xij
                rownames(value[[jj]])[ri] <- rownames(xij)
            }
            else {
                value[[jj]][ri] <- if (is.factor(xij)) 
                  as.vector(xij)
                else xij
                if (!is.null(nm <- names(xij))) 
                  names(value[[jj]])[ri] <- nm
            }
        }
    }
    rlabs <- unlist(rlabs)
    if (any(duplicated(rlabs))) 
        rlabs <- make.unique(as.character(unlist(rlabs)), sep = "")
    if (is.null(cl)) {
        as.data.frame(value, row.names = rlabs)
    }
    else {
        class(value) <- cl
        attr(value, "row.names") <- rlabs
        value
    }
})