From noreply at r-forge.r-project.org Thu May 1 22:02:56 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 1 May 2014 22:02:56 +0200 (CEST) Subject: [Dplr-commits] r845 - in pkg/dplR: . vignettes Message-ID: <20140501200256.D9F0E1875CE@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-01 22:02:52 +0200 (Thu, 01 May 2014) New Revision: 845 Modified: pkg/dplR/DESCRIPTION pkg/dplR/vignettes/intro-dplR.Rnw Log: Tiny optimization to intro-dplR vignette Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-04-30 12:59:51 UTC (rev 844) +++ pkg/dplR/DESCRIPTION 2014-05-01 20:02:52 UTC (rev 845) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-04-30 +Date: 2014-05-01 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-04-30 12:59:51 UTC (rev 844) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-05-01 20:02:52 UTC (rev 845) @@ -224,7 +224,7 @@ (the \code{rwl} object) and produces summary statistics. Here are summary statistics on the first five series in \code{ca533}. <<>>= -rwl.stats(ca533)[1:5, ] +rwl.stats(ca533[1:5]) @ These are common summary statistics like mean, median, etc. but also statistics From noreply at r-forge.r-project.org Thu May 1 23:32:00 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 1 May 2014 23:32:00 +0200 (CEST) Subject: [Dplr-commits] r846 - pkg/dplR/vignettes Message-ID: <20140501213200.2F65518715B@r-forge.r-project.org> Author: andybunn Date: 2014-05-01 23:31:59 +0200 (Thu, 01 May 2014) New Revision: 846 Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw Log: * typo in vignette Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-01 20:02:52 UTC (rev 845) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-01 21:31:59 UTC (rev 846) @@ -31,8 +31,7 @@ \begin{abstract} In this vignette we cover some of the basic time series tools in dplR (and in R to a much lesser extent). These include spectral analysis -using redfit and wavelets. We also discuss fitting AR, ARMA, and -GARCH models. +using redfit and wavelets. We also discuss fitting AR and ARMA. \end{abstract} \tableofcontents From noreply at r-forge.r-project.org Fri May 2 15:32:13 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 2 May 2014 15:32:13 +0200 (CEST) Subject: [Dplr-commits] r847 - in pkg/dplR: . src Message-ID: <20140502133213.A9BD2187636@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-02 15:32:13 +0200 (Fri, 02 May 2014) New Revision: 847 Modified: pkg/dplR/DESCRIPTION pkg/dplR/src/exactsum.h Log: Removed unnecessary complexity: double_t should always be available, as already assumed in redfit.c Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-01 21:31:59 UTC (rev 846) +++ pkg/dplR/DESCRIPTION 2014-05-02 13:32:13 UTC (rev 847) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-01 +Date: 2014-05-02 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/src/exactsum.h =================================================================== --- pkg/dplR/src/exactsum.h 2014-05-01 21:31:59 UTC (rev 846) +++ pkg/dplR/src/exactsum.h 2014-05-02 13:32:13 UTC (rev 847) @@ -3,71 +3,10 @@ #define EXACTSUM_H #include - -/* Conditional typedef of dplr_double */ -#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L #include + typedef double_t dplr_double; -/* - "C9X also requires that the header file define the types - float_t and double_t, which are at least as wide as float and - double, respectively, and are intended to match the types used to - evaluate float and double expressions. For example, if - FLT_EVAL_METHOD is 2, both float_t and double_t are long double." - From "Differences Among IEEE 754 Implementations" by Doug Priest. - Available at http://www.validlab.com/goldberg/addendum.html, - referenced on 2010-10-18. - - The use of double_t here is intended to be a portable way to avoid - the loss of exactness in the exact summation algorithm due to - double-rounding errors caused by the mix of 80-bit internal storage - and 64-bit memory storage of doubles on the 32-bit x86 platform (*). - This requires a C99 compiler (also required by R >= 2.12.0). On - architectures that evaluate doubles with double precision, double_t - should be equivalent to double. On 32-bit x86 without SSE2 (and - math coprocessor in 80-bit mode), double_t should be equivalent to - long double. - - (*) Loss of precision because of double-rounding may still occur - when the result of the msum function is returned to R. -*/ -#else -typedef long double dplr_double; -/* - In case of an old / pre-C99 compiler that does not define double_t, - dplr_double is defined as long double. This is designed for exact - computations on 32-bit x86, and also works fine on x86-64 (see - Footnote). On some architectures / compilers, long double may be - the same as double. On architectures where long double does not - conform to IEEE floating-point standards, non-exactness of the msum - function may result. - - Footnote on the performance of 64-bit vs 80-bit FP math on x86-64 - ================================================================= - - On x86-64, one might guess SSE2 would give a speed gain in cases - where 80-bit precision is not really needed, like here. However, - (non-rigorous) tests showed double_t (64-bit) to have a running time - penalty compared to long double (80-bit). The test was to compute - exactmean for a uniformly random vector of length 1e8 (once or - repeatedly). In the table, penalty (% of user time) has one - significant digit. R version probably does not matter, because we - are dealing with compiled code. - - OS Processor R version Penalty (%) Notes - --------------------------------------------------------------------- - Linux AMD Athlon II 2.12.0 5 -O2 -march=barcelona - Linux Intel Core 2 2.9.2 30 - Mac OS X Intel Core 2 2.11.1 20 - - Maybe future compilers or processors will fare better with SSE2. In - the meantime, the performance penalty of SSE2 is small enough. The - C99 compiler case above uses double_t, which I believe to be the - most elegant and portable solution. -*/ -#endif - /* A linked list for storing dplr_doubles */ struct liststruct{ Rboolean valid; From noreply at r-forge.r-project.org Fri May 2 15:37:25 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 2 May 2014 15:37:25 +0200 (CEST) Subject: [Dplr-commits] r848 - in pkg/dplR: . src Message-ID: <20140502133725.E2C08187676@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-02 15:37:25 +0200 (Fri, 02 May 2014) New Revision: 848 Modified: pkg/dplR/ChangeLog pkg/dplR/src/dplR.h pkg/dplR/src/redfit.c Log: redfit: Avoid using the long double type in some cases, hopefully speeding up slow computation times on some systems (r-patched-solaris-sparc test results on CRAN...) Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-02 13:32:13 UTC (rev 847) +++ pkg/dplR/ChangeLog 2014-05-02 13:37:25 UTC (rev 848) @@ -6,6 +6,13 @@ - Bug fix: make.plot=TRUE threw an error when input data.frame had leading or trailing all-NA rows +File: redfit.c +-------------- + +- Avoid using the long double type in some cases. Hopefully this + will speed up otherwise unbearable computation times on some + systems. + * CHANGES IN dplR VERSION 1.6.0 File: TODO Modified: pkg/dplR/src/dplR.h =================================================================== --- pkg/dplR/src/dplR.h 2014-05-02 13:32:13 UTC (rev 847) +++ pkg/dplR/src/dplR.h 2014-05-02 13:37:25 UTC (rev 848) @@ -4,6 +4,7 @@ #include /* to include Rconfig.h */ #include #include +#include size_t dplRlength(SEXP x); #ifdef ENABLE_NLS @@ -18,4 +19,16 @@ #define DPLR_RGEQ3 #endif +/* + dplr_ldouble is a 64 or 80 bit floating point type +*/ +#if LDBL_MANT_DIG > 64 +typedef double dplr_ldouble; +/* 64 bits */ +#else +#define DPLR_LONG +typedef long double dplr_ldouble; +/* 64 or 80 bits */ #endif + +#endif Modified: pkg/dplR/src/redfit.c =================================================================== --- pkg/dplR/src/redfit.c 2014-05-02 13:32:13 UTC (rev 847) +++ pkg/dplR/src/redfit.c 2014-05-02 13:37:25 UTC (rev 848) @@ -31,7 +31,7 @@ void ftfix(const double *xx, const double *tsamp, const size_t nxx, const double *freq, const size_t nfreq, const double si, const size_t lfreq, const double tzero, const double *tcos, - const double *tsin, const double *wtau, const long double sumbysqrt, + const double *tsin, const double *wtau, const dplr_ldouble sumbysqrt, double *ftrx, double *ftix); SEXP makear1(SEXP t, SEXP np, SEXP tau); @@ -165,7 +165,7 @@ SEXP segskip, SEXP lmfit) { SEXP gxx, twk, xwk, ftrx, ftix, tmp, cbindcall, lengthfun; double dnseg, segskip_val, scal, np_val; - long double sumx, sqrt_nseg; + dplr_ldouble sumx, sqrt_nseg; size_t i, j, nseg_val, nfreq_val, n50_val, segstart, ncopy; size_t sincos_skip, wtau_skip; size_t wwidx = 0; @@ -217,7 +217,11 @@ xwk_data = REAL(xwk); ftrx_data = REAL(ftrx); ftix_data = REAL(ftix); +#ifdef DPLR_LONG sqrt_nseg = sqrtl((long double) dnseg); +#else + sqrt_nseg = sqrt(dnseg); +#endif wtau_skip = nfreq_val - 1; sincos_skip = wtau_skip * nseg_val; for (i = 0; i < nfreq_val; i++) { @@ -233,7 +237,7 @@ /* detrend data */ rmtrend(twk, xwk, lengthfun, lmfit); /* apply window to data */ - sumx = 0.0L; + sumx = 0.0; for (j = 0; j < nseg_val; j++) { xwk_data[j] *= ww_data[wwidx++]; sumx += xwk_data[j]; @@ -284,14 +288,14 @@ void ftfix(const double *xx, const double *tsamp, const size_t nxx, const double *freq, const size_t nfreq, const double si, const size_t lfreq, const double tzero, const double *tcos, - const double *tsin, const double *wtau, const long double sumbysqrt, + const double *tsin, const double *wtau, const dplr_ldouble sumbysqrt, double *ftrx, double *ftix) { const double_t tol1 = 1.0e-4; const double tol2 = 1.0e-8; const double_t const1 = M_SQRT1_2; double_t const2; double const3, ftrd, ftid, phase, wtnew, tmpsin, tmpcos, wrun; - long double cross, sumr, sumi, scos2, ssin2; + dplr_ldouble cross, sumr, sumi, scos2, ssin2; double complex work; size_t i, ii, iput; size_t idx = 0; @@ -306,11 +310,11 @@ wrun = M_2PI * freq[ii]; /* omega = 2 * pi * freq */ wtnew = wtau[ii - 1]; /* summations over the sample */ - cross = 0.0L; - scos2 = 0.0L; - ssin2 = 0.0L; - sumr = 0.0L; - sumi = 0.0L; + cross = 0.0; + scos2 = 0.0; + ssin2 = 0.0; + sumr = 0.0; + sumi = 0.0; for (i = 0; i < nxx; i++) { tmpsin = tsin[idx]; tmpcos = tcos[idx]; From noreply at r-forge.r-project.org Fri May 2 16:39:12 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 2 May 2014 16:39:12 +0200 (CEST) Subject: [Dplr-commits] r849 - pkg/dplR/man Message-ID: <20140502143912.17AE5180384@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-02 16:39:11 +0200 (Fri, 02 May 2014) New Revision: 849 Modified: pkg/dplR/man/redfit.Rd Log: Restore .Random.seed at the end of the example. After running example(redfit), the random state is as if one random number had been used. Avoids always returning to the same state after example(redfit). Modified: pkg/dplR/man/redfit.Rd =================================================================== --- pkg/dplR/man/redfit.Rd 2014-05-02 13:37:25 UTC (rev 848) +++ pkg/dplR/man/redfit.Rd 2014-05-02 14:39:11 UTC (rev 849) @@ -310,6 +310,8 @@ # a period of 10 and an amplitude of have the rednoise sd. library(graphics) library(stats) +runif(1) +rs <- .Random.seed set.seed(123) nyrs <- 500 yrs <- 1:nyrs @@ -391,6 +393,7 @@ box() par(op) } +.Random.seed <- rs } \keyword{ ts } \keyword{ htest } From noreply at r-forge.r-project.org Fri May 2 19:45:21 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 2 May 2014 19:45:21 +0200 (CEST) Subject: [Dplr-commits] r850 - pkg/dplR/man Message-ID: <20140502174521.3A52C184B5D@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-02 19:45:20 +0200 (Fri, 02 May 2014) New Revision: 850 Modified: pkg/dplR/man/ccf.series.rwl.Rd pkg/dplR/man/corr.rwl.seg.Rd pkg/dplR/man/corr.series.seg.Rd pkg/dplR/man/dplR-package.Rd pkg/dplR/man/interseries.cor.Rd pkg/dplR/man/plot.rwl.Rd pkg/dplR/man/powt.Rd pkg/dplR/man/read.tridas.Rd pkg/dplR/man/rwi.stats.running.Rd pkg/dplR/man/rwl.stats.Rd pkg/dplR/man/sea.Rd pkg/dplR/man/sens1.Rd pkg/dplR/man/sens2.Rd pkg/dplR/man/strip.rwl.Rd pkg/dplR/man/write.tridas.Rd pkg/dplR/man/xskel.ccf.plot.Rd Log: Improved appearance of help pages (text, html, pdf): * Adjusted line wraps (some lines in dplR.pdf were too long, some unnecessary line breaks were present in the html) * Unified the formatting of references * Shortened the title of interseries.cor.Rd * Each \keyword entry must be on one line (strip.rwl.Rd created a spurious empty help topic to the Index of dplR.pdf) * Fixed some typos, etc. Modified: pkg/dplR/man/ccf.series.rwl.Rd =================================================================== --- pkg/dplR/man/ccf.series.rwl.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/ccf.series.rwl.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -57,7 +57,7 @@ the master lagged at \code{\var{k} = -5:5} years. The cross correlations are calculated calling - \code{\link{ccf}} as + \code{\link{ccf}} as \cr \code{ccf(x=series, y=master, lag.max=lag.max, plot=FALSE)}. Note that prior to dplR version 1.60, the \code{master} was set as \code{x} and the \code{series} as \code{y}. This was changed to be more in line with @@ -96,8 +96,9 @@ \seealso{ \code{\link{corr.rwl.seg}}, \code{\link{corr.series.seg}}, \code{\link{skel.plot}}, \code{\link{series.rwl.plot}} } -\references{ Bunn AG (2010). Statistical and visual crossdating - in R using the dplR library. Dendrochronologia, 28(4): 251-258. +\references{ Bunn, A. G. (2010) Statistical and visual crossdating + in R using the dplR library. \emph{Dendrochronologia}, + 28(4):251\enc{?}{--}258. } \examples{ data(co021) Modified: pkg/dplR/man/corr.rwl.seg.Rd =================================================================== --- pkg/dplR/man/corr.rwl.seg.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/corr.rwl.seg.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -34,9 +34,9 @@ the correlation test. } \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust mean is calculated using \code{\link{tbrm}}. } - \item{method}{Can either "pearson", "kendall", or "spearman" which indicates - the correlation coefficient is to be used. Defaults to "spearman." See - \code{\link{cor.test}}. } + \item{method}{Can be either \code{"pearson"}, \code{"kendall"}, or + \code{"spearman"} which indicates the correlation coefficient to be + used. Defaults to \code{"spearman"}. See \code{\link{cor.test}}. } \item{make.plot}{ \code{logical flag} indicating whether to make a plot. } \item{label.cex}{ \code{numeric} scalar for the series labels on the Modified: pkg/dplR/man/corr.series.seg.Rd =================================================================== --- pkg/dplR/man/corr.series.seg.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/corr.series.seg.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -37,9 +37,9 @@ whitened using \code{\link{ar}}. } \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust mean is calculated using \code{\link{tbrm}}. } - \item{method}{Can either "pearson", "kendall", or "spearman" which indicates - the correlation coefficient is to be used. Defaults to "spearman." See - \code{\link{cor.test}}. } + \item{method}{Can be either \code{"pearson"}, \code{"kendall"}, or + \code{"spearman"} which indicates the correlation coefficient to be + used. Defaults to \code{"spearman"}. See \code{\link{cor.test}}. } \item{pcrit}{ a number between 0 and 1 giving the critical value for the correlation test. } \item{make.plot}{ \code{logical} flag indicating whether to make a Modified: pkg/dplR/man/dplR-package.Rd =================================================================== --- pkg/dplR/man/dplR-package.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/dplR-package.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -13,7 +13,7 @@ \tabular{ll}{ Package: \tab dplR\cr Type: \tab Package\cr -License: \tab \acronym{GPL}\cr +License: \tab \acronym{GPL} (>= 2)\cr } \emph{Main Functions} \describe{ Modified: pkg/dplR/man/interseries.cor.Rd =================================================================== --- pkg/dplR/man/interseries.cor.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/interseries.cor.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -1,9 +1,9 @@ \name{interseries.cor} \alias{interseries.cor} -\title{ Calculate an indidual series correlation against a master chronology - in an rwl object } +\title{ Individual Series Correlation Against a Master Chronology } \description{ - This function calculates the correlation between a series and a master chronology + This function calculates the correlation between a series and a master + chronology. } \usage{ interseries.cor(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE, @@ -19,9 +19,9 @@ whitened using \code{\link{ar}}. } \item{biweight}{ \code{logical} flag. If \code{TRUE} then a robust mean is calculated using \code{\link{tbrm}}.} - \item{method}{Can either "pearson", "kendall", or "spearman" which indicates - the correlation coefficient is to be used. Defaults to "spearman." See - \code{\link{cor.test}}. } + \item{method}{Can be either \code{"pearson"}, \code{"kendall"}, or + \code{"spearman"} which indicates the correlation coefficient to be + used. Defaults to \code{"spearman"}. See \code{\link{cor.test}}. } } \details{ This function calculates correlation serially between each tree-ring @@ -42,10 +42,10 @@ series length based on the \code{\link{ar}} model fit. The effects of detrending can be seen with \code{\link{series.rwl.plot}}. - This function produces the same output of the "overall" portion of + This function produces the same output of the \code{\var{overall}} portion of \code{\link{corr.rwl.seg}}. The mean correlation value given is sometimes - referred to as the "overall interseries correlation"" or the "COFECHA - interseries correlation." This output differs from the \code{rbar} + referred to as the \dQuote{overall interseries correlation} or the \dQuote{COFECHA + interseries correlation}. This output differs from the \code{rbar} statistics given by \code{\link{rwi.stats}} in that \code{rbar} is the average pairwise correlation between series where this is the correlation between a series and a master chronology. Modified: pkg/dplR/man/plot.rwl.Rd =================================================================== --- pkg/dplR/man/plot.rwl.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/plot.rwl.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -1,10 +1,10 @@ \name{plot.rwl} \alias{plot.rwl} \title{ - Plotting rwl objects + Plotting Rwl Objects } \description{ - Plots rwl objects + Plots rwl objects. } \usage{ \method{plot}{rwl}(x, plot.type=c("seg","spag"), ...) @@ -16,7 +16,7 @@ \item{plot.type}{ Character. Type "seg" calls \code{\link{seg.plot}} while "spag" calls \code{\link{spag.plot}} } - \item{\dots}{ Additional arguemnts for each \code{type} } + \item{\dots}{ Additional arguments for each \code{type} } } \value{ Modified: pkg/dplR/man/powt.Rd =================================================================== --- pkg/dplR/man/powt.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/powt.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -27,7 +27,7 @@ R_t^{1-b}}{R*_t = R_t^(1-b)}. } \references{ - Edward R. Cook and Kenneth Peters (1997) Calculating unbiased + Cook, E. R. and Peters, K. (1997) Calculating unbiased tree-ring indices for the study of climatic and environmental change. \emph{The Holocene}, 7(3):361\enc{?}{--}370. } Modified: pkg/dplR/man/read.tridas.Rd =================================================================== --- pkg/dplR/man/read.tridas.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/read.tridas.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -72,36 +72,38 @@ \item{measurements}{A \code{data.frame} or a list of \code{data.frame}s with the series in columns and the years as rows. Contains measurements - (\verb{}) with known years. The series + (\samp{}) with known years. The series \acronym{ID}s are the column names and the years are the row - names. The series \acronym{ID}s are derived from \verb{} + names. The series \acronym{ID}s are derived from \samp{<title>} elements in the input file. Each unique combination of - \verb{<project>}, \verb{<object>}, \verb{<unit>}, \verb{<taxon>}, - and \verb{<variable>} gets a separate \code{data.frame}. } + \samp{<project>}, \samp{<object>}, \samp{<unit>}, \samp{<taxon>}, + and \samp{<variable>} gets a separate \code{data.frame}. } \item{ids}{A \code{data.frame} or a list of \code{data.frame}s with columns named \code{"tree"}, \code{"core"}, \code{"radius"}, and \code{"measurement"}, together giving a unique \code{numeric} \acronym{ID} for each column of the \code{data.frame}(s) in - \code{\var{measurements}}. If \code{!\var{combine.series} && - (\var{ids.from.titles} || \var{ids.from.identifiers})}, some rows - may be non-unique. } + \code{\var{measurements}}. + + If \code{!\var{combine.series} && (\var{ids.from.titles} || \var{ids.from.identifiers})}, some rows may be non-unique. } \item{titles}{A \code{data.frame} or a list of \code{data.frame}s with columns named \code{"tree"}, \code{"core"}, \code{"radius"}, and - \code{"measurement"}, containing the \verb{<title>} hierarchy of + \code{"measurement"}, containing the \samp{<title>} hierarchy of each column of the \code{data.frame}(s) in \code{\var{measurements}}. } \item{wood.completeness}{A \code{data.frame} or a list of \code{data.frame}s containing wood completeness information. Column names are a subset of the following, almost self-explanatory set: \code{"pith.presence"}, \code{"heartwood.presence"}, - \code{"sapwood.presence"}, \code{"last.ring.presence"}, - \code{"last.ring.details"}, \code{"bark.presence"}, + \code{"sapwood.presence"},\cr + \code{"last.ring.presence"}, \code{"last.ring.details"}, + \code{"bark.presence"},\cr \code{"n.sapwood"}, \code{"n.missing.heartwood"}, - \code{"n.missing.sapwood"}, \code{"missing.heartwood.foundation"}, - \code{"missing.sapwood.foundation"}, \code{"n.unmeasured.inner"}, - \code{"n.unmeasured.outer"}. } + \code{"n.missing.sapwood"},\cr + \code{"missing.heartwood.foundation"}, + \code{"missing.sapwood.foundation"},\cr + \code{"n.unmeasured.inner"}, \code{"n.unmeasured.outer"}. } \item{unit}{A \code{character} vector giving the unit of the measurements. Length equals the number of \code{data.frame}s in @@ -109,7 +111,7 @@ \item{project.id}{A \code{numeric} vector giving the project \acronym{ID}, i.e. the position of the corresponding - \verb{<project>} element), of the measurements in each + \samp{<project>} element), of the measurements in each \code{data.frame} in \code{\var{measurements}}. Length equals the number of \code{data.frame}s. } @@ -118,15 +120,15 @@ Length equals the number of \code{data.frame}s. } \item{site.id}{A \code{data.frame} giving the site \acronym{ID} - (position of \verb{<object>} element(s) within a \verb{<project>}) + (position of \samp{<object>} element(s) within a \samp{<project>}) of each \code{data.frame} in \code{\var{measurements}}. May have - several columns to reflect the possibly nested \verb{<object>} + several columns to reflect the possibly nested \samp{<object>} elements. } \item{site.title}{A \code{data.frame} giving the site - (\verb{<object>}) title of each \code{data.frame} in + (\samp{<object>}) title of each \code{data.frame} in \code{\var{measurements}}. May have several columns to reflect the - possibly nested \verb{<object>} elements. } + possibly nested \samp{<object>} elements. } \item{taxon}{A \code{data.frame} showing the taxonomic name for each \code{data.frame} in \code{\var{measurements}}. Contains some of @@ -165,7 +167,7 @@ \item{titles}{A \code{data.frame} with columns named \code{"tree"}, \code{"core"}, \code{"radius"}, and - \code{"measurement"}, containing the \verb{<title>} hierarchy of + \code{"measurement"}, containing the \samp{<title>} hierarchy of each measurement series in \code{\var{undated}$\var{data}} } \item{project.id}{A \code{numeric} vector giving the project @@ -241,14 +243,14 @@ } \item{type}{A \code{data.frame} containing the type of various - entities, and metadata related to each \verb{type} element. + entities, and metadata related to each \samp{type} element. Contents are \code{NA} where the metadata is not applicable (e.g., - no \code{\var{tree.id}} when the \verb{type} element refers to a + no \code{\var{tree.id}} when the \samp{type} element refers to a project). Columns are a subset of the following: \describe{ - \item{text}{The text of the \verb{type} element} + \item{text}{The text of the \samp{type} element} \item{lang}{The language of the text} @@ -262,8 +264,8 @@ \item{project.id}{The \acronym{ID} of the project} \item{site.id}{One or more columns with this prefix, depending on - the maximum depth of the \verb{<object>} hierarchy. Gives the - \acronym{ID} of the site where the \verb{<type>} element + the maximum depth of the \samp{<object>} hierarchy. Gives the + \acronym{ID} of the site where the \samp{<type>} element appeared.} \item{tree.id}{The \acronym{ID} of the tree} @@ -275,8 +277,8 @@ \item{project.title}{The title of the project} \item{site.title}{One or more columns with this prefix, depending - on the maximum depth of the \verb{<object>} hierarchy. Gives the - title of the site where the \verb{<type>} element appeared.} + on the maximum depth of the \samp{<object>} hierarchy. Gives the + title of the site where the \samp{<type>} element appeared.} \item{tree.title}{The title of the tree} @@ -288,18 +290,18 @@ } \item{comments}{A \code{data.frame} containing comments to various - entities, and metadata related to each \verb{comments} element. + entities, and metadata related to each \samp{comments} element. Contents are \code{NA} where the metadata is not applicable. Columns are a subset of the following: \describe{ - \item{text}{The text of the \verb{comments} element} + \item{text}{The text of the \samp{comments} element} \item{project.id}{The \acronym{ID} of the project} \item{site.id}{One or more columns with this prefix, depending on - the maximum depth of the \verb{<object>} hierarchy. Gives the + the maximum depth of the \samp{<object>} hierarchy. Gives the \acronym{ID} of the site.} \item{tree.id}{The \acronym{ID} of the tree} @@ -315,7 +317,7 @@ \item{project.title}{The title of the project} \item{site.title}{One or more columns with this prefix, depending - on the maximum depth of the \verb{<object>} hierarchy. Gives the + on the maximum depth of the \samp{<object>} hierarchy. Gives the title of the site.} \item{tree.title}{The title of the tree} @@ -332,20 +334,20 @@ } \item{identifier}{A \code{data.frame} containing identifiers of - various entities, and metadata related to each \verb{identifier} + various entities, and metadata related to each \samp{identifier} element. Contents are \code{NA} where the metadata is not applicable. Columns are a subset of the following: \describe{ - \item{text}{The text of the \verb{identifier} element} + \item{text}{The text of the \samp{identifier} element} \item{domain}{The domain which the identifier is applicable to} \item{project.id}{The \acronym{ID} of the project} \item{site.id}{One or more columns with this prefix, depending on - the maximum depth of the \verb{<object>} hierarchy. Gives the + the maximum depth of the \samp{<object>} hierarchy. Gives the \acronym{ID} of the site.} \item{tree.id}{The \acronym{ID} of the tree} @@ -361,7 +363,7 @@ \item{project.title}{The title of the project} \item{site.title}{One or more columns with this prefix, depending - on the maximum depth of the \verb{<object>} hierarchy. Gives the + on the maximum depth of the \samp{<object>} hierarchy. Gives the title of the site.} \item{tree.title}{The title of the tree} @@ -488,7 +490,7 @@ \item{project.id}{The \acronym{ID} of the project} \item{site.id}{One or more columns with this prefix, depending on - the maximum depth of the \verb{<object>} hierarchy. Gives the + the maximum depth of the \samp{<object>} hierarchy. Gives the \acronym{ID} of the site.} \item{tree.id}{The \acronym{ID} of the tree} @@ -496,7 +498,7 @@ \item{project.title}{The title of the project} \item{site.title}{One or more columns with this prefix, depending - on the maximum depth of the \verb{<object>} hierarchy. Gives the + on the maximum depth of the \samp{<object>} hierarchy. Gives the title of the site.} \item{tree.title}{The title of the tree} @@ -521,7 +523,7 @@ \item{project.id}{The \acronym{ID} of the project} \item{site.id}{One or more columns with this prefix, depending on - the maximum depth of the \verb{<object>} hierarchy. Gives the + the maximum depth of the \samp{<object>} hierarchy. Gives the \acronym{ID} of the site.} \item{tree.id}{The \acronym{ID} of the tree} @@ -529,7 +531,7 @@ \item{project.title}{The title of the project} \item{site.title}{One or more columns with this prefix, depending on - the maximum depth of the \verb{<object>} hierarchy. Gives + the maximum depth of the \samp{<object>} hierarchy. Gives the title of the site.} \item{tree.title}{The title of the tree} Modified: pkg/dplR/man/rwi.stats.running.Rd =================================================================== --- pkg/dplR/man/rwi.stats.running.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/rwi.stats.running.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -36,17 +36,16 @@ \item{ids}{ an optional \code{data.frame} with column one named \code{"tree"} giving a \code{numeric} \acronym{ID} for each tree and column two named \code{"core"} giving a \code{numeric} \acronym{ID} - for each core. Defaults to one core per tree as - \code{data.frame(tree = 1:ncol(\var{rwi}), core = rep(1, - ncol(\var{rwi})))}. } + for each core. Defaults to one core per tree as\cr + \code{data.frame(tree=1:ncol(\var{rwi}), core=rep(1, ncol(\var{rwi})))}. } \item{period}{ a \code{character} string, either \code{"common"} or \code{"max"} indicating whether correlations should be limited to complete observations over the period common to all cores (i.e. rows common to all samples) or the maximum pairwise overlap. Defaults to \code{"max"}. } - \item{method}{Can either "pearson", "kendall", or "spearman" which indicates - the correlation coefficient is to be used. Defaults to "spearman." See - \code{\link{cor}}. } + \item{method}{Can be either \code{"pearson"}, \code{"kendall"}, or + \code{"spearman"} which indicates the correlation coefficient to be + used. Defaults to \code{"spearman"}. See \code{\link{cor}}. } \item{n}{ \code{NULL} or an integral value giving the filter length for the \code{\link{hanning}} filter used for removal of low frequency variation. } @@ -163,10 +162,12 @@ least one non-\code{NA} core in order to be counted). Not returned in the results of \code{rwi.stats.legacy}} - \item{n.tot}{total number of correlations calculated as \code{ - \var{n.wt} + \var{n.bt}}. Equal to \code{\var{n.cores} * - (\var{n.cores}-1)/2} if there is overlap between all samples } + \item{n.tot}{total number of correlations calculated as + \code{\var{n.wt} + \var{n.bt}}. + Equal to \code{\var{n.cores} * (\var{n.cores}-1)/2} if there is + overlap between all samples } + \item{n.wt}{number of within-tree correlations computed} \item{n.bt}{number of between-tree correlations computed} @@ -183,15 +184,16 @@ \item{c.eff}{the effective number of cores (takes into account the number of within-tree correlations in each tree)} - \item{rbar.eff}{the effective signal calculated as \code{ - \var{rbar.bt} / (\var{rbar.wt} + (1-\var{rbar.wt}) / \var{c.eff}) }} + \item{rbar.eff}{the effective signal calculated as + \code{\var{rbar.bt} / (\var{rbar.wt} + (1-\var{rbar.wt}) / \var{c.eff}) }} \item{eps}{the expressed population signal calculated using the average - number of trees as \code{\var{n} * \var{rbar.eff} / ((\var{n} - 1) * - \var{rbar.eff} + 1)} } + number of trees as\cr + \code{\var{n} * \var{rbar.eff} / ((\var{n} - 1) * \var{rbar.eff} + 1)} } \item{snr}{the signal to noise ratio calculated using the average - number of trees as \code{\var{n} * \var{rbar.eff} / (1-\var{rbar.eff})} } + number of trees as\cr + \code{\var{n} * \var{rbar.eff} / (1-\var{rbar.eff})} } } \references{ @@ -199,7 +201,10 @@ Dendrochronology: Applications in the Environmental Sciences}. Springer. \acronym{ISBN-13}: 978-0-7923-0586-6. - Cook, E. R. and Pederson, N. (2011) \emph{Uncertainty, Emergence, and Statistics in Dendrochronology} In M.K. Hughes, T.W. Swetnam, and H.F. Diaz (Eds.), \emph{Dendroclimatology}(77-112), \acronym{ISBN-13}: 978-1-4020-4010-8. + Cook, E. R. and Pederson, N. (2011) \emph{Uncertainty, Emergence, and + Statistics in Dendrochronology} In M.K. Hughes, T.W. Swetnam, and + H.F. Diaz (Eds.), \emph{Dendroclimatology} (77\enc{?}{--}112), + \acronym{ISBN-13}: 978-1-4020-4010-8. Fritts, H. C. (2001) \emph{Tree Rings and Climate}. Blackburn. \acronym{ISBN-13}: 978-1-930665-39-2. Modified: pkg/dplR/man/rwl.stats.Rd =================================================================== --- pkg/dplR/man/rwl.stats.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/rwl.stats.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -50,9 +50,10 @@ } \references{ - Bunn. A.G., Jansma E., Korpela M., Westfall R.D., and Baldwin J. (2013) - Using simulations and data to evaluate mean sensitivity (zeta) as a useful - statistic in dendrochronology Dendrochronologia 31 250?4. + Bunn, A. G., Jansma, E., Korpela, M., Westfall, R. D., and Baldwin, + J. (2013) Using simulations and data to evaluate mean sensitivity + (\eqn{\zeta}{zeta}) as a useful statistic in dendrochronology. + \emph{Dendrochronologia}, 31(3):250\enc{?}{--}254. Cook, E. R. and Kairiukstis, L.A. (1990) \emph{Methods of Dendrochronology: Applications in the Environmental Sciences}. Modified: pkg/dplR/man/sea.Rd =================================================================== --- pkg/dplR/man/sea.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/sea.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -51,7 +51,7 @@ \references{ - Lough, J. M., Fritts, H. C. (1987) An assessment of the possible + Lough, J. M. and Fritts, H. C. (1987) An assessment of the possible effects of volcanic eruptions on North American climate using tree-ring data, 1602 to 1900 \acronym{AD}. \emph{Climatic Change}, 10(3):219\enc{?}{--}239. Modified: pkg/dplR/man/sens1.Rd =================================================================== --- pkg/dplR/man/sens1.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/sens1.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -26,9 +26,10 @@ Biondi, F. and Qeadan, F. (2008) Inequality in Paleorecords. \emph{Ecology}, 89(4):1056\enc{?}{--}1067. - Bunn. A.G., Jansma E., Korpela M., Westfall R.D., and Baldwin J. (2013) - Using simulations and data to evaluate mean sensitivity (zeta) as a useful - statistic in dendrochronology Dendrochronologia 31 250?4. + Bunn, A. G., Jansma, E., Korpela, M., Westfall, R. D., and Baldwin, + J. (2013) Using simulations and data to evaluate mean sensitivity + (\eqn{\zeta}{zeta}) as a useful statistic in dendrochronology. + \emph{Dendrochronologia}, 31(3):250\enc{?}{--}254. } \author{ Mikko Korpela, based on original by Andy Bunn } Modified: pkg/dplR/man/sens2.Rd =================================================================== --- pkg/dplR/man/sens2.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/sens2.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -25,9 +25,10 @@ Biondi, F. and Qeadan, F. (2008) Inequality in Paleorecords. \emph{Ecology}, 89(4):1056\enc{?}{--}1067. - Bunn. A.G., Jansma E., Korpela M., Westfall R.D., and Baldwin J. (2013) - Using simulations and data to evaluate mean sensitivity (zeta) as a useful - statistic in dendrochronology Dendrochronologia 31 250?4. + Bunn, A. G., Jansma, E., Korpela, M., Westfall, R. D., and Baldwin, + J. (2013) Using simulations and data to evaluate mean sensitivity + (\eqn{\zeta}{zeta}) as a useful statistic in dendrochronology. + \emph{Dendrochronologia}, 31(3):250\enc{?}{--}254. } \author{ Mikko Korpela, based on original by Andy Bunn } Modified: pkg/dplR/man/strip.rwl.Rd =================================================================== --- pkg/dplR/man/strip.rwl.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/strip.rwl.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -83,6 +83,4 @@ \author{ Christian Zang. Patched and improved by Mikko Korpela. } -\keyword{ - manip -} +\keyword{ manip } Modified: pkg/dplR/man/write.tridas.Rd =================================================================== --- pkg/dplR/man/write.tridas.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/write.tridas.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -76,9 +76,9 @@ radius, and optional column four named \code{"measurement"} giving the \code{numeric} \acronym{ID} of the measurement. If column \code{"measurement"} exists, column \code{"radius"} must also exist. - Defaults to one core, radius and measurement per tree: - \code{data.frame(tree = 1:\var{n.col}, core = rep(1,\var{n.col}), - radius = rep(1,\var{n.col}), measurement = rep(1,\var{n.col}))}, + Defaults to one core, radius and measurement per tree:\preformatted{ + data.frame(tree=1:n.col, core=rep(1,n.col), + radius=rep(1,n.col), measurement=rep(1,n.col))} where \code{\var{n.col}} is the number of columns in \code{\var{rwl.df}}. } @@ -100,7 +100,7 @@ correct length. After that, the vectors inside the list are recycled to match the number of derived series in each \code{data.frame} of \code{\var{crn}}. The default is to write - empty \verb{<type>} elements. } + empty \samp{<type>} elements. } \item{crn.titles}{ optional \code{character} vector or a \code{list} of \code{character} vectors giving the titles of the derived series @@ -113,8 +113,8 @@ \code{character} vectors giving the units of the derived series in \code{\var{crn}}. The interpretation is the same as with \code{\var{crn.types}}, except that the default is to mark the - series as \verb{<unitless>}. Also \code{NA} means - \verb{<unitless>}. } + series as \samp{<unitless>}. Also \code{NA} means + \samp{<unitless>}. } \item{tridas.measuring.method}{ \code{character} vector giving the measuring method used to acquire each series of \code{\var{rwl.df}}. @@ -161,14 +161,15 @@ that have not been measured. Typically used to note when rings are too damaged to measure. Non-negative integral value.} - \item{pith.presence}{Whether the pith is present or absent. Each - element must be a partial match with the contents of category - \code{"complex presence / absence"} in + \item{pith.presence}{Whether the pith is present or absent. + Each element must be a partial match with the contents of + category \code{"complex presence / absence"} in \code{\link{tridas.vocabulary}}.} \item{heartwood.presence}{Whether the outer (youngest) heartwood - is present and if so whether it is complete. Category - \code{"complex presence / absence"} in + is present and if so whether it is complete. + + Category \code{"complex presence / absence"} in \code{\link{tridas.vocabulary}}.} \item{n.missing.heartwood}{Estimated number of missing heartwood @@ -179,14 +180,17 @@ what the certainty is. Free-form string.} \item{sapwood.presence}{Whether the sapwood is present or not. + Category \code{"complex presence / absence"}.} \item{n.sapwood}{Number of sapwood rings measured. Non-negative integral value.} \item{last.ring.presence}{Last ring under the bark is present or - absent. Category \code{"presence / absence"}.} + absent. + Category \code{"presence / absence"}.} + \item{last.ring.details}{If the last ring under the bark is present, include information about the completeness of this ring and/or season of felling. Free-form string.} @@ -198,9 +202,11 @@ estimation of how many sapwood rings are missing was made and what the certainty is. Free-form string.} - \item{bark.presence}{Bark is present or absent. Category - \code{"presence / absence"} in \code{\link{tridas.vocabulary}}.} + \item{bark.presence}{Bark is present or absent. + Category \code{"presence / absence"} in + \code{\link{tridas.vocabulary}}.} + } } @@ -303,7 +309,7 @@ } \item{site.info}{ \code{list} containing information about the site - (\verb{<object>}). Elements are the following, and all are + (\samp{<object>}). Elements are the following, and all are \code{character} strings: \describe{ @@ -319,10 +325,10 @@ \item{random.identifiers}{ \code{logical} flag. If \code{TRUE}, unique random identifiers are created with \code{\link{uuid.gen}} - and attached to each \verb{<project>} (one in the file), - \verb{object} (site, one in the file), \verb{<element>} (tree), - \verb{<sample>} (core), \verb{<radius>}, \verb{<measurementSeries>} - (measurement) and \verb{<derivedSeries>} element in the resulting + and attached to each \samp{<project>} (one in the file), + \samp{object} (site, one in the file), \samp{<element>} (tree), + \samp{<sample>} (core), \samp{<radius>}, \samp{<measurementSeries>} + (measurement) and \samp{<derivedSeries>} element in the resulting TRiDaS file. } \item{identifier.domain}{ \code{character} string. The domain which Modified: pkg/dplR/man/xskel.ccf.plot.Rd =================================================================== --- pkg/dplR/man/xskel.ccf.plot.Rd 2014-05-02 14:39:11 UTC (rev 849) +++ pkg/dplR/man/xskel.ccf.plot.Rd 2014-05-02 17:45:20 UTC (rev 850) @@ -49,7 +49,7 @@ The bottom panels show cross correlations for the first half (left) and second half of the time series using function \code{\link{ccf}} as -\code{ccf(x=series,y=master,lag.max=5}. +\code{ccf(x=series,y=master,lag.max=5)}. The plot is built using the \code{\link[grid]{Grid}} package which allows for great flexibility in building complicated plots. However, these plots look best From noreply at r-forge.r-project.org Fri May 2 19:56:19 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 2 May 2014 19:56:19 +0200 (CEST) Subject: [Dplr-commits] r851 - in pkg/dplR: R man vignettes Message-ID: <20140502175619.A81A31875F0@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-02 19:56:19 +0200 (Fri, 02 May 2014) New Revision: 851 Modified: pkg/dplR/R/interseries.cor.R pkg/dplR/R/xskel.plot.R pkg/dplR/man/interseries.cor.Rd pkg/dplR/man/xskel.plot.Rd pkg/dplR/vignettes/timeseries-dplR.Rnw Log: svn:eol-style set where it was missing Property changes on: pkg/dplR/R/interseries.cor.R ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/R/xskel.plot.R ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/man/interseries.cor.Rd ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/man/xskel.plot.Rd ___________________________________________________________________ Added: svn:eol-style + native Property changes on: pkg/dplR/vignettes/timeseries-dplR.Rnw ___________________________________________________________________ Added: svn:eol-style + native From noreply at r-forge.r-project.org Fri May 2 20:04:50 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 2 May 2014 20:04:50 +0200 (CEST) Subject: [Dplr-commits] r852 - pkg/dplR/vignettes Message-ID: <20140502180450.344861877B7@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-02 20:04:49 +0200 (Fri, 02 May 2014) New Revision: 852 Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw Log: Completed an unfinished sentence. Andy: Did I make a good guess? Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-02 17:56:19 UTC (rev 851) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-02 18:04:49 UTC (rev 852) @@ -114,7 +114,7 @@ \section{Characterizing the Data} Let's start with a quick exploratory data analysis into the time-series -proThe \code{co021.crn} object has two columns, the first giving the chronology +process. The \code{co021.crn} object has two columns, the first giving the chronology and the second the sample depth during that year. We will start our analysis on the chronology by looking at its autocorrelation structure using R's \code{acf} and \code{pacf} functions. From noreply at r-forge.r-project.org Sat May 3 18:56:16 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 May 2014 18:56:16 +0200 (CEST) Subject: [Dplr-commits] r853 - in pkg/dplR: . man Message-ID: <20140503165617.10B2C186FC0@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-03 18:56:16 +0200 (Sat, 03 May 2014) New Revision: 853 Modified: pkg/dplR/DESCRIPTION pkg/dplR/man/crn.plot.Rd pkg/dplR/man/detrend.Rd pkg/dplR/man/pointer.Rd pkg/dplR/man/print.redfit.Rd pkg/dplR/man/redfit.Rd pkg/dplR/man/rwi.stats.running.Rd pkg/dplR/man/rwl.stats.Rd pkg/dplR/man/sens1.Rd pkg/dplR/man/sens2.Rd pkg/dplR/man/xskel.ccf.plot.Rd pkg/dplR/man/xskel.plot.Rd Log: Fixed typos Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/DESCRIPTION 2014-05-03 16:56:16 UTC (rev 853) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-02 +Date: 2014-05-03 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/man/crn.plot.Rd =================================================================== --- pkg/dplR/man/crn.plot.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/crn.plot.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -39,7 +39,7 @@ polygon (if present) } \item{crn.lwd}{ line width for the x line } \item{spline.lwd}{ line width for the spline (if added) } - \item{abline.pos}{ position for a refernce abline on the y-axis. + \item{abline.pos}{ position for a reference abline on the y-axis. No line added if NULL } \item{abline.col}{ color for the reference abline (if added) } \item{abline.lty}{ line type the reference abline (if added) } Modified: pkg/dplR/man/detrend.Rd =================================================================== --- pkg/dplR/man/detrend.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/detrend.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -90,7 +90,7 @@ \author{ Andy Bunn. Improved by Mikko Korpela. } \seealso{ \code{\link{detrend.series}} } \examples{data(ca533) -## Detrend using modified expontential decay. Returns a data.frame +## Detrend using modified exponential decay. Returns a data.frame ca533.rwi <- detrend(rwl = ca533, method = "ModNegExp") \dontrun{ Modified: pkg/dplR/man/pointer.Rd =================================================================== --- pkg/dplR/man/pointer.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/pointer.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -9,7 +9,7 @@ This function calculates pointer years on a \code{data.frame} of ring-width series using the Becker algorithm. The pointer years are computed with adjustable thresholds of relative radial growth - variation and number of series diplaying similar growth pattern + variation and number of series displaying similar growth pattern (i.e. positive or negative variations). } @@ -47,9 +47,9 @@ This calculates pointer years from ring-width series for each year \code{\var{t}} of the time period covered by the series using the Becker algorithm. This algorithm is based on, first, the calculation - of the individual relative radial growth variation by comparision of + of the individual relative radial growth variation by comparison of ring-width of year \code{\var{t}} to that of year \code{\var{t}-1} for - each series, and second, the inter-series comparision of both sign and + each series, and second, the inter-series comparison of both sign and magnitude of these variations. For example, if \code{\var{rgv.thresh}} and Modified: pkg/dplR/man/print.redfit.Rd =================================================================== --- pkg/dplR/man/print.redfit.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/print.redfit.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -8,7 +8,7 @@ } \usage{ \method{print}{redfit}(x, digits = NULL, csv.out = FALSE, do.table = FALSE, - prefix = "", row.names = FALSE, file = "", ...) + prefix = "", row.names = FALSE, file = "", ...) } \arguments{ @@ -31,7 +31,7 @@ \code{print.data.frame}. } \item{prefix}{ A prefix to be used on every output line except the - large informaton table. REDFIT (see \code{References}) uses + large information table. REDFIT (see \code{References}) uses \code{"# "}. } \item{row.names}{ A \code{logical} flag enabling or disabling Modified: pkg/dplR/man/redfit.Rd =================================================================== --- pkg/dplR/man/redfit.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/redfit.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -181,13 +181,13 @@ \item{rcritlo }{ a \code{numeric} vector of critical low values for the number of runs, i.e. the lowest value for accepting the null - hyphothesis at each level of significance \code{\var{p}}. When + hypothesis at each level of significance \code{\var{p}}. When returned from \code{redfit}, \code{NULL} when \code{\var{rcnt}} is \code{NULL}. } \item{rcrithi }{ a \code{numeric} vector of critical high values for the number of runs, i.e. the highest value for accepting the null - hyphothesis at each level of significance \code{\var{p}}. When + hypothesis at each level of significance \code{\var{p}}. When returned from \code{redfit}, \code{NULL} when \code{\var{rcnt}} is \code{NULL}. } Modified: pkg/dplR/man/rwi.stats.running.Rd =================================================================== --- pkg/dplR/man/rwi.stats.running.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/rwi.stats.running.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -129,7 +129,7 @@ effective number of cores or the expressed population signal). Users unfamiliar with these should see Cook and Kairiukstis (1990) and Fritts (2001) for further details for computational details on the - output. The singal-to-noise ratio is calculated following Cook and + output. The signal-to-noise ratio is calculated following Cook and Pederson (2011). If desired, the \code{\var{rwi}} can be filtered in the same manner Modified: pkg/dplR/man/rwl.stats.Rd =================================================================== --- pkg/dplR/man/rwl.stats.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/rwl.stats.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -45,7 +45,7 @@ autocorrelation (\code{"skew"}, \code{"\link{sens1}"}, \code{"\link{sens2}"}, \code{"\link{gini.coef}"}, \code{"ar1"}). - Note that that mean sensitivity is not a robust statitic that should rarely, + Note that mean sensitivity is not a robust statistic that should rarely, if ever, be used (Bunn et al. 2013). } \references{ Modified: pkg/dplR/man/sens1.Rd =================================================================== --- pkg/dplR/man/sens1.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/sens1.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -15,7 +15,7 @@ This calculates mean sensitivity according to Eq. 1 in Biondi and Qeadan (2008). This is the standard measure of sensitivity in dendrochronology and is typically calculated on detrended series. - However, note that that mean sensitivity is not a robust statitic and + However, note that mean sensitivity is not a robust statistic and should rarely, if ever, be used (Bunn et al. 2013). } Modified: pkg/dplR/man/sens2.Rd =================================================================== --- pkg/dplR/man/sens2.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/sens2.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -15,7 +15,7 @@ This calculates mean sensitivity according to Eq. 2 in Biondi and Qeadan (2008). This is a measure of sensitivity in dendrochronology that is typically used in the presence of a trend. However, note - that that mean sensitivity is not a robust statitic and should rarely, + that mean sensitivity is not a robust statistic and should rarely, if ever, be used (Bunn et al. 2013). } \value{ the mean sensitivity. Modified: pkg/dplR/man/xskel.ccf.plot.Rd =================================================================== --- pkg/dplR/man/xskel.ccf.plot.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/xskel.ccf.plot.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -43,7 +43,7 @@ series with the marker years annotated for the master on the bottom axis and series on the top. The text at the top of the figure gives the correlation between the series and master (green bars) as well as the percentage -of agreement betwen the years of skeleton bars for the series and master. +of agreement between the years of skeleton bars for the series and master. I.e., if all the black lines occur in the same years the percentage would be 100\%. Modified: pkg/dplR/man/xskel.plot.Rd =================================================================== --- pkg/dplR/man/xskel.plot.Rd 2014-05-02 18:04:49 UTC (rev 852) +++ pkg/dplR/man/xskel.plot.Rd 2014-05-03 16:56:16 UTC (rev 853) @@ -43,7 +43,7 @@ series with the marker years annotated for the master on the bottom axis and series on the top. The text at the top of the figure gives the correlation between the series and master (green bars) as well as the percentage -of agreement betwen the years of skeleton bars for the series and master. +of agreement between the years of skeleton bars for the series and master. I.e., if all the black lines occur in the same years the percentage would be 100\%. From noreply at r-forge.r-project.org Sat May 3 19:06:59 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 3 May 2014 19:06:59 +0200 (CEST) Subject: [Dplr-commits] r854 - pkg/dplR/vignettes Message-ID: <20140503170659.8A00F187651@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-03 19:06:59 +0200 (Sat, 03 May 2014) New Revision: 854 Modified: pkg/dplR/vignettes/intro-dplR.Rnw pkg/dplR/vignettes/timeseries-dplR.Rnw Log: Fixed typos Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-05-03 16:56:16 UTC (rev 853) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-05-03 17:06:59 UTC (rev 854) @@ -200,7 +200,7 @@ \begin{figure}[h] \centering \includegraphics{intro-dplR-b} -\caption{Detrending a single series via mutiple methods.} +\caption{Detrending a single series via multiple methods.} \label{fig:detrend.series} \end{figure} @@ -287,7 +287,7 @@ dim(ca533.crn) @ -An object produced by \code{chron} has a generic S3 moethod for plotting +An object produced by \code{chron} has a generic S3 method for plotting which calls the \code{crn.plot} function (which has many arguments for customization). Here we will just make a simple plot of the chronology with a smoothing spline added. See Figure~\ref{fig:crn.plot.spline}. Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-03 16:56:16 UTC (rev 853) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-03 17:06:59 UTC (rev 854) @@ -304,16 +304,16 @@ (and we leave that as an exercise to the reader) the variations between voices would be greatly reduced. Note the similarity in Figures~\ref{fig:wavelet} and~\ref{fig:mra} for the variation in the 64-year band around the year 1600 -and the lower frequncy variation at 128 years around the year 1400. +and the lower frequency variation at 128 years around the year 1400. \else% If "waveslim" is not available An example was dropped because \code{"waveslim"} is not available. \fi% End of conditional The pioneering work of Ed Cook -- e.g. \cite{cook1990} -- has left an enduring -mark on nearly every aspect of quantitative dendrochrnology. One such mark +mark on nearly every aspect of quantitative dendrochronology. One such mark that we already alluded to above is the use of smoothing splines to detrend and filter tree-ring data. So, we'll close with an example of how one -can visualise an individual tree-rins series using splines +can visualise an individual tree-ring series using splines (Figure~\ref{fig:spl}). <<g, fig=TRUE>>= From noreply at r-forge.r-project.org Mon May 5 22:39:51 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 5 May 2014 22:39:51 +0200 (CEST) Subject: [Dplr-commits] r855 - in pkg/dplR: . src Message-ID: <20140505203951.5FC14180FB0@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-05 22:39:50 +0200 (Mon, 05 May 2014) New Revision: 855 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/src/dplR.h pkg/dplR/src/rcompact.c Log: C code of read.compact() is now more robust in case of unusual (unlikely) input Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-03 17:06:59 UTC (rev 854) +++ pkg/dplR/ChangeLog 2014-05-05 20:39:50 UTC (rev 855) @@ -6,6 +6,11 @@ - Bug fix: make.plot=TRUE threw an error when input data.frame had leading or trailing all-NA rows +File: rcompact.c +---------------- + +- Made the C code of read.compact() more resilient to unusual inputs + File: redfit.c -------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-03 17:06:59 UTC (rev 854) +++ pkg/dplR/DESCRIPTION 2014-05-05 20:39:50 UTC (rev 855) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-03 +Date: 2014-05-05 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/src/dplR.h =================================================================== --- pkg/dplR/src/dplR.h 2014-05-03 17:06:59 UTC (rev 854) +++ pkg/dplR/src/dplR.h 2014-05-05 20:39:50 UTC (rev 855) @@ -31,4 +31,7 @@ /* 64 or 80 bits */ #endif +#define R_INT_MAX 2147483647 +#define R_INT_MIN -R_INT_MAX + #endif Modified: pkg/dplR/src/rcompact.c =================================================================== --- pkg/dplR/src/rcompact.c 2014-05-03 17:06:59 UTC (rev 854) +++ pkg/dplR/src/rcompact.c 2014-05-05 20:39:50 UTC (rev 855) @@ -114,8 +114,10 @@ *id_start, *old_point, *point, *point2, *endp, *tmp_name, *tmp_comment; int i, j, n, first_yr, last_yr, id_length, exponent, - n_repeats, field_width, precision, n_x_w, n_lines, remainder, idx, + n_repeats, field_width, n_x_w, n_lines, remainder, idx, this_last, *i_first, *i_last; + long int precision; + size_t idx2; Rboolean n_found, divide; long long int read_int; double read_double, mplier, *r_mplier, *r_data; @@ -138,8 +140,8 @@ this = &first; /* current rwlnode */ comment_this = &comment_first; /* current commentnode */ n = 0; /* number of series */ - first_yr = INT_MAX; /* the first year in all data */ - last_yr = INT_MIN; /* the last year in all data */ + first_yr = R_INT_MAX; /* the first year in all data */ + last_yr = R_INT_MIN; /* the last year in all data */ /* Each round of the loop reads a header line, * then the data lines of the corresponding series @@ -203,7 +205,7 @@ error(_("Series %d: Only a number must be found right before 1st '='"), n+1); } - if(read_int > INT_MAX){ + if(read_int > R_INT_MAX || read_int < R_INT_MIN){ fclose(f); error(_("Series %d: Number %lld exceeds integer range"), n+1, read_int); @@ -248,7 +250,7 @@ error(_("Series %d: Only a number must be found after first field, right before 2nd '='"), n+1); } - if(read_int > INT_MAX){ + if(read_int > R_INT_MAX || read_int < R_INT_MIN){ fclose(f); error(_("Series %d: Number %lld exceeds integer range"), n+1, read_int); @@ -269,10 +271,13 @@ n+1, *(found2+1)); } + /* Check for overflow */ + if(this->first_yr > 1 && this->n - 1 > R_INT_MAX - this->first_yr) + error(_("Series %d: Last year exceeds integer range"), n+1); /* Update global first and last year */ if(this->first_yr < first_yr) first_yr = this->first_yr; - this_last = this->first_yr + this->n - 1; + this_last = this->first_yr + (this->n - 1); if(this_last > last_yr) last_yr = this_last; @@ -327,7 +332,7 @@ /* Require space */ if(*point != ' '){ fclose(f); - error(_("Series %d (%s): Space required after alphanumerid ID"), + error(_("Series %d (%s): Space required after alphanumeric ID"), n+1, this->id); } @@ -416,7 +421,7 @@ n+1, this->id, field_width); } point = found_dot+1; - precision = (int) strtol(point, &endp, 10); + precision = strtol(point, &endp, 10); if(endp == point){ fclose(f); error(_("Series %d (%s): Number of decimals not found"), @@ -427,7 +432,7 @@ error(_("Series %d (%s): Number of decimals and ')' must be adjacent"), n+1, this->id); } - if(precision != 0){ + if(precision != 0L){ fclose(f); error(_("Series %d (%s): No (implied) decimal places allowed in format"), n+1, this->id); @@ -564,28 +569,28 @@ r_mplier = REAL(series_mplier); r_data = REAL(series_data); - /* idx is for indexing r_data. + /* idx2 is for indexing r_data. * The matrix series_data is stored in column-major order: We - * proceed one series at a time, simply incrementing idx on each + * proceed one series at a time, simply incrementing idx2 on each * (carefully planned) write to the array. */ - idx = -1; + idx2 = 0; this = &first; for(i=0; i<n; i++){ - this_last = this->first_yr + this->n - 1; + this_last = this->first_yr + (this->n - 1); SET_STRING_ELT(series_id, i, mkChar(this->id)); i_first[i] = this->first_yr; i_last[i] = this_last; r_mplier[i] = this->mplier; /* Add NA to beginning */ for(j=0; j < this->first_yr - first_yr; j++) - r_data[++idx] = NA_REAL; + r_data[idx2++] = NA_REAL; /* Add data to middle */ for(j=0; j < this->n; j++) - r_data[++idx] = this->data[j]; + r_data[idx2++] = this->data[j]; /* Add NA to end */ for(j=0; j < last_yr - this_last; j++) - r_data[++idx] = NA_REAL; + r_data[idx2++] = NA_REAL; this = this->next; } From noreply at r-forge.r-project.org Mon May 5 22:40:23 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 5 May 2014 22:40:23 +0200 (CEST) Subject: [Dplr-commits] r856 - pkg/dplR/R Message-ID: <20140505204023.A6EC31811AF@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-05 22:40:23 +0200 (Mon, 05 May 2014) New Revision: 856 Modified: pkg/dplR/R/redfit.R Log: Typo fix Modified: pkg/dplR/R/redfit.R =================================================================== --- pkg/dplR/R/redfit.R 2014-05-05 20:39:50 UTC (rev 855) +++ pkg/dplR/R/redfit.R 2014-05-05 20:40:23 UTC (rev 856) @@ -247,7 +247,7 @@ cat(gettext("Number of duplicates by age,\n", domain = "R-dplR"), file = stderr()) } - cat(gettext("'k' duplicates means 'k + 1' total obsevations:\n", + cat(gettext("'k' duplicates means 'k + 1' total observations:\n", domain = "R-dplR"), file = stderr()) dtable <- table(t2[dupl]) if (tTime) { From noreply at r-forge.r-project.org Mon May 5 23:01:03 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 5 May 2014 23:01:03 +0200 (CEST) Subject: [Dplr-commits] r857 - in pkg/dplR: inst/po/fi/LC_MESSAGES po Message-ID: <20140505210103.8AD841874A2@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-05 23:01:03 +0200 (Mon, 05 May 2014) New Revision: 857 Modified: pkg/dplR/inst/po/fi/LC_MESSAGES/R-dplR.mo pkg/dplR/inst/po/fi/LC_MESSAGES/dplR.mo pkg/dplR/po/R-dplR.pot pkg/dplR/po/R-fi.po pkg/dplR/po/dplR.pot pkg/dplR/po/fi.po Log: Translations Modified: pkg/dplR/inst/po/fi/LC_MESSAGES/R-dplR.mo =================================================================== (Binary files differ) Modified: pkg/dplR/inst/po/fi/LC_MESSAGES/dplR.mo =================================================================== (Binary files differ) Modified: pkg/dplR/po/R-dplR.pot =================================================================== --- pkg/dplR/po/R-dplR.pot 2014-05-05 20:40:23 UTC (rev 856) +++ pkg/dplR/po/R-dplR.pot 2014-05-05 21:01:03 UTC (rev 857) @@ -1,18 +1,20 @@ # Translation template for messages in dplR R code # Copyright (C) dplR copyright holders # This file is distributed under the same license as the dplR package. -# Mikko Korpela <mvkorpel at iki.fi>, 2011, 2012. +# Mikko Korpela <mvkorpel at iki.fi>, 2011, 2012, 2014. msgid "" msgstr "" -"Project-Id-Version: dplR 1.5.5\n" -"Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" -"POT-Creation-Date: 2012-06-15 18:41+0300\n" +"Project-Id-Version: dplR 1.6.1\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2014-05-05 23:48+0300\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME <EMAIL at ADDRESS>\n" "Language-Team: LANGUAGE <LL at li.org>\n" +"Language: \n" "MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" +"Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: \n" msgid "'rwl' must be a data.frame" @@ -69,15 +71,30 @@ msgid "Nothing to combine here. Please supply data.frames formatted according to the data standards in dplR." msgstr "" -msgid "At least 2 series are needed in 'rwl'" +msgid "'rwl' must have numeric columns" msgstr "" -msgid "At least 1 series is needed in 'rwl'" +msgid "'rwl' must have row names" msgstr "" +msgid "row names of 'rwl' must be interpretable as years" +msgstr "" + msgid "Year" msgstr "" +msgid "Original: %d series, %d years" +msgstr "" + +msgid "Common Interval (type='%s'): %d series x %d years = %d" +msgstr "" + +msgid "At least 2 series are needed in 'rwl'" +msgstr "" + +msgid "At least 1 series is needed in 'rwl'" +msgstr "" + msgid "Segments: length=%d,lag=%d" msgstr "" @@ -87,13 +104,13 @@ msgid "'crn' must be a data.frame" msgstr "" -msgid "Years" +msgid "Sample Depth" msgstr "" -msgid "RWI" +msgid "Verbose output:" msgstr "" -msgid "Sample Depth" +msgid "Options" msgstr "" msgid "all values are 'NA'" @@ -102,6 +119,75 @@ msgid "'NA's are not allowed in the middle of the series" msgstr "" +msgid "Zero years in input series:" +msgstr "" + +msgid "Zero indices in input series:" +msgstr "" + +msgid "No zeros in input series." +msgstr "" + +msgid "Detrend by ModNegExp." +msgstr "" + +msgid "Trying to fit nls model..." +msgstr "" + +msgid "nls failed... fitting linear model..." +msgstr "" + +msgid "Fits from ModNegExp are not all positive, see constrain.modnegexp argument in detrend.series" +msgstr "" + +msgid "Linear model fit" +msgstr "" + +msgid "Intercept: %s" +msgstr "" + +msgid "Slope: %s" +msgstr "" + +msgid "Linear fit (backup of ModNegExp) is not all positive" +msgstr "" + +msgid "lm has a positive slope" +msgstr "" + +msgid "pos.slope = FALSE" +msgstr "" + +msgid "Detrend by mean." +msgstr "" + +msgid "Mean = %s" +msgstr "" + +msgid "nls coefs" +msgstr "" + +msgid "Detrend by spline." +msgstr "" + +msgid "Spline parameters" +msgstr "" + +msgid "Spline fit is not all positive" +msgstr "" + +msgid "Detrend by prewhitening." +msgstr "" + +msgid "Ar fit is not all positive" +msgstr "" + +msgid "Zero years in %s series:" +msgstr "" + +msgid "Zero indices in %s series:" +msgstr "" + msgid "Age (Yrs)" msgstr "" @@ -111,12 +197,18 @@ msgid "Spline" msgstr "" +msgid "RWI" +msgstr "" + msgid "Neg. Exp. Curve or Straight Line" msgstr "" msgid "Horizontal Line (Mean)" msgstr "" +msgid "Ar" +msgstr "" + msgid "'y' must be coercible to a numeric vector" msgstr "" @@ -138,6 +230,15 @@ msgid "abscissa and ordinate vector must be of the same length" msgstr "" +msgid "'x' must be a data.frame" +msgstr "" + +msgid "'x' must have numeric columns" +msgstr "" + +msgid "'fill' must be a single number or character string" +msgstr "" + msgid "Intersection of series %d and %d is not contiguous. NA returned." msgstr "" @@ -156,6 +257,15 @@ msgid "could not remap a name: some series will be missing" msgstr "" +msgid "'series' not found in 'rwl'" +msgstr "" + +msgid "duplicate column names, multiple matches" +msgstr "" + +msgid "'series' of length 1 must be a column index to 'rwl'" +msgstr "" + msgid "Detrend series %d of %d" msgstr "" @@ -171,12 +281,27 @@ msgid "number out of range or not an integer" msgstr "" +msgid "input data must have consecutive years in increasing order" +msgstr "" + +msgid "invalid 'year': skipping years not allowed" +msgstr "" + +msgid "'year' not present in 'rw.vec.yrs'" +msgstr "" + msgid "'x1' and 'y1' lengths differ" msgstr "" -msgid "'rgv.thresh' must range from 0 to 100" +msgid "use only with \"rwl\" objects" msgstr "" +msgid "'rgv.thresh' must be > 0" +msgstr "" + +msgid "'rgv.thresh' > 100 is unusual." +msgstr "" + msgid "'nseries.thresh' must range from 0 to 100" msgstr "" @@ -450,6 +575,9 @@ msgid "failed to read rwl file" msgstr "" +msgid "series.index must be integer: %s" +msgstr "" + msgid "bad location of stop marker in series %s" msgstr "" @@ -462,6 +590,153 @@ msgid "file has no good data" msgstr "" +msgid "oversampling factor 'ofac' must be >= 1" +msgstr "" + +msgid "'hifac' must be positive" +msgstr "" + +msgid "if 'mctest' is TRUE, 'nsim' must be at least %.0f" +msgstr "" + +msgid "numeric 'iwin' must be 0, 1, 2, 3 or 4" +msgstr "" + +msgid "'iwin' must be numeric or character" +msgstr "" + +msgid "lengths of 't' and 'x' must match" +msgstr "" + +msgid "too few points (%.0f), at least %.0f needed" +msgstr "" + +msgid "Duplicate times in 't', averaging data" +msgstr "" + +msgid "Duplicate ages in 't', averaging data" +msgstr "" + +msgid "Number of duplicates by time," +msgstr "" + +msgid "Number of duplicates by age," +msgstr "" + +msgid "'k' duplicates means 'k + 1' total observations:" +msgstr "" + +msgid "redfitGetrho returned rho = %f, forced to zero" +msgstr "" + +msgid "use only with \"redfit\" objects" +msgstr "" + +msgid "Input:" +msgstr "" + +msgid "Initial values:" +msgstr "" + +msgid "Data variance (from data spectrum) = %s" +msgstr "" + +msgid "Avg. dt = %s" +msgstr "" + +msgid "Results:" +msgstr "" + +msgid "Avg. autocorr. coeff., rho = %s" +msgstr "" + +msgid "PRESCRIBED avg. autocorr. coeff., rho = %s" +msgstr "" + +msgid "Avg. tau = %s" +msgstr "" + +msgid "Degrees of freedom = %s" +msgstr "" + +msgid "6-dB Bandwidth = %s" +msgstr "" + +msgid "Critical false-alarm level (Thomson, 1990) = %s" +msgstr "" + +msgid "==> corresponding scaling factor for red noise = %s" +msgstr "" + +msgid "Equality of theoretical and data spectrum: Runs test" +msgstr "" + +msgid "%s-%% acceptance region:" +msgstr "" + +msgid "Test requires iwin = 0" +msgstr "" + +msgid "Test requires ofac = 1" +msgstr "" + +msgid "Test requires n50 = 1" +msgstr "" + +msgid "Data Columns:" +msgstr "" + +msgid "1: Freq = frequency" +msgstr "" + +msgid "2: Gxx = spectrum of input data" +msgstr "" + +msgid "3: Gxx_corr = bias-corrected spectrum of input data" +msgstr "" + +msgid "4: Gred_th = theoretical AR(1) spectrum" +msgstr "" + +msgid "5: Gred_avg = average spectrum of Nsim AR(1) time series (uncorrected)" +msgstr "" + +msgid "6: CorrFac = Gxx / Gxx_corr" +msgstr "" + +msgid "%.0f: Chi2_%.0fpct = %.0f%% false-alarm level (Chi^2)" +msgstr "" + +msgid "%.0f: MC_%.0fpct = %.0f%% false-alarm level (MC)" +msgstr "" + +msgid "timelimit exceeded" +msgstr "" + +msgid "too few points per segment (%.0f), at least %.0f needed" +msgstr "" + +msgid "too many segments: overlap of more than nseg - 1 points" +msgstr "" + +msgid "rho estimation: <= 0" +msgstr "" + +msgid "rho estimation: > 1" +msgstr "" + +msgid "estimation problem: LS function has > 1 minima" +msgstr "" + +msgid "estimation problem: a_min =< 0" +msgstr "" + +msgid "estimation problem: a_min >= 1" +msgstr "" + +msgid "error in tau estimation" +msgstr "" + msgid "'ncol(rwi)' != 'nrow(ids)'" msgstr "" @@ -510,9 +785,12 @@ msgid "'first.start' too large" msgstr "" -msgid "'x' must be a data.frame" +msgid "'x' must have at least one column" msgstr "" +msgid "'x' must have non-automatic row.names" +msgstr "" + msgid "NA result at position %d." msgstr "" @@ -699,6 +977,18 @@ msgid "years later than 99999 are not possible" msgstr "" +msgid "'win.width' must be even" +msgstr "" + +msgid "win.width should be < 100 unless your plotting is very wide!" +msgstr "" + +msgid "Fix window overlap" +msgstr "" + +msgid "These plots get crowded with windows longer than 100 years." +msgstr "" + msgid "There is %d series\n" msgid_plural "There are %d series\n" msgstr[0] "" @@ -728,3 +1018,8 @@ msgid_plural "precision unknown in series %s" msgstr[0] "" msgstr[1] "" + +msgid "%.0f NA value removed" +msgid_plural "%.0f NA values removed" +msgstr[0] "" +msgstr[1] "" Modified: pkg/dplR/po/R-fi.po =================================================================== --- pkg/dplR/po/R-fi.po 2014-05-05 20:40:23 UTC (rev 856) +++ pkg/dplR/po/R-fi.po 2014-05-05 21:01:03 UTC (rev 857) @@ -1,13 +1,13 @@ # Finnish translations for messages in dplR R code # Copyright (C) dplR copyright holders # This file is distributed under the same license as the dplR package. -# Mikko Korpela <mvkorpel at iki.fi>, 2011, 2012. +# Mikko Korpela <mvkorpel at iki.fi>, 2011, 2012, 2014. msgid "" msgstr "" -"Project-Id-Version: dplR 1.5.5\n" +"Project-Id-Version: dplR 1.6.1\n" "Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" -"POT-Creation-Date: 2012-06-15 18:41+0300\n" -"PO-Revision-Date: 2012-06-15 18:46+0300\n" +"POT-Creation-Date: 2014-05-05 23:48+0300\n" +"PO-Revision-Date: 2014-05-05 23:34+0300\n" "Last-Translator: Mikko Korpela <mvkorpel at iki.fi>\n" "Language-Team: Finnish <mvkorpel at iki.fi>\n" "Language: fi\n" @@ -74,15 +74,30 @@ "Ei mit??n yhdistett?v??. Ole hyv? ja sy?t? dplR-datastandardien mukaisia " "data.frameja." +msgid "'rwl' must have numeric columns" +msgstr "?rwl?:ss? t?ytyy olla numeric-tyyppiset sarakkeet" + +msgid "'rwl' must have row names" +msgstr "?rwl?:ss? pit?? olla rivinimet" + +msgid "row names of 'rwl' must be interpretable as years" +msgstr "'rwl':n rivinimien t?ytyy olla tulkittavissa vuosiluvuiksi" + +msgid "Year" +msgstr "Vuosi" + +msgid "Original: %d series, %d years" +msgstr "Alkuper?inen: %d sarjaa, %d vuotta" + +msgid "Common Interval (type='%s'): %d series x %d years = %d" +msgstr "Yhteinen ajanjakso (tyyppi '%s'): %d sarjaa x %d vuotta = %d" + msgid "At least 2 series are needed in 'rwl'" msgstr "V?hint??n 2 sarjaa tarvitaan ?rwl?:ss?" msgid "At least 1 series is needed in 'rwl'" msgstr "V?hint??n 1 sarja tarvitaan ?rwl?:ss?" -msgid "Year" -msgstr "Vuosi" - msgid "Segments: length=%d,lag=%d" msgstr "Segmentit: pituus=%d,viive=%d" @@ -92,21 +107,94 @@ msgid "'crn' must be a data.frame" msgstr "?crn?:n t?ytyy olla data.frame" -msgid "Years" -msgstr "Vuodet" - -msgid "RWI" -msgstr "Indeksi" - msgid "Sample Depth" msgstr "N?ytteiden m??r?" +msgid "Verbose output:" +msgstr "Lis?tuloste:" + +msgid "Options" +msgstr "Valinnat" + msgid "all values are 'NA'" msgstr "kaikki arvot ovat ?NA?" msgid "'NA's are not allowed in the middle of the series" msgstr "?NA??arvoja ei sallita sarjan keskell?" +msgid "Zero years in input series:" +msgstr "Nollavuodet sy?tesarjassa:" + +msgid "Zero indices in input series:" +msgstr "Nollaindeksit sy?tesarjassa:" + +msgid "No zeros in input series." +msgstr "Ei nollia sy?tesarjassa." + +msgid "Detrend by ModNegExp." +msgstr "Trendin poisto menetelm?ll? ModNegExp." + +msgid "Trying to fit nls model..." +msgstr "Yritet??n sovittaa nls-mallia..." + +msgid "nls failed... fitting linear model..." +msgstr "nls ep?onnistui... sovitetaan lineaarista mallia..." + +msgid "" +"Fits from ModNegExp are not all positive, see constrain.modnegexp argument " +"in detrend.series" +msgstr "" +"ModNegExp-mallin sovite ei ole kokonaan positiivinen, katso constrain." +"modnegexp-argumentti detrend.series-ohjeessa" + +msgid "Linear model fit" +msgstr "Lineaarisen mallin sovite" + +msgid "Intercept: %s" +msgstr "Vakiotermi: %s" + +msgid "Slope: %s" +msgstr "Kulmakerroin: %s" + +msgid "Linear fit (backup of ModNegExp) is not all positive" +msgstr "Lineaarinen sovite (ModNegExp:in varalla) ei ole kokonaan positiivinen" + +msgid "lm has a positive slope" +msgstr "lineaarisessa mallissa on positiivinen kulmakerroin" + +msgid "pos.slope = FALSE" +msgstr "pos.slope = FALSE" + +msgid "Detrend by mean." +msgstr "Trendin poisto keskiarvolla." + +msgid "Mean = %s" +msgstr "Keskiarvo = %s" + +msgid "nls coefs" +msgstr "nls-kertoimet" + +msgid "Detrend by spline." +msgstr "Trendin poisto splinill?." + +msgid "Spline parameters" +msgstr "Splinin parametrit" + +msgid "Spline fit is not all positive" +msgstr "Splinisovite is ole kokonaan positiivinen" + +msgid "Detrend by prewhitening." +msgstr "Trendin poisto valkaisemalla (prewhitening)." + +msgid "Ar fit is not all positive" +msgstr "Ar-sovite ei ole kokonaan positiivinen" + +msgid "Zero years in %s series:" +msgstr "Nollavuodet %s-sarjassa:" + +msgid "Zero indices in %s series:" +msgstr "Nollaindeksit %s-sarjassa:" + msgid "Age (Yrs)" msgstr "Ik? (v)" @@ -116,12 +204,18 @@ msgid "Spline" msgstr "Splini" +msgid "RWI" +msgstr "Indeksi" + msgid "Neg. Exp. Curve or Straight Line" msgstr "Neg. eksp. k?yr? tai Suora" msgid "Horizontal Line (Mean)" msgstr "Vakiosuora (Keskiarvo)" +msgid "Ar" +msgstr "Ar" + msgid "'y' must be coercible to a numeric vector" msgstr "?y?:n t?ytyy olla muunnettavissa numeric-vektoriksi" @@ -143,6 +237,15 @@ msgid "abscissa and ordinate vector must be of the same length" msgstr "abskissa- ja ordinaattavektorien t?ytyy olla samanpituiset" +msgid "'x' must be a data.frame" +msgstr "?x?:n t?ytyy olla data.frame" + +msgid "'x' must have numeric columns" +msgstr "?x?:ll? t?ytyy olla numeric-tyyppiset sarakkeet" + +msgid "'fill' must be a single number or character string" +msgstr "?fill?in t?ytyy olla yksitt?inen numero tai merkkijono" + msgid "Intersection of series %d and %d is not contiguous. NA returned." msgstr "Sarjojen %d ja %d leikkaus ei ole katkeamaton. Palautetaan NA." @@ -163,6 +266,15 @@ msgid "could not remap a name: some series will be missing" msgstr "ei voitu kehitt?? uutta nime?: joitain sarjoja puuttuu tuloksesta" +msgid "'series' not found in 'rwl'" +msgstr "'series'iss? nimetty? sarjaa ei ole ?rwl?:ss?" + +msgid "duplicate column names, multiple matches" +msgstr "toistuvia sarakenimi?, useita osumia" + +msgid "'series' of length 1 must be a column index to 'rwl'" +msgstr "yhden elementin 'series'-muuttujan t?ytyy olla sarakeindeksi 'rwl':??n" + msgid "Detrend series %d of %d" msgstr "Trendipuhdistetaan sarja %d / %d" @@ -178,12 +290,27 @@ msgid "number out of range or not an integer" msgstr "luku alueen ulkopuolella tai ei kokonaisluku" +msgid "input data must have consecutive years in increasing order" +msgstr "sy?tedatassa t?ytyy olla per?kk?iset vuodet kasvavassa j?rjestyksess?" + +msgid "invalid 'year': skipping years not allowed" +msgstr "ep?kelpo 'year': vuosien v?liin j?tt?minen ei ole sallittua" + +msgid "'year' not present in 'rw.vec.yrs'" +msgstr "'year' puuttuu 'rw.vec.yrs':st?" + msgid "'x1' and 'y1' lengths differ" msgstr "?x1?:n ja ?y1?:n pituudet eroavat" -msgid "'rgv.thresh' must range from 0 to 100" -msgstr "?rgv.thresh?in t?ytyy olla v?lill? 0?100" +msgid "use only with \"rwl\" objects" +msgstr "k?yt? vain \"rwl\"-objektien kanssa" +msgid "'rgv.thresh' must be > 0" +msgstr "?rgv.thresh?in t?ytyy olla > 0" + +msgid "'rgv.thresh' > 100 is unusual." +msgstr "'rgv.thresh' > 100 on ep?tavallinen." + msgid "'nseries.thresh' must range from 0 to 100" msgstr "?nseries.thresh?in t?ytyy olla v?lill? 0?100" @@ -467,6 +594,9 @@ msgid "failed to read rwl file" msgstr "tiedoston luku ep?onnistui" +msgid "series.index must be integer: %s" +msgstr "series.index:in t?ytyy olla kokonaisluku: %s" + msgid "bad location of stop marker in series %s" msgstr "ep?kelpo loppumerkin sijainti sarjassa %s" @@ -479,6 +609,153 @@ msgid "file has no good data" msgstr "tiedostossa ei ole kelvollista dataa" +msgid "oversampling factor 'ofac' must be >= 1" +msgstr "ylin?ytteistyskertoimen 'ofac' t?ytyy olla >= 1" + +msgid "'hifac' must be positive" +msgstr "?hifac?in t?ytyy olla positiivinen" + +msgid "if 'mctest' is TRUE, 'nsim' must be at least %.0f" +msgstr "jos 'mctest' on TRUE, 'nsim':in t?ytyy olla v?hint??n %.0f" + +msgid "numeric 'iwin' must be 0, 1, 2, 3 or 4" +msgstr "numeerisen 'iwin'-arvon t?ytyy olla 0, 1, 2, 3 tai 4" + +msgid "'iwin' must be numeric or character" +msgstr "?iwin?in t?ytyy olla numeerinen tai merkkijonotyyppinen" + +msgid "lengths of 't' and 'x' must match" +msgstr "'t':n ja 'x':n pituuksien t?ytyy t?sm?t?" + +msgid "too few points (%.0f), at least %.0f needed" +msgstr "liian v?h?n pisteit? (%.0f), v?hint??n %.0f tarvitaan" + +msgid "Duplicate times in 't', averaging data" +msgstr "Toistuvia aikoja 't':ss?, lasketaan keskiarvoja datasta" + +msgid "Duplicate ages in 't', averaging data" +msgstr "Toistuvia iki? 't':ss?, lasketaan keskiarvoja datasta" + +msgid "Number of duplicates by time," +msgstr "Toistuvien arvojen lukum??r? ajan mukaan," + +msgid "Number of duplicates by age," +msgstr "Toistuvien arvojen lukum??r? i?n mukaan," + +msgid "'k' duplicates means 'k + 1' total observations:" +msgstr "'k' toistuvaa arvoa tarkoittaa 'k + 1' havaintoa yhteens?:" + +msgid "redfitGetrho returned rho = %f, forced to zero" +msgstr "redfitGetrho palautti arvon rho = %f, pakotetaan nollaan" + +msgid "use only with \"redfit\" objects" +msgstr "k?yt? vain \"redfit\"-objektien kanssa" + +msgid "Input:" +msgstr "Sy?te:" + +msgid "Initial values:" +msgstr "Alkuarvot:" + +msgid "Data variance (from data spectrum) = %s" +msgstr "Datan varianssi (datan spektrist?) = %s" + +msgid "Avg. dt = %s" +msgstr "Keskim??r?inen n?ytteiden v?li (Avg. dt) = %s" + +msgid "Results:" +msgstr "Tulokset:" + +msgid "Avg. autocorr. coeff., rho = %s" +msgstr "Keskim??r?inen autokorrelaatiokerroin rho = %s" + +msgid "PRESCRIBED avg. autocorr. coeff., rho = %s" +msgstr "ASETETTU keskim??r?inen autokorrelaatiokerroin rho = %s" + +msgid "Avg. tau = %s" +msgstr "Keskim??r?inen tau = %s" + +msgid "Degrees of freedom = %s" +msgstr "Vapausasteet = %s" + +msgid "6-dB Bandwidth = %s" +msgstr "6 dB:n kaistanleveys = %s" + +msgid "Critical false-alarm level (Thomson, 1990) = %s" +msgstr "Kriittinen v??r?n h?lytyksen taso (Thomson, 1990) = %s" + +msgid "==> corresponding scaling factor for red noise = %s" +msgstr "==> vastaava skaalauskerroin punaiselle kohinalle = %s" + +msgid "Equality of theoretical and data spectrum: Runs test" +msgstr "Teoreettisen ja datan spektrin sopivuus: P?tk?testi (runs test)" + +msgid "%s-%% acceptance region:" +msgstr "%s %%:n hyv?ksymisalue:" + +msgid "Test requires iwin = 0" +msgstr "Testi vaatii iwin = 0" + +msgid "Test requires ofac = 1" +msgstr "Testi vaatii ofac = 1" + +msgid "Test requires n50 = 1" +msgstr "Testi vaatii n50 = 1" + +msgid "Data Columns:" +msgstr "Datan Sarakkeet:" + +msgid "1: Freq = frequency" +msgstr "1: Freq = taajuus" + +msgid "2: Gxx = spectrum of input data" +msgstr "2: Gxx = sy?tedatan spektri" + +msgid "3: Gxx_corr = bias-corrected spectrum of input data" +msgstr "3: Gxx_corr = sy?tedatan harhakorjattu spektri" + +msgid "4: Gred_th = theoretical AR(1) spectrum" +msgstr "4: Gred_th = teoreettinen AR(1)-spektri" + +msgid "5: Gred_avg = average spectrum of Nsim AR(1) time series (uncorrected)" +msgstr "5: Gred_avg = keskiarvospektri Nsim AR(1)-aikasarjasta (korjaamaton)" + +msgid "6: CorrFac = Gxx / Gxx_corr" +msgstr "6: CorrFac = Gxx / Gxx_corr" + +msgid "%.0f: Chi2_%.0fpct = %.0f%% false-alarm level (Chi^2)" +msgstr "%.0f: Chi2_%.0fpct = %.0f %%:n v??r?n h?lytyksen taso (Chi^2)" + +msgid "%.0f: MC_%.0fpct = %.0f%% false-alarm level (MC)" +msgstr "%.0f: MC_%.0fpct = %.0f %%:n v??r?n h?lytyksen taso (Markov-ketju)" + +msgid "timelimit exceeded" +msgstr "aikaraja ylitetty" + +msgid "too few points per segment (%.0f), at least %.0f needed" +msgstr "liian v?h?n pisteit? per segmentti (%.0f), v?hint??n %.0f tarvitaan" + +msgid "too many segments: overlap of more than nseg - 1 points" +msgstr "liian monta segmentti?: p??llekk?isyys enemm?n kuin nseg - 1 pistett?" + +msgid "rho estimation: <= 0" +msgstr "rho:n estimointi: <= 0" + +msgid "rho estimation: > 1" +msgstr "rho:n estimointi: > 1" + +msgid "estimation problem: LS function has > 1 minima" +msgstr "estimointiongelma: pienimm?n neli?summan funktiolla on > 1 minimi" + +msgid "estimation problem: a_min =< 0" +msgstr "estimointiongelma: a_min =< 0" + +msgid "estimation problem: a_min >= 1" +msgstr "estimointiongelma: a_min >= 1" + +msgid "error in tau estimation" +msgstr "virhe tau:n estimoinnissa" + msgid "'ncol(rwi)' != 'nrow(ids)'" msgstr "?ncol(rwi)? ? ?nrow(ids)?" @@ -537,9 +814,12 @@ msgid "'first.start' too large" msgstr "?first.start? liian suuri" -msgid "'x' must be a data.frame" -msgstr "?x?:n t?ytyy olla data.frame" +msgid "'x' must have at least one column" +msgstr "?x?:ss? pit?? olla v?hint??n yksi sarake" +msgid "'x' must have non-automatic row.names" +msgstr "?x?:ss? pit?? olla ei-automaattiset rivinimet" + msgid "NA result at position %d." msgstr "NA-tulos paikassa %d." @@ -745,6 +1025,18 @@ msgid "years later than 99999 are not possible" msgstr "99999:n j?lkeiset vuodet eiv?t ole mahdollisia" +msgid "'win.width' must be even" +msgstr "?win.width?in t?ytyy olla parillinen" + +msgid "win.width should be < 100 unless your plotting is very wide!" +msgstr "win.width:in pit?isi olla < 100 ellei kuva ole hyvin leve?!" + +msgid "Fix window overlap" +msgstr "Korjaa ikkunoiden p??llekk?isyys" + +msgid "These plots get crowded with windows longer than 100 years." +msgstr "Kuvista tulee ahtaita jos ikkunat ovat pidempi? kuin 100 vuotta" + msgid "There is %d series\n" msgid_plural "There are %d series\n" msgstr[0] "On %d sarja\n" @@ -775,3 +1067,11 @@ msgid_plural "precision unknown in series %s" msgstr[0] "tuntematon tarkkuus sarjassa %s" msgstr[1] "tuntematon tarkkuus sarjoissa %s" + +msgid "%.0f NA value removed" +msgid_plural "%.0f NA values removed" +msgstr[0] "%.0f NA-arvo poistettu" +msgstr[1] "%.0f NA-arvoa poistettu" + +#~ msgid "Years" +#~ msgstr "Vuodet" Modified: pkg/dplR/po/dplR.pot =================================================================== --- pkg/dplR/po/dplR.pot 2014-05-05 20:40:23 UTC (rev 856) +++ pkg/dplR/po/dplR.pot 2014-05-05 21:01:03 UTC (rev 857) @@ -1,215 +1,253 @@ # Translation template for messages in dplR C code # Copyright (C) dplR copyright holders # This file is distributed under the same license as the dplR package. -# Mikko Korpela <mvkorpel at iki.fi>, 2011. +# Mikko Korpela <mvkorpel at iki.fi>, 2011, 2014. msgid "" msgstr "" -"Project-Id-Version: dplR 1.4.8\n" -"Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" -"POT-Creation-Date: 2011-11-06 18:46+0200\n" +"Project-Id-Version: dplR 1.6.1\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2014-05-05 23:51+0300\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME <EMAIL at ADDRESS>\n" "Language-Team: LANGUAGE <LL at li.org>\n" "Language: \n" "MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" +"Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: \n" -#: rcompact.c:137 +#: rcompact.c:138 #, c-format msgid "Could not open file %s for reading" msgstr "" -#: rcompact.c:182 +#: rcompact.c:183 #, c-format msgid "Series %d: Header line is too long (max length %d)" msgstr "" -#: rcompact.c:192 +#: rcompact.c:193 #, c-format msgid "Series %d: No '=' found when header line was expected" msgstr "" -#: rcompact.c:197 +#: rcompact.c:198 #, c-format msgid "Series %d: No room for number before first '='" msgstr "" -#: rcompact.c:204 +#: rcompact.c:205 #, c-format msgid "Series %d: Only a number must be found right before 1st '='" msgstr "" -#: rcompact.c:209 rcompact.c:254 +#: rcompact.c:210 rcompact.c:255 #, c-format msgid "Series %d: Number %lld exceeds integer range" msgstr "" -#: rcompact.c:219 rcompact.c:263 +#: rcompact.c:220 rcompact.c:264 #, c-format msgid "Series %d: Length of series must be at least one (%ld seen)" msgstr "" -#: rcompact.c:227 +#: rcompact.c:228 #, c-format msgid "Series %d: Unknown field id: %c" msgstr "" -#: rcompact.c:233 +#: rcompact.c:234 #, c-format msgid "Series %d: Space required between N and I fields" msgstr "" -#: rcompact.c:240 +#: rcompact.c:241 #, c-format msgid "Series %d: Second '=' missing" msgstr "" -#: rcompact.c:244 +#: rcompact.c:245 #, c-format msgid "Series %d: No room for number before second '='" msgstr "" -#: rcompact.c:249 +#: rcompact.c:250 #, c-format msgid "" "Series %d: Only a number must be found after first field, right before 2nd " "'='" msgstr "" -#: rcompact.c:269 +#: rcompact.c:270 #, c-format msgid "Series %d: Unknown or doubled field id: %c" msgstr "" -#: rcompact.c:284 +#: rcompact.c:276 #, c-format +msgid "Series %d: Last year exceeds integer range" +msgstr "" + +#: rcompact.c:288 +#, c-format msgid "Series %d (%s): Space required before ID" msgstr "" -#: rcompact.c:296 +#: rcompact.c:300 #, c-format msgid "Series %d (%s): '~' not found in expected location" msgstr "" -#: rcompact.c:314 +#: rcompact.c:318 #, c-format msgid "Series %d: Invalid character in series ID" msgstr "" -#: rcompact.c:325 +#: rcompact.c:329 #, c-format msgid "Series %d: Alphanumeric series ID not found" msgstr "" -#: rcompact.c:331 +#: rcompact.c:335 #, c-format -msgid "Series %d (%s): Space required after alphanumerid ID" +msgid "Series %d (%s): Space required after alphanumeric ID" msgstr "" -#: rcompact.c:340 +#: rcompact.c:344 #, c-format msgid "Series %d (%s): Exponent not found" msgstr "" -#: rcompact.c:352 +#: rcompact.c:356 #, c-format msgid "Series %d (%s): Exponent has too many characters" msgstr "" -#: rcompact.c:357 +#: rcompact.c:361 #, c-format msgid "Series %d (%s): Opening parenthesis required after exponent" msgstr "" -#: rcompact.c:364 +#: rcompact.c:368 #, c-format msgid "Series %d (%s): No dot found in number format description" msgstr "" -#: rcompact.c:370 +#: rcompact.c:374 #, c-format msgid "Series %d (%s): No closing parenthesis found" msgstr "" -#: rcompact.c:384 +#: rcompact.c:388 #, c-format msgid "Series %d (%s): Number of values per line not found" msgstr "" -#: rcompact.c:389 +#: rcompact.c:393 #, c-format msgid "Series %d (%s): At least one value per line is needed" msgstr "" -#: rcompact.c:394 +#: rcompact.c:398 #, c-format msgid "Series %d (%s): Number of values per line (%d) > max line length (%d)" msgstr "" -#: rcompact.c:399 +#: rcompact.c:403 #, c-format msgid "Series %d (%s): Only 'F' number format is supported" msgstr "" -#: rcompact.c:406 +#: rcompact.c:410 #, c-format msgid "Series %d (%s): Field width not found" msgstr "" -#: rcompact.c:411 +#: rcompact.c:415 #, c-format msgid "Series %d (%s): Field width and '.' must be adjacent" msgstr "" -#: rcompact.c:416 +#: rcompact.c:420 #, c-format msgid "Series %d (%s): Field width must be at least one (%d seen)" msgstr "" -#: rcompact.c:423 +#: rcompact.c:427 #, c-format msgid "Series %d (%s): Number of decimals not found" msgstr "" -#: rcompact.c:428 +#: rcompact.c:432 #, c-format msgid "Series %d (%s): Number of decimals and ')' must be adjacent" msgstr "" -#: rcompact.c:433 +#: rcompact.c:437 #, c-format msgid "Series %d (%s): No (implied) decimal places allowed in format" msgstr "" -#: rcompact.c:439 +#: rcompact.c:443 #, c-format msgid "Series %d (%s): Required line length %d exceeds the maximum %d" msgstr "" -#: rcompact.c:455 rcompact.c:495 +#: rcompact.c:459 rcompact.c:499 #, c-format msgid "Series %d (%s): Unexpected end of file (%d data lines read)" msgstr "" -#: rcompact.c:461 rcompact.c:500 +#: rcompact.c:465 rcompact.c:504 #, c-format msgid "Series %d (%s): Data line %d is too long (max length %d)" msgstr "" -#: rcompact.c:474 rcompact.c:512 +#: rcompact.c:478 rcompact.c:516 #, c-format msgid "" "Series %d (%s): Could not read number (data row %d, field %d).\n" "Malformed number or previous line too long." msgstr "" -#: rcompact.c:530 +#: rcompact.c:534 #, c-format msgid "Error reading file %s" msgstr "" -#: rcompact.c:537 +#: rcompact.c:541 #, c-format msgid "No data found in file %s" msgstr "" + +#: readloop.c:18 +msgid "all arguments must be integers" +msgstr "" + +#: readloop.c:25 +msgid "'x' must be a matrix" +msgstr "" + +#: readloop.c:31 +msgid "too many columns in 'x'" +msgstr "" + +#: readloop.c:40 +msgid "dimensions of 'x', 'series_index' and 'decade' must match" +msgstr "" + +#: readloop.c:53 +msgid "'series_index' must be positive" +msgstr "" + +#: readloop.c:91 +msgid "no data found in 'x'" +msgstr "" + +#: tbrm.c:28 +msgid "long vectors not supported" +msgstr "" + +#: tbrm.c:33 +msgid "length of 'C' must be 1" +msgstr "" Modified: pkg/dplR/po/fi.po =================================================================== --- pkg/dplR/po/fi.po 2014-05-05 20:40:23 UTC (rev 856) +++ pkg/dplR/po/fi.po 2014-05-05 21:01:03 UTC (rev 857) @@ -1,13 +1,13 @@ # Finnish translations for messages in dplR C code # Copyright (C) dplR copyright holders # This file is distributed under the same license as the dplR package. -# Mikko Korpela <mvkorpel at iki.fi>, 2011. +# Mikko Korpela <mvkorpel at iki.fi>, 2011, 2014. msgid "" msgstr "" -"Project-Id-Version: dplR 1.4.8\n" +"Project-Id-Version: dplR 1.6.1\n" "Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" -"POT-Creation-Date: 2011-11-06 18:46+0200\n" -"PO-Revision-Date: 2011-11-06 18:50+0200\n" +"POT-Creation-Date: 2014-05-05 23:51+0300\n" +"PO-Revision-Date: 2014-05-05 23:49+0300\n" "Last-Translator: Mikko Korpela <mvkorpel at iki.fi>\n" "Language-Team: Finnish <mvkorpel at iki.fi>\n" "Language: fi\n" @@ -16,63 +16,63 @@ "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" -#: rcompact.c:137 +#: rcompact.c:138 #, c-format msgid "Could not open file %s for reading" msgstr "Ei voitu avata tiedostoa %s luettavaksi" -#: rcompact.c:182 +#: rcompact.c:183 #, c-format msgid "Series %d: Header line is too long (max length %d)" msgstr "Sarja %d: Otsakerivi on liian pitk? (maksimipituus %d)" -#: rcompact.c:192 +#: rcompact.c:193 #, c-format msgid "Series %d: No '=' found when header line was expected" msgstr "Sarja %d: Ei ?=?-merkki? oletetulla otsakerivill?" -#: rcompact.c:197 +#: rcompact.c:198 #, c-format msgid "Series %d: No room for number before first '='" msgstr "Sarja %d: Ei tilaa luvulle ennen ensimm?ist? ?=?-merkki?" -#: rcompact.c:204 +#: rcompact.c:205 #, c-format msgid "Series %d: Only a number must be found right before 1st '='" msgstr "" "Sarja %d: Juuri ennen ensimm?ist? ?=?-merkki? t?ytyy olla luku, ei muuta" -#: rcompact.c:209 rcompact.c:254 +#: rcompact.c:210 rcompact.c:255 #, c-format msgid "Series %d: Number %lld exceeds integer range" msgstr "Sarja %d: Luku %lld ylitt?? kokonaislukualueen" -#: rcompact.c:219 rcompact.c:263 +#: rcompact.c:220 rcompact.c:264 #, c-format msgid "Series %d: Length of series must be at least one (%ld seen)" msgstr "Sarja %d: Sarjan pituuden t?ytyy olla v?hint??n yksi (%ld n?hty)" -#: rcompact.c:227 +#: rcompact.c:228 #, c-format msgid "Series %d: Unknown field id: %c" msgstr "Sarja %d: Tuntematon kent?n tunniste: %c" -#: rcompact.c:233 +#: rcompact.c:234 #, c-format msgid "Series %d: Space required between N and I fields" msgstr "Sarja %d: N- ja I-kenttien v?liss? t?ytyy olla tilaa" -#: rcompact.c:240 +#: rcompact.c:241 #, c-format msgid "Series %d: Second '=' missing" msgstr "Sarja %d: Toinen ?=?-merkki puuttuu" -#: rcompact.c:244 +#: rcompact.c:245 #, c-format msgid "Series %d: No room for number before second '='" msgstr "Sarja %d: Ei tilaa luvulle ennen toista ?=?-merkki?" -#: rcompact.c:249 +#: rcompact.c:250 #, c-format msgid "" "Series %d: Only a number must be found after first field, right before 2nd " @@ -81,130 +81,135 @@ "Sarja %d: Ensimm?isen kent?n j?lkeen, juuri ennen toista, t?ytyy olla luku, " "ei muuta" -#: rcompact.c:269 +#: rcompact.c:270 #, c-format msgid "Series %d: Unknown or doubled field id: %c" msgstr "Sarja %d: Tuntematon tai kahdennettu kent?n tunniste: %c" -#: rcompact.c:284 +#: rcompact.c:276 #, c-format +msgid "Series %d: Last year exceeds integer range" +msgstr "Sarja %d: Viimeinen vuosi ylitt?? kokonaislukualueen" + +#: rcompact.c:288 +#, c-format msgid "Series %d (%s): Space required before ID" msgstr "Sarja %d (%s): Ennen tunnistetta t?ytyy olla tilaa" -#: rcompact.c:296 +#: rcompact.c:300 #, c-format msgid "Series %d (%s): '~' not found in expected location" msgstr "Sarja %d (%s): ?~?-merkki? ei l?ytynyt odotetusta paikasta" -#: rcompact.c:314 +#: rcompact.c:318 #, c-format msgid "Series %d: Invalid character in series ID" msgstr "Sarja %d: Ep?kelpo merkki sarjan tunnisteessa" -#: rcompact.c:325 +#: rcompact.c:329 #, c-format msgid "Series %d: Alphanumeric series ID not found" msgstr "Sarja %d: Aakkosnumeerista sarjan tunnistetta ei l?ytynyt" -#: rcompact.c:331 +#: rcompact.c:335 #, c-format [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/dplr -r 857 From noreply at r-forge.r-project.org Tue May 6 08:17:41 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 6 May 2014 08:17:41 +0200 (CEST) Subject: [Dplr-commits] r858 - in pkg/dplR: . src Message-ID: <20140506061741.990D318736E@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-06 08:17:41 +0200 (Tue, 06 May 2014) New Revision: 858 Modified: pkg/dplR/DESCRIPTION pkg/dplR/src/rcompact.c Log: More (paranoid) robustness in C code of read.compact() Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-05 21:01:03 UTC (rev 857) +++ pkg/dplR/DESCRIPTION 2014-05-06 06:17:41 UTC (rev 858) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-05 +Date: 2014-05-06 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/src/rcompact.c =================================================================== --- pkg/dplR/src/rcompact.c 2014-05-05 21:01:03 UTC (rev 857) +++ pkg/dplR/src/rcompact.c 2014-05-06 06:17:41 UTC (rev 858) @@ -153,6 +153,8 @@ */ while(strchr(line, '~') == NULL){ if(n_content > 0){ /* Skip empty lines */ + if(n_comments == R_INT_MAX) + error(_("Number of comments exceeds integer range")); ++n_comments; tmp_comment = (char *) R_alloc(n_content+1, sizeof(char)); strncpy(tmp_comment, line, n_content); @@ -170,6 +172,9 @@ if(early_eof == TRUE) break; + if(n == R_INT_MAX) + error(_("Number of series exceeds integer range")); + /* A simple check to point out too long header * lines. Generally, if one line is too long, this function * will probably be unable to parse the next line. In that From noreply at r-forge.r-project.org Tue May 6 08:36:53 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 6 May 2014 08:36:53 +0200 (CEST) Subject: [Dplr-commits] r859 - in pkg/dplR: . src Message-ID: <20140506063653.71D6B1874CA@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-06 08:36:53 +0200 (Tue, 06 May 2014) New Revision: 859 Modified: pkg/dplR/ChangeLog pkg/dplR/src/readloop.c Log: Robustness of read.tucson() improved in case of unlikely input data Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-06 06:17:41 UTC (rev 858) +++ pkg/dplR/ChangeLog 2014-05-06 06:36:53 UTC (rev 859) @@ -6,10 +6,11 @@ - Bug fix: make.plot=TRUE threw an error when input data.frame had leading or trailing all-NA rows -File: rcompact.c ----------------- +Files: rcompact.c, readloop.c +----------------------------- -- Made the C code of read.compact() more resilient to unusual inputs +- Made the C code of read.compact() and read.tucson() more + resilient to unusual inputs File: redfit.c -------------- Modified: pkg/dplR/src/readloop.c =================================================================== --- pkg/dplR/src/readloop.c 2014-05-06 06:17:41 UTC (rev 858) +++ pkg/dplR/src/readloop.c 2014-05-06 06:36:53 UTC (rev 859) @@ -66,6 +66,8 @@ } } if (max_year >= min_year) { + if (max_year >= 0 && min_year < max_year - R_INT_MAX + 1) + error(_("Number of years exceeds integer range")); span = max_year - min_year + 1; } else { min_year = NA_INTEGER; From noreply at r-forge.r-project.org Tue May 6 09:10:52 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 6 May 2014 09:10:52 +0200 (CEST) Subject: [Dplr-commits] r860 - in pkg/dplR: inst/po/fi/LC_MESSAGES po Message-ID: <20140506071052.0F1A31851CD@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-06 09:10:51 +0200 (Tue, 06 May 2014) New Revision: 860 Modified: pkg/dplR/inst/po/fi/LC_MESSAGES/dplR.mo pkg/dplR/po/R-dplR.pot pkg/dplR/po/R-fi.po pkg/dplR/po/dplR.pot pkg/dplR/po/fi.po Log: Translations Modified: pkg/dplR/inst/po/fi/LC_MESSAGES/dplR.mo =================================================================== (Binary files differ) Modified: pkg/dplR/po/R-dplR.pot =================================================================== --- pkg/dplR/po/R-dplR.pot 2014-05-06 06:36:53 UTC (rev 859) +++ pkg/dplR/po/R-dplR.pot 2014-05-06 07:10:51 UTC (rev 860) @@ -5,8 +5,8 @@ msgid "" msgstr "" "Project-Id-Version: dplR 1.6.1\n" -"Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2014-05-05 23:48+0300\n" +"Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" +"POT-Creation-Date: 2014-05-06 09:59+0300\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME <EMAIL at ADDRESS>\n" "Language-Team: LANGUAGE <LL at li.org>\n" Modified: pkg/dplR/po/R-fi.po =================================================================== --- pkg/dplR/po/R-fi.po 2014-05-06 06:36:53 UTC (rev 859) +++ pkg/dplR/po/R-fi.po 2014-05-06 07:10:51 UTC (rev 860) @@ -6,7 +6,7 @@ msgstr "" "Project-Id-Version: dplR 1.6.1\n" "Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" -"POT-Creation-Date: 2014-05-05 23:48+0300\n" +"POT-Creation-Date: 2014-05-06 09:59+0300\n" "PO-Revision-Date: 2014-05-05 23:34+0300\n" "Last-Translator: Mikko Korpela <mvkorpel at iki.fi>\n" "Language-Team: Finnish <mvkorpel at iki.fi>\n" Modified: pkg/dplR/po/dplR.pot =================================================================== --- pkg/dplR/po/dplR.pot 2014-05-06 06:36:53 UTC (rev 859) +++ pkg/dplR/po/dplR.pot 2014-05-06 07:10:51 UTC (rev 860) @@ -5,8 +5,8 @@ msgid "" msgstr "" "Project-Id-Version: dplR 1.6.1\n" -"Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2014-05-05 23:51+0300\n" +"Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" +"POT-Creation-Date: 2014-05-06 10:00+0300\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME <EMAIL at ADDRESS>\n" "Language-Team: LANGUAGE <LL at li.org>\n" @@ -21,201 +21,209 @@ msgid "Could not open file %s for reading" msgstr "" -#: rcompact.c:183 +#: rcompact.c:157 +msgid "Number of comments exceeds integer range" +msgstr "" + +#: rcompact.c:176 +msgid "Number of series exceeds integer range" +msgstr "" + +#: rcompact.c:188 #, c-format msgid "Series %d: Header line is too long (max length %d)" msgstr "" -#: rcompact.c:193 +#: rcompact.c:198 #, c-format msgid "Series %d: No '=' found when header line was expected" msgstr "" -#: rcompact.c:198 +#: rcompact.c:203 #, c-format msgid "Series %d: No room for number before first '='" msgstr "" -#: rcompact.c:205 +#: rcompact.c:210 #, c-format msgid "Series %d: Only a number must be found right before 1st '='" msgstr "" -#: rcompact.c:210 rcompact.c:255 +#: rcompact.c:215 rcompact.c:260 #, c-format msgid "Series %d: Number %lld exceeds integer range" msgstr "" -#: rcompact.c:220 rcompact.c:264 +#: rcompact.c:225 rcompact.c:269 #, c-format msgid "Series %d: Length of series must be at least one (%ld seen)" msgstr "" -#: rcompact.c:228 +#: rcompact.c:233 #, c-format msgid "Series %d: Unknown field id: %c" msgstr "" -#: rcompact.c:234 +#: rcompact.c:239 #, c-format msgid "Series %d: Space required between N and I fields" msgstr "" -#: rcompact.c:241 +#: rcompact.c:246 #, c-format msgid "Series %d: Second '=' missing" msgstr "" -#: rcompact.c:245 +#: rcompact.c:250 #, c-format msgid "Series %d: No room for number before second '='" msgstr "" -#: rcompact.c:250 +#: rcompact.c:255 #, c-format msgid "" "Series %d: Only a number must be found after first field, right before 2nd " "'='" msgstr "" -#: rcompact.c:270 +#: rcompact.c:275 #, c-format msgid "Series %d: Unknown or doubled field id: %c" msgstr "" -#: rcompact.c:276 +#: rcompact.c:281 #, c-format msgid "Series %d: Last year exceeds integer range" msgstr "" -#: rcompact.c:288 +#: rcompact.c:293 #, c-format msgid "Series %d (%s): Space required before ID" msgstr "" -#: rcompact.c:300 +#: rcompact.c:305 #, c-format msgid "Series %d (%s): '~' not found in expected location" msgstr "" -#: rcompact.c:318 +#: rcompact.c:323 #, c-format msgid "Series %d: Invalid character in series ID" msgstr "" -#: rcompact.c:329 +#: rcompact.c:334 #, c-format msgid "Series %d: Alphanumeric series ID not found" msgstr "" -#: rcompact.c:335 +#: rcompact.c:340 #, c-format msgid "Series %d (%s): Space required after alphanumeric ID" msgstr "" -#: rcompact.c:344 +#: rcompact.c:349 #, c-format msgid "Series %d (%s): Exponent not found" msgstr "" -#: rcompact.c:356 +#: rcompact.c:361 #, c-format msgid "Series %d (%s): Exponent has too many characters" msgstr "" -#: rcompact.c:361 +#: rcompact.c:366 #, c-format msgid "Series %d (%s): Opening parenthesis required after exponent" msgstr "" -#: rcompact.c:368 +#: rcompact.c:373 #, c-format msgid "Series %d (%s): No dot found in number format description" msgstr "" -#: rcompact.c:374 +#: rcompact.c:379 #, c-format msgid "Series %d (%s): No closing parenthesis found" msgstr "" -#: rcompact.c:388 +#: rcompact.c:393 #, c-format msgid "Series %d (%s): Number of values per line not found" msgstr "" -#: rcompact.c:393 +#: rcompact.c:398 #, c-format msgid "Series %d (%s): At least one value per line is needed" msgstr "" -#: rcompact.c:398 +#: rcompact.c:403 #, c-format msgid "Series %d (%s): Number of values per line (%d) > max line length (%d)" msgstr "" -#: rcompact.c:403 +#: rcompact.c:408 #, c-format msgid "Series %d (%s): Only 'F' number format is supported" msgstr "" -#: rcompact.c:410 +#: rcompact.c:415 #, c-format msgid "Series %d (%s): Field width not found" msgstr "" -#: rcompact.c:415 +#: rcompact.c:420 #, c-format msgid "Series %d (%s): Field width and '.' must be adjacent" msgstr "" -#: rcompact.c:420 +#: rcompact.c:425 #, c-format msgid "Series %d (%s): Field width must be at least one (%d seen)" msgstr "" -#: rcompact.c:427 +#: rcompact.c:432 #, c-format msgid "Series %d (%s): Number of decimals not found" msgstr "" -#: rcompact.c:432 +#: rcompact.c:437 #, c-format msgid "Series %d (%s): Number of decimals and ')' must be adjacent" msgstr "" -#: rcompact.c:437 +#: rcompact.c:442 #, c-format msgid "Series %d (%s): No (implied) decimal places allowed in format" msgstr "" -#: rcompact.c:443 +#: rcompact.c:448 #, c-format msgid "Series %d (%s): Required line length %d exceeds the maximum %d" msgstr "" -#: rcompact.c:459 rcompact.c:499 +#: rcompact.c:464 rcompact.c:504 #, c-format msgid "Series %d (%s): Unexpected end of file (%d data lines read)" msgstr "" -#: rcompact.c:465 rcompact.c:504 +#: rcompact.c:470 rcompact.c:509 #, c-format msgid "Series %d (%s): Data line %d is too long (max length %d)" msgstr "" -#: rcompact.c:478 rcompact.c:516 +#: rcompact.c:483 rcompact.c:521 #, c-format msgid "" "Series %d (%s): Could not read number (data row %d, field %d).\n" "Malformed number or previous line too long." msgstr "" -#: rcompact.c:534 +#: rcompact.c:539 #, c-format msgid "Error reading file %s" msgstr "" -#: rcompact.c:541 +#: rcompact.c:546 #, c-format msgid "No data found in file %s" msgstr "" @@ -240,7 +248,11 @@ msgid "'series_index' must be positive" msgstr "" -#: readloop.c:91 +#: readloop.c:70 +msgid "Number of years exceeds integer range" +msgstr "" + +#: readloop.c:93 msgid "no data found in 'x'" msgstr "" Modified: pkg/dplR/po/fi.po =================================================================== --- pkg/dplR/po/fi.po 2014-05-06 06:36:53 UTC (rev 859) +++ pkg/dplR/po/fi.po 2014-05-06 07:10:51 UTC (rev 860) @@ -6,8 +6,8 @@ msgstr "" "Project-Id-Version: dplR 1.6.1\n" "Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" -"POT-Creation-Date: 2014-05-05 23:51+0300\n" -"PO-Revision-Date: 2014-05-05 23:49+0300\n" +"POT-Creation-Date: 2014-05-06 10:00+0300\n" +"PO-Revision-Date: 2014-05-06 10:03+0300\n" "Last-Translator: Mikko Korpela <mvkorpel at iki.fi>\n" "Language-Team: Finnish <mvkorpel at iki.fi>\n" "Language: fi\n" @@ -21,58 +21,66 @@ msgid "Could not open file %s for reading" msgstr "Ei voitu avata tiedostoa %s luettavaksi" -#: rcompact.c:183 +#: rcompact.c:157 +msgid "Number of comments exceeds integer range" +msgstr "Kommenttien lukum??r? ylitt?? kokonaislukualueen" + +#: rcompact.c:176 +msgid "Number of series exceeds integer range" +msgstr "Sarjojen lukum??r? ylitt?? kokonaislukualueen" + +#: rcompact.c:188 #, c-format msgid "Series %d: Header line is too long (max length %d)" msgstr "Sarja %d: Otsakerivi on liian pitk? (maksimipituus %d)" -#: rcompact.c:193 +#: rcompact.c:198 #, c-format msgid "Series %d: No '=' found when header line was expected" msgstr "Sarja %d: Ei ?=?-merkki? oletetulla otsakerivill?" -#: rcompact.c:198 +#: rcompact.c:203 #, c-format msgid "Series %d: No room for number before first '='" msgstr "Sarja %d: Ei tilaa luvulle ennen ensimm?ist? ?=?-merkki?" -#: rcompact.c:205 +#: rcompact.c:210 #, c-format msgid "Series %d: Only a number must be found right before 1st '='" msgstr "" "Sarja %d: Juuri ennen ensimm?ist? ?=?-merkki? t?ytyy olla luku, ei muuta" -#: rcompact.c:210 rcompact.c:255 +#: rcompact.c:215 rcompact.c:260 #, c-format msgid "Series %d: Number %lld exceeds integer range" msgstr "Sarja %d: Luku %lld ylitt?? kokonaislukualueen" -#: rcompact.c:220 rcompact.c:264 +#: rcompact.c:225 rcompact.c:269 #, c-format msgid "Series %d: Length of series must be at least one (%ld seen)" msgstr "Sarja %d: Sarjan pituuden t?ytyy olla v?hint??n yksi (%ld n?hty)" -#: rcompact.c:228 +#: rcompact.c:233 #, c-format msgid "Series %d: Unknown field id: %c" msgstr "Sarja %d: Tuntematon kent?n tunniste: %c" -#: rcompact.c:234 +#: rcompact.c:239 #, c-format msgid "Series %d: Space required between N and I fields" msgstr "Sarja %d: N- ja I-kenttien v?liss? t?ytyy olla tilaa" -#: rcompact.c:241 +#: rcompact.c:246 #, c-format msgid "Series %d: Second '=' missing" msgstr "Sarja %d: Toinen ?=?-merkki puuttuu" -#: rcompact.c:245 +#: rcompact.c:250 #, c-format msgid "Series %d: No room for number before second '='" msgstr "Sarja %d: Ei tilaa luvulle ennen toista ?=?-merkki?" -#: rcompact.c:250 +#: rcompact.c:255 #, c-format msgid "" "Series %d: Only a number must be found after first field, right before 2nd " @@ -81,135 +89,135 @@ "Sarja %d: Ensimm?isen kent?n j?lkeen, juuri ennen toista, t?ytyy olla luku, " "ei muuta" -#: rcompact.c:270 +#: rcompact.c:275 #, c-format msgid "Series %d: Unknown or doubled field id: %c" msgstr "Sarja %d: Tuntematon tai kahdennettu kent?n tunniste: %c" -#: rcompact.c:276 +#: rcompact.c:281 #, c-format msgid "Series %d: Last year exceeds integer range" msgstr "Sarja %d: Viimeinen vuosi ylitt?? kokonaislukualueen" -#: rcompact.c:288 +#: rcompact.c:293 #, c-format msgid "Series %d (%s): Space required before ID" msgstr "Sarja %d (%s): Ennen tunnistetta t?ytyy olla tilaa" -#: rcompact.c:300 +#: rcompact.c:305 #, c-format msgid "Series %d (%s): '~' not found in expected location" msgstr "Sarja %d (%s): ?~?-merkki? ei l?ytynyt odotetusta paikasta" -#: rcompact.c:318 +#: rcompact.c:323 #, c-format msgid "Series %d: Invalid character in series ID" msgstr "Sarja %d: Ep?kelpo merkki sarjan tunnisteessa" -#: rcompact.c:329 +#: rcompact.c:334 #, c-format msgid "Series %d: Alphanumeric series ID not found" msgstr "Sarja %d: Aakkosnumeerista sarjan tunnistetta ei l?ytynyt" -#: rcompact.c:335 +#: rcompact.c:340 #, c-format msgid "Series %d (%s): Space required after alphanumeric ID" msgstr "Sarja %d (%s): Aakkosnumeerisen tunnisteen j?lkeen t?ytyy olla tilaa" -#: rcompact.c:344 +#: rcompact.c:349 #, c-format msgid "Series %d (%s): Exponent not found" msgstr "Sarja %d (%s): Eksponenttia ei l?ytynyt" -#: rcompact.c:356 +#: rcompact.c:361 #, c-format msgid "Series %d (%s): Exponent has too many characters" msgstr "Sarja %d (%s): Eksponentissa on liian monta merkki?" -#: rcompact.c:361 +#: rcompact.c:366 #, c-format msgid "Series %d (%s): Opening parenthesis required after exponent" msgstr "Sarja %d (%s): Eksponentin j?lkeen t?ytyy olla vasen kaarisulje" -#: rcompact.c:368 +#: rcompact.c:373 #, c-format msgid "Series %d (%s): No dot found in number format description" msgstr "Sarja %d (%s): Lukumuotoilun kuvauksesta ei l?ytynyt pistett?" -#: rcompact.c:374 +#: rcompact.c:379 #, c-format msgid "Series %d (%s): No closing parenthesis found" msgstr "Sarja %d (%s): Oikeaa kaarisuljetta ei l?ytynyt" -#: rcompact.c:388 +#: rcompact.c:393 #, c-format msgid "Series %d (%s): Number of values per line not found" msgstr "Sarja %d (%s): Rivill? olevien arvojen lukum??r?? ei l?ytynyt" -#: rcompact.c:393 +#: rcompact.c:398 #, c-format msgid "Series %d (%s): At least one value per line is needed" msgstr "Sarja %d (%s): Tarvitaan v?hint??n yksi arvo rivi? kohti" -#: rcompact.c:398 +#: rcompact.c:403 #, c-format msgid "Series %d (%s): Number of values per line (%d) > max line length (%d)" msgstr "" "Sarja %d (%s): Rivill? olevien arvojen lukum??r? (%d) > rivin maksimipituus " "(%d)" -#: rcompact.c:403 +#: rcompact.c:408 #, c-format msgid "Series %d (%s): Only 'F' number format is supported" msgstr "Sarja %d (%s): Vain ?F?-lukumuotoilua tuetaan" -#: rcompact.c:410 +#: rcompact.c:415 #, c-format msgid "Series %d (%s): Field width not found" msgstr "Sarja %d (%s): Kent?n leveytt? ei l?ytynyt" -#: rcompact.c:415 +#: rcompact.c:420 #, c-format msgid "Series %d (%s): Field width and '.' must be adjacent" msgstr "Sarja %d (%s): Kent?n leveyden ja ?.?-merkin t?ytyy olla vierekk?in" -#: rcompact.c:420 +#: rcompact.c:425 #, c-format msgid "Series %d (%s): Field width must be at least one (%d seen)" msgstr "Sarja %d (%s): Kent?n leveyden t?ytyy olla v?hint??n yksi (%d n?hty)" -#: rcompact.c:427 +#: rcompact.c:432 #, c-format msgid "Series %d (%s): Number of decimals not found" msgstr "Sarja %d (%s): Desimaalien lukum??r?? ei l?ytynyt" -#: rcompact.c:432 +#: rcompact.c:437 #, c-format msgid "Series %d (%s): Number of decimals and ')' must be adjacent" msgstr "" "Sarja %d (%s): Desimaalien lukum??r?n ja ?)?-merkin t?ytyy olla vierekk?in" -#: rcompact.c:437 +#: rcompact.c:442 #, c-format msgid "Series %d (%s): No (implied) decimal places allowed in format" msgstr "Sarja %d (%s): Lukumuotoilussa ei sallita (ep?suoria) desimaaleja" -#: rcompact.c:443 +#: rcompact.c:448 #, c-format msgid "Series %d (%s): Required line length %d exceeds the maximum %d" msgstr "Sarja %d (%s): Tarvittava rivin pituus %d ylitt?? maksimin %d" -#: rcompact.c:459 rcompact.c:499 +#: rcompact.c:464 rcompact.c:504 #, c-format msgid "Series %d (%s): Unexpected end of file (%d data lines read)" msgstr "Sarja %d (%s): Odottamaton tiedoston lopetus (%d datarivi? luettu)" -#: rcompact.c:465 rcompact.c:504 +#: rcompact.c:470 rcompact.c:509 #, c-format msgid "Series %d (%s): Data line %d is too long (max length %d)" msgstr "Sarja %d (%s): Datarivi %d on liian pitk? (maksimipituus %d)" -#: rcompact.c:478 rcompact.c:516 +#: rcompact.c:483 rcompact.c:521 #, c-format msgid "" "Series %d (%s): Could not read number (data row %d, field %d).\n" @@ -218,12 +226,12 @@ "Sarja %d (%s): Ei voitu lukea lukua (datarivi %d, kentt? %d).\n" "V??r?nmuotoinen luku tai edellinen rivi liian pitk?." -#: rcompact.c:534 +#: rcompact.c:539 #, c-format msgid "Error reading file %s" msgstr "Virhe luettaessa tiedostoa %s" -#: rcompact.c:541 +#: rcompact.c:546 #, c-format msgid "No data found in file %s" msgstr "Tiedostosta %s ei l?ytynyt dataa" @@ -248,7 +256,11 @@ msgid "'series_index' must be positive" msgstr "'series_index'in t?ytyy olla positiivinen" -#: readloop.c:91 +#: readloop.c:70 +msgid "Number of years exceeds integer range" +msgstr "Vuosien lukum??r? ylitt?? kokonaislukualueen" + +#: readloop.c:93 msgid "no data found in 'x'" msgstr "'x':st? ei l?ytynyt dataa" From noreply at r-forge.r-project.org Tue May 6 16:13:08 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 6 May 2014 16:13:08 +0200 (CEST) Subject: [Dplr-commits] r861 - pkg/dplR Message-ID: <20140506141308.BD678185A70@r-forge.r-project.org> Author: andybunn Date: 2014-05-06 16:13:08 +0200 (Tue, 06 May 2014) New Revision: 861 Modified: pkg/dplR/TODO Log: updating TODO Modified: pkg/dplR/TODO =================================================================== --- pkg/dplR/TODO 2014-05-06 07:10:51 UTC (rev 860) +++ pkg/dplR/TODO 2014-05-06 14:13:08 UTC (rev 861) @@ -1,3 +1,5 @@ +o[mvkorpel] Add option for smooth CI curves from theoretical AR1 in redfit! + * At the moment, in the crossdating functions where a user wants to compare a series to a master chrnology we calculate the master from a rwl object. The pick.rwl.series function was a great improvement to the former method From noreply at r-forge.r-project.org Sat May 10 23:12:04 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 10 May 2014 23:12:04 +0200 (CEST) Subject: [Dplr-commits] r862 - in pkg/dplR: . R man vignettes Message-ID: <20140510211204.A07E1184928@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-10 23:12:04 +0200 (Sat, 10 May 2014) New Revision: 862 Added: pkg/dplR/R/latexify.R pkg/dplR/man/latexDate.Rd pkg/dplR/man/latexify.Rd Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/NAMESPACE pkg/dplR/vignettes/intro-dplR.Rnw pkg/dplR/vignettes/timeseries-dplR.Rnw pkg/dplR/vignettes/xdate-dplR.Rnw Log: Helper functions for vignettes: * latexDate(): Use this to fix date shown in document at Sweave / knit time * latexify(): When you are not directly in control of 'expr' in '\Sexpr{expr}', use '\Sexpr{latexify(expr)}', because as.character(expr) may include characters that cannot be used in LaTeX code unescaped. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-06 14:13:08 UTC (rev 861) +++ pkg/dplR/ChangeLog 2014-05-10 21:12:04 UTC (rev 862) @@ -1,11 +1,21 @@ * CHANGES IN dplR VERSION 1.6.1 +File: NAMESPACE +--------------- + +- Added latexify() and latexDate() to export list + File: common.interval.R ----------------------- - Bug fix: make.plot=TRUE threw an error when input data.frame had leading or trailing all-NA rows +File: latexify.R +---------------- + +- New utility functions latexify() and latexDate() for use in vignettes + Files: rcompact.c, readloop.c ----------------------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-06 14:13:08 UTC (rev 861) +++ pkg/dplR/DESCRIPTION 2014-05-10 21:12:04 UTC (rev 862) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-06 +Date: 2014-05-10 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-05-06 14:13:08 UTC (rev 861) +++ pkg/dplR/NAMESPACE 2014-05-10 21:12:04 UTC (rev 862) @@ -38,7 +38,8 @@ tridas.vocabulary, uuid.gen, wavelet.plot, wc.to.po, write.compact, write.crn, write.rwl, write.tridas, write.tucson, plot.rwl, interseries.cor, summary.rwl, - plot.crn, insert.ring, delete.ring, xskel.ccf.plot, xskel.plot) + plot.crn, insert.ring, delete.ring, xskel.ccf.plot, xskel.plot, + latexify, latexDate) S3method(print, redfit) S3method(plot, rwl) Added: pkg/dplR/R/latexify.R =================================================================== --- pkg/dplR/R/latexify.R (rev 0) +++ pkg/dplR/R/latexify.R 2014-05-10 21:12:04 UTC (rev 862) @@ -0,0 +1,81 @@ +### Helpers for vignettes. + +## Return a string representing the given date(s) (default: current date) +## in the format used by \today in LaTeX. +## Example: latexDate("2013-12-06") returns "December 6, 2013" +latexDate <- function(x = Sys.Date(), ...) { + ltDate <- as.POSIXlt(x, ...) + sprintf("%s %d, %d", + month.name[ltDate[["mon"]] + 1], + ltDate[["mday"]], + 1900 + ltDate[["year"]]) +} + +## Usage: \Sexpr{latexify(string_produced_by_R_code)} +## +## Make arbitrary character() vector compatible with LaTeX by escaping +## special characters, then convert to UTF-8 encoding. Any formatting +## (newlines, tabs, etc.) will be lost. Note that the set of +## characters actually supported depends on the font, LaTeX engine and +## set of packages used. +latexify <- function(x) { + y <- as.character(x) + ## Kludge for converting from "byte" to the current encoding + ## in a way which preserves the hex notation. + encBytes <- Encoding(y) == "bytes" + if (any(encBytes)) { + foo <- character(0) # dummy line + tc <- textConnection("foo", "w", local = TRUE) + sink(tc) + on.exit(sink()) + on.exit(close(tc), add = TRUE) + ## Embedded newlines (if any) in y[encBytes] will not cause + ## line breaks with cat(). + cat(y[encBytes], sep = "\n") + y[encBytes] <- foo + } + ## Convert any sequence of whitespace to a single space. This + ## substitution must be done before control characters because + ## newline belongs to both groups. + y <- gsub("[[:space:]]+", " ", y) + ## Remove control characters + y <- gsub("[[:cntrl:]]", "", y) + ## Escape LaTeX special characters. + ## Source: Scott Pakin (2009) The Comprehensive LaTeX Symbol List. + ## Accessible through "texdoc symbols". + ## Particularly section 8.6 "ASCII and Latin 1 quick reference". + ## + ## The order of the elements in the list matters! + ## First, { and } are replaced with \{ and \}, respectively. + ## Then, \ is replaced with \textbackslash{}, + ## but not if followed by { or }. + ## After that, the order does not matter. + substitutions <- + list(c("\\{", "\\\\{"), + c("\\}", "\\\\}"), + c("\\\\(?!(\\{|\\}))", "\\\\textbackslash{}"), + c("\\#", "\\\\#"), + c("\\$", "\\\\$"), + c("%", "\\\\%"), + c("\\^", "\\\\^{}"), + c("&", "\\\\&"), + c("_", "\\\\_"), + c("~", "\\\\~{}"), + c('"', "\\\\textquotedbl{}"), + c("/", "\\\\slash{}")) + for (subst in substitutions) { + y <- gsub(subst[1], subst[2], y, perl = TRUE) + } + ## gsub() may have changed encodings. Therefore we check them + ## again. + encs <- Encoding(y) + encLatin <- which(encs == "latin1") + if (length(encLatin) > 0) { + y[encLatin] <- iconv(y[encLatin], from = "latin1", to = "UTF-8") + } + encUnknown <- which(encs == "unknown") + if (length(encUnknown) > 0) { + y[encUnknown] <- iconv(y[encUnknown], to = "UTF-8") + } + y +} Added: pkg/dplR/man/latexDate.Rd =================================================================== --- pkg/dplR/man/latexDate.Rd (rev 0) +++ pkg/dplR/man/latexDate.Rd 2014-05-10 21:12:04 UTC (rev 862) @@ -0,0 +1,32 @@ +\name{latexDate} +\alias{latexDate} +\title{ + Date Conversion to Character in LaTeX Format +} +\description{ + This is a simple convenience function that returns a date in the + format used by \samp{\today} in LaTeX. A possible use case is fixing + the date shown in a vignette at weaving time. +} +\usage{ +latexDate(x = Sys.Date(), ...) +} +\arguments{ + \item{x}{ any object for which an \code{as.POSIXlt} method exists. + Defaults to the current date. } + \item{\dots}{ other arguments to \code{as.POSIXlt} } +} +\value{ + A \code{character} vector +} +\author{ + Mikko Korpela +} +\examples{ +latexDate() # today +latexDate(Sys.Date() + 5) # today + 5 days +latexDate(c("2013-12-06", "2014-09-19")) # fixed dates +## [1] "December 6, 2013" "September 19, 2014" +latexDate(5*60*60*24, origin=Sys.Date()) # today + 5 days +} +\keyword{ utilities } Added: pkg/dplR/man/latexify.Rd =================================================================== --- pkg/dplR/man/latexify.Rd (rev 0) +++ pkg/dplR/man/latexify.Rd 2014-05-10 21:12:04 UTC (rev 862) @@ -0,0 +1,74 @@ +\name{latexify} +\alias{latexify} +\title{ + Convert Character Strings for Use with LaTeX +} +\description{ + Some characters cannot be entered directly into a LaTeX document. + This function converts the input \code{character} vector to a form + suitable for inclusion in a LaTeX document in text mode. It can be + used together with \samp{\Sexpr} in vignettes. +} +\usage{ +latexify(x) +} +\arguments{ + \item{x}{ a \code{character} vector } +} +\details{ + + The function is intended for use with unformatted inline text. + Newlines, tabs and other whitespace characters (\code{"[:space:]"} in + \link{regex}) are converted to spaces. Control character + (\code{"[:cntrl:]"}) that are not whitespace are removed. Other + special characters are {, }, \, #, $, \%, ^, &, _, ~, \" and /. They + are converted to the corresponding LaTeX commands. + + Before applying the substitutions described above, input elements with + \code{Encoding} set to \code{"bytes"} are printed and the result is + captured using the current text encoding. The result of this + intermediate stage is ASCII text where some characters are shown as + their byte codes using a hexadecimal pair prefixed with \code{"\\x"}. + This set includes tabs, newlines and control characters. The + substitutions are then applied to the intermediate result. + + Input elements with \code{"unknown"} encoding are assumed to be in the + current encoding. These and \code{"latin1"} encoded elements are + converted to UTF-8. + + Suggested package loading commands in the document preamble + are:\preformatted{\usepackage[T1]{fontenc} \% required for " +\usepackage[utf8]{inputenx} \% UTF-8 input encoding +\input{ix-utf8enc.dfu} \% more supported characters} + +} +\value{ + A \code{character} vector +} +\references{ + Pakin, S. (2009) The Comprehensive LaTeX Symbol + List. \url{http://www.ctan.org/tex-archive/info/symbols/comprehensive} +} +\author{ + Mikko Korpela +} +\examples{ +x1 <- "clich\xe9\nma\xf1ana" +Encoding(x1) <- "latin1" +x1 +x2 <- x1 +Encoding(x2) <- "bytes" +x2 +testStrings <- + c("different kinds\nof\tspace", + "control\a characters \ftoo", + "{braces} and \\\\backslash", + '#various$ \%other^ &characters_ ~escaped"/coded', + x1, + x2) +latexStrings <- latexify(testStrings) +## 5th element should be "UTF-8", the rest "unknown" +Encoding(latexStrings) +cat(latexStrings, sep="\n") +} +\keyword{ utilities } Modified: pkg/dplR/vignettes/intro-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/intro-dplR.Rnw 2014-05-06 14:13:08 UTC (rev 861) +++ pkg/dplR/vignettes/intro-dplR.Rnw 2014-05-10 21:12:04 UTC (rev 862) @@ -6,12 +6,15 @@ \input{ix-utf8enc.dfu} % more characters supported \title{An introduction to dplR} \author{Andy Bunn \and Mikko Korpela} +<<echo=FALSE,results=hide>>= +library(dplR) # latexify(), latexDate() +@ \hypersetup{ pdfauthor = {Andy Bunn; Mikko Korpela}, } -\date{\footnotesize{$ $Processed with dplR +\date{\footnotesize Processed with dplR \Sexpr{packageDescription("dplR", field="Version")} -in \Sexpr{R.version.string} on \today}} +in \Sexpr{latexify(R.version.string)} on \Sexpr{latexDate()}} \begin{document} \bibliographystyle{jss} Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-06 14:13:08 UTC (rev 861) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-10 21:12:04 UTC (rev 862) @@ -6,12 +6,15 @@ \input{ix-utf8enc.dfu} % more characters supported \title{Time Series Analysis in dplR} \author{Andy Bunn \and Mikko Korpela} +<<echo=FALSE,results=hide>>= +library(dplR) # latexify(), latexDate() +@ \hypersetup{ pdfauthor = {Andy Bunn; Mikko Korpela}, } -\date{\footnotesize{$ $Processed with dplR +\date{\footnotesize Processed with dplR \Sexpr{packageDescription("dplR", field="Version")} -in \Sexpr{R.version.string} on \today}} +in \Sexpr{latexify(R.version.string)} on \Sexpr{latexDate()}} \begin{document} \bibliographystyle{jss} Modified: pkg/dplR/vignettes/xdate-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/xdate-dplR.Rnw 2014-05-06 14:13:08 UTC (rev 861) +++ pkg/dplR/vignettes/xdate-dplR.Rnw 2014-05-10 21:12:04 UTC (rev 862) @@ -6,12 +6,15 @@ \input{ix-utf8enc.dfu} % more characters supported \title{Crossdating in dplR} \author{Andy Bunn \and Mikko Korpela} +<<echo=FALSE,results=hide>>= +library(dplR) # latexify(), latexDate() +@ \hypersetup{ pdfauthor = {Andy Bunn; Mikko Korpela}, } -\date{\footnotesize{$ $Processed with dplR +\date{\footnotesize Processed with dplR \Sexpr{packageDescription("dplR", field="Version")} -in \Sexpr{R.version.string} on \today}} +in \Sexpr{latexify(R.version.string)} on \Sexpr{latexDate()}} \begin{document} \bibliographystyle{jss} From noreply at r-forge.r-project.org Sun May 11 00:28:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 11 May 2014 00:28:46 +0200 (CEST) Subject: [Dplr-commits] r863 - in pkg/dplR: R man Message-ID: <20140510222846.BA5ED1873BB@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-11 00:28:45 +0200 (Sun, 11 May 2014) New Revision: 863 Modified: pkg/dplR/R/latexify.R pkg/dplR/man/latexify.Rd Log: "Interestingly", \Sexpr behaves differently in knitr vs Sweave. Added an option, 'doublebackslash', to latexify(). Modified: pkg/dplR/R/latexify.R =================================================================== --- pkg/dplR/R/latexify.R 2014-05-10 21:12:04 UTC (rev 862) +++ pkg/dplR/R/latexify.R 2014-05-10 22:28:45 UTC (rev 863) @@ -18,7 +18,10 @@ ## (newlines, tabs, etc.) will be lost. Note that the set of ## characters actually supported depends on the font, LaTeX engine and ## set of packages used. -latexify <- function(x) { +## +## It seems that Sweave needs doublebackslash = TRUE +## but knitr needs doublebackslash = FALSE. +latexify <- function(x, doublebackslash=TRUE) { y <- as.character(x) ## Kludge for converting from "byte" to the current encoding ## in a way which preserves the hex notation. @@ -66,6 +69,9 @@ for (subst in substitutions) { y <- gsub(subst[1], subst[2], y, perl = TRUE) } + if (isTRUE(doublebackslash)) { + y <- gsub("\\", "\\\\", y, fixed=TRUE) + } ## gsub() may have changed encodings. Therefore we check them ## again. encs <- Encoding(y) Modified: pkg/dplR/man/latexify.Rd =================================================================== --- pkg/dplR/man/latexify.Rd 2014-05-10 21:12:04 UTC (rev 862) +++ pkg/dplR/man/latexify.Rd 2014-05-10 22:28:45 UTC (rev 863) @@ -10,10 +10,13 @@ used together with \samp{\Sexpr} in vignettes. } \usage{ -latexify(x) +latexify(x, doublebackslash = TRUE) } \arguments{ \item{x}{ a \code{character} vector } + \item{doublebackslash}{ a \code{logical} flag. If \code{TRUE}, + backslashes in the output are doubled. It seems that Sweave needs + \code{TRUE} and knitr \code{FALSE}. } } \details{ @@ -66,7 +69,7 @@ '#various$ \%other^ &characters_ ~escaped"/coded', x1, x2) -latexStrings <- latexify(testStrings) +latexStrings <- latexify(testStrings, doublebackslash = FALSE) ## 5th element should be "UTF-8", the rest "unknown" Encoding(latexStrings) cat(latexStrings, sep="\n") From noreply at r-forge.r-project.org Mon May 12 20:53:38 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 12 May 2014 20:53:38 +0200 (CEST) Subject: [Dplr-commits] r864 - in pkg/dplR: . inst inst/doc man Message-ID: <20140512185338.981F6186E4F@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-12 20:53:38 +0200 (Mon, 12 May 2014) New Revision: 864 Added: pkg/dplR/inst/doc/ pkg/dplR/inst/doc/00_INDEX pkg/dplR/inst/doc/build-math-dplR.R pkg/dplR/inst/doc/math-dplR.R pkg/dplR/inst/doc/math-dplR.Rnw.txt pkg/dplR/inst/doc/math-dplR.bib pkg/dplR/inst/doc/math-dplR.pdf Modified: pkg/dplR/.Rbuildignore pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/man/ffcsaps.Rd pkg/dplR/man/gini.coef.Rd Log: Document: Mathematical Details of Functions in dplR (math-dplR.pdf). This is not a vignette, i.e. not listed as a vignette and not built automatically. A build script is provided (build-math-dplR.R). There is a reference to the new document in ?ffcsaps and ?gini.coef. help(package="dplR", help_type="html") shows the document files under "Other files in the doc directory". Andy: If you make changes to the document, please add yourself as an author. In that case, could you also change the first person singular sentences accordingly. Modified: pkg/dplR/.Rbuildignore =================================================================== --- pkg/dplR/.Rbuildignore 2014-05-10 22:28:45 UTC (rev 863) +++ pkg/dplR/.Rbuildignore 2014-05-12 18:53:38 UTC (rev 864) @@ -2,3 +2,7 @@ ^[^/]*\.sh$ ^(.*/)?svn.*\.tmp$ ^(.*/)?\..+$ +^inst/doc/cache(/.*)?$ +^inst/doc/figure(/.*)?$ +^inst/doc/.*\.Rout$ +^.*-tikzDictionary$ Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-10 22:28:45 UTC (rev 863) +++ pkg/dplR/ChangeLog 2014-05-12 18:53:38 UTC (rev 864) @@ -5,6 +5,13 @@ - Added latexify() and latexDate() to export list +File: DESCRIPTION +----------------- + +- New Suggested packages. These are for document building (see + math-dplR.pdf below) and openPDF (math-dplR.pdf is not available through + vignette()) + File: common.interval.R ----------------------- @@ -16,6 +23,32 @@ - New utility functions latexify() and latexDate() for use in vignettes +New files in subdirectory inst/doc: +----------------------------------- + +- math-dplR.pdf is a vignette-ish document about the mathematical details + of some dplR functions (room for expansion in the future). It is + packaged as a static PDF due to the long build time. However, the + source is available as required by the CRAN policies for an open + source package. Arguably the staticness also makes sense in light of + the document presenting non-changing information about the package. If + the functions analyzed in the document change fundamentally (which is not + to be expected), the relevant parts of the document must be rewritten + and the document recompiled. Compare this to the idea that regular + vignettes usually include concrete examples about how the package can be + used. In that case it makes sense to compile the document often to + verify that the examples work. + +- math-dplR.Rnw.txt is the source of math-dplR.pdf, with extra file + extension .txt to prevent automatic rebuild by R CMD build and R CMD + check + +- math-dplR.bib is the BibTeX bibliography of the document + +- math-dplR.R is the R source extracted from the document + +- build-math-dplR.R is a build script + Files: rcompact.c, readloop.c ----------------------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-10 22:28:45 UTC (rev 863) +++ pkg/dplR/DESCRIPTION 2014-05-12 18:53:38 UTC (rev 864) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-10 +Date: 2014-05-12 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", @@ -21,7 +21,8 @@ Imports: gmp (>= 0.5-2), graphics, grDevices, grid, stats, utils, digest (>= 0.2.3), lattice (>= 0.13-6), stringr (>= 0.4), XML (>= 2.1-0) -Suggests: foreach, forecast, iterators, RUnit (>= 0.4.25), waveslim +Suggests: Biobase, dichromat, foreach, forecast, iterators, knitr, + RUnit (>= 0.4.25), tikzDevice, waveslim Description: This package contains functions for performing tree-ring analyses, IO, and graphics. LazyData: no Property changes on: pkg/dplR/inst/doc ___________________________________________________________________ Added: svn:ignore + svn*.tmp .* *~ cache figure *.Rout *-tikzDictionary *.aux *.bbl *.blg *.fdb_latexmk *.glo *.gls *.glg *.idx *.ind *.ilg *.lof *.log *.lot *.out *.synctex.gz *.tex *.toc Added: pkg/dplR/inst/doc/00_INDEX =================================================================== --- pkg/dplR/inst/doc/00_INDEX (rev 0) +++ pkg/dplR/inst/doc/00_INDEX 2014-05-12 18:53:38 UTC (rev 864) @@ -0,0 +1,5 @@ +build-math-dplR.R Build script for math-dplR.pdf +math-dplR.bib BibTeX bibliography +math-dplR.pdf Document: Mathematical Details of Functions in dplR +math-dplR.R R code extracted from math-dplR.Rnw.txt +math-dplR.Rnw.txt Literate programming source of math-dplR.pdf Property changes on: pkg/dplR/inst/doc/00_INDEX ___________________________________________________________________ Added: svn:eol-style + native Added: pkg/dplR/inst/doc/build-math-dplR.R =================================================================== --- pkg/dplR/inst/doc/build-math-dplR.R (rev 0) +++ pkg/dplR/inst/doc/build-math-dplR.R 2014-05-12 18:53:38 UTC (rev 864) @@ -0,0 +1,42 @@ +### Script for compiling math-dplR.pdf +### +### Run with 'source("build-math-dplR.R")' in R prompt or 'R CMD BATCH +### build-math-dplR.R' on the command line, where the initial R is the +### command to launch R. +### +### Written by Mikko Korpela +SOURCE_NAME <- "math-dplR" +SOURCE_EXT <- "Rnw" +DUMMY_EXT <- "txt" +CLEAN <- TRUE + +builder <- function(sourceName, sourceExt, dummyExt, clean) { + sourceFile <- paste0(sourceName, ".", sourceExt) + regExt <- sprintf("\\.%s$", sourceExt) + texFile <- sub(regExt, ".tex", sourceFile) + pdfFile <- sub(regExt, ".pdf", sourceFile) + + if (!file.exists(sourceFile)) { + dummyFile <- paste0(sourceFile, ".", dummyExt) + if (!file.exists(dummyFile)) { + stop(sprintf("File does not exist: %s", dummyFile)) + } else { + message(sprintf("Temporarily copying %s to %s", + dummyFile, sourceFile)) + file.copy(dummyFile, sourceFile) + on.exit(unlink(sourceFile)) + } + } + + if (!require(knitr)) { + stop("Please install knitr") + } + knit(sourceFile, encoding = "UTF-8", envir=globalenv()) # produces .tex + if (isTRUE(clean)) { + on.exit(unlink(texFile), add = TRUE) # remove .tex at exit + } + purl(sourceFile) # produces .R + tools::texi2pdf(texFile, clean=isTRUE(clean)) # produces .pdf + tools::compactPDF(pdfFile, gs_quality = "ebook") +} +builder(SOURCE_NAME, SOURCE_EXT, DUMMY_EXT, CLEAN) Property changes on: pkg/dplR/inst/doc/build-math-dplR.R ___________________________________________________________________ Added: svn:eol-style + native Added: pkg/dplR/inst/doc/math-dplR.R =================================================================== --- pkg/dplR/inst/doc/math-dplR.R (rev 0) +++ pkg/dplR/inst/doc/math-dplR.R 2014-05-12 18:53:38 UTC (rev 864) @@ -0,0 +1,504 @@ + +## ----"try-matlab", echo=FALSE, results="hide"---------------------------- +TRY_MATLAB <- TRUE + + +## ----"flip-to-retry", echo=FALSE, results="hide", cache=TRUE------------- +"tails" + + +## ----"packages", echo=FALSE, results="hide"------------------------------ +library(dplR) # latexify(), latexDate() +latexify2 <- function(x) latexify(x, doublebackslash = FALSE) +library(dichromat) +library(graphics) +library(stats) + + + + +## ----"knitr-init-fig", echo=FALSE, cache=FALSE--------------------------- +PAGE_WIDTH <- 4.74 +PAGE_HEIGHT <- 8.22 +opts_template$set(myfigures=list(fig.path = "figure/", fig.pos = "tbp", + fig.align = "center", fig.lp = "fig:", dev = "tikz")) + + +## ----"response-comp-init"------------------------------------------------ +## Helper function used in ffcsaps2 +inc <- function(from, to) { + if (is.numeric(to) && is.numeric(from) && to >= from) { + seq(from=from, to=to) + } else { + integer(length=0) + } +} +## Copied from ffcsaps() in dplR/R/ffcsaps.R, +## with the following additions: +## - As an alternative to nyrs and f, smoothing parameter p +## can be directly specified as an argument to the function +## - altP = TRUE activates a different (incompatible) formula +## for computing p as a function of nyrs and f +ffcsaps2 <- function(y, x=seq_along(y), nyrs=length(y)/2, f=0.5, + p, altP = FALSE) { +### support functions + ffppual <- function(breaks, c1, c2, c3, c4, x, left){ + if (left){ + ix <- order(x) + x2 <- x[ix] + } else{ + x2 <- x + } + + n.breaks <- length(breaks) + if (left) { + ## index[i] is maximum of a and b: + ## a) number of elements in 'breaks[-n.breaks]' that are + ## less than or equal to x2[i], + ## b) 1 + index <- pmax(ffsorted(breaks[-n.breaks], x2), 1) + } else { + ## index[i] is: + ## 1 + number of elements in 'breaks[-1]' that are + ## less than x2[i] + index <- ffsorted2(breaks[-1], x2) + } + + x2 <- x2 - breaks[index] + v <- x2 * (x2 * (x2 * c1[index] + c2[index]) + c3[index]) + c4[index] + + if (left) + v[ix] <- v + v + } + + ffsorted <- function(meshsites, sites) { + index <- order(c(meshsites, sites)) + which(index > length(meshsites)) - seq_along(sites) + } + + ffsorted2 <- function(meshsites, sites) { + index <- order(c(sites, meshsites)) + which(index <= length(sites)) - seq(from=0, to=length(sites)-1) + } + + ## Creates a sparse matrix A of size n x n. + ## The columns of B are set to the diagonals of A so that column k + ## becomes the diagonal in position d[k] relative to the main + ## diagonal (zero d[k] is the main diagonal, positive d[k] is + ## above, negative is below the main diagonal). + ## A value on column j in A comes from row j in B. + ## This is similar in function to spdiags(B, d, n, n) in MATLAB. + spdiags <- function(B, d, n) { + n.d <- length(d) + A <- matrix(0, n.d * n, 3) + count <- 0 + for(k in seq_len(n.d)){ + this.diag <- d[k] + i <- inc(max(1, 1 - this.diag), min(n, n - this.diag)) # row + n.i <- length(i) + if(n.i > 0){ + j <- i + this.diag # column + row.idx <- seq(from=count+1, by=1, length.out=n.i) + A[row.idx, 1] <- i + A[row.idx, 2] <- j + A[row.idx, 3] <- B[j, k] + count <- count + n.i + } + } + A <- A[A[, 3] != 0, , drop=FALSE] + A[order(A[, 2], A[, 1]), , drop=FALSE] + } + +### start main function + + y2 <- as.numeric(y) + ## If as.numeric() does not signal an error, it is unlikely that + ## the result would not be numeric, but... + if(!is.numeric(y2)) stop("'y' must be coercible to a numeric vector") + x2 <- as.numeric(x) + if(!is.numeric(x2)) stop("'x' must be coercible to a numeric vector") + + n <- length(x2) + ## quick error check + if (n < 3) stop("there must be at least 3 data points") + if (missing(p)) { + if(!is.numeric(f) || length(f) != 1 || f < 0 || f > 1) + stop("'f' must be a number between 0 and 1") + if(!is.numeric(nyrs) || length(nyrs) != 1 || nyrs <= 1) + stop("'nyrs' must be a number greater than 1") + } + + ix <- order(x2) + zz1 <- n - 1 + xi <- x2[ix] + zz2 <- n - 2 + diff.xi <- diff(xi) + + ## quick error check + if (any(diff.xi == 0)) stop("the data abscissae must be distinct") + + yn <- length(y2) + + ## quick error check + if (n != yn) + stop("abscissa and ordinate vector must be of the same length") + + arg2 <- -1:1 + odx <- 1 / diff.xi + R <- spdiags(cbind(c(diff.xi[-c(1, zz1)], 0), + 2 * (diff.xi[-1] + diff.xi[-zz1]), + c(0, diff.xi[-c(1, 2)])), + arg2, zz2) + R2 <- spdiags(cbind(c(odx[-zz1], 0, 0), + c(0, -(odx[-1] + odx[-zz1]), 0), + c(0, 0, odx[-1])), + arg2, n) + R2[, 1] <- R2[, 1] - 1 + forR <- matrix(0, zz2, zz2) + forR2 <- matrix(0, zz2, n) + forR[R[, 1] + (R[, 2] - 1) * zz2] <- R[, 3] + forR2[R2[, 1] + (R2[, 2] - 1) * zz2] <- R2[, 3] + if (!missing(p)) { + ## NEW: give value of p directly as an argument + p.inv <- 1 / p + } else if (altP) { + ## NEW: what if the value of p was computed with the formula + ## from Cook and Kairiukstis (1990). + p.inv <- (1 - f) * (cos(2 * pi / nyrs) + 2) / + (6 * (cos(2 * pi / nyrs) - 1) ^ 2) / f + p <- 1 / p.inv + } else { + ## The following order of operations was tested to be relatively + ## accurate across a wide range of f and nyrs + p.inv <- (1 - f) * (cos(2 * pi / nyrs) + 2) / + (12 * (cos(2 * pi / nyrs) - 1) ^ 2) / f + 1 + p <- 1 / p.inv + } + yi <- y2[ix] + mplier <- 6 - 6 / p.inv # slightly more accurate than 6*(1-1/p.inv) + ## forR*p is faster than forR/p.inv, and a quick test didn't + ## show any difference in the final spline + u <- solve(mplier * tcrossprod(forR2) + forR * p, + diff(diff(yi) / diff.xi)) + yi <- yi - mplier * diff(c(0, diff(c(0, u, 0)) / diff.xi, 0)) + test0 <- xi[-c(1, n)] + c3 <- c(0, u / p.inv, 0) + x3 <- c(test0, seq(from=xi[1], to=xi[n], length = 101)) + cc.1 <- diff(c3) / diff.xi + cc.2 <- 3 * c3[-n] + cc.3 <- diff(yi) / diff.xi - diff.xi * (2 * c3[-n] + c3[-1]) + cc.4 <- yi[-n] + to.sort <- c(test0, x3) + ix.final <- order(to.sort) + sorted.final <- to.sort[ix.final] + tmp <- + unique(data.frame(sorted.final, + c(ffppual(xi, cc.1,cc.2,cc.3,cc.4, test0, FALSE), + ffppual(xi, cc.1,cc.2,cc.3,cc.4, x3, TRUE))[ix.final])) + ## get spline on the right timescale - kludgy + tmp2 <- tmp + tmp2[[1]] <- round(tmp2[[1]], 5) # tries to deal with identical() issues + res <- tmp2[[2]][tmp2[[1]] %in% x2] + ## deals with identical() issues via linear approx + if(length(res) != n) + res <- approx(x=tmp[[1]], y=tmp[[2]], xout=x2)$y + res +} + + +## ----"response-init"----------------------------------------------------- +## Cook, E. R. and Kairiukstis, L. A. (1990) Methods of +## Dendrochronology: Applications in the Environmental Sciences. +## Cook, E. R. and Peters, K. (1981) The smoothing spline: a new +## approach to standardizing forest interior tree-ring width series +## for dendroclimatic studies +## (altP = TRUE) +pCook <- function(nyrs, f = 0.5) { + p.inv <- (1 - f) * (cos(2 * pi / nyrs) + 2) / + (6 * (cos(2 * pi / nyrs) - 1) ^ 2) / f + p <- 1 / p.inv + p +} +## Frequency response according to Cook and Kairiukstis (citing Cook +## and Peters) +respCook <- function(f, p) { + pif2 <- 2 * pi * f + 1 - 1 / (1 + (p * (cos(pif2) + 2)) / (6 * (cos(pif2) - 1)^2)) +} + + +## ----"response-comp", message=FALSE, dependson="response-comp-init", cache.vars=c("response1", "response2", "NYRS", "nFreq")---- +N <- 1536 +K <- 500 +NYRS <- c(4, 16, 64) +nFreq <- N / 2 + 1 +halfseq <- seq_len(nFreq) + +ratio1 <- array(NA_real_, c(nFreq, K, length(NYRS))) +ratio2 <- array(NA_real_, c(nFreq, K, length(NYRS))) + +if (!exists(".Random.seed", globalenv(), mode="numeric")) { + foo <- sample(TRUE) +} +seed <- get(".Random.seed", globalenv()) +rng <- RNGversion("2.15.0") +set.seed(123) + +## Because this takes a long time, progress messages will be printed +updates <- round(c(0.002, 0.02, seq_len(9)/10) * K) +updates <- updates[updates >= 1] +upIdx <- 1 +time0 <- Sys.time() +message(sprintf("Starting spline frequency response test at %s", + format(time0, "%X"))) +message("Progress messages will be printed along the way.") +for (k in seq_len(K)) { + x <- rnorm(N) + fftx <- abs(fft(x))[halfseq] + for (j in seq_along(NYRS)) { + nyrs <- NYRS[j] + spline1 <- ffcsaps2(x, nyrs = nyrs, altP = FALSE) + spline2 <- ffcsaps2(x, nyrs = nyrs, altP = TRUE) + fft1 <- abs(fft(spline1))[halfseq] + fft2 <- abs(fft(spline2))[halfseq] + ratio1[, k, j] <- fft1 / fftx + ratio2[, k, j] <- fft2 / fftx + } + if (length(updates) >= upIdx && k == updates[upIdx]) { + upIdx <- upIdx + 1 + timeNow <- Sys.time() + timeElapsed <- difftime(timeNow, time0, units = "mins") + timePerRound <- timeElapsed / k + roundsLeft <- K - k + timeLeft <- roundsLeft * timePerRound + timeAtFinish <- timeNow + timeLeft + message(sprintf(paste0("%4.1f%% done. ", + "Estimated completion at %s (%.0f mins left)"), + k / K * 100, + format(timeAtFinish, "%X"), + as.numeric(timeLeft))) + } +} +message("Finished.") + +RNGkind(rng[1], rng[2]) +assign(".Random.seed", seed, globalenv()) + +response1 <- matrix(NA_real_, nFreq, 3) +response2 <- matrix(NA_real_, nFreq, 3) +colnames(response1) <- NYRS +colnames(response2) <- NYRS +for (j in seq_along(NYRS)) { + response1[, j] <- rowMeans(ratio1[, , j]) + response2[, j] <- rowMeans(ratio2[, , j]) +} + + +## ----"ffcsaps-caption", cache=FALSE-------------------------------------- +FFCSAPS_CAPTION <- + paste("Theoretical frequency response of spline filter vs response", + "with i.i.d. normal series of 1536 samples (mean of 500 repeats)", + "using \\texttt{ffcsaps}. The legend on the bottom panel applies to", + "all panels. The blue circles were obtained by", + "using~\\eqref{eq:pinv.code} for computing (inverse) \\texttt{p} in", + "\\texttt{ffcsaps}. The orange crosses show the results", + "when~\\eqref{eq:pinv.book} is used instead.") + + +## ----"response", opts.label="myfigures", fig.width=PAGE_WIDTH, fig.height=PAGE_HEIGHT-0.95, fig.cap=FFCSAPS_CAPTION, dependson=c("response-init", "response-comp"), cache.vars=character(0)---- +op <- par(mfcol = c(3, 1), mgp = c(2, 0.75, 0), mar = par("mar") - 1) + +COLOR_1 <- colorschemes$Categorical.12[10] +COLOR_2 <- colorschemes$Categorical.12[2] +COLOR_LINE <- colorschemes$Categorical.12[6] +LWD <- 3 +PCH_1 <- 1 +PCH_2 <- 4 +fftFreq <- seq(from = 0, to = 0.5, length.out = nFreq) +for (j in seq_along(NYRS)) { + plot(fftFreq, response1[, j], type = "n", + xlab = "Frequency (1 / year)", ylab = "Amplitude response", + main = sprintf("\\texttt{nyrs} = %d, \\texttt{f} = 0.5", NYRS[j])) + points(fftFreq, response2[, j], pch = PCH_2, col = COLOR_2) + points(fftFreq, response1[, j], pch = PCH_1, col = COLOR_1) + lines(fftFreq, respCook(fftFreq, pCook(NYRS[j])), col = COLOR_LINE, + lwd = LWD) + abline(h = 0.5, lty = "dashed") + abline(v = 1 / NYRS[j], lty = "dashed") + text(0.35, 0.5, "50\\% response", pos = 1, offset=1) + text(1 / NYRS[j], 0.6, + sprintf("%d yr period", NYRS[j]), + pos = 4, srt = 90, offset=1) +} +legend("topright", bg = "white", + legend = c("Simulation (\\texttt{p} from \\texttt{ffcsaps()})", + "Simulation (\\texttt{p} from Cook and Peters)", + "Theoretical (Cook and Peters))"), + col = c(COLOR_1, COLOR_2, COLOR_LINE), + lty = c(NA, NA, "solid"), pch = c(PCH_1, PCH_2, NA), + lwd = c(1, 1, LWD)) +par(op) + + +## ----"smoothed-R", dependson="response-comp-init", cache.vars=c("smoothed.R", "y")---- +if (!exists(".Random.seed", globalenv(), mode="numeric")) { + foo <- sample(TRUE) +} +seed <- get(".Random.seed", globalenv()) +rng <- RNGversion("2.15.0") +set.seed(234) + +## Sine wave with added noise +y <- 5 * sin(seq(from = 0, to = 6*pi, length.out = 101)[-101]) + rnorm(100) + +RNGkind(rng[1], rng[2]) +assign(".Random.seed", seed, globalenv()) + +## Smoothing parameter used with csaps and ffcsaps modified to accept p +## 0, 0.01, 0.02, ..., 0.98, 0.99, 1 +P <- seq(0, 100) / 100 + +## Columns of the matrices correspond to elements of P +smoothed.R <- matrix(0, length(y), length(P)) +for (i in seq_along(P)) { + smoothed.R[, i] <- ffcsaps2(y, p = P[i]) +} + + +## ----"smoothed-matlab", dependson=c("smoothed-R", "flip-to-retry"), cache.vars=c("matlabValue", "matlabVersion", "smoothed.matlab")---- +if (isTRUE(TRY_MATLAB)) { + fnames <- tempfile(pattern=c("a", "b", "c"), fileext=".txt") + fname1 <- fnames[1] # input series y + fname2 <- fnames[2] # smoothed series from MATLAB + fname3 <- fnames[3] # MATLAB version + writeLines(as.character(y), fname1) + + ## System call to MATLAB. + ## Requirement: MATLAB with Curve Fitting Toolbox. + matlabCall <- + paste0("matlab -nodisplay -nojvm ", + shQuote(paste0("-r \"", + "x=1:100;", + "P=(0:100)/100;", + "fname1 = '", fname1, "';", + "y=load(fname1);", + "Y=zeros(100,101);", + "try,", + "for i=1:101, Y(:,i) = csaps(x,y,P(i),x); end,", + "catch e, exit(1), end;", + "fname2 = '", fname2, "';", + "fname3 = '", fname3, "';", + "save(fname2, 'Y', '-ascii');", + "fid=fopen(fname3, 'w', 'n', 'UTF-8');", + "fprintf(fid, '%s\\n', version);", + "fclose(fid);", + "exit\""))) + matlabValue <- + system(matlabCall, ignore.stdout = TRUE, ignore.stderr = TRUE) + if (matlabValue != 0) { + smoothed.matlab <- NULL + matlabVersion <- NULL + } else { + smoothed.matlab <- as.matrix(read.table(fname2)) + con <- file(fname3, "r", encoding="UTF-8") + matlabVersion <- readLines(con) + close(con) + } + unlink(fnames) +} else { + matlabValue <- NULL + smoothed.matlab <- NULL + matlabVersion <- "8.3.0.532 (R2014a)" # tested ok on 2014-05-12 +} + + +## ----"R-matlab-compare", cache=FALSE, error=FALSE------------------------ +if (isTRUE(TRY_MATLAB) && matlabValue == 0) { + stopifnot(identical(as.numeric(dim(smoothed.R)), c(100, 101)), + identical(as.numeric(dim(smoothed.matlab)), c(100, 101))) + + ## Compare Matlab and R results with all.equal, one column (value of + ## smoothing parameter from P) at a time + allEqual <- logical(101) + for (i in seq_len(101)) { + allEqual[i] <- isTRUE(all.equal(smoothed.matlab[, i], smoothed.R[, i])) + } + ## A difference in spline smoothing results between dplR and MATLAB + ## (when results from MATLAB are available) will stop the document + ## from compiling. + stopifnot(all(allEqual)) +} + + +## ----"smoothed-caption", cache=FALSE------------------------------------- +SMOOTHED_CAPTION <- + paste("Spline with different values of smoothing parameter", + "\\texttt{p} fitted to a noisy sine wave") + + +## ----"smoothed", opts.label="myfigures", fig.width=PAGE_WIDTH, fig.height=PAGE_WIDTH, fig.cap=SMOOTHED_CAPTION, dependson="smoothed-R", cache.vars=character(0)---- +## Plot the input series and a few output series +COLORS <- c("black", colorschemes$Categorical.12[c(10, 2, 6, 8)]) +mar <- par("mar") +mar <- mar - 1.5 +mar[1] <- mar[1] - 0.3 +mar[3] <- mar[3] + 0.3 +op <- par(lwd = 3, mgp = c(2, 0.75, 0), xpd = NA, mar = mar) +plot(smoothed.R[, 101], ylab = "", col = COLORS[1]) +LTY <- c("solid", "solid", "dashed", "solid") +lines(smoothed.R[, 91], col = COLORS[2], lty=LTY[1]) +lines(smoothed.R[, 51], col = COLORS[3], lty=LTY[2]) +lines(smoothed.R[, 11], col = COLORS[4], lty=LTY[3]) +lines(smoothed.R[, 1], col = COLORS[5], lty=LTY[4]) +usr <- par("usr") +legend(usr[1], usr[4], xjust = 0, yjust = 0, cex = 0.85, + legend = paste("\\texttt{p} =", + c("1 (input)", "0.9", "0.5", "0.1", "0")), + col = COLORS, + lty = c(NA, LTY), + pch = c(1, rep.int(NA, 4)), ncol = 3, + bty = "n") +par(op) + + +## ----"matlab-version", cache=FALSE--------------------------------------- +if (isTRUE(TRY_MATLAB) && matlabValue == 0) { + matlabVersionText <- paste0("(version ", latexify2(matlabVersion), ")") +} + + +## ----"matlab-note", cache=FALSE, message=FALSE--------------------------- +matlabNoteText <- if (!isTRUE(TRY_MATLAB)) { + message(paste("Set TRY_MATLAB=TRUE and re-knit the document to repeat the comparison.", + "MATLAB with Curve Fitting Toolbox required.", sep="\n")) + "" +} else if (matlabValue != 0) { + if (matlabValue == 127) { + msg <- "MATLAB could not be run." + LaTeXmsg <- "\\textsc{matlab} could not be run." + } else if (matlabValue == 1) { + msg <- "Function csaps in MATLAB could not be run." + LaTeXmsg <- + "Function \\texttt{csaps} in \\textsc{matlab} could not be run." + } else { + msg <- "Unexpected problem with system(\"matlab...\")." + LaTeXmsg <- "Unexpected problem with \\texttt{system(\"matlab...\")}." + } + message(msg) + sprintf(paste0("\\textbf{", + "A problem occurred when the document was compiled:", + "} \\textcolor{red}{%s}"), LaTeXmsg) +} else { + "The result was reproduced when this document was compiled." +} + + +## ----gini-rmd, echo=TRUE, tidy=FALSE, cache=FALSE------------------------ +## Gini index is one half of relative mean difference. +## x should not have NA values. +gini.rmd <- function(x) { + mean(abs(outer(x, x, "-"))) / mean(x) * 0.5 +} + + Added: pkg/dplR/inst/doc/math-dplR.Rnw.txt =================================================================== --- pkg/dplR/inst/doc/math-dplR.Rnw.txt (rev 0) +++ pkg/dplR/inst/doc/math-dplR.Rnw.txt 2014-05-12 18:53:38 UTC (rev 864) @@ -0,0 +1,907 @@ +% -*- mode: noweb; noweb-default-code-mode: R-mode; -*- +%\VignetteIndexEntry{Mathematical Details of Functions in dplR} +%\VignetteEngine{knitr::knitr} +% +% Using \Vignette* directives above as if this was a regular vignette. +% However, processing the document takes a long time (~ 50 minutes on +% an Intel i5-3470 CPU) and an external non-free program (MATLAB) is +% suggested (see below). Therefore a static PDF is provided instead +% of compiling the document every time when R CMD build or R CMD check +% is run on the package. +% +% Build instructions (or go straight to build-math-dplR.R) +% +% 0. Rename this file to math-dplR.Rnw +% +% 1. Compile ("knit") with knitr (R prompt). +% library(knitr) +% knit("math-dplR.Rnw", encoding = "UTF-8") +% purl("math-dplR.Rnw") # optional, extracts R code +% NOTE that files will be created in the current working directory and +% its subdirectories "cache" and "figures". +% +% 2. Compile the file to .pdf (R prompt). +% tools::texi2pdf("math-dplR.tex") +% +% Additionally, the .pdf file may be compacted by running +% tools::compactPDF("math-dplR.pdf", gs_quality = "ebook") +% +% Requirements +% +% 1. For knitting: +% - R packages "dichromat", "dplR" (this package), "knitr" and "tikzDevice" +% - R packages "graphics" and "stats" which should always be available +% - Suggested: MATLAB with Curve Fitting Toolbox (system() call to "matlab") +% +% NOTE: MATLAB is used for checking the equivalence of results from +% ffcsaps in dplR and csaps in MATLAB. If TRY_MATLAB (below) is FALSE, +% the comparison will be skipped which will be noted in the +% document. A flip of coin (any change) is needed in the +% "flip-to-retry" chunk below to invalidate the cached (possibly +% failed / skipped) result of the comparison. +% +% 2. For LaTeXing +% - a modern TeX distribution, e.g. TeX Live. +% - required packages are listed below (\usepackage). The xcolor +% package is also needed. The required packages also have other +% dependencies which increases the total number of packages +% required. A TeX Live installation, for example, should have all of +% the required packages. + +<<"try-matlab", echo=FALSE, results="hide">>= +TRY_MATLAB <- TRUE +@ +<<"flip-to-retry", echo=FALSE, results="hide", cache=TRUE>>= +"tails" +@ +<<"packages", echo=FALSE, results="hide">>= +library(dplR) # latexify(), latexDate() +latexify2 <- function(x) latexify(x, doublebackslash = FALSE) +library(dichromat) +library(graphics) +library(stats) +@ + +\documentclass[a4paper]{article} + +\usepackage[T1]{fontenc} +\usepackage[utf8]{inputenx} +\usepackage[english]{babel} +\usepackage{amsmath} +\usepackage{amsfonts} +\usepackage{hyperref} +\usepackage{tikz} +\usetikzlibrary{shapes.misc,patterns,decorations.pathreplacing} +\hypersetup{ + pdfauthor = {Mikko Korpela}, +} +\makeatletter +\AtBeginDocument{ + \hypersetup{ + pdftitle = {\@title}, + pdfsubject = {Dendrochronology Program Library in R}, + pdfkeywords = {dendrochronology, dplR, R, Gini, Spline}, + } +} +\makeatother + +\title{Mathematical Details of Functions in dplR} +\author{Mikko Korpela} +\date{\small Processed in \Sexpr{latexify2(R.version.string)} on + \Sexpr{latexDate()}} + +\begin{document} +\maketitle + +% This initialization chunk is probably not interesting for people +% extracting the R code from the document. Therefore purl=FALSE. +<<"knitr-init", echo=FALSE, cache=FALSE, purl=FALSE>>= +## Use xcolor instead of color. +## This kludge removes the following warning: +## Package xcolor Warning: Incompatible color definition on input line xx. +## where xx is a line number of the .tex file produced by knitr. +## Another solution is to put something like +## \definecolor{fgcolor}{rgb}{0.345, 0.345, 0.345} +## after the line where tikz and xcolor (loaded by tikz) are loaded. +## This substitution of color with xcolor (although a bit ugly) +## looks neater to me. +knit_hooks$set(document = function(x) { + sub("(\\usepackage(\\[[^]]*\\])?)\\{color\\}", "\\1{xcolor}", x) +}) +opts_chunk$set(cache = 2) +opts_chunk$set(echo = FALSE) +opts_chunk$set(cache.path = "cache/") # default (at the time of writing) +@ + +% Figure sizes and device used may be interesting. Therefore we keep +% the default (TRUE) value of the purl option. Compare to the chunk +% above where purl=FALSE. +<<"knitr-init-fig", echo=FALSE, cache=FALSE>>= +PAGE_WIDTH <- 4.74 +PAGE_HEIGHT <- 8.22 +opts_template$set(myfigures=list(fig.path = "figure/", fig.pos = "tbp", + fig.align = "center", fig.lp = "fig:", dev = "tikz")) +@ + +<<"response-comp-init">>= +## Helper function used in ffcsaps2 +inc <- function(from, to) { + if (is.numeric(to) && is.numeric(from) && to >= from) { + seq(from=from, to=to) + } else { + integer(length=0) + } +} +## Copied from ffcsaps() in dplR/R/ffcsaps.R, +## with the following additions: +## - As an alternative to nyrs and f, smoothing parameter p +## can be directly specified as an argument to the function +## - altP = TRUE activates a different (incompatible) formula +## for computing p as a function of nyrs and f +ffcsaps2 <- function(y, x=seq_along(y), nyrs=length(y)/2, f=0.5, + p, altP = FALSE) { +### support functions + ffppual <- function(breaks, c1, c2, c3, c4, x, left){ + if (left){ + ix <- order(x) + x2 <- x[ix] + } else{ + x2 <- x + } + + n.breaks <- length(breaks) + if (left) { + ## index[i] is maximum of a and b: + ## a) number of elements in 'breaks[-n.breaks]' that are + ## less than or equal to x2[i], + ## b) 1 + index <- pmax(ffsorted(breaks[-n.breaks], x2), 1) + } else { + ## index[i] is: + ## 1 + number of elements in 'breaks[-1]' that are + ## less than x2[i] + index <- ffsorted2(breaks[-1], x2) + } + + x2 <- x2 - breaks[index] + v <- x2 * (x2 * (x2 * c1[index] + c2[index]) + c3[index]) + c4[index] + + if (left) + v[ix] <- v + v + } + + ffsorted <- function(meshsites, sites) { + index <- order(c(meshsites, sites)) + which(index > length(meshsites)) - seq_along(sites) + } + + ffsorted2 <- function(meshsites, sites) { + index <- order(c(sites, meshsites)) + which(index <= length(sites)) - seq(from=0, to=length(sites)-1) + } + + ## Creates a sparse matrix A of size n x n. + ## The columns of B are set to the diagonals of A so that column k + ## becomes the diagonal in position d[k] relative to the main + ## diagonal (zero d[k] is the main diagonal, positive d[k] is + ## above, negative is below the main diagonal). + ## A value on column j in A comes from row j in B. + ## This is similar in function to spdiags(B, d, n, n) in MATLAB. + spdiags <- function(B, d, n) { + n.d <- length(d) + A <- matrix(0, n.d * n, 3) + count <- 0 + for(k in seq_len(n.d)){ + this.diag <- d[k] + i <- inc(max(1, 1 - this.diag), min(n, n - this.diag)) # row + n.i <- length(i) + if(n.i > 0){ + j <- i + this.diag # column + row.idx <- seq(from=count+1, by=1, length.out=n.i) + A[row.idx, 1] <- i + A[row.idx, 2] <- j + A[row.idx, 3] <- B[j, k] + count <- count + n.i + } + } + A <- A[A[, 3] != 0, , drop=FALSE] + A[order(A[, 2], A[, 1]), , drop=FALSE] + } + +### start main function + + y2 <- as.numeric(y) + ## If as.numeric() does not signal an error, it is unlikely that + ## the result would not be numeric, but... + if(!is.numeric(y2)) stop("'y' must be coercible to a numeric vector") + x2 <- as.numeric(x) [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/dplr -r 864 From noreply at r-forge.r-project.org Tue May 13 17:10:05 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 13 May 2014 17:10:05 +0200 (CEST) Subject: [Dplr-commits] r865 - in pkg/dplR: . R man Message-ID: <20140513151005.3934018045C@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-13 17:10:04 +0200 (Tue, 13 May 2014) New Revision: 865 Added: pkg/dplR/R/rasterPlot.R Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/NAMESPACE pkg/dplR/R/wavelet.plot.R pkg/dplR/man/wavelet.plot.Rd Log: Added possibility to do .filled.contour() as a raster image in wavelet.plot() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-12 18:53:38 UTC (rev 864) +++ pkg/dplR/ChangeLog 2014-05-13 15:10:04 UTC (rev 865) @@ -4,13 +4,15 @@ --------------- - Added latexify() and latexDate() to export list +- Import readPNG from png. File: DESCRIPTION ----------------- -- New Suggested packages. These are for document building (see - math-dplR.pdf below) and openPDF (math-dplR.pdf is not available through - vignette()) +- New Suggested packages: Biobase, dichromat, knitr, tikzDevice. + These are for document building (see math-dplR.pdf below) and + openPDF (math-dplR.pdf is not available through vignette()) +- New Imported package: png. File: common.interval.R ----------------------- @@ -49,6 +51,13 @@ - build-math-dplR.R is a build script +New file rasterPlot.R +--------------------- + +- New function rasterPlot(), internal to the package. Adds a + raster image drawn with low level graphics commands to the current + high level plot. + Files: rcompact.c, readloop.c ----------------------------- @@ -62,6 +71,13 @@ will speed up otherwise unbearable computation times on some systems. +File: wavelet.plot.R +-------------------- + +- Added two options to wavelet.plot(). + 'useRaster': draw the filled contours as a raster image? (default 'FALSE') + 'res': resolution of the filled contours when 'useRaster' is 'TRUE' + * CHANGES IN dplR VERSION 1.6.0 File: TODO Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-12 18:53:38 UTC (rev 864) +++ pkg/dplR/DESCRIPTION 2014-05-13 15:10:04 UTC (rev 865) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-12 +Date: 2014-05-13 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", @@ -19,10 +19,10 @@ Maintainer: Andy Bunn <andy.bunn at wwu.edu> Depends: R (>= 2.15.0) Imports: gmp (>= 0.5-2), graphics, grDevices, grid, stats, utils, - digest (>= 0.2.3), lattice (>= 0.13-6), stringr (>= 0.4), XML - (>= 2.1-0) -Suggests: Biobase, dichromat, foreach, forecast, iterators, knitr, - RUnit (>= 0.4.25), tikzDevice, waveslim + digest (>= 0.2.3), lattice (>= 0.13-6), png (>= 0.1-1), + stringr (>= 0.4), XML (>= 2.1-0) +Suggests: Biobase, dichromat (>= 1.2-1), foreach, forecast, iterators, + knitr, RUnit (>= 0.4.25), tikzDevice, waveslim Description: This package contains functions for performing tree-ring analyses, IO, and graphics. LazyData: no Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-05-12 18:53:38 UTC (rev 864) +++ pkg/dplR/NAMESPACE 2014-05-13 15:10:04 UTC (rev 865) @@ -19,6 +19,8 @@ importFrom(lattice, panel.abline, panel.dotplot, panel.segments, trellis.par.set, xyplot) +importFrom(png, readPNG) + importFrom(stringr, str_pad, str_trim) importFrom(utils, head, installed.packages, read.fwf, tail, Added: pkg/dplR/R/rasterPlot.R =================================================================== --- pkg/dplR/R/rasterPlot.R (rev 0) +++ pkg/dplR/R/rasterPlot.R 2014-05-13 15:10:04 UTC (rev 865) @@ -0,0 +1,98 @@ +### Add raster elements to the active high-level plot. The given +### plotting commands are drawn using a temporary png() device. The +### raster image is read into memory and added to the original plot. +### +### Written by Mikko Korpela +### +### Arguments: +### x Low-level plotting commands representing elements to be added +### to the current plot. Examples: lines(), points(), text(), +### mtext(), .filled.contour() +### res Resolution in points per inch. +### Estimated useful range: 100 - 300. +### antialias antialiasing argument for png(). "none" is preferred for +### images. The default value (missing argument) is probably +### good for line plots. +rasterPlot <- function(x, res = 150, antialias) { + if (identical(dev.capabilities("rasterImage")[["rasterImage"]], "no")) { + stop("device does not support raster images") + } + if (sum(capabilities(c("cairo", "png", "aqua")), na.rm=TRUE) == 0) { + stop("png device unavailable") + } + ## Record number of current device so it can be reactivated later + curDev <- dev.cur() + ## Record graphical parameters of the device + op <- par(no.readonly = TRUE) + plt <- op[["plt"]] + usr <- op[["usr"]] + figureWidthHeight <- op[["fin"]] + op <- op[!(names(op) %in% + c("ask", "bg", "fig", "fin", "mar", "mfcol", "mfg", "mfrow", + "new", "oma", "omd", "omi", "pin", "plt"))] + ## Open a png device (raster image) using a temporary file. Width + ## and height are set to match the dimensions of the figure region + ## in the original device. Resolution (points per inch) is the + ## argument 'res'. + fname <- tempfile(fileext = ".png") + if (missing(antialias)) { + png(fname, width = figureWidthHeight[1], height = figureWidthHeight[2], + units = "in", res = res, bg = "transparent") + } else { + png(fname, width = figureWidthHeight[1], height = figureWidthHeight[2], + units = "in", res = res, bg = "transparent", antialias = antialias) + } + ## Record things to do on exit (will be removed from list one-by-one) + on.exit(dev.off()) + on.exit(dev.set(curDev), add=TRUE) + on.exit(unlink(fname), add=TRUE) + devAskNewPage(FALSE) + par(mfcol=c(1,1)) + par(oma=rep(0, 4)) + ## Dummy plot for initialization + plot(1, type = "n", xlab = "", ylab = "", axes=FALSE) + ## Copy graphical parameters from original device to png: + ## margins, coordinates of plot region, etc. + par(op) + ## Evaluate the plotting commands 'x' in the environment of the + ## caller of rasterPlot() + pf <- parent.frame() + eval(x, pf) + on.exit(dev.set(curDev)) + on.exit(unlink(fname), add=TRUE) + ## Close the png device + dev.off() + on.exit(unlink(fname)) + ## Return to the original plot (device) + dev.set(curDev) + ## Read the png image to memory + pngData <- readPNG(fname, native=TRUE) + on.exit() + ## Remove the temporary .png file + unlink(fname) + ## Limits of the plot region in user coordinates + usrLeft <- usr[1] + usrRight <- usr[2] + usrWidth <- usrRight - usrLeft + usrBottom <- usr[3] + usrTop <- usr[4] + usrHeight <- usrTop - usrBottom + ## Limits of the plot region proportional to the figure region, 0..1 + pltLeft <- plt[1] + pltRight <- plt[2] + pltWidth <- pltRight - pltLeft + pltBottom <- plt[3] + pltTop <- plt[4] + pltHeight <- pltTop - pltBottom + ## Limits of the figure region in user coordinates + figLeft <- usrLeft - pltLeft / pltWidth * usrWidth + figRight <- usrRight + (1 - pltRight) / pltWidth * usrWidth + figBottom <- usrBottom - pltBottom / pltHeight * usrHeight + figTop <- usrTop + (1 - pltTop) / pltHeight * usrHeight + ## Set clipping to figure region, restore at exit + par(xpd = TRUE) + on.exit(par(xpd = op[["xpd"]])) + ## Add a raster image to the figure region of the original plot + rasterImage(pngData, xleft = figLeft, ybottom = figBottom, + xright = figRight, ytop = figTop) +} Modified: pkg/dplR/R/wavelet.plot.R =================================================================== --- pkg/dplR/R/wavelet.plot.R 2014-05-12 18:53:38 UTC (rev 864) +++ pkg/dplR/R/wavelet.plot.R 2014-05-13 15:10:04 UTC (rev 865) @@ -7,7 +7,8 @@ key.lab = parse(text = paste0("\"", gettext("Power"), "\"^2")), add.spline = FALSE, f = 0.5, nyrs = NULL, crn.col = "black", crn.lwd = 1,coi.col='black', - crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE) + crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE, + useRaster = FALSE, res = 150) { ## Wavelet transform variables: @@ -86,12 +87,29 @@ plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las) # note replacement of .Internal(filledcontour(as.double(x),...) # with .filled.contour() as of R-2.15.0 - .filled.contour(as.double(x), - as.double(period2), - z, - as.double(wavelet.levels), - key.cols) - + if (isTRUE(useRaster)) { + cl <- quote(.filled.contour(as.double(x), + as.double(period2), + z, + as.double(wavelet.levels), + key.cols)) + tryCatch(rasterPlot(cl, res = res, antialias = "none"), + error = function(e) { + warning(e) + message("reverting to useRaster=FALSE") + .filled.contour(as.double(x), + as.double(period2), + z, + as.double(wavelet.levels), + key.cols) + }) + } else { + .filled.contour(as.double(x), + as.double(period2), + z, + as.double(wavelet.levels), + key.cols) + } if (add.sig) { contour(x, period2, Signif, levels=1, labels=siglvl, drawlabels = FALSE, axes = FALSE, @@ -155,12 +173,29 @@ plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las) # note replacement of .Internal(filledcontour(as.double(x),...) # with .filled.contour() as of R-2.15.0 - .filled.contour(as.double(x), - as.double(period2), - z, - as.double(wavelet.levels), - key.cols) - + if (isTRUE(useRaster)) { + cl <- quote(.filled.contour(as.double(x), + as.double(period2), + z, + as.double(wavelet.levels), + key.cols)) + tryCatch(rasterPlot(cl, res = res, antialias = "none"), + error = function(e) { + warning(e) + message("reverting to useRaster=FALSE") + .filled.contour(as.double(x), + as.double(period2), + z, + as.double(wavelet.levels), + key.cols) + }) + } else { + .filled.contour(as.double(x), + as.double(period2), + z, + as.double(wavelet.levels), + key.cols) + } if (add.sig) { contour(x, period2, Signif, levels=1, labels=siglvl, drawlabels = FALSE, axes = FALSE, Modified: pkg/dplR/man/wavelet.plot.Rd =================================================================== --- pkg/dplR/man/wavelet.plot.Rd 2014-05-12 18:53:38 UTC (rev 864) +++ pkg/dplR/man/wavelet.plot.Rd 2014-05-13 15:10:04 UTC (rev 865) @@ -15,7 +15,8 @@ key.lab = parse(text=paste0("\"", gettext("Power"), "\"^2")), add.spline = FALSE, f = 0.5, nyrs = NULL, crn.col = "black", crn.lwd = 1,coi.col='black', - crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE) + crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE, + useRaster = FALSE, res = 150) } \arguments{ \item{wave.list}{A \code{list}. Output from \code{\link{morlet}}.} @@ -38,7 +39,17 @@ \item{coi.col}{Color for the COI if \code{add.coi} is \code{TRUE}.} \item{crn.ylim}{Axis limits for the time-series plot.} \item{side.by.side}{A \code{logical} flag. Plots will be in one row if - \code{TRUE}. } + \code{TRUE}.} + \item{useRaster}{A \code{logical} flag. If \code{TRUE}, the filled + contours are drawn as a raster image. Other parts of the plot are + not affected. \code{useRaster=TRUE} can be especially useful when a + \code{pdf} device is used: the size and complexity of the + \acronym{PDF} file will probably be greatly reduced. Setting this + to \code{TRUE} only has negative effects when used with a bitmap + device such as \code{png}. The default is \code{FALSE}. } + \item{res}{A \code{numeric} vector of length 1. The resolution + (pixels per inch) of the filled contours when \code{useRaster} is + \code{TRUE}.} } \details{ This produces a plot of a continuous wavelet transform and plots the From noreply at r-forge.r-project.org Tue May 13 18:00:44 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 13 May 2014 18:00:44 +0200 (CEST) Subject: [Dplr-commits] r866 - in pkg/dplR: . vignettes Message-ID: <20140513160044.CA1361873F7@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-13 18:00:44 +0200 (Tue, 13 May 2014) New Revision: 866 Modified: pkg/dplR/ChangeLog pkg/dplR/vignettes/timeseries-dplR.Rnw Log: Reduced size of timeseries-dplR.pdf and the whole package with useRaster=TRUE in a wavelet.plot() call Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-13 15:10:04 UTC (rev 865) +++ pkg/dplR/ChangeLog 2014-05-13 16:00:44 UTC (rev 866) @@ -71,6 +71,12 @@ will speed up otherwise unbearable computation times on some systems. +File: timeseries-dplR.Rnw +------------------------- + +- wavelet.plot(useRaster=TRUE) in the vignette reduces the size of + both timeseries-dplR.pdf and the package tarball + File: wavelet.plot.R -------------------- Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-13 15:10:04 UTC (rev 865) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-13 16:00:44 UTC (rev 866) @@ -239,7 +239,7 @@ yrs <- as.numeric(rownames(co021.crn)) out.wave <- morlet(y1 = dat, x1 = yrs, p2 = 8, dj = 0.1, siglvl = 0.99) -wavelet.plot(out.wave) +wavelet.plot(out.wave, useRaster=TRUE) @ \begin{figure}[h] \centering From noreply at r-forge.r-project.org Tue May 13 19:54:15 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 13 May 2014 19:54:15 +0200 (CEST) Subject: [Dplr-commits] r867 - pkg/dplR/R Message-ID: <20140513175415.BA495186E53@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-13 19:54:15 +0200 (Tue, 13 May 2014) New Revision: 867 Modified: pkg/dplR/R/rasterPlot.R Log: svn:eol-style native for the new file Property changes on: pkg/dplR/R/rasterPlot.R ___________________________________________________________________ Added: svn:eol-style + native From noreply at r-forge.r-project.org Tue May 13 23:47:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 13 May 2014 23:47:33 +0200 (CEST) Subject: [Dplr-commits] r868 - pkg/dplR/R Message-ID: <20140513214734.06252186BE3@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-13 23:47:33 +0200 (Tue, 13 May 2014) New Revision: 868 Modified: pkg/dplR/R/rasterPlot.R Log: Optimization: in most cases it should be enough to add a raster image to the plot region. This is now the default in rasterPlot(). Modified: pkg/dplR/R/rasterPlot.R =================================================================== --- pkg/dplR/R/rasterPlot.R 2014-05-13 17:54:15 UTC (rev 867) +++ pkg/dplR/R/rasterPlot.R 2014-05-13 21:47:33 UTC (rev 868) @@ -10,36 +10,42 @@ ### mtext(), .filled.contour() ### res Resolution in points per inch. ### Estimated useful range: 100 - 300. +### region Draw in the plot region or the figure region? +### The figure region contains the plot region and margins. +### Plotting in the outer margin is not supported. ### antialias antialiasing argument for png(). "none" is preferred for ### images. The default value (missing argument) is probably ### good for line plots. -rasterPlot <- function(x, res = 150, antialias) { +rasterPlot <- function(x, res = 150, region=c("plot", "figure"), antialias) { if (identical(dev.capabilities("rasterImage")[["rasterImage"]], "no")) { stop("device does not support raster images") } if (sum(capabilities(c("cairo", "png", "aqua")), na.rm=TRUE) == 0) { stop("png device unavailable") } + region2 <- match.arg(region) + plotRegion <- region2 == "plot" ## Record number of current device so it can be reactivated later curDev <- dev.cur() ## Record graphical parameters of the device op <- par(no.readonly = TRUE) plt <- op[["plt"]] usr <- op[["usr"]] - figureWidthHeight <- op[["fin"]] + pngWidthHeight <- op[[c(figure="fin", plot="pin")[region2]]] op <- op[!(names(op) %in% c("ask", "bg", "fig", "fin", "mar", "mfcol", "mfg", "mfrow", - "new", "oma", "omd", "omi", "pin", "plt"))] + "new", "oma", "omd", "omi", "pin", "plt", + if (plotRegion) "mai"))] ## Open a png device (raster image) using a temporary file. Width ## and height are set to match the dimensions of the figure region ## in the original device. Resolution (points per inch) is the ## argument 'res'. fname <- tempfile(fileext = ".png") if (missing(antialias)) { - png(fname, width = figureWidthHeight[1], height = figureWidthHeight[2], + png(fname, width = pngWidthHeight[1], height = pngWidthHeight[2], units = "in", res = res, bg = "transparent") } else { - png(fname, width = figureWidthHeight[1], height = figureWidthHeight[2], + png(fname, width = pngWidthHeight[1], height = pngWidthHeight[2], units = "in", res = res, bg = "transparent", antialias = antialias) } ## Record things to do on exit (will be removed from list one-by-one) @@ -48,11 +54,14 @@ on.exit(unlink(fname), add=TRUE) devAskNewPage(FALSE) par(mfcol=c(1,1)) - par(oma=rep(0, 4)) + par(omi=rep(0, 4)) + if (plotRegion) { + par(mai=rep(0, 4)) + } ## Dummy plot for initialization plot(1, type = "n", xlab = "", ylab = "", axes=FALSE) ## Copy graphical parameters from original device to png: - ## margins, coordinates of plot region, etc. + ## (margins), coordinates of plot region, etc. par(op) ## Evaluate the plotting commands 'x' in the environment of the ## caller of rasterPlot() @@ -73,26 +82,32 @@ ## Limits of the plot region in user coordinates usrLeft <- usr[1] usrRight <- usr[2] - usrWidth <- usrRight - usrLeft usrBottom <- usr[3] usrTop <- usr[4] - usrHeight <- usrTop - usrBottom - ## Limits of the plot region proportional to the figure region, 0..1 - pltLeft <- plt[1] - pltRight <- plt[2] - pltWidth <- pltRight - pltLeft - pltBottom <- plt[3] - pltTop <- plt[4] - pltHeight <- pltTop - pltBottom - ## Limits of the figure region in user coordinates - figLeft <- usrLeft - pltLeft / pltWidth * usrWidth - figRight <- usrRight + (1 - pltRight) / pltWidth * usrWidth - figBottom <- usrBottom - pltBottom / pltHeight * usrHeight - figTop <- usrTop + (1 - pltTop) / pltHeight * usrHeight - ## Set clipping to figure region, restore at exit - par(xpd = TRUE) - on.exit(par(xpd = op[["xpd"]])) - ## Add a raster image to the figure region of the original plot - rasterImage(pngData, xleft = figLeft, ybottom = figBottom, - xright = figRight, ytop = figTop) + if (plotRegion) { + ## Add a raster image to the plot region of the original plot + rasterImage(pngData, xleft = usrLeft, ybottom = usrBottom, + xright = usrRight, ytop = usrTop) + } else { + usrWidth <- usrRight - usrLeft + usrHeight <- usrTop - usrBottom + ## Limits of the plot region proportional to the figure region, 0..1 + pltLeft <- plt[1] + pltRight <- plt[2] + pltWidth <- pltRight - pltLeft + pltBottom <- plt[3] + pltTop <- plt[4] + pltHeight <- pltTop - pltBottom + ## Limits of the figure region in user coordinates + figLeft <- usrLeft - pltLeft / pltWidth * usrWidth + figRight <- usrRight + (1 - pltRight) / pltWidth * usrWidth + figBottom <- usrBottom - pltBottom / pltHeight * usrHeight + figTop <- usrTop + (1 - pltTop) / pltHeight * usrHeight + ## Set clipping to figure region, restore at exit + par(xpd = TRUE) + on.exit(par(xpd = op[["xpd"]])) + ## Add a raster image to the figure region of the original plot + rasterImage(pngData, xleft = figLeft, ybottom = figBottom, + xright = figRight, ytop = figTop) + } } From noreply at r-forge.r-project.org Wed May 14 10:15:59 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 14 May 2014 10:15:59 +0200 (CEST) Subject: [Dplr-commits] r869 - in pkg/dplR: . R Message-ID: <20140514081559.B559B185F8B@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-14 10:15:59 +0200 (Wed, 14 May 2014) New Revision: 869 Modified: pkg/dplR/DESCRIPTION pkg/dplR/R/wavelet.plot.R Log: wavelet.plot(): Adjusted handling of situation where rasterPlot() fails Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-13 21:47:33 UTC (rev 868) +++ pkg/dplR/DESCRIPTION 2014-05-14 08:15:59 UTC (rev 869) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-13 +Date: 2014-05-14 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/wavelet.plot.R =================================================================== --- pkg/dplR/R/wavelet.plot.R 2014-05-13 21:47:33 UTC (rev 868) +++ pkg/dplR/R/wavelet.plot.R 2014-05-14 08:15:59 UTC (rev 869) @@ -95,7 +95,7 @@ key.cols)) tryCatch(rasterPlot(cl, res = res, antialias = "none"), error = function(e) { - warning(e) + message(as.character(e), appendLF = FALSE) message("reverting to useRaster=FALSE") .filled.contour(as.double(x), as.double(period2), @@ -181,7 +181,7 @@ key.cols)) tryCatch(rasterPlot(cl, res = res, antialias = "none"), error = function(e) { - warning(e) + message(as.character(e), appendLF = FALSE) message("reverting to useRaster=FALSE") .filled.contour(as.double(x), as.double(period2), From noreply at r-forge.r-project.org Wed May 14 11:00:35 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 14 May 2014 11:00:35 +0200 (CEST) Subject: [Dplr-commits] r870 - in pkg/dplR: . R man Message-ID: <20140514090035.B9294187429@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-14 11:00:35 +0200 (Wed, 14 May 2014) New Revision: 870 Modified: pkg/dplR/ChangeLog pkg/dplR/R/wavelet.plot.R pkg/dplR/man/wavelet.plot.Rd Log: A tiny change to the default wavelet.levels (floating point accuracy) Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-14 08:15:59 UTC (rev 869) +++ pkg/dplR/ChangeLog 2014-05-14 09:00:35 UTC (rev 870) @@ -83,6 +83,10 @@ - Added two options to wavelet.plot(). 'useRaster': draw the filled contours as a raster image? (default 'FALSE') 'res': resolution of the filled contours when 'useRaster' is 'TRUE' +- A subtle change to the default value of wavelet.levels: To get + the sequence 0, 0.1, 0.2, ..., 1 it is best to use (0:10)/10 + instead of seq(from=0, to=1, by=0.1). Parentheses in the former are + used for clarity of meaning. * CHANGES IN dplR VERSION 1.6.0 Modified: pkg/dplR/R/wavelet.plot.R =================================================================== --- pkg/dplR/R/wavelet.plot.R 2014-05-14 08:15:59 UTC (rev 869) +++ pkg/dplR/R/wavelet.plot.R 2014-05-14 09:00:35 UTC (rev 870) @@ -1,6 +1,6 @@ wavelet.plot <- function(wave.list, - wavelet.levels = quantile(wave.list$Power, probs=seq(from=0, to=1, by=0.1)), + wavelet.levels = quantile(wave.list$Power, probs=(0:10)/10), add.coi = TRUE, add.sig = TRUE, x.lab = gettext("Time"), period.lab = gettext("Period"), crn.lab = gettext("RWI"), key.cols = rev(rainbow(length(wavelet.levels)-1)), Modified: pkg/dplR/man/wavelet.plot.Rd =================================================================== --- pkg/dplR/man/wavelet.plot.Rd 2014-05-14 08:15:59 UTC (rev 869) +++ pkg/dplR/man/wavelet.plot.Rd 2014-05-14 09:00:35 UTC (rev 870) @@ -8,7 +8,7 @@ \usage{ wavelet.plot(wave.list, wavelet.levels = quantile(wave.list$Power, - probs = seq(from=0, to=1, by=0.1)), + probs = (0:10)/10), add.coi = TRUE, add.sig = TRUE, x.lab = gettext("Time"), period.lab = gettext("Period"), crn.lab = gettext("RWI"), key.cols = rev(rainbow(length(wavelet.levels)-1)), From noreply at r-forge.r-project.org Wed May 14 11:39:03 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 14 May 2014 11:39:03 +0200 (CEST) Subject: [Dplr-commits] r871 - in pkg/dplR: . man Message-ID: <20140514093903.64DB0180451@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-14 11:39:02 +0200 (Wed, 14 May 2014) New Revision: 871 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/man/wavelet.plot.Rd Log: Alternative color palette in example of wavelet.plot() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-14 09:00:35 UTC (rev 870) +++ pkg/dplR/ChangeLog 2014-05-14 09:39:02 UTC (rev 871) @@ -9,9 +9,12 @@ File: DESCRIPTION ----------------- -- New Suggested packages: Biobase, dichromat, knitr, tikzDevice. - These are for document building (see math-dplR.pdf below) and - openPDF (math-dplR.pdf is not available through vignette()) +- New Suggested packages: Biobase, dichromat, knitr, tikzDevice, + RColorBrewer. Of these, dichromat, knitr, and tikzDevice are for document + building (see math-dplR.pdf below). Biobase is for making access to + math-dplR.pdf easier with openPDF(). RColorBrewer provides an + alternative palette to an example in wavelet.plot.Rd. + - New Imported package: png. File: common.interval.R Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-14 09:00:35 UTC (rev 870) +++ pkg/dplR/DESCRIPTION 2014-05-14 09:39:02 UTC (rev 871) @@ -22,7 +22,7 @@ digest (>= 0.2.3), lattice (>= 0.13-6), png (>= 0.1-1), stringr (>= 0.4), XML (>= 2.1-0) Suggests: Biobase, dichromat (>= 1.2-1), foreach, forecast, iterators, - knitr, RUnit (>= 0.4.25), tikzDevice, waveslim + knitr, RColorBrewer, RUnit (>= 0.4.25), tikzDevice, waveslim Description: This package contains functions for performing tree-ring analyses, IO, and graphics. LazyData: no Modified: pkg/dplR/man/wavelet.plot.Rd =================================================================== --- pkg/dplR/man/wavelet.plot.Rd 2014-05-14 09:00:35 UTC (rev 870) +++ pkg/dplR/man/wavelet.plot.Rd 2014-05-14 09:39:02 UTC (rev 871) @@ -82,6 +82,12 @@ out.wave <- morlet(y1 = CAMstd, x1 = Years, p2 = 9, dj = 0.1, siglvl = 0.99) wavelet.plot(out.wave) +\dontrun{ +## Alternative palette with better separation of colors +if (require(RColorBrewer)) { + wavelet.plot(out.wave, key.cols=rev(brewer.pal(10, "Spectral"))) +} +} levs <- quantile(out.wave$Power, probs = c(0, 0.5, 0.75, 0.9, 0.99)) wavelet.plot(out.wave, wavelet.levels = levs, add.sig = FALSE, key.cols = c("white", "green", "blue", "red")) From noreply at r-forge.r-project.org Wed May 14 22:02:40 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 14 May 2014 22:02:40 +0200 (CEST) Subject: [Dplr-commits] r872 - in pkg/dplR: . R Message-ID: <20140514200240.807C8180348@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-14 22:02:40 +0200 (Wed, 14 May 2014) New Revision: 872 Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE pkg/dplR/R/xskel.ccf.plot.R Log: xskel.ccf.plot(): optimizations in code, small changes to output. NAMESPACE: import more functions from grid Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-14 09:39:02 UTC (rev 871) +++ pkg/dplR/ChangeLog 2014-05-14 20:02:40 UTC (rev 872) @@ -91,6 +91,12 @@ instead of seq(from=0, to=1, by=0.1). Parentheses in the former are used for clarity of meaning. +File: xskel.ccf.plot.R +---------------------- + +- Code optimizations +- Small changes to output + * CHANGES IN dplR VERSION 1.6.0 File: TODO Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-05-14 09:39:02 UTC (rev 871) +++ pkg/dplR/NAMESPACE 2014-05-14 20:02:40 UTC (rev 872) @@ -14,7 +14,7 @@ importFrom(grid, gpar, grid.lines, grid.newpage, grid.polygon, grid.segments, grid.text, pushViewport, seekViewport, unit, viewport, vpList, vpTree, plotViewport, grid.grill, upViewport, - grid.points, popViewport, grid.rect) + grid.points, popViewport, grid.rect, textGrob, grid.draw) importFrom(lattice, panel.abline, panel.dotplot, panel.segments, trellis.par.set, xyplot) Modified: pkg/dplR/R/xskel.ccf.plot.R =================================================================== --- pkg/dplR/R/xskel.ccf.plot.R 2014-05-14 09:39:02 UTC (rev 871) +++ pkg/dplR/R/xskel.ccf.plot.R 2014-05-14 20:02:40 UTC (rev 872) @@ -1,7 +1,7 @@ xskel.ccf.plot <- function(rwl,series,series.yrs = as.numeric(names(series)), win.start, win.width=50, n = NULL, prewhiten = TRUE, biweight = TRUE) { - # check to see that win.width is even + ## check to see that win.width is even if(as.logical(win.width %% 2)) stop("'win.width' must be even") if (win.width > 100) { warning("win.width should be < 100 unless your plotting is very wide!") @@ -15,10 +15,10 @@ master.yrs <- as.numeric(rownames(rwl)) series.yrs <- as.numeric(names(series)) yrs <- seq(from=win.start,to=win.start+win.width) - nyrs <- length(yrs) + ## nyrs <- length(yrs) cen.win <- win.width/2 - # check window overlap with master and series yrs + ## check window overlap with master and series yrs if (!all(yrs %in% series.yrs)) { cat("Window Years: ", min(yrs), "-", max(yrs)," & ", "Series Years: ", min(series.yrs), "-", max(series.yrs), @@ -32,23 +32,23 @@ stop("Fix window overlap") } - # normalize. + ## normalize. names(series) <- series.yrs tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) - # master + ## master master <- tmp$master master.yrs <- as.numeric(names(master)) master <- master[master.yrs%in%yrs] master.yrs <- as.numeric(names(master)) - # series + ## series series <- tmp$series series.yrs <- as.numeric(names(series)) series <- series[series.yrs%in%yrs] series.yrs <- as.numeric(names(series)) - # skeleton + ## skeleton master.skel <- cbind(master.yrs,xskel.calc(master)) master.skel <- master.skel[master.skel[,1]%in%yrs,] master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] @@ -56,7 +56,7 @@ series.skel <- series.skel[series.skel[,1]%in%yrs,] series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] - # divide in half + ## divide in half first.half <- 1:cen.win second.half <- (cen.win + 1):win.width first.yrs <- yrs[first.half] @@ -66,7 +66,7 @@ master.late <- master[second.half] series.late <- series[second.half] - # subset skel data + ## subset skel data early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,] early.series.yrs.sig <- early.series.skel[!is.na(early.series.skel[,2]),1] @@ -80,19 +80,19 @@ late.master.yrs.sig <- late.master.skel[!is.na(late.master.skel[,2]),1] - # ccf + ## ccf ccf.early <- as.vector(ccf(x=series.early,y=master.early,lag.max=5,plot=FALSE)$acf) ccf.late <- as.vector(ccf(x=series.late,y=master.late,lag.max=5,plot=FALSE)$acf) pcrit=0.05 sig <- qnorm(1 - pcrit / 2) / sqrt(length(master.early)) sig <- c(-sig, sig) - # cor and skel agreement + ## cor and skel agreement overall.r <- round(cor(series,master),3) early.r <- round(cor(series.early,master.early),3) late.r <- round(cor(series.late,master.late),3) - # aggreement btwn series skel and master skel + ## aggreement btwn series skel and master skel overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) overall.agree <- round(overall.agree*100,1) @@ -102,76 +102,86 @@ late.agree <- sum(late.series.yrs.sig%in%late.master.yrs.sig)/length(late.master.yrs.sig) late.agree <- round(late.agree*100,1) - # build page for plotting + ## build page for plotting grid.newpage() - # 1.0 a bounding box for margins - bnd.vp <- plotViewport(margins=rep(0.5,4),name = "bnd.vp") # 1/2 line margin - # go from bottom up. + fontsize <- 12 # fontsize for all text + pointsize <- 12 # fontsize for grid.points() + textJust <- "center" # justification for horizontal text elements + col1light <- "lightgreen" + col1dark <- "darkgreen" + col2light <- "lightblue" + col2dark <- "darkblue" + ## 1.0 a bounding box for margins + bnd.vp <- plotViewport(margins=rep(0.5,4), # 1/2 line margin + name = "bnd.vp", + gp = gpar(fontsize = fontsize)) + ## go from bottom up. - # 2.1 bounding box for ccf early: 30% of area height inside bnd.vp + ## 2.1 bounding box for ccf early: 30% of area height inside bnd.vp ccf.early.bnd.vp <- viewport(x = 0, y = 0, width = 0.5, height = 0.3, just = c("left", "bottom"), name = "ccf.early.bnd.vp") - # 2.12 plotting region for ccf early. 1 line margin bottom. 2 lines left + ## 2.12 plotting region for ccf early. 1 line margin bottom. 2 lines left ccf.early.region.vp <- plotViewport(margins=c(1,2,0,0), xscale=c(0,12), yscale=c(-1,1), name = "ccf.early.region.vp") - # 2.2 bounding box for ccf late: 30% of area height inside bnd.vp + ## 2.2 bounding box for ccf late: 30% of area height inside bnd.vp ccf.late.bnd.vp <- viewport(x = 0.5, y = 0, width = 0.5, height = 0.3, - just = c("left", "bottom"), name = "ccf2.late.vp") - # 2.22 plotting region for ccf late. 1 line margin bottom. 2 lines right + just = c("left", "bottom"), + name = "ccf.late.bnd.vp") + ## 2.22 plotting region for ccf late. 1 line margin bottom. 2 lines right ccf.late.region.vp <- plotViewport(margins=c(1, 0, 0, 2), xscale=c(0,12), yscale=c(-1,1), name = "ccf.late.region.vp") - # 3.0 box for text comparing early and late periods. 10% area height + ## 3.0 box for text comparing early and late periods. 10% area height text.bnd.vp <- viewport(x = 0, y = 0.3, width = 1, height = 0.1, just = c("left", "bottom"), name = "text.bnd.vp") - # 4.1 bounding box for skeleton plot. 55% of area + ## 4.1 bounding box for skeleton plot. 55% of area skel.bnd.vp <- viewport(x = 0, y = 0.4, width = 1, height = 0.55, just = c("left", "bottom"), name = "skel.bnd.vp") - # 4.2 plotting region for skeleton plot. 2 lines left and right. - # 3 lines on top and bottom + ## 4.2 plotting region for skeleton plot. 2 lines left and right. + ## 3 lines on top and bottom skel.region.vp <- plotViewport(margins=c(3,2,3,2), xscale=c(min(yrs)-0.5,max(yrs)+0.5), yscale=c(-10,10), name = "skel.region.vp") - # 5.0 a box for overall text. 5% + ## 5.0 a box for overall text. 5% overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, just = c("left", "bottom"), name = "overall.txt.vp") - # actual plotting + ## actual plotting pushViewport(bnd.vp) # inside margins pushViewport(skel.bnd.vp) # inside skel pushViewport(skel.region.vp) # inside margins - grid.rect(gp = gpar(col="lightgreen", lwd=1)) + grid.rect(gp = gpar(col=col1light, lwd=1)) grid.grill(h = unit(seq(-10, 10, by=1), "native"), v = unit(yrs-0.5, "native"), - gp = gpar(col="lightgreen", lineend = "square", + gp = gpar(col=col1light, lineend = "square", linejoin = "round")) - # rw plot + ## rw plot master.tmp <- master*-2 for(i in 1:length(yrs)){ xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) yy <- c(0,0,master.tmp[i],master.tmp[i]) grid.polygon(xx,yy,default.units="native", - gp=gpar(fill='lightgreen',col='darkgreen')) + gp=gpar(fill=col1light,col=col1dark)) } series.tmp <- series*2 for(i in 1:length(yrs)){ xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) yy <- c(0,0,series.tmp[i],series.tmp[i]) grid.polygon(xx,yy,default.units="native", - gp=gpar(fill='lightgreen',col='darkgreen')) + gp=gpar(fill=col1light,col=col1dark)) } - #master + ## master grid.segments(x0=master.yrs.sig,y0=0, x1=master.yrs.sig,y1=-10, default.units="native", @@ -180,7 +190,7 @@ x1=master.skel[,1],y1=master.skel[,2]*-1, default.units="native", gp=gpar(lwd=5,col='black',lineend="butt")) - #series + ## series grid.segments(x0=series.yrs.sig,y0=0, x1=series.yrs.sig,y1=10, default.units="native", @@ -190,142 +200,98 @@ default.units="native", gp=gpar(lwd=5,col='black',lineend="butt")) - # text + ## text grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), - y = unit(0, "npc"), rot = 90,just="right", - gp=gpar(fontsize=12)) + y = unit(0, "npc"), rot = 90,just="right") grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), - y = unit(1, "npc"), rot = 90,just="left", - gp= gpar(fontsize = 12)) - grid.text("Master",x=unit(0,"npc"), - y=unit(0,"npc"),hjust = 0,vjust = 0,rot=90, - gp= gpar(fontsize = 12)) - grid.text("Series",x=unit(0,"npc"), - y=unit(1,"npc"),hjust=1,vjust=0,rot=90, - gp= gpar(fontsize = 12)) + y = unit(1, "npc"), rot = 90,just="left") + grid.text(gettext("Master", domain="R-dplR"),x=unit(0,"npc"), + y=unit(0,"npc"),hjust = 0,vjust = 0,rot=90) + grid.text(gettext("Series", domain="R-dplR"),x=unit(0,"npc"), + y=unit(1,"npc"),hjust=1,vjust=0,rot=90) - upViewport(3) # back to bnd - pushViewport(ccf.early.bnd.vp) #into early ccf - pushViewport(ccf.early.region.vp) # inside margins - grid.grill(v = unit(seq(1, 11, by=1), "native"), - h=NA, - gp = gpar(col="lightblue", lineend = "square", - linejoin = "round")) - grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), - x1=unit(12, "native"),y1=unit(sig[1], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) + popViewport(2) # back to bnd + + negText <- textGrob(gettext("(Negative)", domain="R-dplR"), + y=unit(-0.5,"lines"),x=unit(3,"native"), + just = textJust) + posText <- textGrob(gettext("(Positive)", domain="R-dplR"), + y=unit(-0.5,"lines"),x=unit(9,"native"), + just = textJust) + for (period in c("early", "late")) { + if (period == "early") { + vp1 <- ccf.early.bnd.vp + vp2 <- ccf.early.region.vp + ccf.period <- ccf.early + } else { + vp1 <- ccf.late.bnd.vp + vp2 <- ccf.late.region.vp + ccf.period <- ccf.late + } + pushViewport(vp1) # into ccf + pushViewport(vp2) # inside margins + grid.grill(v = unit(seq(1, 11, by=1), "native"), + h=NA, + gp = gpar(col=col2light, lineend = "square", + linejoin = "round")) + grid.segments(x0=unit(c(0, 0), "native"),y0=unit(sig, "native"), + x1=unit(c(12, 12), "native"),y1=unit(sig, "native"), + gp=gpar(col=col2dark, lty="dashed",lwd=2)) + grid.segments(x0=unit(c(0, 6), "native"),y0=unit(c(0, -1), "native"), + x1=unit(c(12, 6), "native"),y1=unit(c(0, 1), "native"), + gp=gpar(col="black", lty="solid",lwd=1)) + grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.period, + default.units="native", + gp=gpar(lwd=2,lend="butt", col=col2dark)) + grid.points(x=1:11, y=ccf.period, pch=21, + default.units="native", + gp=gpar(fill=col2light, col=col2dark, + fontsize=pointsize)) + grid.draw(negText) + grid.draw(posText) + popViewport(2) # back to bnd + } + + periodPattern <- gettext("Period: %d-%d", domain = "R-dplR") + agreePattern <- gettext("Skeleton Agreement %s%%", domain = "R-dplR") - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), - x1=unit(12, "native"),y1=unit(0, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), - x1=unit(6, "native"),y1=unit(1, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - - grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.early, - default.units="native", - gp=gpar(lwd=2,lend="butt", col="darkblue")) - grid.points(x=1:11,y=ccf.early,pch=21, - default.units="native", - gp=gpar(fill="lightblue",col="darkblue")) - grid.text("(Negative)",y=unit(-0.5,"lines"),x=unit(3,"native"), - default.units="native",just = "center", - gp= gpar(fontsize = 12)) - grid.text("(Positive)",y=unit(-0.5,"lines"),x=unit(9,"native"), - just = "center", - gp= gpar(fontsize = 12)) - - upViewport(2) - pushViewport(ccf.late.bnd.vp) #into late ccf - pushViewport(ccf.late.region.vp) # inside margins - grid.grill(v = unit(seq(1, 11, by=1), "native"), - h=NA, - gp = gpar(col="lightblue", lineend = "square", - linejoin = "round")) - grid.segments(x0=unit(0, "native"),y0=unit(sig[1], "native"), - x1=unit(12, "native"),y1=unit(sig[1], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(sig[2], "native"), - x1=unit(12, "native"),y1=unit(sig[2], "native"), - gp=gpar(col="darkblue", lty="dashed",lwd=2)) - - grid.segments(x0=unit(0, "native"),y0=unit(0, "native"), - x1=unit(12, "native"),y1=unit(0, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - grid.segments(x0=unit(6, "native"),y0=unit(-1, "native"), - x1=unit(6, "native"),y1=unit(1, "native"), - gp=gpar(col="black", lty="solid",lwd=1)) - - - grid.segments(x0=1:11,y0=0,x1=1:11,y1=ccf.late, - default.units="native", - gp=gpar(lwd=2,lend="butt", col="darkblue")) - grid.points(x=1:11,y=ccf.late,pch=21, - default.units="native", - gp=gpar(fill="lightblue",col="darkblue")) - grid.text("(Negative)",y=unit(-0.5,"lines"),x=unit(3,"native"), - default.units="native",just = "center", - gp= gpar(fontsize = 12)) - grid.text("(Positive)",y=unit(-0.5,"lines"),x=unit(9,"native"), - just = "center", - gp= gpar(fontsize = 12)) - popViewport(2) # to top - grid.segments(x0=0.5,y0=0,x1=0.5,y1=1, + grid.segments(x0=0.5,y0=0,x1=0.5,y1=0.95, default.units="npc", gp=gpar(lwd=2,lend="butt", col="black")) pushViewport(text.bnd.vp) # description - tmp.txt <- bquote("Period:" ~ .(min(first.yrs)) * "-" * .(max(first.yrs)) * - ","~r[lag0] * "=" * .(early.r)) - + tmp.txt <- substitute(period * ", " * r[lag0] == corr, + list(period = sprintf(periodPattern, + min(first.yrs), max(first.yrs)), + corr = early.r)) grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.25,"npc"), - just = "center", - gp= gpar(fontsize = 12)) + just = textJust) - tmp.txt <- paste("Skeleton Agreement ", early.agree, "%",sep="") - grid.text(tmp.txt,y=unit(0.35,"npc"),x=unit(0.25,"npc"), - just = "center", - gp= gpar(fontsize = 12)) + grid.text(sprintf(agreePattern, early.agree), + y=unit(0.35,"npc"), x=unit(0.25,"npc"), + just = textJust) - tmp.txt <- bquote("Period:" ~ .(min(second.yrs)) * "-" * - .(max(second.yrs)) * ","~r[lag0] * "=" * .(late.r)) + tmp.txt <- substitute(period * ", " * r[lag0] == corr, + list(period = sprintf(periodPattern, + min(second.yrs), max(second.yrs)), + corr = late.r)) grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.75,"npc"), - just = "center", - gp= gpar(fontsize = 12)) + just = textJust) - tmp.txt <- paste("Skeleton Agreement ", late.agree, "%",sep="") - grid.text(tmp.txt,y=unit(0.35,"npc"),x=unit(0.75,"npc"), - just = "center", - gp= gpar(fontsize = 12)) + grid.text(sprintf(agreePattern, late.agree), + y=unit(0.35,"npc"), x=unit(0.75,"npc"), + just = textJust) - upViewport(1) # back to bnd + popViewport(1) # back to bnd pushViewport(overall.txt.vp) # description - tmp.txt <- paste("Period: ",min(yrs),"-",max(yrs), - ", r(lag0)= ", overall.r, - ". Skeleton Agreement ", overall.agree, "%",sep="") - tmp.txt <- bquote("Period:" ~ .(min(yrs)) * "-" * - .(max(yrs)) * ","~r[lag0] * "=" * .(overall.r)* - ","~"Skeleton Agreement"~.(overall.agree)*"%") - grid.rect(gp=gpar(col=NA,fill="white")) + tmp.txt <- substitute(period * ", " * r[lag0] == corr * ", " * agree, + list(period = sprintf(periodPattern, + min(yrs), max(yrs)), + corr = overall.r, + agree = sprintf(agreePattern, overall.agree))) grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), - just = "center", - gp= gpar(fontsize = 12)) + just = textJust) + popViewport(2) -} \ No newline at end of file +} From noreply at r-forge.r-project.org Wed May 14 22:04:48 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 14 May 2014 22:04:48 +0200 (CEST) Subject: [Dplr-commits] r873 - pkg/dplR Message-ID: <20140514200448.6F3C7186DF1@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-14 22:04:48 +0200 (Wed, 14 May 2014) New Revision: 873 Modified: pkg/dplR/ChangeLog Log: note about importing from grid Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-14 20:02:40 UTC (rev 872) +++ pkg/dplR/ChangeLog 2014-05-14 20:04:48 UTC (rev 873) @@ -5,6 +5,7 @@ - Added latexify() and latexDate() to export list - Import readPNG from png. +- Import more functions from grid. File: DESCRIPTION ----------------- From noreply at r-forge.r-project.org Thu May 15 11:05:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 15 May 2014 11:05:42 +0200 (CEST) Subject: [Dplr-commits] r874 - in pkg/dplR: . man Message-ID: <20140515090542.A7BA2187478@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-15 11:05:42 +0200 (Thu, 15 May 2014) New Revision: 874 Modified: pkg/dplR/DESCRIPTION pkg/dplR/man/xskel.ccf.plot.Rd pkg/dplR/man/xskel.plot.Rd Log: Slightly reformatted .Rd files Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-14 20:04:48 UTC (rev 873) +++ pkg/dplR/DESCRIPTION 2014-05-15 09:05:42 UTC (rev 874) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-14 +Date: 2014-05-15 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/man/xskel.ccf.plot.Rd =================================================================== --- pkg/dplR/man/xskel.ccf.plot.Rd 2014-05-14 20:04:48 UTC (rev 873) +++ pkg/dplR/man/xskel.ccf.plot.Rd 2014-05-15 09:05:42 UTC (rev 874) @@ -5,10 +5,9 @@ ... } \usage{ -xskel.ccf.plot(rwl,series,series.yrs = as.numeric(names(series)), - win.start, win.width=50, n = NULL, prewhiten = TRUE, - biweight = TRUE) - +xskel.ccf.plot(rwl, series, series.yrs = as.numeric(names(series)), + win.start, win.width = 50, n = NULL, + prewhiten = TRUE, biweight = TRUE) } \arguments{ \item{rwl}{ a \code{data.frame} with series as columns and years as rows Modified: pkg/dplR/man/xskel.plot.Rd =================================================================== --- pkg/dplR/man/xskel.plot.Rd 2014-05-14 20:04:48 UTC (rev 873) +++ pkg/dplR/man/xskel.plot.Rd 2014-05-15 09:05:42 UTC (rev 874) @@ -5,10 +5,9 @@ ... } \usage{ -xskel.plot(rwl,series,series.yrs = as.numeric(names(series)), - win.start, win.end=win.start+100, n = NULL, - prewhiten = TRUE, biweight = TRUE) - +xskel.plot(rwl, series, series.yrs = as.numeric(names(series)), + win.start, win.end = win.start+100, n = NULL, + prewhiten = TRUE, biweight = TRUE) } \arguments{ \item{rwl}{ a \code{data.frame} with series as columns and years as rows From noreply at r-forge.r-project.org Thu May 15 11:33:13 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 15 May 2014 11:33:13 +0200 (CEST) Subject: [Dplr-commits] r875 - pkg/dplR/R Message-ID: <20140515093313.20F301873DB@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-15 11:33:12 +0200 (Thu, 15 May 2014) New Revision: 875 Modified: pkg/dplR/R/xskel.ccf.plot.R Log: whitespace changes only Modified: pkg/dplR/R/xskel.ccf.plot.R =================================================================== --- pkg/dplR/R/xskel.ccf.plot.R 2014-05-15 09:05:42 UTC (rev 874) +++ pkg/dplR/R/xskel.ccf.plot.R 2014-05-15 09:33:12 UTC (rev 875) @@ -1,23 +1,23 @@ xskel.ccf.plot <- function(rwl,series,series.yrs = as.numeric(names(series)), - win.start, win.width=50, n = NULL, prewhiten = TRUE, - biweight = TRUE) { + win.start, win.width=50, n = NULL, prewhiten = TRUE, + biweight = TRUE) { ## check to see that win.width is even if(as.logical(win.width %% 2)) stop("'win.width' must be even") - if (win.width > 100) { + if (win.width > 100) { warning("win.width should be < 100 unless your plotting is very wide!") } - + ## Handle different types of 'series' tmp <- pick.rwl.series(rwl, series, series.yrs) rwl <- tmp[[1]] series <- tmp[[2]] - + master.yrs <- as.numeric(rownames(rwl)) series.yrs <- as.numeric(names(series)) yrs <- seq(from=win.start,to=win.start+win.width) ## nyrs <- length(yrs) cen.win <- win.width/2 - + ## check window overlap with master and series yrs if (!all(yrs %in% series.yrs)) { cat("Window Years: ", min(yrs), "-", max(yrs)," & ", @@ -31,11 +31,11 @@ "\n", sep="") stop("Fix window overlap") } - + ## normalize. names(series) <- series.yrs tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) - + ## master master <- tmp$master master.yrs <- as.numeric(names(master)) @@ -46,8 +46,8 @@ series.yrs <- as.numeric(names(series)) series <- series[series.yrs%in%yrs] series.yrs <- as.numeric(names(series)) - - + + ## skeleton master.skel <- cbind(master.yrs,xskel.calc(master)) master.skel <- master.skel[master.skel[,1]%in%yrs,] @@ -55,7 +55,7 @@ series.skel <- cbind(series.yrs,xskel.calc(series)) series.skel <- series.skel[series.skel[,1]%in%yrs,] series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] - + ## divide in half first.half <- 1:cen.win second.half <- (cen.win + 1):win.width @@ -65,65 +65,65 @@ series.early <- series[first.half] master.late <- master[second.half] series.late <- series[second.half] - + ## subset skel data early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,] early.series.yrs.sig <- early.series.skel[!is.na(early.series.skel[,2]),1] - + early.master.skel <- master.skel[master.skel[,1]%in%first.yrs,] early.master.yrs.sig <- early.master.skel[!is.na(early.master.skel[,2]),1] - + late.series.skel <- series.skel[series.skel[,1]%in%second.yrs,] late.series.yrs.sig <- late.series.skel[!is.na(late.series.skel[,2]),1] - + late.master.skel <- master.skel[master.skel[,1]%in%second.yrs,] late.master.yrs.sig <- late.master.skel[!is.na(late.master.skel[,2]),1] - - + + ## ccf ccf.early <- as.vector(ccf(x=series.early,y=master.early,lag.max=5,plot=FALSE)$acf) ccf.late <- as.vector(ccf(x=series.late,y=master.late,lag.max=5,plot=FALSE)$acf) pcrit=0.05 sig <- qnorm(1 - pcrit / 2) / sqrt(length(master.early)) sig <- c(-sig, sig) - + ## cor and skel agreement - overall.r <- round(cor(series,master),3) + overall.r <- round(cor(series,master),3) early.r <- round(cor(series.early,master.early),3) late.r <- round(cor(series.late,master.late),3) - - ## aggreement btwn series skel and master skel + + ## aggreement btwn series skel and master skel overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) overall.agree <- round(overall.agree*100,1) - + early.agree <- sum(early.series.yrs.sig%in%early.master.yrs.sig)/length(early.master.yrs.sig) early.agree <- round(early.agree*100,1) - + late.agree <- sum(late.series.yrs.sig%in%late.master.yrs.sig)/length(late.master.yrs.sig) late.agree <- round(late.agree*100,1) - + ## build page for plotting grid.newpage() fontsize <- 12 # fontsize for all text - pointsize <- 12 # fontsize for grid.points() + pointsize <- 12 # fontsize for grid.points() textJust <- "center" # justification for horizontal text elements col1light <- "lightgreen" col1dark <- "darkgreen" col2light <- "lightblue" col2dark <- "darkblue" - ## 1.0 a bounding box for margins + ## 1.0 a bounding box for margins bnd.vp <- plotViewport(margins=rep(0.5,4), # 1/2 line margin name = "bnd.vp", gp = gpar(fontsize = fontsize)) ## go from bottom up. - + ## 2.1 bounding box for ccf early: 30% of area height inside bnd.vp ccf.early.bnd.vp <- viewport(x = 0, y = 0, width = 0.5, height = 0.3, - just = c("left", "bottom"), + just = c("left", "bottom"), name = "ccf.early.bnd.vp") ## 2.12 plotting region for ccf early. 1 line margin bottom. 2 lines left ccf.early.region.vp <- plotViewport(margins=c(1,2,0,0), - xscale=c(0,12), + xscale=c(0,12), yscale=c(-1,1), name = "ccf.early.region.vp") ## 2.2 bounding box for ccf late: 30% of area height inside bnd.vp @@ -132,30 +132,30 @@ name = "ccf.late.bnd.vp") ## 2.22 plotting region for ccf late. 1 line margin bottom. 2 lines right ccf.late.region.vp <- plotViewport(margins=c(1, 0, 0, 2), - xscale=c(0,12), + xscale=c(0,12), yscale=c(-1,1), name = "ccf.late.region.vp") - + ## 3.0 box for text comparing early and late periods. 10% area height text.bnd.vp <- viewport(x = 0, y = 0.3, width = 1, height = 0.1, just = c("left", "bottom"), name = "text.bnd.vp") - - ## 4.1 bounding box for skeleton plot. 55% of area + + ## 4.1 bounding box for skeleton plot. 55% of area skel.bnd.vp <- viewport(x = 0, y = 0.4, width = 1, height = 0.55, just = c("left", "bottom"), name = "skel.bnd.vp") - ## 4.2 plotting region for skeleton plot. 2 lines left and right. + ## 4.2 plotting region for skeleton plot. 2 lines left and right. ## 3 lines on top and bottom skel.region.vp <- plotViewport(margins=c(3,2,3,2), - xscale=c(min(yrs)-0.5,max(yrs)+0.5), + xscale=c(min(yrs)-0.5,max(yrs)+0.5), yscale=c(-10,10), name = "skel.region.vp") ## 5.0 a box for overall text. 5% overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, - just = c("left", "bottom"), + just = c("left", "bottom"), name = "overall.txt.vp") - - - + + + ## actual plotting pushViewport(bnd.vp) # inside margins pushViewport(skel.bnd.vp) # inside skel @@ -163,24 +163,24 @@ grid.rect(gp = gpar(col=col1light, lwd=1)) grid.grill(h = unit(seq(-10, 10, by=1), "native"), v = unit(yrs-0.5, "native"), - gp = gpar(col=col1light, lineend = "square", + gp = gpar(col=col1light, lineend = "square", linejoin = "round")) ## rw plot master.tmp <- master*-2 for(i in 1:length(yrs)){ xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) yy <- c(0,0,master.tmp[i],master.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill=col1light,col=col1dark)) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill=col1light,col=col1dark)) } series.tmp <- series*2 for(i in 1:length(yrs)){ xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) yy <- c(0,0,series.tmp[i],series.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill=col1light,col=col1dark)) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill=col1light,col=col1dark)) } - + ## master grid.segments(x0=master.yrs.sig,y0=0, x1=master.yrs.sig,y1=-10, @@ -199,17 +199,17 @@ x1=series.skel[,1],y1=series.skel[,2], default.units="native", gp=gpar(lwd=5,col='black',lineend="butt")) - - ## text - grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), + + ## text + grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), y = unit(0, "npc"), rot = 90,just="right") - grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), + grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), y = unit(1, "npc"), rot = 90,just="left") grid.text(gettext("Master", domain="R-dplR"),x=unit(0,"npc"), y=unit(0,"npc"),hjust = 0,vjust = 0,rot=90) grid.text(gettext("Series", domain="R-dplR"),x=unit(0,"npc"), y=unit(1,"npc"),hjust=1,vjust=0,rot=90) - + popViewport(2) # back to bnd negText <- textGrob(gettext("(Negative)", domain="R-dplR"), @@ -232,7 +232,7 @@ pushViewport(vp2) # inside margins grid.grill(v = unit(seq(1, 11, by=1), "native"), h=NA, - gp = gpar(col=col2light, lineend = "square", + gp = gpar(col=col2light, lineend = "square", linejoin = "round")) grid.segments(x0=unit(c(0, 0), "native"),y0=unit(sig, "native"), x1=unit(c(12, 12), "native"),y1=unit(sig, "native"), @@ -254,7 +254,7 @@ periodPattern <- gettext("Period: %d-%d", domain = "R-dplR") agreePattern <- gettext("Skeleton Agreement %s%%", domain = "R-dplR") - + grid.segments(x0=0.5,y0=0,x1=0.5,y1=0.95, default.units="npc", gp=gpar(lwd=2,lend="butt", col="black")) @@ -265,25 +265,25 @@ corr = early.r)) grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.25,"npc"), just = textJust) - + grid.text(sprintf(agreePattern, early.agree), y=unit(0.35,"npc"), x=unit(0.25,"npc"), just = textJust) - - + + tmp.txt <- substitute(period * ", " * r[lag0] == corr, list(period = sprintf(periodPattern, min(second.yrs), max(second.yrs)), corr = late.r)) grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.75,"npc"), just = textJust) - + grid.text(sprintf(agreePattern, late.agree), y=unit(0.35,"npc"), x=unit(0.75,"npc"), just = textJust) - + popViewport(1) # back to bnd - + pushViewport(overall.txt.vp) # description tmp.txt <- substitute(period * ", " * r[lag0] == corr * ", " * agree, list(period = sprintf(periodPattern, @@ -293,5 +293,5 @@ grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), just = textJust) popViewport(2) - + } From noreply at r-forge.r-project.org Thu May 15 18:11:48 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 15 May 2014 18:11:48 +0200 (CEST) Subject: [Dplr-commits] r876 - in pkg/dplR: . R Message-ID: <20140515161148.A54D71845E3@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-15 18:11:48 +0200 (Thu, 15 May 2014) New Revision: 876 Modified: pkg/dplR/ChangeLog pkg/dplR/R/xskel.plot.R Log: xskel.plot() got the same type of treatment as xskel.ccf.plot() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-15 09:33:12 UTC (rev 875) +++ pkg/dplR/ChangeLog 2014-05-15 16:11:48 UTC (rev 876) @@ -92,8 +92,8 @@ instead of seq(from=0, to=1, by=0.1). Parentheses in the former are used for clarity of meaning. -File: xskel.ccf.plot.R ----------------------- +Files: xskel.ccf.plot.R and xskel.plot.R +---------------------------------------- - Code optimizations - Small changes to output Modified: pkg/dplR/R/xskel.plot.R =================================================================== --- pkg/dplR/R/xskel.plot.R 2014-05-15 09:33:12 UTC (rev 875) +++ pkg/dplR/R/xskel.plot.R 2014-05-15 16:11:48 UTC (rev 876) @@ -1,109 +1,121 @@ xskel.plot <- function(rwl,series,series.yrs = as.numeric(names(series)), - win.start, win.end=win.start+100, n = NULL, prewhiten = TRUE, - biweight = TRUE) { - + win.start, win.end=win.start+100, n = NULL, prewhiten = TRUE, + biweight = TRUE) { + ## Handle different types of 'series' tmp <- pick.rwl.series(rwl, series, series.yrs) rwl <- tmp[[1]] series <- tmp[[2]] - + master.yrs <- as.numeric(rownames(rwl)) series.yrs <- as.numeric(names(series)) yrs <- seq(from=win.start,to=win.end) nyrs <- length(yrs) - + if(nyrs > 101){ warning("These plots get crowded with windows longer than 100 years.") } - # check window overlap with master and series yrs + ## check window overlap with master and series yrs if (!all(yrs %in% series.yrs)) { - cat("Window Years: ", min(yrs), "-", max(yrs)," & ", - "Series Years: ", min(series.yrs), "-", max(series.yrs), - "\n", sep="") - stop("Fix window overlap") + cat(gettextf("Window Years: %d-%d", min(yrs), max(yrs), + domain = "R-dplR"), + " & ", + gettextf("Series Years: %d-%d", min(series.yrs), max(series.yrs), + domain = "R-dplR"), + "\n", sep="") + stop("Fix window overlap") } if (!all(yrs %in% master.yrs)) { - cat("Window Years: ", min(yrs), "-", max(yrs)," & ", - "Master Years: ", min(master.yrs), "-", max(master.yrs), - "\n", sep="") - stop("Fix window overlap") + cat(gettextf("Window Years: %d-%d", min(yrs), max(yrs), + domain = "R-dplR"), + " & ", + gettextf("Master Years: %d-%d", min(master.yrs), max(master.yrs), + domain = "R-dplR"), + "\n", sep="") + stop("Fix window overlap") } - - # normalize. + + ## normalize. names(series) <- series.yrs tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) - - # master + + ## master master <- tmp$master master.yrs <- as.numeric(names(master)) master <- master[master.yrs%in%yrs] master.yrs <- as.numeric(names(master)) - # series + ## series series <- tmp$series series.yrs <- as.numeric(names(series)) series <- series[series.yrs%in%yrs] series.yrs <- as.numeric(names(series)) - - - # skeleton + + + ## skeleton master.skel <- cbind(master.yrs,xskel.calc(master)) master.skel <- master.skel[master.skel[,1]%in%yrs,] master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] series.skel <- cbind(series.yrs,xskel.calc(series)) series.skel <- series.skel[series.skel[,1]%in%yrs,] series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] - - # cor and skel agreement - overall.r <- round(cor(series,master),3) + + ## cor and skel agreement + overall.r <- round(cor(series,master),3) overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) overall.agree <- round(overall.agree*100,1) - - # build page for plotting + + ## build page for plotting grid.newpage() - # 1.0 a bounding box for margins - bnd.vp <- plotViewport(margins=rep(0.5,4),name = "bnd.vp") # 1/2 line margin - # go from bottom up. - - # 4.1 bounding box for skeleton plot. 55% of area + fontsize <- 12 + textJust <- "center" + col1light <- "lightgreen" + col1dark <- "darkgreen" + ## 1.0 a bounding box for margins + bnd.vp <- plotViewport(margins=rep(0.5,4), # 1/2 line margin + name = "bnd.vp", + gp = gpar(fontsize = fontsize)) + ## go from bottom up. + + ## 4.1 bounding box for skeleton plot. 55% of area skel.bnd.vp <- viewport(x = 0, y = 0, width = 1, height = 0.95, just = c("left", "bottom"), name = "skel.bnd.vp") - # 4.2 plotting region for skeleton plot. 2 lines left and right. - # 3 lines on top and bottom + ## 4.2 plotting region for skeleton plot. 2 lines left and right. + ## 3 lines on top and bottom skel.region.vp <- plotViewport(margins=c(3,2,3,2), - xscale=c(min(yrs)-0.5,max(yrs)+0.5), + xscale=c(min(yrs)-0.5,max(yrs)+0.5), yscale=c(-10,10), name = "skel.region.vp") - # 5.0 a box for overall text. 5% + ## 5.0 a box for overall text. 5% overall.txt.vp <- viewport(x = 0, y = 0.95, width = 1, height = 0.05, - just = c("left", "bottom"), + just = c("left", "bottom"), name = "overall.txt.vp") - - # actual plotting + + ## actual plotting pushViewport(bnd.vp) # inside margins pushViewport(skel.bnd.vp) # inside skel pushViewport(skel.region.vp) # inside margins - grid.rect(gp = gpar(col="lightgreen", lwd=1)) + grid.rect(gp = gpar(col=col1light, lwd=1)) grid.grill(h = unit(seq(-10, 10, by=1), "native"), v = unit(yrs-0.5, "native"), - gp = gpar(col="lightgreen", lineend = "square", + gp = gpar(col=col1light, lineend = "square", linejoin = "round")) - # rw plot + ## rw plot master.tmp <- master*-2 for(i in 1:length(yrs)){ xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) yy <- c(0,0,master.tmp[i],master.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill='lightgreen',col='darkgreen')) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill=col1light,col=col1dark)) } series.tmp <- series*2 for(i in 1:length(yrs)){ xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) yy <- c(0,0,series.tmp[i],series.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill='lightgreen',col='darkgreen')) + grid.polygon(xx,yy,default.units="native", + gp=gpar(fill=col1light,col=col1dark)) } - - #master + + ## master grid.segments(x0=master.yrs.sig,y0=0, x1=master.yrs.sig,y1=-10, default.units="native", @@ -112,7 +124,7 @@ x1=master.skel[,1],y1=master.skel[,2]*-1, default.units="native", gp=gpar(lwd=5,col='black',lineend="butt")) - #series + ## series grid.segments(x0=series.yrs.sig,y0=0, x1=series.yrs.sig,y1=10, default.units="native", @@ -121,32 +133,28 @@ x1=series.skel[,1],y1=series.skel[,2], default.units="native", gp=gpar(lwd=5,col='black',lineend="butt")) - - # text - grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), - y = unit(0, "npc"), rot = 90,just="right", - gp=gpar(fontsize=12)) - grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), - y = unit(1, "npc"), rot = 90,just="left", - gp= gpar(fontsize = 12)) - grid.text("Master",x=unit(0,"npc"), - y=unit(0,"npc"),hjust = 0,vjust = 0,rot=90, - gp= gpar(fontsize = 12)) - grid.text("Series",x=unit(0,"npc"), - y=unit(1,"npc"),hjust=1,vjust=0,rot=90, - gp= gpar(fontsize = 12)) - - upViewport(3) # back to bnd + + ## text + grid.text(master.yrs.sig, x=unit(master.yrs.sig,"native"), + y = unit(0, "npc"), rot = 90,just="right") + grid.text(series.yrs.sig, x=unit(series.yrs.sig,"native"), + y = unit(1, "npc"), rot = 90,just="left") + grid.text(gettext("Master", domain="R-dplR"),x=unit(0,"npc"), + y=unit(0,"npc"),hjust = 0,vjust = 0,rot=90) + grid.text(gettext("Series", domain="R-dplR"),x=unit(0,"npc"), + y=unit(1,"npc"),hjust=1,vjust=0,rot=90) + + popViewport(2) # back to bnd pushViewport(overall.txt.vp) # description - tmp.txt <- paste("Period: ",min(yrs),"-",max(yrs), - ", r(lag0)= ", overall.r, - ". Skeleton Agreement ", overall.agree, "%",sep="") - tmp.txt <- bquote("Period:" ~ .(min(yrs)) * "-" * - .(max(yrs)) * ","~r[lag0] * "=" * .(overall.r)* - ","~"Skeleton Agreement"~.(overall.agree)*"%") - grid.rect(gp=gpar(col=NA,fill="white")) + periodPattern <- gettext("Period: %d-%d", domain = "R-dplR") + agreePattern <- gettext("Skeleton Agreement %s%%", domain = "R-dplR") + tmp.txt <- substitute(period * ", " * r[lag0] == corr * ", " * agree, + list(period = sprintf(periodPattern, + min(yrs), max(yrs)), + corr = overall.r, + agree = sprintf(agreePattern, overall.agree))) grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"), - just = "center", - gp= gpar(fontsize = 12)) - -} \ No newline at end of file + just = textJust) + popViewport(2) + +} From noreply at r-forge.r-project.org Thu May 15 19:03:50 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 15 May 2014 19:03:50 +0200 (CEST) Subject: [Dplr-commits] r877 - in pkg/dplR: . R Message-ID: <20140515170350.B8553186DC6@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-15 19:03:50 +0200 (Thu, 15 May 2014) New Revision: 877 Modified: pkg/dplR/NAMESPACE pkg/dplR/R/xskel.ccf.plot.R pkg/dplR/R/xskel.plot.R Log: Speedup due to use of vectorized grid.rect(). Also dev.hold() and dev.flush(). Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-05-15 16:11:48 UTC (rev 876) +++ pkg/dplR/NAMESPACE 2014-05-15 17:03:50 UTC (rev 877) @@ -9,7 +9,7 @@ importFrom(gmp, as.bigq, as.bigz, chooseZ, is.bigq) -importFrom(grDevices, rainbow) +importFrom(grDevices, dev.hold, dev.flush, rainbow) importFrom(grid, gpar, grid.lines, grid.newpage, grid.polygon, grid.segments, grid.text, pushViewport, seekViewport, unit, Modified: pkg/dplR/R/xskel.ccf.plot.R =================================================================== --- pkg/dplR/R/xskel.ccf.plot.R 2014-05-15 16:11:48 UTC (rev 876) +++ pkg/dplR/R/xskel.ccf.plot.R 2014-05-15 17:03:50 UTC (rev 877) @@ -157,6 +157,8 @@ ## actual plotting + dev.hold() + on.exit(dev.flush()) pushViewport(bnd.vp) # inside margins pushViewport(skel.bnd.vp) # inside skel pushViewport(skel.region.vp) # inside margins @@ -166,20 +168,12 @@ gp = gpar(col=col1light, lineend = "square", linejoin = "round")) ## rw plot - master.tmp <- master*-2 - for(i in 1:length(yrs)){ - xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) - yy <- c(0,0,master.tmp[i],master.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill=col1light,col=col1dark)) - } - series.tmp <- series*2 - for(i in 1:length(yrs)){ - xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) - yy <- c(0,0,series.tmp[i],series.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill=col1light,col=col1dark)) - } + grid.rect(x = yrs, y = 0, width = 1, height = 2 * master, + hjust = 0.5, vjust = 1, default.units = "native", + gp=gpar(fill=col1light,col=col1dark)) + grid.rect(x = yrs, y = 0, width = 1, height = 2 * series, + hjust = 0.5, vjust = 0, default.units = "native", + gp=gpar(fill=col1light,col=col1dark)) ## master grid.segments(x0=master.yrs.sig,y0=0, Modified: pkg/dplR/R/xskel.plot.R =================================================================== --- pkg/dplR/R/xskel.plot.R 2014-05-15 16:11:48 UTC (rev 876) +++ pkg/dplR/R/xskel.plot.R 2014-05-15 17:03:50 UTC (rev 877) @@ -91,6 +91,8 @@ name = "overall.txt.vp") ## actual plotting + dev.hold() + on.exit(dev.flush()) pushViewport(bnd.vp) # inside margins pushViewport(skel.bnd.vp) # inside skel pushViewport(skel.region.vp) # inside margins @@ -100,20 +102,12 @@ gp = gpar(col=col1light, lineend = "square", linejoin = "round")) ## rw plot - master.tmp <- master*-2 - for(i in 1:length(yrs)){ - xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) - yy <- c(0,0,master.tmp[i],master.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill=col1light,col=col1dark)) - } - series.tmp <- series*2 - for(i in 1:length(yrs)){ - xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5) - yy <- c(0,0,series.tmp[i],series.tmp[i]) - grid.polygon(xx,yy,default.units="native", - gp=gpar(fill=col1light,col=col1dark)) - } + grid.rect(x = yrs, y = 0, width = 1, height = 2 * master, + hjust = 0.5, vjust = 1, default.units = "native", + gp=gpar(fill=col1light,col=col1dark)) + grid.rect(x = yrs, y = 0, width = 1, height = 2 * series, + hjust = 0.5, vjust = 0, default.units = "native", + gp=gpar(fill=col1light,col=col1dark)) ## master grid.segments(x0=master.yrs.sig,y0=0, From noreply at r-forge.r-project.org Fri May 16 01:55:53 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 16 May 2014 01:55:53 +0200 (CEST) Subject: [Dplr-commits] r878 - in pkg/dplR: . R Message-ID: <20140515235553.8DCA5186CD0@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-16 01:55:53 +0200 (Fri, 16 May 2014) New Revision: 878 Modified: pkg/dplR/ChangeLog pkg/dplR/NAMESPACE pkg/dplR/R/skel.plot.R Log: Performance optimizations in skel.plot() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-15 17:03:50 UTC (rev 877) +++ pkg/dplR/ChangeLog 2014-05-15 23:55:53 UTC (rev 878) @@ -75,6 +75,11 @@ will speed up otherwise unbearable computation times on some systems. +File: skel.plot.R +----------------- + +- Performance optimization + File: timeseries-dplR.Rnw ------------------------- Modified: pkg/dplR/NAMESPACE =================================================================== --- pkg/dplR/NAMESPACE 2014-05-15 17:03:50 UTC (rev 877) +++ pkg/dplR/NAMESPACE 2014-05-15 23:55:53 UTC (rev 878) @@ -14,7 +14,8 @@ importFrom(grid, gpar, grid.lines, grid.newpage, grid.polygon, grid.segments, grid.text, pushViewport, seekViewport, unit, viewport, vpList, vpTree, plotViewport, grid.grill, upViewport, - grid.points, popViewport, grid.rect, textGrob, grid.draw) + grid.points, popViewport, grid.rect, textGrob, grid.draw, + segmentsGrob, linesGrob, grobTree) importFrom(lattice, panel.abline, panel.dotplot, panel.segments, trellis.par.set, xyplot) Modified: pkg/dplR/R/skel.plot.R =================================================================== --- pkg/dplR/R/skel.plot.R 2014-05-15 17:03:50 UTC (rev 877) +++ pkg/dplR/R/skel.plot.R 2014-05-15 23:55:53 UTC (rev 878) @@ -14,6 +14,7 @@ cat(gettextf("input series has length of %d\n", n.val)) stop("long series (> 840) must be split into multiple plots") } + stopifnot(filt.weight >= 3) if(n.val < filt.weight) { cat(gettextf("input series has length of %d", n.val), gettextf("'filt.weight' is %f\n", filt.weight), sep=", ") @@ -42,12 +43,13 @@ } ## detrend and pad - rw.dt <- hanning(rw.df$rw, filt.weight) - skel <- rep(NA, length(rw.df$rw)) + rwRw <- rw.df[["rw"]] + rw.dt <- hanning(rwRw, filt.weight) + skel <- rep(NA, length(rwRw)) ## calc rel growth - n.diff <- length(rw.df$rw) - 1 + n.diff <- length(rwRw) - 1 idx <- 2:n.diff - temp.diff <- diff(rw.df$rw) + temp.diff <- diff(rwRw) skel[idx] <- rowMeans(cbind(temp.diff[-n.diff], -temp.diff[-1])) / rw.dt[idx] skel[skel > 0] <- NA @@ -81,14 +83,13 @@ n <- length(skel) n.rows <- ceiling(n / yrs.col) m <- seq_len(n.rows) - row.index <- rep(m, each = yrs.col)[seq_len(n)] - skel.df <- data.frame(yr=rw.df$yr, skel) + skel.df <- data.frame(yr=rw.df[["yr"]], skel) if(plot){ ## master page grid.newpage() - vps <- list() + vps <- vector(mode = "list", length = n.rows) y <- ph - for (i in seq_len(min(n.rows, 7))) { + for (i in m) { y <- y - (rh + spcr) vps[[i]] <- viewport(x=unit(3, "mm"), @@ -96,124 +97,125 @@ width=unit(246, "mm"), height=unit(rh, "mm"), just=c("left", "bottom"), name=LETTERS[i]) } - tree <- - vpTree(viewport(width=unit(pw, "mm"), height=unit(ph, "mm"), - name="page"), - do.call(vpList, vps)) - ## set up page with the right number of rows - pushViewport(tree) ## seq for 0 to plot width by 2mm tmp.1 <- seq(from=0, to=rw, by=2) tmp.2 <- seq(from=0, to=rh, by=2) - tmp.3 <- seq(from=0, to=rw, by=20) + ticks <- seq(from=0, to=rw, by=20) + vSegments <- + segmentsGrob(x0 = tmp.1, y0 = 0, x1 = tmp.1, y1 = rh, + default.units = "mm", + gp = gpar(col="green", lineend = "square", + linejoin = "round")) + hSegments <- + segmentsGrob(x0 = 0, y0 = tmp.2, x1 = rw, y1 = tmp.2, + default.units = "mm", + gp = gpar(col="green", lineend = "square", + linejoin = "round")) + ## decadal lines + decades <- + segmentsGrob(x0 = ticks, y0 = 0, x1 = ticks, y1 = rh, + default.units = "mm", + gp = gpar(col = "black", lwd = 1.5, lty = "dashed", + lineend = "square", linejoin = "round")) + ## lines on top and bottom of plot + topLine <- + linesGrob(x = c(0, rw), y = c(rh, rh), + default.units = "mm", + gp = gpar(lwd = 2, lineend = "square", + linejoin = "round")) + bottomLine <- + linesGrob(x = c(0, rw), y = c(0, 0), + default.units = "mm", + gp = gpar(lwd = 2, lineend = "square", + linejoin = "round")) + rowTree <- grobTree(vSegments, hSegments, decades, topLine, bottomLine) + if(!master){ + yy1 <- c(0, 6, 6) + yy2 <- rh - 1 + sjust <- c("right", "bottom") + yrjust <- c("center", "bottom") + yry <- rh + 0.5 + } + else{ + yy1 <- c(rh, 16, 16) + yy2 <- 1 + sjust <- c("left", "bottom") + yrjust <- c("center", "top") + yry <- rh - 22.5 + } + ## set up page with the right number of rows + dev.hold() + on.exit(dev.flush()) + pushViewport(vpTree(viewport(width=unit(pw, "mm"), + height=unit(ph, "mm"), name="page"), + do.call(vpList, vps))) + row.last <- 0 for (i in m) { seekViewport(LETTERS[i]) ## working code goes here - e.g., skelplot! - grid.segments(x0=unit(tmp.1, "mm"), y0=unit(0, "mm"), - x1=unit(tmp.1, "mm"), y1=unit(rh, "mm"), - gp = gpar(col="green", lineend = "square", linejoin = "round")) - grid.segments(x0=unit(0, "mm"), y0=unit(tmp.2, "mm"), - x1=unit(rw, "mm"), y1=unit(tmp.2, "mm"), - gp = gpar(col="green", lineend = "square", linejoin = "round")) + grid.draw(rowTree) - ## decadal lines - grid.segments(x0=unit(tmp.3, "mm"), y0=unit(0, "mm"), - x1=unit(tmp.3, "mm"), y1=unit(rh, "mm"), - gp = gpar(col = "black", lwd = 1.5, lty = "dashed", - lineend = "square", linejoin = "round")) - - ## lines on top and bottom of plot - grid.lines(x=unit(c(0, rw), "mm"), - y=unit(c(rh, rh), "mm"), - gp=gpar(lwd = 2, lineend = "square", linejoin = "round")) - grid.lines(x=unit(c(0, rw), "mm"), - y=unit(c(0, 0), "mm"), - gp=gpar(lwd = 2, lineend = "square", linejoin = "round")) ## plot x axis ## get this row's data - skel.sub <- skel.df[row.index == i, ] - end.yr <- length(skel.sub$yr) - ticks <- seq(from=0, to=rw / 2, by=10) - init.lab <- min(skel.sub$yr) + row.first <- row.last + 1 + row.last <- min(row.first + (yrs.col - 1), n) + skel.sub <- skel.df[row.first:row.last, ] + skelYr <- skel.sub[["yr"]] + skel2 <- skel.sub[["skel"]] + end.yr <- length(skelYr) + init.lab <- min(skelYr) x.labs <- seq(from=init.lab, length.out = length(ticks), by=10) - for(j in seq_along(ticks)) - if(!master) - grid.text(label = x.labs[j], - x=unit(ticks[j] * 2, "mm"), - y=unit(rh + 0.5, "mm"), - just = c("center", "bottom"), - gp = gpar(fontsize=10)) - else - grid.text(label = x.labs[j], - x=unit(ticks[j] * 2, "mm"), - y=unit(rh - 22.5, "mm"), - just = c("center", "top"), - gp = gpar(fontsize=10)) + grid.text(label = x.labs, x = ticks, y = yry, + default.units = "mm", just = yrjust, + gp = gpar(fontsize=10)) ## plot data - for(j in seq_along(skel.sub$yr)){ - if(!is.na(skel.sub$skel[j])){ - if(!master) - grid.lines(x=unit(c((j - 1) * 2, (j - 1) * 2), "mm"), - y=unit(c(0, skel.sub$skel[j] * 2), "mm"), - gp = gpar(col = "black", lwd = 2, lineend = "square", - linejoin = "round")) - else - grid.lines(x=unit(c((j - 1) * 2, (j - 1) * 2), "mm"), - y=unit(c(22, 22 - skel.sub$skel[j] * 2), "mm"), - gp = gpar(col = "black", lwd = 2, lineend = "square", - linejoin = "round")) + notNA <- which(!is.na(skel2)) + if (length(notNA) > 0) { + xx <- (notNA - 1) * 2 + if (!master) { + y0 <- 0 + y1 <- 2 * skel2[notNA] + } else { + y0 <- 22 + y1 <- 22 - 2 * skel2[notNA] } - ## end arrow - if(i == n.rows && j == end.yr){ - end.mm <- (j - 1) * 2 - grid.lines(x=unit(c(end.mm, end.mm), "mm"), - y=unit(c(rh, 0), "mm"), - gp = gpar(lwd = 2, lineend = "square", linejoin = "round")) - if(!master) - grid.polygon(x=unit(c(end.mm, end.mm, end.mm + 2), "mm"), - y=unit(c(0, 6, 6), "mm"), - gp=gpar(fill = "black", lineend = "square", linejoin = "round")) - else - grid.polygon(x=unit(c(end.mm, end.mm, end.mm + 2), "mm"), - y=unit(c(rh, 16, 16), "mm"), - gp=gpar(fill = "black", lineend = "square", linejoin = "round")) - } + grid.segments(x0 = xx, x1 = xx, y0 = y0, y1 = y1, + default.units = "mm", + gp = gpar(col = "black", lwd = 2, + lineend = "square", linejoin = "round")) } - ## start arrow and sample id - if(i == 1){ - start.mm <- pad.length * 2 - grid.lines(x=unit(c(start.mm, start.mm), "mm"), - y=unit(c(rh, 0), "mm"), - gp = gpar(lwd = 2, lineend = "square", linejoin = "round")) - fontsize.sname <- ifelse(nchar(sname) > 6, 9, 10) - if(!master){ - grid.polygon(x=unit(c(start.mm, start.mm, start.mm - 2), "mm"), - y=unit(c(0, 6, 6), "mm"), - gp=gpar(fill = "black", lineend = "square", linejoin = "round")) - grid.text(label = sname, - x=unit(start.mm - 1, "mm"), - y=unit(rh - 1, "mm"), - just = c("right", "bottom"), - rot = 90, - gp = gpar(fontsize=fontsize.sname)) - } - else{ - grid.polygon(x=unit(c(start.mm, start.mm, start.mm - 2), "mm"), - y=unit(c(rh, 16, 16), "mm"), - gp=gpar(fill = "black", lineend = "square", linejoin = "round")) - grid.text(label = sname, - x=unit(start.mm - 1, "mm"), - y=unit(1, "mm"), - just = c("left", "bottom"), - rot = 90, - gp = gpar(fontsize=fontsize.sname)) - } - - } - } + ## end arrow + end.mm <- (end.yr - 1) * 2 + grid.lines(x=unit(c(end.mm, end.mm), "mm"), y=unit(c(rh, 0), "mm"), + gp = gpar(lwd = 2, lineend = "square", linejoin = "round")) + grid.polygon(x = c(end.mm, end.mm, end.mm + 2), y = yy1, + gp = gpar(fill = "black", lineend = "square", + linejoin = "round"), default.units = "mm") + ## start arrow and sample id + seekViewport(LETTERS[1]) + start.mm <- pad.length * 2 + grid.lines(x=unit(c(start.mm, start.mm), "mm"), + y=unit(c(rh, 0), "mm"), + gp = gpar(lwd = 2, lineend = "square", linejoin = "round")) + fontsize.sname <- ifelse(nchar(sname) > 6, 9, 10) + grid.polygon(x = c(start.mm, start.mm, start.mm - 2), + y = yy1, default.units = "mm", + gp=gpar(fill = "black", lineend = "square", + linejoin = "round")) + grid.text(label = sname, x = start.mm - 1, y = yy2, + just = sjust, rot = 90, default.units = "mm", + gp = gpar(fontsize=fontsize.sname)) + popViewport() + for (i in seq(from = 2, by = 1, length.out = n.rows - 1)) { + seekViewport(LETTERS[i]) + popViewport() + } + popViewport() } - if(dat.out) return(skel.df) + if (dat.out) { + skel.df + } } From noreply at r-forge.r-project.org Fri May 16 13:25:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 16 May 2014 13:25:33 +0200 (CEST) Subject: [Dplr-commits] r879 - pkg/dplR Message-ID: <20140516112533.1BC33187490@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-16 13:25:32 +0200 (Fri, 16 May 2014) New Revision: 879 Modified: pkg/dplR/DESCRIPTION Log: Bumped up the minimum version number of Suggested package "dichromat". Earlier versions did not install cleanly (tested with R 2.15.0). Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-15 23:55:53 UTC (rev 878) +++ pkg/dplR/DESCRIPTION 2014-05-16 11:25:32 UTC (rev 879) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-15 +Date: 2014-05-16 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", @@ -21,7 +21,7 @@ Imports: gmp (>= 0.5-2), graphics, grDevices, grid, stats, utils, digest (>= 0.2.3), lattice (>= 0.13-6), png (>= 0.1-1), stringr (>= 0.4), XML (>= 2.1-0) -Suggests: Biobase, dichromat (>= 1.2-1), foreach, forecast, iterators, +Suggests: Biobase, dichromat (>= 1.2-3), foreach, forecast, iterators, knitr, RColorBrewer, RUnit (>= 0.4.25), tikzDevice, waveslim Description: This package contains functions for performing tree-ring analyses, IO, and graphics. From noreply at r-forge.r-project.org Sat May 17 01:07:11 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 17 May 2014 01:07:11 +0200 (CEST) Subject: [Dplr-commits] r880 - pkg/dplR/R Message-ID: <20140516230711.43F4B18747D@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-17 01:07:10 +0200 (Sat, 17 May 2014) New Revision: 880 Modified: pkg/dplR/R/rasterPlot.R pkg/dplR/R/wavelet.plot.R Log: wavelet.plot() is now using interpolate=FALSE in rasterImage(), through dplR::rasterPlot()". The difference between 'antialias' and 'interpolate' is that the former option works at the time when the raster image (png) is created and the latter has an effect on how the raster image is shown. This change has a small impact on the appearance of pictures from wavelet.plot(useRaster=TRUE). Modified: pkg/dplR/R/rasterPlot.R =================================================================== --- pkg/dplR/R/rasterPlot.R 2014-05-16 11:25:32 UTC (rev 879) +++ pkg/dplR/R/rasterPlot.R 2014-05-16 23:07:10 UTC (rev 880) @@ -6,17 +6,24 @@ ### ### Arguments: ### x Low-level plotting commands representing elements to be added -### to the current plot. Examples: lines(), points(), text(), +### to the current plot. Examples: lines(), points(), text(), ### mtext(), .filled.contour() ### res Resolution in points per inch. ### Estimated useful range: 100 - 300. ### region Draw in the plot region or the figure region? ### The figure region contains the plot region and margins. ### Plotting in the outer margin is not supported. -### antialias antialiasing argument for png(). "none" is preferred for -### images. The default value (missing argument) is probably -### good for line plots. -rasterPlot <- function(x, res = 150, region=c("plot", "figure"), antialias) { +### antialias Antialiasing option for png(). See argument 'antialias' +### in ?png. "none" is preferred for images in which color +### signifies value of data. The default (missing argument) +### is probably good for line plots. +### interpolate +### Argument passed to rasterImage(). A logical flag. +### The default is TRUE: use linear interpolation. +### Analogously to 'antialias', FALSE is preferred when +### color maps to value. +rasterPlot <- function(x, res = 150, region=c("plot", "figure"), antialias, + interpolate = TRUE) { if (identical(dev.capabilities("rasterImage")[["rasterImage"]], "no")) { stop("device does not support raster images") } @@ -87,7 +94,8 @@ if (plotRegion) { ## Add a raster image to the plot region of the original plot rasterImage(pngData, xleft = usrLeft, ybottom = usrBottom, - xright = usrRight, ytop = usrTop) + xright = usrRight, ytop = usrTop, + interpolate = interpolate) } else { usrWidth <- usrRight - usrLeft usrHeight <- usrTop - usrBottom @@ -108,6 +116,7 @@ on.exit(par(xpd = op[["xpd"]])) ## Add a raster image to the figure region of the original plot rasterImage(pngData, xleft = figLeft, ybottom = figBottom, - xright = figRight, ytop = figTop) + xright = figRight, ytop = figTop, + interpolate = interpolate) } } Modified: pkg/dplR/R/wavelet.plot.R =================================================================== --- pkg/dplR/R/wavelet.plot.R 2014-05-16 11:25:32 UTC (rev 879) +++ pkg/dplR/R/wavelet.plot.R 2014-05-16 23:07:10 UTC (rev 880) @@ -93,7 +93,8 @@ z, as.double(wavelet.levels), key.cols)) - tryCatch(rasterPlot(cl, res = res, antialias = "none"), + tryCatch(rasterPlot(cl, res = res, + antialias = "none", interpolate = FALSE), error = function(e) { message(as.character(e), appendLF = FALSE) message("reverting to useRaster=FALSE") @@ -179,7 +180,8 @@ z, as.double(wavelet.levels), key.cols)) - tryCatch(rasterPlot(cl, res = res, antialias = "none"), + tryCatch(rasterPlot(cl, res = res, + antialias = "none", interpolate = FALSE), error = function(e) { message(as.character(e), appendLF = FALSE) message("reverting to useRaster=FALSE") From noreply at r-forge.r-project.org Sat May 17 10:40:28 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 17 May 2014 10:40:28 +0200 (CEST) Subject: [Dplr-commits] r881 - in pkg/dplR: . R Message-ID: <20140517084029.056FE18478E@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-17 10:40:28 +0200 (Sat, 17 May 2014) New Revision: 881 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/corr.rwl.seg.R Log: Performance optimization in corr.rwl.seg() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-16 23:07:10 UTC (rev 880) +++ pkg/dplR/ChangeLog 2014-05-17 08:40:28 UTC (rev 881) @@ -24,6 +24,11 @@ - Bug fix: make.plot=TRUE threw an error when input data.frame had leading or trailing all-NA rows +File: corr.rwl.seg.R, skel.plot.R +--------------------------------- + +- Performance optimization, including the use of dev.hold() and dev.flush() + File: latexify.R ---------------- @@ -75,11 +80,6 @@ will speed up otherwise unbearable computation times on some systems. -File: skel.plot.R ------------------ - -- Performance optimization - File: timeseries-dplR.Rnw ------------------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-16 23:07:10 UTC (rev 880) +++ pkg/dplR/DESCRIPTION 2014-05-17 08:40:28 UTC (rev 881) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-16 +Date: 2014-05-17 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/corr.rwl.seg.R =================================================================== --- pkg/dplR/R/corr.rwl.seg.R 2014-05-16 23:07:10 UTC (rev 880) +++ pkg/dplR/R/corr.rwl.seg.R 2014-05-17 08:40:28 UTC (rev 881) @@ -151,7 +151,8 @@ idx.good <- norm.one$idx.good ## loop through series - for (i in seq_len(nseries)) { + seq.series <- seq_len(nseries) + for (i in seq.series) { if (is.null(master)) { idx.noti <- rep(TRUE, nseries) idx.noti[i] <- FALSE @@ -217,18 +218,18 @@ on.exit(par(op), add=TRUE) col.pal <- c("#E41A1C", "#377EB8", "#4DAF4A") par(mar=c(4, 5, 4, 5) + 0.1, mgp=c(1.25, 0.25, 0), tcl=0.25) + dev.hold() + on.exit(dev.flush(), add=TRUE) plot(yrs, segs[, 1], type="n", ylim=c(0.5, nsegs + 0.5), axes=FALSE, ylab="", xlab=gettext("Year"), sub=gettextf("Segments: length=%d,lag=%d", seg.length, seg.lag, domain="R-dplR"), ...) ## bounding poly for even series - xx <- c(min.yr - 100, max.yr + 100) - xx <- c(xx, rev(xx)) - for (i in seq(from=1, to=nseries, by=2)) { - yy <- c(i - 0.5, i - 0.5, i + 0.5, i + 0.5) - polygon(xx, yy, col="grey90", border=NA) - } + iEven <- seq(from=1, to=nseries, by=2) + rect(xleft = min.yr - 100, ybottom = iEven - 0.5, + xright = max.yr + 100, ytop = iEven + 0.5, + col="grey90", border=NA) abline(v=c(bins[, 1], bins[c(nbins - 1, nbins), 2] + 1), col="grey", lty="dotted") @@ -242,7 +243,7 @@ flag.segs <- matrix(NA, ncol=nseries, nrow=nyrs) ## loop through these.bins tmp <- res.pval[neworder, this.seq, drop=FALSE] > pcrit - for (i in seq_len(nseries)) { + for (i in seq.series) { for (j in seq_len(nrow(these.bins))) { mask <- yrs %in% seq(from = these.bins[j, 1], to = these.bins[j, 2]) @@ -265,29 +266,36 @@ ## Ticks at 1) first year of each bin, ## and 2) first year larger than any of these bins axis(ax[odd.even], at=guides.x.base) - for (i in seq_len(nseries)) { - y.deviation <- y.deviation + 1 - ## whole segs - xx <- c(segs.mat[i, 1], segs.mat[i, 2] + 1) - xx <- c(xx, rev(xx)) - yy <- c(i, i, y.deviation, y.deviation) - polygon(xx, yy, col=col.pal[3], border=NA) - ## complete segs - xx <- c(com.segs.mat[i, 1], com.segs.mat[i, 2] + 1) - xx <- c(xx, rev(xx)) - polygon(xx, yy, col=col.pal[2], border=NA) + ## whole segs + if (odd.even == 1) { + ytop <- seq.series + ybottom <- ytop - 0.25 + } else { + ybottom <- seq.series + ytop <- ybottom + 0.25 + } + rect(xleft = segs.mat[, 1], ybottom = ybottom, + xright = segs.mat[, 2] + 1, ytop = ytop, + col=col.pal[3], border=NA) + ## complete segs + rect(xleft = com.segs.mat[, 1], ybottom = ybottom, + xright = com.segs.mat[, 2] + 1, ytop = ytop, + col=col.pal[2], border=NA) + for (i in seq.series) { + yb <- ybottom[i] + yt <- ytop[i] ## flags flag.segs.mat <- yr.ranges(flag.segs[, i], yrs) - for (j in seq_len(nrow(flag.segs.mat))) { - xx <- c(flag.segs.mat[j, 1], flag.segs.mat[j, 2] + 1) - xx <- c(xx, rev(xx)) - polygon(xx, yy, col=col.pal[1], border=NA) + if (nrow(flag.segs.mat) > 0) { + rect(xleft = flag.segs.mat[, 1], ybottom = yb, + xright = flag.segs.mat[, 2] + 1, ytop = yt, + col=col.pal[1], border=NA) } ## guides guides.x <- guides.x.base[guides.x.base >= segs.mat[i, 1]] guides.x <- guides.x[guides.x <= segs.mat[i, 2]] if (length(guides.x) > 0) { - segments(guides.x, i, guides.x, y.deviation, col="white") + segments(guides.x, yb, guides.x, yt, col="white") } } } @@ -302,7 +310,7 @@ axis(4, at=even.seq, labels=cnames.segs[even.seq], srt=45, tick=FALSE, las=2, cex.axis=label.cex) - abline(h=seq_len(nseries), col="white") + abline(h=seq.series, col="white") box() } From noreply at r-forge.r-project.org Sat May 17 15:21:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 17 May 2014 15:21:09 +0200 (CEST) Subject: [Dplr-commits] r882 - pkg/dplR/man Message-ID: <20140517132109.E62D71873D6@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-17 15:21:09 +0200 (Sat, 17 May 2014) New Revision: 882 Modified: pkg/dplR/man/combine.rwl.Rd pkg/dplR/man/corr.rwl.seg.Rd pkg/dplR/man/pointer.Rd pkg/dplR/man/strip.rwl.Rd Log: Edited examples to reduce the number of lines printed to the console or log file Modified: pkg/dplR/man/combine.rwl.Rd =================================================================== --- pkg/dplR/man/combine.rwl.Rd 2014-05-17 08:40:28 UTC (rev 881) +++ pkg/dplR/man/combine.rwl.Rd 2014-05-17 13:21:09 UTC (rev 882) @@ -31,9 +31,10 @@ \examples{data(ca533) data(co021) -combine.rwl(list(ca533, co021)) +combi1 <- combine.rwl(list(ca533, co021)) ## or alternatively for data.frames to combine -combine.rwl(ca533, co021) +combi2 <- combine.rwl(ca533, co021) +identical(combi1, combi2) # TRUE } \keyword{ manip } \ No newline at end of file Modified: pkg/dplR/man/corr.rwl.seg.Rd =================================================================== --- pkg/dplR/man/corr.rwl.seg.Rd 2014-05-17 08:40:28 UTC (rev 881) +++ pkg/dplR/man/corr.rwl.seg.Rd 2014-05-17 13:21:09 UTC (rev 882) @@ -127,7 +127,12 @@ \code{\link{series.rwl.plot}}, \code{\link{ccf.series.rwl}} } \examples{data(co021) -corr.rwl.seg(co021, seg.length = 100, label.cex = 1.25) +crs <- corr.rwl.seg(co021, seg.length = 100, label.cex = 1.25) +names(crs) +## Average correlation and p-value for the first few series +head(crs$overall) +## Average correlation for each bin +crs$avg.seg.rho } \keyword{ manip } Modified: pkg/dplR/man/pointer.Rd =================================================================== --- pkg/dplR/man/pointer.Rd 2014-05-17 08:40:28 UTC (rev 881) +++ pkg/dplR/man/pointer.Rd 2014-05-17 13:21:09 UTC (rev 882) @@ -111,5 +111,7 @@ \examples{## Pointer years calculation on ring-width series. Returns a data.frame. data(gp.rwl) -pointer(rwl=gp.rwl, rgv.thresh=10, nseries.thresh=75, round.decimals=2) +py <- pointer(rwl=gp.rwl, rgv.thresh=10, nseries.thresh=75, + round.decimals=2) +tail(py) } Modified: pkg/dplR/man/strip.rwl.Rd =================================================================== --- pkg/dplR/man/strip.rwl.Rd 2014-05-17 08:40:28 UTC (rev 881) +++ pkg/dplR/man/strip.rwl.Rd 2014-05-17 13:21:09 UTC (rev 882) @@ -78,7 +78,8 @@ \examples{ data(anos1) anos1.ids <- read.ids(anos1, stc = c(4, 3, 1)) -strip.rwl(anos1, ids = anos1.ids, verbose = TRUE) +srwl <- strip.rwl(anos1, ids = anos1.ids, verbose = TRUE) +tail(srwl) } \author{ Christian Zang. Patched and improved by Mikko Korpela. From noreply at r-forge.r-project.org Mon May 19 09:55:16 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 May 2014 09:55:16 +0200 (CEST) Subject: [Dplr-commits] r883 - in pkg/dplR: . R Message-ID: <20140519075516.76BA0187000@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-19 09:55:16 +0200 (Mon, 19 May 2014) New Revision: 883 Modified: pkg/dplR/DESCRIPTION pkg/dplR/R/morlet.R Log: A tiny optimization to morlet() Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-17 13:21:09 UTC (rev 882) +++ pkg/dplR/DESCRIPTION 2014-05-19 07:55:16 UTC (rev 883) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-17 +Date: 2014-05-19 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/morlet.R =================================================================== --- pkg/dplR/R/morlet.R 2014-05-17 13:21:09 UTC (rev 882) +++ pkg/dplR/R/morlet.R 2014-05-19 07:55:16 UTC (rev 883) @@ -98,11 +98,12 @@ dof <- 2 Signif <- fft_theor * qchisq(siglvl, dof) / dof # [Eqn(18)] - Power <- abs(wave[seq_len(n1), , drop=FALSE]) + wave2 <- wave[seq_len(n1), , drop=FALSE] + Power <- abs(wave2) Power <- Power * Power # Compute wavelet power spectrum ## Done - list(y=y1, x=x1, wave = wave[seq_len(n1), , drop=FALSE], coi = coi, + list(y=y1, x=x1, wave = wave2, coi = coi, period = period, Scale = Scale, Signif = Signif, Power = Power, siglvl = siglvl) } From noreply at r-forge.r-project.org Mon May 19 11:45:29 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 May 2014 11:45:29 +0200 (CEST) Subject: [Dplr-commits] r884 - in pkg/dplR: . R man Message-ID: <20140519094529.EFE6F186BFF@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-19 11:45:29 +0200 (Mon, 19 May 2014) New Revision: 884 Modified: pkg/dplR/ChangeLog pkg/dplR/R/morlet.R pkg/dplR/R/wavelet.plot.R pkg/dplR/man/wavelet.plot.Rd Log: * Added input checks to morlet() and wavelet.plot() * Added option 'reverse.y' to wavelet.plot(): if TRUE, reverse the Y-axis of the filled contour plot. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-19 07:55:16 UTC (rev 883) +++ pkg/dplR/ChangeLog 2014-05-19 09:45:29 UTC (rev 884) @@ -60,6 +60,11 @@ - build-math-dplR.R is a build script +File: morlet.R +-------------- + +- Added some input checks + New file rasterPlot.R --------------------- @@ -89,13 +94,16 @@ File: wavelet.plot.R -------------------- -- Added two options to wavelet.plot(). +- Added three options to wavelet.plot(). 'useRaster': draw the filled contours as a raster image? (default 'FALSE') 'res': resolution of the filled contours when 'useRaster' is 'TRUE' + 'reverse.y': if TRUE, Y-axis of the filled contour plot is reversed - A subtle change to the default value of wavelet.levels: To get the sequence 0, 0.1, 0.2, ..., 1 it is best to use (0:10)/10 instead of seq(from=0, to=1, by=0.1). Parentheses in the former are used for clarity of meaning. +- Added some input checks +- Small optimizations Files: xskel.ccf.plot.R and xskel.plot.R ---------------------------------------- Modified: pkg/dplR/R/morlet.R =================================================================== --- pkg/dplR/R/morlet.R 2014-05-19 07:55:16 UTC (rev 883) +++ pkg/dplR/R/morlet.R 2014-05-19 09:45:29 UTC (rev 884) @@ -34,8 +34,12 @@ ## global=NULL ## r = 0 + n <- length(y1) + stopifnot(is.numeric(dj), is.numeric(siglvl), length(dj) == 1, + length(siglvl) == 1, is.numeric(x1), is.numeric(y1), + is.null(p2) || (is.numeric(p2) && length(p2) == 1), + n > 0) if(length(x1) != length(y1)) stop("'x1' and 'y1' lengths differ") - n <- length(y1) n1 <- n base2 <- trunc(log2(n) + 0.4999) # power of 2 nearest to N if(is.null(p2)) J <- trunc(log2(n * Dt / s0) / dj) # [Eqn(10)] Modified: pkg/dplR/R/wavelet.plot.R =================================================================== --- pkg/dplR/R/wavelet.plot.R 2014-05-19 07:55:16 UTC (rev 883) +++ pkg/dplR/R/wavelet.plot.R 2014-05-19 09:45:29 UTC (rev 884) @@ -8,20 +8,28 @@ add.spline = FALSE, f = 0.5, nyrs = NULL, crn.col = "black", crn.lwd = 1,coi.col='black', crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE, - useRaster = FALSE, res = 150) + useRaster = FALSE, res = 150, reverse.y = FALSE) { ## Wavelet transform variables: y <- wave.list$y x <- wave.list$x - wave <- wave.list$wave period <- wave.list$period Signif <- wave.list$Signif coi <- wave.list$coi - coi[coi == 0] <- 1e-12 Power <- wave.list$Power siglvl <- wave.list$siglvl + stopifnot(is.numeric(x), is.numeric(y), is.numeric(period), + is.numeric(Signif), is.numeric(coi), is.numeric(Power), + is.numeric(siglvl)) + n.x <- length(x) + n.period <- length(period) + dim.Power <- dim(Power) + stopifnot(length(dim.Power) == 2, n.x == length(y), dim.Power[1] == n.x, + dim.Power[2] == n.period, length(Signif) == n.period, + length(coi) == n.x, length(siglvl) == 1, n.x >= 2, n.period >= 2) + if (any(diff(x) <= 0) || any(diff(period) <= 0)) { stop("'wave.list$x' and 'wave.list$period' must be strictly ascending") } @@ -29,20 +37,22 @@ stop("'wave.list$period' must be positive") } + coi[coi == 0] <- 1e-12 + ## Expand signif --> (length(wave.list$Scale))x(N) array - Signif <- t(matrix(Signif, dim(wave)[2], dim(wave)[1])) + Signif <- t(matrix(Signif, dim.Power[2], dim.Power[1])) ## Where ratio > 1, power is significant Signif <- Power / Signif ## Period is in years, period2 is in powers of 2 period2 <- log2(period) ytick <- unique(trunc(period2)) # Unique integer powers of 2 - ytickv <- 2^(ytick) # Labels are in years + ytickv <- 2^ytick # Labels are in years ## coi is in years, coi2 in powers of 2 coi2 <- log2(coi) coi2[coi2 < 0] <- 0 - coi2.yy <- c(coi2, rep(max(period2, na.rm=TRUE), length(coi2))) + coi2.yy <- c(coi2, rep(max(period2, na.rm=TRUE), n.x)) coi2.yy[is.na(coi2.yy)] <- coi[2] yr.vec.xx <- c(x, rev(x)) @@ -57,13 +67,10 @@ las <- 1 xlim <- range(x, finite=TRUE) ylim <- range(period2, finite=TRUE) + if (isTRUE(reverse.y)) { + ylim <- rev(ylim) + } z <- Power - ## invert to match std figs? Not sure how to do tht coi - ## parabola be easier to just fool the filled.countor internal - ## to change the plot order? - ##z <- z[,ncol(z):1] - ##Signif <-Signif[,ncol(Signif):1] - ##ytick <- rev(ytick) if (side.by.side) { ## plot set up Modified: pkg/dplR/man/wavelet.plot.Rd =================================================================== --- pkg/dplR/man/wavelet.plot.Rd 2014-05-19 07:55:16 UTC (rev 883) +++ pkg/dplR/man/wavelet.plot.Rd 2014-05-19 09:45:29 UTC (rev 884) @@ -16,7 +16,7 @@ add.spline = FALSE, f = 0.5, nyrs = NULL, crn.col = "black", crn.lwd = 1,coi.col='black', crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE, - useRaster = FALSE, res = 150) + useRaster = FALSE, res = 150, reverse.y = FALSE) } \arguments{ \item{wave.list}{A \code{list}. Output from \code{\link{morlet}}.} @@ -50,6 +50,9 @@ \item{res}{A \code{numeric} vector of length 1. The resolution (pixels per inch) of the filled contours when \code{useRaster} is \code{TRUE}.} + \item{reverse.y}{A \code{logical} flag. If \code{TRUE}, the Y-axis + will be reversed, i.e. period increasing towards the bottom. The + default is \code{FALSE}. } } \details{ This produces a plot of a continuous wavelet transform and plots the From noreply at r-forge.r-project.org Mon May 19 12:39:06 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 May 2014 12:39:06 +0200 (CEST) Subject: [Dplr-commits] r885 - in pkg/dplR: R man vignettes Message-ID: <20140519103906.A40CD180384@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-19 12:39:06 +0200 (Mon, 19 May 2014) New Revision: 885 Modified: pkg/dplR/R/wavelet.plot.R pkg/dplR/man/wavelet.plot.Rd pkg/dplR/vignettes/timeseries-dplR.Rnw Log: There is one new choice for the value of the 'useRaster' argument of wavelet.plot(): NA. When used, this effectively sets useRaster to TRUE if and only if the name of the graphics device is either "pdf" or "postscript". The examples and the timeseries vignette now also use useRaster = NA. The default is still FALSE. Modified: pkg/dplR/R/wavelet.plot.R =================================================================== --- pkg/dplR/R/wavelet.plot.R 2014-05-19 09:45:29 UTC (rev 884) +++ pkg/dplR/R/wavelet.plot.R 2014-05-19 10:39:06 UTC (rev 885) @@ -22,14 +22,14 @@ stopifnot(is.numeric(x), is.numeric(y), is.numeric(period), is.numeric(Signif), is.numeric(coi), is.numeric(Power), - is.numeric(siglvl)) + is.numeric(siglvl), is.logical(useRaster), + length(useRaster) == 1) n.x <- length(x) n.period <- length(period) dim.Power <- dim(Power) stopifnot(length(dim.Power) == 2, n.x == length(y), dim.Power[1] == n.x, dim.Power[2] == n.period, length(Signif) == n.period, length(coi) == n.x, length(siglvl) == 1, n.x >= 2, n.period >= 2) - if (any(diff(x) <= 0) || any(diff(period) <= 0)) { stop("'wave.list$x' and 'wave.list$period' must be strictly ascending") } @@ -92,9 +92,14 @@ plot.new() plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las) - # note replacement of .Internal(filledcontour(as.double(x),...) - # with .filled.contour() as of R-2.15.0 - if (isTRUE(useRaster)) { + if (is.na(useRaster)) { + useRaster2 <- names(dev.cur()) %in% c("pdf", "postscript") + } else { + useRaster2 <- useRaster + } + ## note replacement of .Internal(filledcontour(as.double(x),...) + ## with .filled.contour() as of R-2.15.0 + if (useRaster2) { cl <- quote(.filled.contour(as.double(x), as.double(period2), z, @@ -179,9 +184,14 @@ plot.new() plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las) - # note replacement of .Internal(filledcontour(as.double(x),...) - # with .filled.contour() as of R-2.15.0 - if (isTRUE(useRaster)) { + if (is.na(useRaster)) { + useRaster2 <- names(dev.cur()) %in% c("pdf", "postscript") + } else { + useRaster2 <- useRaster + } + ## note replacement of .Internal(filledcontour(as.double(x),...) + ## with .filled.contour() as of R-2.15.0 + if (useRaster2) { cl <- quote(.filled.contour(as.double(x), as.double(period2), z, Modified: pkg/dplR/man/wavelet.plot.Rd =================================================================== --- pkg/dplR/man/wavelet.plot.Rd 2014-05-19 09:45:29 UTC (rev 884) +++ pkg/dplR/man/wavelet.plot.Rd 2014-05-19 10:39:06 UTC (rev 885) @@ -45,11 +45,15 @@ not affected. \code{useRaster=TRUE} can be especially useful when a \code{pdf} device is used: the size and complexity of the \acronym{PDF} file will probably be greatly reduced. Setting this - to \code{TRUE} only has negative effects when used with a bitmap - device such as \code{png}. The default is \code{FALSE}. } + to \code{TRUE} has negative effects when used with a bitmap + device such as \code{png}. If \code{NA}, plotting of a raster image + will be attempted if and only if the name of the graphics device is + \code{"pdf"} or \code{"postscript"}. The default is \code{FALSE}: + draw directly to the graphics device without using an intermediate + raster image. } \item{res}{A \code{numeric} vector of length 1. The resolution - (pixels per inch) of the filled contours when \code{useRaster} is - \code{TRUE}.} + (pixels per inch) of the filled contours when a raster image is + used. See \code{useRaster}.} \item{reverse.y}{A \code{logical} flag. If \code{TRUE}, the Y-axis will be reversed, i.e. period increasing towards the bottom. The default is \code{FALSE}. } @@ -84,15 +88,17 @@ CAMstd <- ca533.crn[, 1] out.wave <- morlet(y1 = CAMstd, x1 = Years, p2 = 9, dj = 0.1, siglvl = 0.99) -wavelet.plot(out.wave) +wavelet.plot(out.wave, useRaster = NA) \dontrun{ ## Alternative palette with better separation of colors if (require(RColorBrewer)) { - wavelet.plot(out.wave, key.cols=rev(brewer.pal(10, "Spectral"))) + wavelet.plot(out.wave, key.cols=rev(brewer.pal(10, "Spectral")), + useRaster = NA) } } levs <- quantile(out.wave$Power, probs = c(0, 0.5, 0.75, 0.9, 0.99)) wavelet.plot(out.wave, wavelet.levels = levs, add.sig = FALSE, - key.cols = c("white", "green", "blue", "red")) + key.cols = c("white", "green", "blue", "red"), + useRaster = NA) } \keyword{ hplot } Modified: pkg/dplR/vignettes/timeseries-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-19 09:45:29 UTC (rev 884) +++ pkg/dplR/vignettes/timeseries-dplR.Rnw 2014-05-19 10:39:06 UTC (rev 885) @@ -239,7 +239,7 @@ yrs <- as.numeric(rownames(co021.crn)) out.wave <- morlet(y1 = dat, x1 = yrs, p2 = 8, dj = 0.1, siglvl = 0.99) -wavelet.plot(out.wave, useRaster=TRUE) +wavelet.plot(out.wave, useRaster=NA) @ \begin{figure}[h] \centering From noreply at r-forge.r-project.org Mon May 19 15:08:38 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 May 2014 15:08:38 +0200 (CEST) Subject: [Dplr-commits] r886 - in pkg/dplR: . R Message-ID: <20140519130838.3CC4C18767E@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-19 15:08:37 +0200 (Mon, 19 May 2014) New Revision: 886 Modified: pkg/dplR/ChangeLog pkg/dplR/R/wavelet.plot.R Log: Internal improvements to wavelet.plot() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-19 10:39:06 UTC (rev 885) +++ pkg/dplR/ChangeLog 2014-05-19 13:08:37 UTC (rev 886) @@ -104,6 +104,9 @@ used for clarity of meaning. - Added some input checks - Small optimizations +- More graphical parameters are restored after the function has run +- Better reuse of code between side.by.side=TRUE and side.by.side=FALSE +- Use of dev.hold() and dev.flush() Files: xskel.ccf.plot.R and xskel.plot.R ---------------------------------------- Modified: pkg/dplR/R/wavelet.plot.R =================================================================== --- pkg/dplR/R/wavelet.plot.R 2014-05-19 10:39:06 UTC (rev 885) +++ pkg/dplR/R/wavelet.plot.R 2014-05-19 13:08:37 UTC (rev 886) @@ -23,7 +23,9 @@ stopifnot(is.numeric(x), is.numeric(y), is.numeric(period), is.numeric(Signif), is.numeric(coi), is.numeric(Power), is.numeric(siglvl), is.logical(useRaster), - length(useRaster) == 1) + length(useRaster) == 1, + identical(side.by.side, TRUE) || identical(side.by.side, FALSE)) + stopifnot(is.numeric(wavelet.levels)) n.x <- length(x) n.period <- length(period) dim.Power <- dim(Power) @@ -56,7 +58,7 @@ coi2.yy[is.na(coi2.yy)] <- coi[2] yr.vec.xx <- c(x, rev(x)) - par.orig <- par(c("mar", "las", "mfrow")) + par.orig <- par(c("mar", "las", "mfrow", "mgp", "tcl")) on.exit(par(par.orig)) nlevels <- length(wavelet.levels) seq.level <- seq_len(nlevels - 1) @@ -72,190 +74,127 @@ } z <- Power + ## plot set up if (side.by.side) { - ## plot set up layout(matrix(c(3, 2, 1), nrow=1, byrow=TRUE), widths=c(1, 1, 0.2)) - ## plot 1: scale - mar <- c(3, 1, 3, 3) - par(mar=mar, tcl=0.5, mgp=c(1.5, 0.25, 0), las=las) - plot.new() - plot.window(ylim=c(1, nlevels), xlim=c(0, 1), - xaxs=xaxs, yaxs=yaxs, asp=asp) - rect(0, seq.level, 1, 2:nlevels, col = key.cols) - axis(4, at=seq_along(wavelet.levels), labels=key.labs) - ## add units + scale.xlim <- c(0, 1) + scale.ylim <- c(1, nlevels) + scale.side <- 4 + scale.xleft <- 0 + scale.ybottom <- seq.level + scale.xright <- 1 + scale.ytop <- 2:nlevels + mar1 <- c(3, 1, 3, 3) + mar2 <- c(3, 3, 3, 3) + mar3 <- c(3, 3, 3, 3) + } else { + layout(matrix(c(3, 2, 1), ncol=1, byrow=TRUE), + heights=c(1, 1, 0.3)) + scale.xlim <- c(1, nlevels) + scale.ylim <- c(0, 1) + scale.side <- 1 + scale.xleft <- seq.level + scale.ybottom <- 0 + scale.xright <- 2:nlevels + scale.ytop <- 1 + mar1 <- c(3, 3, 0.1, 3) + mar2 <- mar1 + mar3 <- c(0.1, 3, 3, 3) + } + ## plot 1: scale + par(mar=mar1, tcl=0.5, mgp=c(1.5, 0.25, 0), las=las) + dev.hold() + on.exit(dev.flush(), add=TRUE) + plot.new() + plot.window(ylim=scale.ylim, xlim=scale.xlim, + xaxs=xaxs, yaxs=yaxs, asp=asp) + rect(scale.xleft, scale.ybottom, scale.xright, scale.ytop, col = key.cols) + axis(scale.side, at=seq_along(wavelet.levels), labels=key.labs) + ## add units + if (side.by.side) { title(key.lab, cex.main=1) - ## plot 2: contour-image - mar <- c(3, 3, 3, 3) - par(mar=mar, tcl=0.5, mgp=c(1.5, 0.25, 0)) - plot.new() + } else { + title(sub=key.lab, cex.sub=1, line=1.5) + } + ## plot 2: contour-image + par(mar=mar2, tcl=0.5, mgp=c(1.5, 0.25, 0)) + plot.new() - plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las) - if (is.na(useRaster)) { - useRaster2 <- names(dev.cur()) %in% c("pdf", "postscript") - } else { - useRaster2 <- useRaster - } - ## note replacement of .Internal(filledcontour(as.double(x),...) - ## with .filled.contour() as of R-2.15.0 - if (useRaster2) { - cl <- quote(.filled.contour(as.double(x), - as.double(period2), - z, - as.double(wavelet.levels), - key.cols)) - tryCatch(rasterPlot(cl, res = res, - antialias = "none", interpolate = FALSE), - error = function(e) { - message(as.character(e), appendLF = FALSE) - message("reverting to useRaster=FALSE") - .filled.contour(as.double(x), - as.double(period2), - z, - as.double(wavelet.levels), - key.cols) - }) - } else { - .filled.contour(as.double(x), - as.double(period2), - z, - as.double(wavelet.levels), - key.cols) - } - if (add.sig) { - contour(x, period2, Signif, levels=1, labels=siglvl, - drawlabels = FALSE, axes = FALSE, - frame.plot = FALSE, add = TRUE, - lwd = 2, col="black") - } - if (add.coi) { - polygon(yr.vec.xx, coi2.yy, density=c(10, 20), - angle=c(-45, 45), col=coi.col) - } - axis(1) + plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las) + if (is.na(useRaster)) { + useRaster2 <- names(dev.cur()) %in% c("pdf", "postscript") + } else { + useRaster2 <- useRaster + } + ## note replacement of .Internal(filledcontour(as.double(x),...) + ## with .filled.contour() as of R-2.15.0 + cl <- quote(.filled.contour(as.double(x), + as.double(period2), + z, + as.double(wavelet.levels), + key.cols)) + if (useRaster2) { + tryCatch(rasterPlot(cl, res = res, + antialias = "none", interpolate = FALSE), + error = function(e) { + message(as.character(e), appendLF = FALSE) + message("reverting to useRaster=FALSE") + eval(cl) + }) + } else { + eval(cl) + } + if (isTRUE(add.sig)) { + contour(x, period2, Signif, levels=1, labels=siglvl, + drawlabels = FALSE, axes = FALSE, + frame.plot = FALSE, add = TRUE, + lwd = 2, col="black") + } + if (isTRUE(add.coi)) { + polygon(yr.vec.xx, coi2.yy, density=c(10, 20), + angle=c(-45, 45), col=coi.col) + } + axis(1) + axis(2, at = ytick, labels = ytickv) + if (side.by.side) { axis(3) - axis(2, at = ytick, labels = ytickv) axis(4, at = ytick, labels = ytickv) - title(xlab = x.lab, ylab = period.lab) - box() - - ## plot 3: chron - mar <- c(3, 3, 3, 3) - par(mar = mar, las=0) - plot(x, y, type = "l", xlim, xaxs = xaxs, yaxs = yaxs, - asp = asp, xlab = "", ylab = "", axes = FALSE, col = crn.col, - lwd = crn.lwd, ylim = crn.ylim) - if (add.spline) { - spl <- y - tmp <- na.omit(spl) - if (is.null(nyrs)) { - nyrs2 <- length(tmp) * 0.33 - } else { - nyrs2 <- nyrs - } - tmp <- ffcsaps(y = tmp, x = seq_along(tmp), nyrs = nyrs2, f = f) - spl[!is.na(spl)] <- tmp - lines(x, spl, col = "red", lwd = 2) - } - axis(1) - axis(3) - axis(2) - axis(4) - title(xlab = x.lab, ylab = crn.lab) - box() + } else { + axis(3, labels = NA) + axis(4, at = ytick, labels = NA) } - else { - ## plot set up - layout(matrix(c(3, 2, 1), ncol=1, byrow=TRUE), - heights=c(1, 1, 0.3)) - ## plot 1: scale - mar <- c(3, 3, 0.1, 3) - par(mar=mar, tcl=0.5, mgp=c(1.5, 0.25, 0), las=las) - plot.new() - plot.window(xlim=c(1, nlevels), ylim=c(0, 1), - xaxs=xaxs, yaxs=yaxs, asp=asp) - rect(seq.level, 0, 2:nlevels, 1, col = key.cols) - axis(1, at=seq_along(wavelet.levels), labels=key.labs) - ## add units - title(sub=key.lab, cex.sub=1, line=1.5) - ## plot 2: contour-image - par(mar=mar, tcl=0.5, mgp=c(1.5, 0.25, 0)) - plot.new() + title(xlab = x.lab, ylab = period.lab) + box() - plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las) - if (is.na(useRaster)) { - useRaster2 <- names(dev.cur()) %in% c("pdf", "postscript") + ## plot 3: chron + par(mar = mar3, las=0) + plot(x, y, type = "l", xlim, xaxs = xaxs, yaxs = yaxs, + asp = asp, xlab = "", ylab = "", axes = FALSE, col = crn.col, + lwd = crn.lwd, ylim = crn.ylim) + if (add.spline) { + spl <- y + tmp <- na.omit(spl) + if (is.null(nyrs)) { + nyrs2 <- length(tmp) * 0.33 } else { - useRaster2 <- useRaster + nyrs2 <- nyrs } - ## note replacement of .Internal(filledcontour(as.double(x),...) - ## with .filled.contour() as of R-2.15.0 - if (useRaster2) { - cl <- quote(.filled.contour(as.double(x), - as.double(period2), - z, - as.double(wavelet.levels), - key.cols)) - tryCatch(rasterPlot(cl, res = res, - antialias = "none", interpolate = FALSE), - error = function(e) { - message(as.character(e), appendLF = FALSE) - message("reverting to useRaster=FALSE") - .filled.contour(as.double(x), - as.double(period2), - z, - as.double(wavelet.levels), - key.cols) - }) - } else { - .filled.contour(as.double(x), - as.double(period2), - z, - as.double(wavelet.levels), - key.cols) - } - if (add.sig) { - contour(x, period2, Signif, levels=1, labels=siglvl, - drawlabels = FALSE, axes = FALSE, - frame.plot = FALSE, add = TRUE, - lwd = 2, col="black") - } - if (add.coi) { - polygon(yr.vec.xx, coi2.yy, density=c(10, 20), - angle=c(-45, 45), col=coi.col) - } + tmp <- ffcsaps(y = tmp, x = seq_along(tmp), nyrs = nyrs2, f = f) + spl[!is.na(spl)] <- tmp + lines(x, spl, col = "red", lwd = 2) + } + axis(3) + axis(4) + if (side.by.side) { axis(1) - axis(2, at = ytick, labels = ytickv) - axis(3, labels = NA) - axis(4, at = ytick, labels = NA) - title(xlab = x.lab, ylab = period.lab) - box() - - ## plot 3: chron - mar <- c(0.1, 3, 3, 3) - par(mar = mar, las=0) - plot(x, y, type = "l", xlim, xaxs = xaxs, yaxs = yaxs, - asp = asp, xlab = "", ylab = "", axes = FALSE, col = crn.col, - lwd = crn.lwd, ylim = crn.ylim) - if (add.spline) { - spl <- y - tmp <- na.omit(spl) - if (is.null(nyrs)) { - nyrs2 <- length(tmp) * 0.33 - } else { - nyrs2 <- nyrs - } - tmp <- ffcsaps(y = tmp, x = seq_along(tmp), nyrs = nyrs2, f = f) - spl[!is.na(spl)] <- tmp - lines(x, spl, col = "red", lwd = 2) - } + axis(2) + title(xlab = x.lab, ylab = crn.lab) + } else { axis(1, labels = NA) axis(2, labels = NA) - axis(3) - axis(4) mtext(crn.lab, side=4, line=1.5, cex=0.75) - box() } + box() invisible() } From noreply at r-forge.r-project.org Mon May 19 15:48:35 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 May 2014 15:48:35 +0200 (CEST) Subject: [Dplr-commits] r887 - in pkg/dplR: . R Message-ID: <20140519134835.C943B186CBD@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-19 15:48:35 +0200 (Mon, 19 May 2014) New Revision: 887 Modified: pkg/dplR/ChangeLog pkg/dplR/R/series.rwl.plot.R Log: Fixed clipping of text in series.rwl.plot() Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-19 13:08:37 UTC (rev 886) +++ pkg/dplR/ChangeLog 2014-05-19 13:48:35 UTC (rev 887) @@ -85,6 +85,11 @@ will speed up otherwise unbearable computation times on some systems. +Files: series.rwl.plot.R +------------------------ + +- Fixed clipping of text in the lower right corner of the plot + File: timeseries-dplR.Rnw ------------------------- Modified: pkg/dplR/R/series.rwl.plot.R =================================================================== --- pkg/dplR/R/series.rwl.plot.R 2014-05-19 13:08:37 UTC (rev 886) +++ pkg/dplR/R/series.rwl.plot.R 2014-05-19 13:48:35 UTC (rev 887) @@ -124,6 +124,7 @@ polygon(xx, yy, col="grey90") } ## plot 4 + par(xpd = TRUE) plot(c(-1, 1), c(-2, 1), type="n", ylab="", xlab="", axes=FALSE) txt1 <- gettextf("Series:%d-%d", min(na.omit(series.yrs0)), max(na.omit(series.yrs0)), domain="R-dplR") From noreply at r-forge.r-project.org Mon May 19 16:57:16 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 May 2014 16:57:16 +0200 (CEST) Subject: [Dplr-commits] r888 - in pkg/dplR: . R Message-ID: <20140519145716.36791186EEC@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-19 16:57:15 +0200 (Mon, 19 May 2014) New Revision: 888 Modified: pkg/dplR/ChangeLog pkg/dplR/R/skel.plot.R Log: Fixed issues with clipping and alignment in skel.plot(). Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-19 13:48:35 UTC (rev 887) +++ pkg/dplR/ChangeLog 2014-05-19 14:57:15 UTC (rev 888) @@ -90,6 +90,13 @@ - Fixed clipping of text in the lower right corner of the plot +File: skel.plot.R +----------------- + +- Adjusted alignment, size and clipping properties of viewports. Now a + plot with less than the full number of rows can fit in a smaller + device and text on the sides won't be clipped. + File: timeseries-dplR.Rnw ------------------------- Modified: pkg/dplR/R/skel.plot.R =================================================================== --- pkg/dplR/R/skel.plot.R 2014-05-19 13:48:35 UTC (rev 887) +++ pkg/dplR/R/skel.plot.R 2014-05-19 14:57:15 UTC (rev 888) @@ -68,7 +68,7 @@ ## Variables for plotting ## page width - pw <- 254 + pw <- 278 ## page height ph <- 178 ## row height @@ -92,8 +92,7 @@ for (i in m) { y <- y - (rh + spcr) vps[[i]] <- - viewport(x=unit(3, "mm"), - y=unit(y, "mm"), + viewport(x=unit(19, "mm"), y=unit(y, "mm"), width=unit(246, "mm"), height=unit(rh, "mm"), just=c("left", "bottom"), name=LETTERS[i]) } @@ -147,8 +146,9 @@ ## set up page with the right number of rows dev.hold() on.exit(dev.flush()) - pushViewport(vpTree(viewport(width=unit(pw, "mm"), - height=unit(ph, "mm"), name="page"), + pushViewport(vpTree(viewport(width=unit(pw, "mm"), y=1, just="top", + height=unit(ph, "mm"), name="page", + clip="off"), do.call(vpList, vps))) row.last <- 0 for (i in m) { From noreply at r-forge.r-project.org Mon May 19 20:50:06 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 May 2014 20:50:06 +0200 (CEST) Subject: [Dplr-commits] r889 - in pkg/dplR: . R Message-ID: <20140519185006.62939186DFF@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-19 20:50:06 +0200 (Mon, 19 May 2014) New Revision: 889 Modified: pkg/dplR/ChangeLog pkg/dplR/R/corr.series.seg.R Log: Bug fix to corr.series.seg(). Andy: correct me if I'm wrong. Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-19 14:57:15 UTC (rev 888) +++ pkg/dplR/ChangeLog 2014-05-19 18:50:06 UTC (rev 889) @@ -29,6 +29,12 @@ - Performance optimization, including the use of dev.hold() and dev.flush() +File: corr.series.seg.R +----------------------- + +- Bug fix: Argument 'method' was not used for moving correlations. + Instead, the method used was always "spearman". + File: latexify.R ---------------- Modified: pkg/dplR/R/corr.series.seg.R =================================================================== --- pkg/dplR/R/corr.series.seg.R 2014-05-19 14:57:15 UTC (rev 888) +++ pkg/dplR/R/corr.series.seg.R 2014-05-19 18:50:06 UTC (rev 889) @@ -5,7 +5,7 @@ pcrit=0.05, make.plot = TRUE, floor.plus1 = FALSE, ...) { - method <- match.arg(method) + method2 <- match.arg(method) ## Handle different types of 'series' tmp <- pick.rwl.series(rwl, series, series.yrs) @@ -98,7 +98,7 @@ bin.cor <- NA bin.pval <- NA } else { - tmp <- cor.test(series2[mask], master[mask], method = method, + tmp <- cor.test(series2[mask], master[mask], method = method2, alternative = "greater") bin.cor <- tmp$estimate bin.pval <- tmp$p.val @@ -107,7 +107,7 @@ res.pval[j] <- bin.pval } ## overall correlation - tmp <- cor.test(series2, master, method = method, + tmp <- cor.test(series2, master, method = method2, alternative = "greater") overall.cor[1] <- tmp$estimate overall.cor[2] <- tmp$p.val @@ -116,7 +116,7 @@ for (i in seq_len(nyrs - seg.length + 1)) { mask <- i:(i + seg.length - 1) tmp <- cor.test(series2[mask], master[mask], - method = "spearman", alternative = "greater") + method = method2, alternative = "greater") res.mcor[i + seg.lag, 1] <- tmp$estimate res.mcor[i + seg.lag, 2] <- tmp$p.val } From noreply at r-forge.r-project.org Tue May 20 12:08:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 20 May 2014 12:08:46 +0200 (CEST) Subject: [Dplr-commits] r890 - in pkg/dplR: . R Message-ID: <20140520100846.87FF81877AE@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-20 12:08:45 +0200 (Tue, 20 May 2014) New Revision: 890 Modified: pkg/dplR/DESCRIPTION pkg/dplR/R/corr.rwl.seg.R pkg/dplR/R/wavelet.plot.R Log: Internal details Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-19 18:50:06 UTC (rev 889) +++ pkg/dplR/DESCRIPTION 2014-05-20 10:08:45 UTC (rev 890) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-19 +Date: 2014-05-20 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/corr.rwl.seg.R =================================================================== --- pkg/dplR/R/corr.rwl.seg.R 2014-05-19 18:50:06 UTC (rev 889) +++ pkg/dplR/R/corr.rwl.seg.R 2014-05-20 10:08:45 UTC (rev 890) @@ -260,7 +260,6 @@ t(apply(com.segs, 2, yr.range, yr.vec=yrs)) ## polygons for these bins (go down or up from series line) - y.deviation <- y.offset[odd.even] guides.x.base <- c(these.bins[, 1], these.bins[length(this.seq), 2] + 1) ## Ticks at 1) first year of each bin, Modified: pkg/dplR/R/wavelet.plot.R =================================================================== --- pkg/dplR/R/wavelet.plot.R 2014-05-19 18:50:06 UTC (rev 889) +++ pkg/dplR/R/wavelet.plot.R 2014-05-20 10:08:45 UTC (rev 890) @@ -72,7 +72,6 @@ if (isTRUE(reverse.y)) { ylim <- rev(ylim) } - z <- Power ## plot set up if (side.by.side) { @@ -131,7 +130,7 @@ ## with .filled.contour() as of R-2.15.0 cl <- quote(.filled.contour(as.double(x), as.double(period2), - z, + Power, as.double(wavelet.levels), key.cols)) if (useRaster2) { From noreply at r-forge.r-project.org Tue May 20 14:23:17 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 20 May 2014 14:23:17 +0200 (CEST) Subject: [Dplr-commits] r891 - in pkg/dplR: . R Message-ID: <20140520122317.1DB55186E59@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-20 14:23:16 +0200 (Tue, 20 May 2014) New Revision: 891 Modified: pkg/dplR/ChangeLog pkg/dplR/R/corr.rwl.seg.R pkg/dplR/R/interseries.cor.R pkg/dplR/R/rwi.stats.running.R pkg/dplR/R/xskel.ccf.plot.R pkg/dplR/R/xskel.plot.R Log: Parameters not changed by assignment anymore Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-20 10:08:45 UTC (rev 890) +++ pkg/dplR/ChangeLog 2014-05-20 12:23:16 UTC (rev 891) @@ -18,6 +18,12 @@ - New Imported package: png. +Files: corr.rwl.seg.R, corr.series.seg.R, interseries.cor.R, + rwi.stats.running.R, xskel.ccf.plot.R, xskel.plot.R +------------------------------------------------------------ + +- Parameters not changed by assignment anymore (small technical detail) + File: common.interval.R ----------------------- Modified: pkg/dplR/R/corr.rwl.seg.R =================================================================== --- pkg/dplR/R/corr.rwl.seg.R 2014-05-20 10:08:45 UTC (rev 890) +++ pkg/dplR/R/corr.rwl.seg.R 2014-05-20 12:23:16 UTC (rev 891) @@ -9,7 +9,7 @@ rownames(master) }), ...) { - method <- match.arg(method) + method2 <- match.arg(method) ## run error checks qa.xdate(rwl, seg.length, n, bin.floor) @@ -177,7 +177,7 @@ bin.pval <- NA } else { tmp <- cor.test(series[mask], master2[mask], - method = method, alternative = "greater") + method = method2, alternative = "greater") bin.cor <- tmp$estimate bin.pval <- tmp$p.val } @@ -186,7 +186,7 @@ } ## overall correlation tmp <- cor.test(series, master2, - method = method, alternative = "greater") + method = method2, alternative = "greater") overall.cor[i, 1] <- tmp$estimate overall.cor[i, 2] <- tmp$p.val } @@ -234,7 +234,6 @@ col="grey", lty="dotted") ## First odd segs, then even segs - y.offset <- c(-0.25, 0.25) ax <- c(1, 3) for (odd.even in c(1, 2)) { this.seq <- seq(from=odd.even, to=nbins, by=2) Modified: pkg/dplR/R/interseries.cor.R =================================================================== --- pkg/dplR/R/interseries.cor.R 2014-05-20 10:08:45 UTC (rev 890) +++ pkg/dplR/R/interseries.cor.R 2014-05-20 12:23:16 UTC (rev 891) @@ -1,6 +1,6 @@ interseries.cor <- function(rwl, n=NULL, prewhiten=TRUE, biweight=TRUE, method = c("spearman", "pearson", "kendall")) { - method <- match.arg(method) + method2 <- match.arg(method) nseries <- length(rwl) res.cor <- numeric(nseries) p.val <- numeric(nseries) @@ -12,7 +12,7 @@ master <- tmp[["master"]] for (i in seq_len(nseries)) { tmp2 <- cor.test(series[, i], master[, i], - method = method, alternative = "greater") + method = method2, alternative = "greater") res.cor[i] <- tmp2[["estimate"]] p.val[i] <- tmp2[["p.value"]] } Modified: pkg/dplR/R/rwi.stats.running.R =================================================================== --- pkg/dplR/R/rwi.stats.running.R 2014-05-20 10:08:45 UTC (rev 890) +++ pkg/dplR/R/rwi.stats.running.R 2014-05-20 12:23:16 UTC (rev 891) @@ -67,7 +67,7 @@ round.decimals=3, zero.is.missing=TRUE) { period2 <- match.arg(period) - method <- match.arg(method) + method2 <- match.arg(method) if (running.window) { if (window.length < 3) { stop("minimum 'window.length' is 3") @@ -255,7 +255,7 @@ for (j in (i + 1):n.trees) { j.data <- rwi3[year.idx, cores.of.tree[[j]], drop=FALSE] bt.r.mat <- cor.with.limit(min.corr.overlap, i.data, j.data, - method=method) + method=method2) bt.r.mat <- bt.r.mat[!is.na(bt.r.mat)] n.bt.temp <- length(bt.r.mat) if (n.bt.temp > 0) { @@ -278,7 +278,7 @@ } else { these.data <- rwi3[year.idx, these.cores, drop=FALSE] wt.r.vec <- cor.with.limit.upper(min.corr.overlap, these.data, - method=method) + method=method2) wt.r.vec <- wt.r.vec[!is.na(wt.r.vec)] n.wt.temp <- length(wt.r.vec) if (n.wt.temp > 0) { Modified: pkg/dplR/R/xskel.ccf.plot.R =================================================================== --- pkg/dplR/R/xskel.ccf.plot.R 2014-05-20 10:08:45 UTC (rev 890) +++ pkg/dplR/R/xskel.ccf.plot.R 2014-05-20 12:23:16 UTC (rev 891) @@ -9,19 +9,19 @@ ## Handle different types of 'series' tmp <- pick.rwl.series(rwl, series, series.yrs) - rwl <- tmp[[1]] - series <- tmp[[2]] + rwl2 <- tmp[[1]] + series2 <- tmp[[2]] - master.yrs <- as.numeric(rownames(rwl)) - series.yrs <- as.numeric(names(series)) + master.yrs <- as.numeric(rownames(rwl2)) + series.yrs2 <- as.numeric(names(series2)) yrs <- seq(from=win.start,to=win.start+win.width) ## nyrs <- length(yrs) cen.win <- win.width/2 ## check window overlap with master and series yrs - if (!all(yrs %in% series.yrs)) { + if (!all(yrs %in% series.yrs2)) { cat("Window Years: ", min(yrs), "-", max(yrs)," & ", - "Series Years: ", min(series.yrs), "-", max(series.yrs), + "Series Years: ", min(series.yrs2), "-", max(series.yrs2), "\n", sep="") stop("Fix window overlap") } @@ -33,8 +33,8 @@ } ## normalize. - names(series) <- series.yrs - tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) + names(series2) <- series.yrs2 + tmp <- normalize.xdate(rwl2, series2, n, prewhiten, biweight) ## master master <- tmp$master @@ -42,17 +42,17 @@ master <- master[master.yrs%in%yrs] master.yrs <- as.numeric(names(master)) ## series - series <- tmp$series - series.yrs <- as.numeric(names(series)) - series <- series[series.yrs%in%yrs] - series.yrs <- as.numeric(names(series)) + series2 <- tmp$series + series.yrs2 <- as.numeric(names(series2)) + series2 <- series2[series.yrs2%in%yrs] + series.yrs2 <- as.numeric(names(series2)) ## skeleton master.skel <- cbind(master.yrs,xskel.calc(master)) master.skel <- master.skel[master.skel[,1]%in%yrs,] master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] - series.skel <- cbind(series.yrs,xskel.calc(series)) + series.skel <- cbind(series.yrs2,xskel.calc(series2)) series.skel <- series.skel[series.skel[,1]%in%yrs,] series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] @@ -62,9 +62,9 @@ first.yrs <- yrs[first.half] second.yrs <- yrs[second.half] master.early <- master[first.half] - series.early <- series[first.half] + series.early <- series2[first.half] master.late <- master[second.half] - series.late <- series[second.half] + series.late <- series2[second.half] ## subset skel data early.series.skel <- series.skel[series.skel[,1]%in%first.yrs,] @@ -88,7 +88,7 @@ sig <- c(-sig, sig) ## cor and skel agreement - overall.r <- round(cor(series,master),3) + overall.r <- round(cor(series2,master),3) early.r <- round(cor(series.early,master.early),3) late.r <- round(cor(series.late,master.late),3) @@ -171,7 +171,7 @@ grid.rect(x = yrs, y = 0, width = 1, height = 2 * master, hjust = 0.5, vjust = 1, default.units = "native", gp=gpar(fill=col1light,col=col1dark)) - grid.rect(x = yrs, y = 0, width = 1, height = 2 * series, + grid.rect(x = yrs, y = 0, width = 1, height = 2 * series2, hjust = 0.5, vjust = 0, default.units = "native", gp=gpar(fill=col1light,col=col1dark)) Modified: pkg/dplR/R/xskel.plot.R =================================================================== --- pkg/dplR/R/xskel.plot.R 2014-05-20 10:08:45 UTC (rev 890) +++ pkg/dplR/R/xskel.plot.R 2014-05-20 12:23:16 UTC (rev 891) @@ -4,11 +4,11 @@ ## Handle different types of 'series' tmp <- pick.rwl.series(rwl, series, series.yrs) - rwl <- tmp[[1]] - series <- tmp[[2]] + rwl2 <- tmp[[1]] + series2 <- tmp[[2]] - master.yrs <- as.numeric(rownames(rwl)) - series.yrs <- as.numeric(names(series)) + master.yrs <- as.numeric(rownames(rwl2)) + series.yrs2 <- as.numeric(names(series2)) yrs <- seq(from=win.start,to=win.end) nyrs <- length(yrs) @@ -16,11 +16,11 @@ warning("These plots get crowded with windows longer than 100 years.") } ## check window overlap with master and series yrs - if (!all(yrs %in% series.yrs)) { + if (!all(yrs %in% series.yrs2)) { cat(gettextf("Window Years: %d-%d", min(yrs), max(yrs), domain = "R-dplR"), " & ", - gettextf("Series Years: %d-%d", min(series.yrs), max(series.yrs), + gettextf("Series Years: %d-%d", min(series.yrs2), max(series.yrs2), domain = "R-dplR"), "\n", sep="") stop("Fix window overlap") @@ -36,8 +36,8 @@ } ## normalize. - names(series) <- series.yrs - tmp <- normalize.xdate(rwl, series, n, prewhiten, biweight) + names(series2) <- series.yrs2 + tmp <- normalize.xdate(rwl2, series2, n, prewhiten, biweight) ## master master <- tmp$master @@ -45,22 +45,22 @@ master <- master[master.yrs%in%yrs] master.yrs <- as.numeric(names(master)) ## series - series <- tmp$series - series.yrs <- as.numeric(names(series)) - series <- series[series.yrs%in%yrs] - series.yrs <- as.numeric(names(series)) + series2 <- tmp$series + series.yrs2 <- as.numeric(names(series2)) + series2 <- series2[series.yrs2%in%yrs] + series.yrs2 <- as.numeric(names(series2)) ## skeleton master.skel <- cbind(master.yrs,xskel.calc(master)) master.skel <- master.skel[master.skel[,1]%in%yrs,] master.yrs.sig <- master.skel[!is.na(master.skel[,2]),1] - series.skel <- cbind(series.yrs,xskel.calc(series)) + series.skel <- cbind(series.yrs2,xskel.calc(series2)) series.skel <- series.skel[series.skel[,1]%in%yrs,] series.yrs.sig <- series.skel[!is.na(series.skel[,2]),1] ## cor and skel agreement - overall.r <- round(cor(series,master),3) + overall.r <- round(cor(series2,master),3) overall.agree <- sum(series.yrs.sig%in%master.yrs.sig)/length(master.yrs.sig) overall.agree <- round(overall.agree*100,1) @@ -105,7 +105,7 @@ grid.rect(x = yrs, y = 0, width = 1, height = 2 * master, hjust = 0.5, vjust = 1, default.units = "native", gp=gpar(fill=col1light,col=col1dark)) - grid.rect(x = yrs, y = 0, width = 1, height = 2 * series, + grid.rect(x = yrs, y = 0, width = 1, height = 2 * series2, hjust = 0.5, vjust = 0, default.units = "native", gp=gpar(fill=col1light,col=col1dark)) From noreply at r-forge.r-project.org Tue May 20 15:04:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 20 May 2014 15:04:09 +0200 (CEST) Subject: [Dplr-commits] r892 - pkg/dplR/vignettes Message-ID: <20140520130409.88B05187777@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-20 15:04:07 +0200 (Tue, 20 May 2014) New Revision: 892 Modified: pkg/dplR/vignettes/xdate-dplR.Rnw Log: Fixed a typo Modified: pkg/dplR/vignettes/xdate-dplR.Rnw =================================================================== --- pkg/dplR/vignettes/xdate-dplR.Rnw 2014-05-20 12:23:16 UTC (rev 891) +++ pkg/dplR/vignettes/xdate-dplR.Rnw 2014-05-20 13:04:07 UTC (rev 892) @@ -132,7 +132,7 @@ on overlapping segments (e.g., 50-year segments would be overlapped by 25 years). By default, each of the series is filtered to remove low-frequency variation prior to the correlation analysis. The help file has abundant -details. Here will will look at overlapping 60 year segments. A plot is +details. Here we will look at overlapping 60 year segments. A plot is produced by default with \code{corr.rwl.seg} (Figure~\ref{fig:corr.rwl.plot}). In the \code{corr.rwl.seg} plots each segment of each series is shown and colored by its correlation with the master. Each series is From noreply at r-forge.r-project.org Tue May 20 16:13:44 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 20 May 2014 16:13:44 +0200 (CEST) Subject: [Dplr-commits] r893 - pkg/dplR/man Message-ID: <20140520141344.3B95B18680D@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-20 16:13:43 +0200 (Tue, 20 May 2014) New Revision: 893 Modified: pkg/dplR/man/corr.series.seg.Rd Log: Added something, removed something Modified: pkg/dplR/man/corr.series.seg.Rd =================================================================== --- pkg/dplR/man/corr.series.seg.Rd 2014-05-20 13:04:07 UTC (rev 892) +++ pkg/dplR/man/corr.series.seg.Rd 2014-05-20 14:13:43 UTC (rev 893) @@ -51,8 +51,8 @@ } \details{ - This function calculates the correlation a tree-ring series and a - master chronology built from a rwl object. Correlations are done by + This function calculates the correlation between a tree-ring series and a + master chronology built from a rwl object. Correlations are done by segment (see below) and with a moving correlation with length equal to the \code{\var{seg.length}}. The function is typically invoked to produce a plot. @@ -67,7 +67,7 @@ (segments). Matrix \code{\var{moving.rho}} contains the moving correlation and p-value for a moving average equal to \code{\var{seg.length}}. Vector \code{\var{spearman.rho}} contains - the correlations each series by bin and \code{\var{p.val}} contains + the correlations by bin and \code{\var{p.val}} contains the p-values. Vector \code{\var{overall}} contains the average correlation and p-value. } From noreply at r-forge.r-project.org Wed May 21 12:51:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 21 May 2014 12:51:09 +0200 (CEST) Subject: [Dplr-commits] r894 - in pkg/dplR: . inst/unitTests Message-ID: <20140521105109.F3DA0186FFE@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-21 12:51:09 +0200 (Wed, 21 May 2014) New Revision: 894 Modified: pkg/dplR/DESCRIPTION pkg/dplR/inst/unitTests/runit.dplR.R Log: Better tests for corr.series.seg() Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-20 14:13:43 UTC (rev 893) +++ pkg/dplR/DESCRIPTION 2014-05-21 10:51:09 UTC (rev 894) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-20 +Date: 2014-05-21 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/inst/unitTests/runit.dplR.R =================================================================== --- pkg/dplR/inst/unitTests/runit.dplR.R 2014-05-20 14:13:43 UTC (rev 893) +++ pkg/dplR/inst/unitTests/runit.dplR.R 2014-05-21 10:51:09 UTC (rev 894) @@ -314,14 +314,16 @@ test.corr.series.seg <- function() { ## Setup - srs1 <- rep(seq(from=0.5, to=1.5, length.out=50), 10) + srs1 <- rep.int(seq(from=0.5, to=1.5, length.out=50), 10) srs2 <- rev(srs1) srs3 <- srs1 srs3[26:75] <- rev(srs3[26:75]) srs3[326:425] <- rev(srs3[326:425]) + srs4 <- rep.int(seq(1, 2, length.out=50) + sin((1:50)*0.4), 10) names(srs1) <- seq_along(srs1) names(srs2) <- seq_along(srs2) names(srs3) <- seq_along(srs3) + names(srs4) <- seq_along(srs4) dat <- data.frame(a=srs1, b=srs1, c=srs1, d=srs1, e=srs1, f=srs1, g=srs1) res1 <- corr.series.seg(rwl=dat, series=srs1, seg.length=50, bin.floor=100, make.plot=FALSE) @@ -332,6 +334,30 @@ res4 <- corr.series.seg(rwl=dat, series=srs3, seg.length=100, prewhiten=FALSE, bin.floor=100, make.plot=FALSE, floor.plus1=TRUE) + res5 <- corr.series.seg(rwl=dat, series=srs4, seg.length=50, + biweight=FALSE, prewhiten=FALSE, + bin.floor=100, make.plot=FALSE) + res6 <- corr.series.seg(rwl=dat, series=srs4, seg.length=50, + biweight=FALSE, prewhiten=FALSE, + bin.floor=100, make.plot=FALSE, method="spearman") + res6.2 <- corr.series.seg(rwl=dat, series=srs4, seg.length=50, + biweight=FALSE, prewhiten=FALSE, + bin.floor=50, make.plot=FALSE, method="spearman") + res7 <- corr.series.seg(rwl=dat, series=srs4, seg.length=50, + biweight=FALSE, prewhiten=FALSE, + bin.floor=100, make.plot=FALSE, method="pearson") + res8 <- corr.series.seg(rwl=dat, series=srs4, seg.length=50, + biweight=FALSE, prewhiten=FALSE, + bin.floor=100, make.plot=FALSE, method="kendall") + res9 <- corr.series.seg(rwl=dat, series=srs4, seg.length=48, + biweight=FALSE, prewhiten=FALSE, + bin.floor=100, make.plot=FALSE, method="pearson") + res10 <- corr.series.seg(rwl=dat, series=srs4, seg.length=100, + biweight=FALSE, prewhiten=FALSE, + bin.floor=100, make.plot=FALSE, method="pearson") + res11 <- corr.series.seg(rwl=dat, series=srs4, seg.length=142, + biweight=FALSE, prewhiten=FALSE, + bin.floor=100, make.plot=FALSE, method="pearson") expected.cnames1 <- paste(res1$bins[, 1], res1$bins[, 2], sep=".") expected.cnames3 <- paste(res3$bins[, 1], res3$bins[, 2], sep=".") @@ -372,32 +398,33 @@ ## Test checkTrue(all(res1$bins[, 2] - res1$bins[, 1] + 1 == 50), msg="Bins have correct length(test 1)") - checkEqualsNumeric(100, res1$bins[1, 1], - msg="First bin is in correct position (test 1)") + checkTrue(res1$bins[1, 1] == 100, + msg="First bin is in correct position (test 1)") checkTrue(all(diff(res1$bins[, 1]) == 25), msg="Bins have correct overlap (test 1)") - checkEqualsNumeric(450, res1$bins[nrow(res1$bins), 1], - msg="Last bin is in correct position (test 1)") + checkTrue(res1$bins[nrow(res1$bins), 1] == 450, + msg="Last bin is in correct position (test 1)") - checkEquals(res1$bins, res2$bins, msg="Bins are equal (tests 1 and 2)") + checkIdentical(res1$bins, res2$bins, + msg="Bins are identical (tests 1 and 2)") checkTrue(all(res3$bins[, 2] - res3$bins[, 1] + 1 == 100), msg="Bins have correct length(test 3)") - checkEqualsNumeric(100, res3$bins[1, 1], - msg="First bin is in correct position (test 3)") + checkTrue(res3$bins[1, 1] == 100, + msg="First bin is in correct position (test 3)") checkTrue(all(diff(res3$bins[, 1]) == 50), msg="Bins have correct overlap (test 3)") - checkEqualsNumeric(400, res3$bins[nrow(res3$bins), 1], - msg="Last bin is in correct position (test 3)") + checkTrue(res3$bins[nrow(res3$bins), 1] == 400, + msg="Last bin is in correct position (test 3)") checkTrue(all(res4$bins[, 2] - res4$bins[, 1] + 1 == 100), msg="Bins have correct length(test 4)") - checkEqualsNumeric(1, res4$bins[1, 1], - msg="First bin is in correct position (test 4)") + checkTrue(res4$bins[1, 1] == 1, + msg="First bin is in correct position (test 4)") checkTrue(all(diff(res4$bins[, 1]) == 50), msg="Bins have correct overlap (test 4)") - checkEqualsNumeric(401, res4$bins[nrow(res4$bins), 1], - msg="Last bin is in correct position (test 4)") + checkTrue(res4$bins[nrow(res4$bins), 1] == 401, + msg="Last bin is in correct position (test 4)") checkEquals(expected.corr1, res1$spearman.rho, msg="Correlations are as expected (test 1)") @@ -428,6 +455,56 @@ msg="Moving correlations are as expected (test 3)") checkEquals(c(-1, 1), range(res4$moving.rho[, "rho"], na.rm=TRUE), msg="Moving correlations are as expected (test 4)") + + checkIdentical(res5, res6, msg="Default method is spearman") + checkTrue(!isTRUE(all.equal(res6$overall, res7$overall)), + msg="Overall correlation differs between methods (test 1)") + checkTrue(!isTRUE(all.equal(res6$overall, res8$overall)), + msg="Overall correlation differs between methods (test 2)") + checkTrue(!isTRUE(all.equal(res7$overall, res8$overall)), + msg="Overall correlation differs between methods (test 3)") + checkTrue(!isTRUE(all.equal(res6$moving.rho, res7$moving.rho)), + msg="Moving correlations differ between methods (test 1)") + checkTrue(!isTRUE(all.equal(res6$moving.rho, res8$moving.rho)), + msg="Moving correlations differ between methods (test 2)") + checkTrue(!isTRUE(all.equal(res7$moving.rho, res8$moving.rho)), + msg="Moving correlations differ between methods (test 3)") + checkTrue(!isTRUE(all.equal(res6$spearman.rho, res7$spearman.rho)), + msg="Segment correlations differ between methods (test 1)") + checkTrue(!isTRUE(all.equal(res6$spearman.rho, res8$spearman.rho)), + msg="Segment correlations differ between methods (test 2)") + checkTrue(!isTRUE(all.equal(res7$spearman.rho, res8$spearman.rho)), + msg="Segment correlations differ between methods (test 3)") + + tmp7 <- na.omit(res7$moving.rho[, "rho"]) + checkTrue(length(tmp7) == 451, + msg = "Number of non-NA correlations (test 1)") + uniqueRho7 <- unique(tmp7) + checkTrue(length(uniqueRho7) == 1, + msg = "Correlation when segment length matches the common cycle of rwl and series") + tmp9 <- na.omit(res9$moving.rho[, "rho"]) + checkTrue(length(tmp9) == 453, + msg = "Number of non-NA correlations (test 2)") + uniqueRho9 <- unique(tmp9) + checkTrue(length(uniqueRho9) == 50, + msg = "Correlations for rwl and series with a common cycle, shorter segments") + tmp10 <- na.omit(res10$moving.rho[, "rho"]) + checkTrue(length(tmp10) == 401, + msg = "Number of non-NA correlations (test 3)") + uniqueRho10 <- unique(tmp10) + checkTrue(length(uniqueRho10) == 1, + msg = "Correlation when segment length is a multiple of the length of the common cycle of rwl and series") + tmp11 <- na.omit(res11$moving.rho[, "rho"]) + checkTrue(length(tmp11) == 359, + msg = "Number of non-NA correlations (test 4)") + uniqueRho11 <- unique(tmp11) + checkTrue(length(uniqueRho11) == 50, + msg = "Correlations for rwl and series with a common cycle, longer segments (not a multiple of cycle length)") + + checkTrue(length(res6.2$spearman.rho) == length(res6$spearman.rho) + 2, + msg = "Extra segments with different bin.floor") + checkIdentical(res6.2$spearman.rho[-c(1, 2)], res6$spearman.rho, + msg = "Other segments have identical correlation") } test.ffcsaps <- function() { From noreply at r-forge.r-project.org Tue May 27 13:47:04 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 27 May 2014 13:47:04 +0200 (CEST) Subject: [Dplr-commits] r895 - in pkg/dplR: . inst/po/fi/LC_MESSAGES po Message-ID: <20140527114704.1EAA118702B@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-27 13:47:03 +0200 (Tue, 27 May 2014) New Revision: 895 Modified: pkg/dplR/DESCRIPTION pkg/dplR/inst/po/fi/LC_MESSAGES/R-dplR.mo pkg/dplR/po/R-dplR.pot pkg/dplR/po/R-fi.po Log: updated translations Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-21 10:51:09 UTC (rev 894) +++ pkg/dplR/DESCRIPTION 2014-05-27 11:47:03 UTC (rev 895) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-21 +Date: 2014-05-27 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/inst/po/fi/LC_MESSAGES/R-dplR.mo =================================================================== (Binary files differ) Modified: pkg/dplR/po/R-dplR.pot =================================================================== --- pkg/dplR/po/R-dplR.pot 2014-05-21 10:51:09 UTC (rev 894) +++ pkg/dplR/po/R-dplR.pot 2014-05-27 11:47:03 UTC (rev 895) @@ -6,7 +6,7 @@ msgstr "" "Project-Id-Version: dplR 1.6.1\n" "Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" -"POT-Creation-Date: 2014-05-06 09:59+0300\n" +"POT-Creation-Date: 2014-05-27 12:43+0300\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME <EMAIL at ADDRESS>\n" "Language-Team: LANGUAGE <LL at li.org>\n" @@ -338,6 +338,12 @@ msgid "'bin.floor' must be a non-negative integer" msgstr "" +msgid "device does not support raster images" +msgstr "" + +msgid "png device unavailable" +msgstr "" + msgid "minimum 'po' is 1" msgstr "" @@ -878,6 +884,9 @@ msgid "'wave.list$period' must be positive" msgstr "" +msgid "reverting to useRaster=FALSE" +msgstr "" + msgid "'rwl.df' must be a data.frame" msgstr "" @@ -986,9 +995,30 @@ msgid "Fix window overlap" msgstr "" +msgid "(Negative)" +msgstr "" + +msgid "(Positive)" +msgstr "" + +msgid "Period: %d-%d" +msgstr "" + +msgid "Skeleton Agreement %s%%" +msgstr "" + msgid "These plots get crowded with windows longer than 100 years." msgstr "" +msgid "Window Years: %d-%d" +msgstr "" + +msgid "Series Years: %d-%d" +msgstr "" + +msgid "Master Years: %d-%d" +msgstr "" + msgid "There is %d series\n" msgid_plural "There are %d series\n" msgstr[0] "" Modified: pkg/dplR/po/R-fi.po =================================================================== --- pkg/dplR/po/R-fi.po 2014-05-21 10:51:09 UTC (rev 894) +++ pkg/dplR/po/R-fi.po 2014-05-27 11:47:03 UTC (rev 895) @@ -6,8 +6,8 @@ msgstr "" "Project-Id-Version: dplR 1.6.1\n" "Report-Msgid-Bugs-To: mvkorpel at iki.fi\n" -"POT-Creation-Date: 2014-05-06 09:59+0300\n" -"PO-Revision-Date: 2014-05-05 23:34+0300\n" +"POT-Creation-Date: 2014-05-27 12:43+0300\n" +"PO-Revision-Date: 2014-05-27 14:41+0300\n" "Last-Translator: Mikko Korpela <mvkorpel at iki.fi>\n" "Language-Team: Finnish <mvkorpel at iki.fi>\n" "Language: fi\n" @@ -347,6 +347,12 @@ msgid "'bin.floor' must be a non-negative integer" msgstr "?bin.floor?in t?ytyy olla ep?negatiivinen kokonaisluku" +msgid "device does not support raster images" +msgstr "laite ei tue bittikarttakuvia" + +msgid "png device unavailable" +msgstr "png-laite ei ole saatavana" + msgid "minimum 'po' is 1" msgstr "pienin mahdollinen ?po? on 1" @@ -911,6 +917,9 @@ msgid "'wave.list$period' must be positive" msgstr "?wave.list$period?in t?ytyy olla positiivinen" +msgid "reverting to useRaster=FALSE" +msgstr "palataan asetukseen useRaster=FALSE" + msgid "'rwl.df' must be a data.frame" msgstr "?rwl.df?:n t?ytyy olla data.frame" @@ -1034,9 +1043,30 @@ msgid "Fix window overlap" msgstr "Korjaa ikkunoiden p??llekk?isyys" +msgid "(Negative)" +msgstr "(Negatiivinen)" + +msgid "(Positive)" +msgstr "(Positiivinen)" + +msgid "Period: %d-%d" +msgstr "Jakso: %d?%d" + +msgid "Skeleton Agreement %s%%" +msgstr "Yhteensopivuus %s%%" + msgid "These plots get crowded with windows longer than 100 years." msgstr "Kuvista tulee ahtaita jos ikkunat ovat pidempi? kuin 100 vuotta" +msgid "Window Years: %d-%d" +msgstr "Ikkunan vuodet: %d?%d" + +msgid "Series Years: %d-%d" +msgstr "Sarjan vuodet: %d?%d" + +msgid "Master Years: %d-%d" +msgstr "P??sarjan vuodet: %d?%d" + msgid "There is %d series\n" msgid_plural "There are %d series\n" msgstr[0] "On %d sarja\n" @@ -1072,6 +1102,3 @@ msgid_plural "%.0f NA values removed" msgstr[0] "%.0f NA-arvo poistettu" msgstr[1] "%.0f NA-arvoa poistettu" - -#~ msgid "Years" -#~ msgstr "Vuodet" From noreply at r-forge.r-project.org Fri May 30 11:16:42 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 30 May 2014 11:16:42 +0200 (CEST) Subject: [Dplr-commits] r896 - in pkg/dplR: . R Message-ID: <20140530091642.D76371861E5@r-forge.r-project.org> Author: mvkorpel Date: 2014-05-30 11:16:42 +0200 (Fri, 30 May 2014) New Revision: 896 Modified: pkg/dplR/ChangeLog pkg/dplR/DESCRIPTION pkg/dplR/R/powt.R Log: Patch from Christian Zang: In powt(), handle cases where the running mean of a series is 0 Modified: pkg/dplR/ChangeLog =================================================================== --- pkg/dplR/ChangeLog 2014-05-27 11:47:03 UTC (rev 895) +++ pkg/dplR/ChangeLog 2014-05-30 09:16:42 UTC (rev 896) @@ -77,6 +77,11 @@ - Added some input checks +File: powt.R +------------ + +- Handle cases where the running mean of a series is 0 + New file rasterPlot.R --------------------- Modified: pkg/dplR/DESCRIPTION =================================================================== --- pkg/dplR/DESCRIPTION 2014-05-27 11:47:03 UTC (rev 895) +++ pkg/dplR/DESCRIPTION 2014-05-30 09:16:42 UTC (rev 896) @@ -3,7 +3,7 @@ Type: Package Title: Dendrochronology Program Library in R Version: 1.6.1 -Date: 2014-05-27 +Date: 2014-05-30 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph", "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko", "Korpela", role = c("aut", "trl")), person("Franco", "Biondi", Modified: pkg/dplR/R/powt.R =================================================================== --- pkg/dplR/R/powt.R 2014-05-27 11:47:03 UTC (rev 895) +++ pkg/dplR/R/powt.R 2014-05-30 09:16:42 UTC (rev 896) @@ -28,6 +28,7 @@ runn.M <- (drop.1 + drop.n) / 2 runn.S <- abs(drop.1 - drop.n) runn.S[runn.S == 0] <- prec # add minimal difference + runn.M[runn.M == 0] <- prec mod <- lm.fit(cbind(1, log(runn.M)), log(runn.S)) b <- mod[["coefficients"]][2] 1 - b