biwavelet package: "cex.axis" not working in plot.biwavelet(); A bug?

1.1k Views Asked by At

I am using biwavelet package to conduct wavelet analysis. However, when I want to adjust the label size for axis using cex.axis, the label size does not changed. On the other hand, cex.lab and cex.main are working well. Is this a bug? The following gives a reproducible example.

library(biwavelet)
t1 <- cbind(1:100, rnorm(100))
t2 <- cbind(1:100, rnorm(100))
# Continuous wavelet transform
wt.t1 <- wt(t1)
par(oma = c(0, 0.5, 0, 0), mar = c(4, 2, 2, 4))
plot(wt.t1,plot.cb = T,plot.phase = T,type = 'power.norm',
 xlab = 'Time(year)',ylab = 'Period(year)',mgp=c(2,1,0),
 main='Winter station 1',cex.main=0.8,cex.lab=0.8,cex.axis=0.8)

Edit

There was a previous question on this site a month ago: Wavelets plot: changing x-, y- axis, and color plot, but not solved. Any help this time? Thank you!

2

There are 2 best solutions below

7
Zheyuan Li On BEST ANSWER

Yeah, it is a bug. Here is patched version: my.plot.biwavelet()

This version accepts argument cex.axis (defaults to 1), and you can change it when needed. I will briefly explain to you what the problem is, in the "explanation" section in the end.

my.plot.biwavelet <- function (x, ncol = 64, fill.cols = NULL, xlab = "Time", ylab = "Period", 
    tol = 1, plot.cb = FALSE, plot.phase = FALSE, type = "power.corr.norm", 
    plot.coi = TRUE, lwd.coi = 1, col.coi = "white", lty.coi = 1, 
    alpha.coi = 0.5, plot.sig = TRUE, lwd.sig = 4, col.sig = "black", 
    lty.sig = 1, bw = FALSE, legend.loc = NULL, legend.horiz = FALSE, 
    arrow.len = min(par()$pin[2]/30, par()$pin[1]/40), arrow.lwd = arrow.len * 
        0.3, arrow.cutoff = 0.9, arrow.col = "black", xlim = NULL, 
    ylim = NULL, zlim = NULL, xaxt = "s", yaxt = "s", form = "%Y", cex.axis = 1,
    ...)  {
         if (is.null(fill.cols)) {
             if (bw) {
                fill.cols <- c("black", "white")
            }
            else {
                fill.cols <- c("#00007F", "blue", "#007FFF", 
                  "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", 
                  "#7F0000")
            }
        }
        col.pal <- colorRampPalette(fill.cols)
        fill.colors <- col.pal(ncol)
        types <- c("power.corr.norm", "power.corr", "power.norm", 
            "power", "wavelet", "phase")
        type <- match.arg(tolower(type), types)
        if (type == "power.corr" | type == "power.corr.norm") {
            if (x$type == "wtc" | x$type == "xwt") {
                x$power <- x$power.corr
                x$wave <- x$wave.corr
            }
            else {
                x$power <- x$power.corr
            }
        }
         if (type == "power.norm" | type == "power.corr.norm") {
            if (x$type == "xwt") {
                zvals <- log2(x$power)/(x$d1.sigma * x$d2.sigma)
                if (is.null(zlim)) {
                   zlim <- range(c(-1, 1) * max(zvals))
                }
                zvals[zvals < zlim[1]] <- zlim[1]
                locs <- pretty(range(zlim), n = 5)
                leg.lab <- 2^locs
            }
            else if (x$type == "wtc" | x$type == "pwtc") {
                zvals <- x$rsq
                zvals[!is.finite(zvals)] <- NA
                if (is.null(zlim)) {
                  zlim <- range(zvals, na.rm = TRUE)
                }
                zvals[zvals < zlim[1]] <- zlim[1]
                locs <- pretty(range(zlim), n = 5)
                leg.lab <- locs
            }
            else {
                zvals <- log2(abs(x$power/x$sigma2))
                if (is.null(zlim)) {
                  zlim <- range(c(-1, 1) * max(zvals))
                }
                zvals[zvals < zlim[1]] <- zlim[1]
                locs <- pretty(range(zlim), n = 5)
                leg.lab <- 2^locs
            }
        }
        else if (type == "power" | type == "power.corr") {
            zvals <- log2(x$power)
            if (is.null(zlim)) {
                zlim <- range(c(-1, 1) * max(zvals))
            }
            zvals[zvals < zlim[1]] <- zlim[1]
            locs <- pretty(range(zlim), n = 5)
            leg.lab <- 2^locs
        }
        else if (type == "wavelet") {
            zvals <- (Re(x$wave))
            if (is.null(zlim)) {
                zlim <- range(zvals)
            }
            locs <- pretty(range(zlim), n = 5)
            leg.lab <- locs
        }
        else if (type == "phase") {
            zvals <- x$phase
            if (is.null(zlim)) {
                zlim <- c(-pi, pi)
            }
            locs <- pretty(range(zlim), n = 5)
            leg.lab <- locs
        }
        if (is.null(xlim)) {
            xlim <- range(x$t)
        }
        yvals <- log2(x$period)
        if (is.null(ylim)) {
            ylim <- range(yvals)
        }
        else {
             ylim <- log2(ylim)
        }
        image(x$t, yvals, t(zvals), zlim = zlim, xlim = xlim, 
             ylim = rev(ylim), xlab = xlab, ylab = ylab, yaxt = "n", 
             xaxt = "n", col = fill.colors, ...)
        box()
         if (class(x$xaxis)[1] == "Date" | class(x$xaxis)[1] == 
              "POSIXct") {
             if (xaxt != "n") {
                  xlocs <- pretty(x$t) + 1
                 axis(side = 1, at = xlocs, labels = format(x$xaxis[xlocs], 
                   form))
             }
          }
         else {
              if (xaxt != "n") {
                xlocs <- axTicks(1)
                axis(side = 1, at = xlocs, cex.axis = cex.axis)
             }
        }
        if (yaxt != "n") {
            axis.locs <- axTicks(2)
            yticklab <- format(2^axis.locs, dig = 1)
            axis(2, at = axis.locs, labels = yticklab, cex.axis = cex.axis)
         }
         if (plot.coi) {
             polygon(x = c(x$t, rev(x$t)), lty = lty.coi, lwd = lwd.coi, 
                  y = c(log2(x$coi), rep(max(log2(x$coi), na.rm = TRUE), 
                  length(x$coi))), col = adjustcolor(col.coi, 
                  alpha.f = alpha.coi), border = col.coi)
         }
         if (plot.sig & length(x$signif) > 1) {
             if (x$type %in% c("wt", "xwt")) {
                 contour(x$t, yvals, t(x$signif), level = tol, 
                  col = col.sig, lwd = lwd.sig, add = TRUE, drawlabels = FALSE)
              }
             else {
                 tmp <- x$rsq/x$signif
                 contour(x$t, yvals, t(tmp), level = tol, col = col.sig, 
                   lwd = lwd.sig, add = TRUE, drawlabels = FALSE)
             }
         }
         if (plot.phase) {
             a <- x$phase
             locs.phases <- which(zvals < quantile(zvals, arrow.cutoff))
             a[locs.phases] <- NA
              phase.plot(x$t, log2(x$period), a, arrow.len = arrow.len, 
                 arrow.lwd = arrow.lwd, arrow.col = arrow.col)
         }
          box()
          if (plot.cb) {
              fields::image.plot(x$t, yvals, t(zvals), zlim = zlim, ylim = rev(range(yvals)), 
                  xlab = xlab, ylab = ylab, col = fill.colors, 
                 smallplot = legend.loc, horizontal = legend.horiz, 
                legend.only = TRUE, axis.args = list(at = locs, 
                    labels = format(leg.lab, dig = 2)), xpd = NA)
        }
    }

