Bugs Bubbles

[GoogleCodeExporter]

There is also a bug in plotBubbles.  The yval parameter does not work.

The fix is below (commented with my initials ARK), mayhaps some testing is wise 
to ensure I haven't broken anything.

My version is named .plotBubbles to avoid conflict with PBSmodelling 
plotBubbles.

Rob

.plotBubbles <- function (z, xval = FALSE, yval = FALSE, dnam = FALSE, rpro = 
FALSE, 
    cpro = FALSE, rres = FALSE, cres = FALSE, powr = 0.5, size = 0.2, 
    lwd = 1, clrs = c("black", "red", "blue"), hide0 = FALSE, 
    frange = 0.1, ...) 
{
    if (is.data.frame(z)) {
        use = !sapply(z, is.factor) & sapply(z, is.numeric)
        z = z[, use]
        if (ncol(z) == 0) {
            showAlert("data frame not useable")
            return()
        }
        z = as.matrix(z)
    }
    dz <- dim(z)
    ny = ny1 = dz[1]
    nx = nx1 = dz[2]
    if (length(dz) > 2) {
        showAlert("Input matrix must have only 2 dimensions")
        return()
    }
    xval1 <- 1:nx
    yval1 <- 1:ny
    if (mode(xval) == "logical") {
        if (xval[1]) {
            xval1 <- z[1, ]
            ny1 <- ny - 1
        }
    }
    if (mode(yval) == "logical") {
        if (yval[1]) {
            yval1 <- z[, 1]
            nx1 <- nx - 1
        }
    }
    xind <- (nx - nx1 + 1):nx
    x2 = xlabel = xval1[xind]
    yind <- (ny - ny1 + 1):ny
    y2 = ylabel = yval1[yind]
    if ((mode(xval) != "logical") & (length(xval) == nx1)) {
        if (mode(xval) == "numeric") 
            x2 = xval
        xlabel = xval
    }
    if ((mode(yval) != "logical") & (length(yval) == ny1)) {
        if (mode(yval) == "numeric") 
            y2 = yval
        ylabel = yval
    }
    zz <- array(z[yind, xind], dim = c(length(yind), length(xind)), 
        dimnames = dimnames(z))
    dots = list(...)
    xlab = dots$xlab
    if (is.null(xlab)) 
        xlab = ""
    ylab = dots$ylab
    if (is.null(ylab)) 
        ylab = ""
    if (dnam & !is.null(dimnames(zz))) {
        warn = options()$warn
        options(warn = -1)
        if (!is.null(dimnames(zz)[[2]])) {
            xpos = try(as.numeric(dimnames(zz)[[2]]), silent = TRUE)
            if (all(is.na(xpos))) 
                xlabel = dimnames(zz)[[2]]
            else if (!any(is.na(xpos)) && all(diff(xpos) > 0 | 
                all(diff(xpos) < 0))) {
                xlabel = as.character(xpos)
                x2 = xpos
            }
        }
        if (!is.null(dimnames(zz)[[1]])) {
            ypos = try(as.numeric(dimnames(zz)[[1]]), silent = TRUE)
            if (all(is.na(ypos))) 
                ylabel = dimnames(zz)[[2]]
            else if (!any(is.na(ypos)) && all(diff(ypos) > 0 | 
                all(diff(ypos) < 0))) {
                ylabel = as.character(ypos)
                y2 = ypos
            }
        }
        options(warn = warn)
    }
    xx <- rep(x2, each = length(y2))
    yy <- rep(y2, length(x2))
    minz <- min(zz, na.rm = TRUE)
    maxz <- max(zz, na.rm = TRUE)
    if (rpro | cpro) {
        if (minz < 0) {
            zz <- zz - minz
            minz <- 0
            maxz <- max(zz, na.rm = TRUE)
        }
    }
    if (rpro) {
        zs <- apply(zz, 1, sum, na.rm = TRUE)
        zz <- sweep(zz, 1, zs, "/")
    }
    if (cpro) {
        zs <- apply(zz, 2, sum, na.rm = TRUE)
        zz <- sweep(zz, 2, zs, "/")
    }
    if (rres) {
        zm <- apply(zz, 1, mean, na.rm = TRUE)
        zz <- sweep(zz, 1, zm, "-")
    }
    if (cres) {
        zm <- apply(zz, 2, mean, na.rm = TRUE)
        zz <- sweep(zz, 2, zm, "-")
    }
    zNA <- is.na(zz) | is.nan(zz) | is.infinite(zz)
    zz[zNA] <- 0
    z0 <- sign(zz) * abs(zz)^abs(powr)
    z1 <- z3 <- z0
    z1[z0 <= 0] <- NA
    z3[z0 < 0 | z0 > 0] <- NA
    z2 <- -z0
    z2[z0 >= 0] <- NA
    za <- max(z0, na.rm = TRUE)
    zb <- min(z0, na.rm = TRUE)
    zM <- max(abs(z0))
    sz1 <- max(za * size/zM, 0.001)
    sz2 <- max(-zb * size/zM, 0.001)

    # ARK (11-Jul-10) Added axes=FALSE to remove y-axis labels.
    evalCall(plot, argu = list(x = 0, y = 0, xlim = extendrange(x2, 
        f = frange), ylim = extendrange(y2, f = frange), axes=FALSE, type = "n", 
        xaxt = "n", xlab = xlab, ylab = ylab ), ..., checkdef = TRUE, 
        checkpar = TRUE)

    evalCall(axis, argu = list(side = 1, at = x2, labels = xlabel), 
        ..., checkpar = TRUE)

    # ARK (11-Jul-10) Added to implement yval.    
    evalCall(axis, argu = list(side = 2, at = y2, labels = ylabel), 
        ..., checkpar = TRUE)
    box()        

    if (!hide0 && !all(is.na(z3))) {
        evalCall(symbols, argu = list(x = xx, y = yy, circles = as.vector(z3), 
            inches = 0.001, fg = clrs[3], lwd = lwd, add = TRUE), 
            ..., checkpar = TRUE)
    }
    if (!all(is.na(z2))) {
        evalCall(symbols, argu = list(x = xx, y = yy, circles = as.vector(z2), 
            inches = sz2, fg = clrs[2], lwd = lwd, add = TRUE), 
            ..., checkpar = TRUE)
    }
    if (!all(is.na(z1))) {
        evalCall(symbols, argu = list(x = xx, y = yy, circles = as.vector(z1), 
            inches = sz1, fg = clrs[1], lwd = lwd, add = TRUE), 
            ..., checkpar = TRUE)
    }
    invisible(z0)
}

