0

パッケージを使用biwaveletしてウェーブレット解析を行っています。しかし、 で軸のラベルサイズを調整したいのですがcex.axis、ラベルサイズが変わりません。一方、cex.labcex.mainはうまく機能しています。これはバグですか?以下に、再現可能な例を示します。

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)

編集

1 か月前にこのサイトに以前の質問がありました:ウェーブレット プロット: x 軸、y 軸、およびカラー プロットの変更ですが、解決されていません。今回はお手伝い?ありがとうございました!

4

2 に答える 2

4

ええ、それはバグです。ここにパッチが適用されたバージョンがあります: my.plot.biwavelet()

このバージョンは引数を受け入れcex.axis(デフォルトは 1)、必要に応じて変更できます。最後の「説明」セクションで、問題が何であるかを簡単に説明します。

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)
        }
    }

テスト

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)

期待どおり、動作しています。

良い


説明

plot.biwavelet()、なぜcex.axis経由...が機能しないのですか?

plot.biwavelet()主に 3 つの段階で最終的なプロットを生成します。

  1. image(..., xaxt = "n", yaxt = "n")基本的なプロットを生成するため。
  2. axis(1, at = atTicks(1)); axis(2, at = atTicks(2))軸を追加するため。
  3. fields::image.plot() 色の凡例ストリップを表示します。

現在、この関数は を受け取りますが、それらは最初の呼び出しに...のみ供給されますが、次の , ( , を含む)からは何も受け取りません. 後で を呼び出す場合、軸制御に関する柔軟な指定はサポートされていません。image()axis()polygon(), contour()phase.plot()image.plot()...axis()

パッケージの開発中に、「…」引数からRの正しい関数に引数を渡すという問題が発生したと思います。おそらく、作成者はこの潜在的な問題に気付いておらず、ここにバグを残しています。その投稿に対する私の回答と Roland のコメントは、確実な修正を示しています。

私はパッケージの作成者ではないので、彼がこれをどのように修正するかを決めることはできません. 私の修正は残忍ですが、一時的な必要性に対しては機能します。呼び出すcex.axis引数を追加するだけです。axis()Tarik (パッケージ作成者) に電子メールで連絡を取りました。彼がより適切な説明と解決策を提供してくれると思います。

于 2016-06-25T04:47:33.607 に答える
1

inに...引数を渡すことで、この問題を修正しました。コードは期待どおりに動作するはずです。およびその他の引数を変更すると、3 つの軸 (x、y、z) すべてに影響することに注意してください。axisplot.biwaveletcex.axisaxis

biwaveletコンソールで次のコマンドを発行して、GitHub からの新しいバージョン (0.20.8) をダウンロードできますR(これは、パッケージdevtoolsが既にインストールされていることを前提としています)。devtools::install_github("tgouhier/biwavelet")

バグのご指摘ありがとうございます!

于 2016-06-25T18:56:58.513 に答える