2016-06-25 6 views
0

私はウェーブレット解析を行うためにbiwaveletパッケージを使用しています。ただし、cex.axisを使用して軸のラベルサイズを調整する場合、ラベルサイズは変更されません。一方、cex.labcex.mainはうまくいきます。これはバグですか?以下に再現可能な例を示します。バイウェーブレットパッケージ: "cex.axis"はplot.biwavelet()で動作しません。バグ?

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) 

編集

ありヶ月前にこのサイト上の前の質問だった:Wavelets plot: changing x-, y- axis, and color plotは、しかし、解決していません。今回のお手伝いは?ありがとうございました!

答えて

4

ええ、バグです。

このバージョンでは、引数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()

nice


説明

、なぜ...経由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()色の凡例のストリップを表示します。この関数は...をとるが今、それらのみ(polygon(), contour()phase.plot()含む)axis()に追従して、第一image()コールに供給され、image.plot()...からどれを取っていない

。後でaxis()を呼び出すと、軸コントロールに関する柔軟な指定がサポートされません。

パッケージ開発時には、Giving arguments from “…” argument to right function in Rのような問題が発生していたようです。著者がこの潜在的な問題を認識していない可能性があります。その記事への私の答えと、Rolandのコメントは、堅調な修正を指し示しています。

私はパッケージの著者ではないので、彼がこれをどのように修正するかを決めることはできません。私の修正は残酷ですが、一時的な必要性のために働きます:axis()呼び出しにcex.axis引数を追加するだけです。私は電子メールでTarik(パッケージ作成者)に連絡しました。私は彼があなたにもっと良い説明と解決策を与えると信じています。

+0

あなたは本当にRのマスターです。本当にありがとうございました。ご協力いただきありがとうございます。本当にありがとうございました。 –

+0

親愛なるLi、私はStackOverflowを初めて使っています。私はあなたの答えを受け入れました。私はどのように私はあなたの答えを投票することができますか?ありがとう。 –

+0

親愛なる李、私はちょうどGoogleの答えを投票する方法を学びました。あなたの親切な助けをもう一度ありがとう。 –

1

...引数をaxisplot.biwaveletに設定してこの問題を修正しました。あなたのコードは必要に応じて動作するはずです。 cex.axisとその他のaxis引数を変更すると、3つの軸(x、y、z)すべてに影響します。

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

感謝を不具合!

+0

あなたは素晴らしいです!それは今働いている。あなたの親切な助けをありがとうございました。 –

関連する問題