Original issue reported on code.google.com by rowan.ha...@dfo-mpo.gc.ca on 19 Jul 2010 at 9:03

[GoogleCodeExporter]

Hi Rob,
I've revised plotBubbles along the lines you suggested. I also found a bug for 
one of the options I personally never used. I've also added a new logical 
argument called 'prettyaxis' that attempts to make the axis labelling look a 
little less cluttered. If you get a chance could you try the function out on 
whatever was causing you grief before. Thanks.
Ciao for now, Rowan (2010-07-12)

Original comment by rowan.ha...@dfo-mpo.gc.ca on 19 Jul 2010 at 9:05

Attachments:

• plotBubbles.r

[GoogleCodeExporter]

(Possibly) more plotBubbles issues.

plotBubbles allows a variety of options for what to do with the input data, 
namely rpro, cpro, rres, cres.  All are FALSE by default according to the UG.

Thus, if the matrix of age proportions is submitted to plotBubbles for 
plotting, with no amendments required, I assumed that these default settings 
would pass the matrix through without modification.

In fact, the value returned by plotBubbles (z0 in the function) appears to be 
as though cpro was TRUE.  I changed it to zz and got the desired result but 
have not tested it extensively for other options.  I assumed that plotBubbles 
should return a matrix corresponding to the settings of rpro, cpro, rres, and 
cres.  I'm not even sure that zz was the correct choice in general.

I think that plotBubbles should have additional documenation in the UG to 
provide the details of VALUE (i.e, what is returned) and the intended behavior.

This could be a particularly nasty one if people use plotBubbles to generate 
the proportions at age for a catch-at-age model, for example.

Thoughts?  Rob (2010-07-19)

Original comment by rowan.ha...@dfo-mpo.gc.ca on 19 Jul 2010 at 9:06

[GoogleCodeExporter]

Rowan points out to me that plotBubbles returns the matrix values raised to the 
pwr ( i.e., the symbol expansion value )

This is fine, but the documentation should be revised to reflect the value 
returned by .plotBubbles and maybe a cautionary note about setting pwr to 1 if 
you want the actual values.

I mistakenly assumed that pwr would only be a plotting side effect.  My bad.

R. (2010-07-19) 

Original comment by rowan.ha...@dfo-mpo.gc.ca on 19 Jul 2010 at 11:01

[GoogleCodeExporter]

RH: The code above was incorporated some time ago. 

Original comment by rowan.ha...@dfo-mpo.gc.ca on 9 Sep 2011 at 7:21

• Changed state: Fixed