Test

library(biwavelet)
t1 <- cbind(1:100, rnorm(100))
t2 <- cbind(1:100, rnorm(100))
# Continuous wavelet transform
wt.t1 <- wt(t1)
par(oma = c(0, 0.5, 0, 0), mar = c(4, 2, 2, 4))
my.plot.biwavelet(wt.t1,plot.cb = T,plot.phase = T,type = 'power.norm',
   xlab = 'Time(year)',ylab = 'Period(year)',mgp=c(2,1,0),
   main='Winter station 1',cex.main=0.8,cex.lab=0.8,cex.axis=0.8)

As expected, it is working.

nice


Explanation

In plot.biwavelet(), why passing cex.axis via ... does not work?

plot.biwavelet() generates the your final plot mainly in 3 stages:

  1. image(..., xaxt = "n", yaxt = "n") for generating basic plot;
  2. axis(1, at = atTicks(1)); axis(2, at = atTicks(2)) for adding axis;
  3. fields::image.plot() for displaying colour legend strip.

Now, although this function takes ..., they are only fed to the first image() call, while the following axis(), (including polygon(), contour(), phase.plot()) and image.plot() take none from .... When later calling axis(), no flexible specification with respect to axis control are supported.

I guess during package development time, problem described as in: Giving arguments from “…” argument to right function in R had been encountered. Maybe the author did not realize this potential issue, leaving a bug here. My answer to that post, as well as Roland's comments, points toward a robust fix.

I am not the package author so can not decide how he will fix this. My fix is brutal, but works for you temporary need: just add the cex.axis argument to axis() call. I have reached Tarik (package author) with an email, and I believe he will give you a much better explanation and solution.

1
Tarik On

I fixed this issue by passing the ... argument to axis in plot.biwavelet. Your code should now work as desired. Note that changes to cex.axis and other axis arguments will affect all three axes (x, y, z).

You can download the new version (0.20.8) of biwavelet from GitHub by issuing the following command at the R console (this assumes that you have the package devtools already installed): devtools::install_github("tgouhier/biwavelet")

Thanks for pointing out the bug!