[Analogue-commits] r241 - in pkg: . R inst man tests/Examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 18 22:51:04 CEST 2011
Author: gsimpson
Date: 2011-09-18 22:51:03 +0200 (Sun, 18 Sep 2011)
New Revision: 241
Added:
pkg/R/rdaFit.R
pkg/R/weightedCor.R
pkg/man/weightedCor.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/inst/ChangeLog
pkg/man/analogue-internal.Rd
pkg/tests/Examples/analogue-Ex.Rout.save
Log:
adds Telford and Birks (2011) weighted correlation test of reconstructions.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2011-09-11 18:10:14 UTC (rev 240)
+++ pkg/DESCRIPTION 2011-09-18 20:51:03 UTC (rev 241)
@@ -1,7 +1,7 @@
Package: analogue
Type: Package
Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.7-4
+Version: 0.7-5
Date: $Date$
Depends: R (>= 2.10.0), stats, graphics, vegan (>= 1.17-12), lattice, grid,
MASS, princurve
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2011-09-11 18:10:14 UTC (rev 240)
+++ pkg/NAMESPACE 2011-09-18 20:51:03 UTC (rev 241)
@@ -23,7 +23,7 @@
performance, prcurve, ##randomWA,
reconPlot, residLen, RMSEP, roc,
smoothSpline, Stratiplot, stdError, timetrack, tran, varExpl, wa,
- "setK<-", Hellinger, ChiSquare)
+ weightedCor, "setK<-", Hellinger, ChiSquare)
### S3 Methods
##
@@ -95,6 +95,7 @@
S3method(varExpl, prcurve)
S3method(wa, default)
S3method(wa, formula)
+S3method(weightedCor, default)
## fitted, predict, coef etc
S3method(coef, pcr)
S3method(coef, wa)
@@ -124,6 +125,7 @@
S3method(plot, roc)
S3method(plot, timetrack)
S3method(plot, wa)
+S3method(plot, weightedCor)
S3method(reconPlot, default)
S3method(reconPlot, predict.mat)
S3method(reconPlot, predict.wa)
@@ -164,6 +166,7 @@
S3method(print, timetrack)
S3method(print, tolerance)
S3method(print, wa)
+S3method(print, weightedCor)
## summary
S3method(summary, analog)
S3method(summary, bootstrap.mat)
Added: pkg/R/rdaFit.R
===================================================================
--- pkg/R/rdaFit.R (rev 0)
+++ pkg/R/rdaFit.R 2011-09-18 20:51:03 UTC (rev 241)
@@ -0,0 +1,162 @@
+rdaFit <- function(X, Y, Z, scale = FALSE, ...) {
+ sdFun <- function(m) {
+ sqrt(colSums(sweep(m, 2, colMeans(m), "-")^2) / (nrow(m) - 1))
+ }
+ ZERO <- 1e-04
+ X <- data.matrix(X)
+ NR <- nrow(X) - 1
+ Xbar <- scale(X, center = TRUE, scale = scale)
+ ##SD <- sd(Xbar)
+ SD <- sdFun(Xbar)
+ if(scale)
+ Xbar[is.nan(Xbar)] <- 0
+ ##tot.chi <- sum(svd(Xbar, nu = 0, nv = 0)$d^2) / NR
+ ## partial RDA?
+ if(!missing(Z) && !is.null(Z)) {
+ Z <- data.matrix(Z)
+ Zr <- scale(Z, center = TRUE, scale = FALSE)
+ Q <- qr(Zr)
+ Z <- qr.fitted(Q, Xbar)
+ if(zrank <- Q$rank)
+ Xbar <- qr.resid(Q, Xbar)
+ } else {
+ Zr <- NULL
+ }
+ ## Do RDA
+ Y <- data.matrix(Y)
+ Yr <- scale(Y, center = TRUE, scale = FALSE)
+ Q <- qr(cbind(Zr, Yr), tol = ZERO)
+ if(is.null(Zr))
+ yrank <- Q$rank
+ else
+ yrank <- Q$rank - zrank
+ Y <- qr.fitted(Q, Xbar)
+ sol <- svd(Y)
+ rank <- min(yrank, sum(sol$d > ZERO))
+ sol$d <- sol$d / sqrt(NR)
+ ax.names <- paste("RDA", 1:length(sol$d), sep = "")
+ colnames(sol$u) <- ax.names
+ colnames(sol$v) <- ax.names
+ names(sol$d) <- ax.names
+ rownames(sol$u) <- rownames(X)
+ rownames(sol$v) <- colnames(X)
+ if(rank) {
+ wa.eig <- (Xbar %*% sol$v[, 1:rank, drop = FALSE]) / sqrt(NR)
+ RDA <- list(lambda = sol$d[1:rank]^2,
+ u = as.matrix(sol$u)[, 1:rank, drop = FALSE],
+ v = as.matrix(sol$v)[, 1:rank, drop = FALSE],
+ wa = sweep(wa.eig, 2, 1/sol$d[1:rank], "*"))
+ oo <- Q$pivot
+ if(!is.null(Zr))
+ oo <- oo[-(seq_len(zrank))] - ncol(Zr)
+ oo <- oo[seq_len(yrank)]
+ if(length(oo) < ncol(Yr))
+ RDA$alias <- colnames(Yr)[-oo]
+ RDA$biplot <- cor(Yr[, oo, drop = FALSE],
+ sol$u[, 1:rank, drop = FALSE])
+ RDA$rank <- rank
+ RDA$qrank <- Q$rank
+ RDA$tot.chi <- sum(RDA$eig)
+ RDA$QR <- Q
+ RDA$envcentre <- attr(Yr, "scaled:center")
+ RDA$Xbar <- Xbar
+ } else {
+ RDA <- list(eig = 0, rank = rank, qrank = Q$rank, tot.chi = 0,
+ QR = Q, Xbar = Xbar)
+ u <- matrix(0, nrow=nrow(sol$u), ncol=0)
+ v <- matrix(0, nrow=nrow(sol$v), ncol=0)
+ RDA$u <- RDA$u.eig <- RDA$wa <- u
+ RDA$v <- RDA$v.eig <- v
+ RDA$biplot <- matrix(0, 0, 0)
+ RDA$alias <- colnames(Yr)
+ }
+ RDA$colsum <- SD
+ class(RDA) <- "rdaFit"
+ RDA
+}
+
+`scores.rdaFit` <- function(x, choices = c(1,2),
+ display = c("sp","wa","cn"), scaling = 2, ...) {
+ display <- match.arg(display, c("sites", "species", "wa",
+ "lc", "bp", "cn"),
+ several.ok = TRUE)
+ if("sites" %in% display)
+ display[display == "sites"] <- "wa"
+ if("species" %in% display)
+ display[display == "species"] <- "sp"
+ tabula <- c("species", "sites", "constraints", "biplot",
+ "centroids")
+ names(tabula) <- c("sp", "wa", "lc", "bp", "cn")
+ take <- tabula[display]
+ slam <- sqrt(x$lambda[choices])
+ rnk <- x$rank
+ sol <- list()
+ if ("species" %in% take) {
+ v <- x$v[, choices, drop = FALSE]
+ if (scaling) {
+ scal <- list(1, slam, sqrt(slam))[[abs(scaling)]]
+ v <- sweep(v, 2, scal, "*")
+ if (scaling < 0) {
+ scal <- sqrt(1/(1 - slam^2))
+ v <- sweep(v, 2, scal, "*")
+ }
+ }
+ sol$species <- v
+ }
+ if ("sites" %in% take) {
+ wa <- x$wa[, choices, drop = FALSE]
+ if (scaling) {
+ scal <- list(slam, 1, sqrt(slam))[[abs(scaling)]]
+ wa <- sweep(wa, 2, scal, "*")
+ if (scaling < 0) {
+ scal <- sqrt(1/(1 - slam^2))
+ wa <- sweep(wa, 2, scal, "*")
+ }
+ }
+ sol$sites <- wa
+ }
+ if ("constraints" %in% take) {
+ u <- x$u[, choices, drop = FALSE]
+ if (scaling) {
+ scal <- list(slam, 1, sqrt(slam))[[abs(scaling)]]
+ u <- sweep(u, 2, scal, "*")
+ if (scaling < 0) {
+ scal <- sqrt(1/(1 - slam^2))
+ u <- sweep(u, 2, scal, "*")
+ }
+ }
+ sol$constraints <- u
+ }
+ if ("biplot" %in% take && !is.null(x$biplot)) {
+ b <- matrix(0, nrow(x$biplot), length(choices))
+ b[, choices <= rnk] <- x$biplot[, choices[choices <=
+ rnk]]
+ colnames(b) <- colnames(x$u)[choices]
+ rownames(b) <- rownames(x$biplot)
+ sol$biplot <- b
+ }
+ if ("centroids" %in% take) {
+ if (is.null(x$centroids))
+ sol$centroids <- NA
+ else {
+ cn <- matrix(0, nrow(x$centroids), length(choices))
+ cn[, choices <= rnk] <- x$centroids[, choices[choices <=
+ rnk]]
+ colnames(cn) <- colnames(x$u)[choices]
+ rownames(cn) <- rownames(x$centroids)
+ if (scaling) {
+ scal <- list(slam, 1, sqrt(slam))[[abs(scaling)]]
+ cn <- sweep(cn, 2, scal, "*")
+ if (scaling < 0) {
+ scal <- sqrt(1/(1 - slam^2))
+ cn <- sweep(cn, 2, scal, "*")
+ }
+ }
+ sol$centroids <- cn
+ }
+ }
+ ## Only one type of scores: return a matrix instead of a list
+ if (length(sol) == 1)
+ sol <- sol[[1]]
+ sol
+}
Added: pkg/R/weightedCor.R
===================================================================
--- pkg/R/weightedCor.R (rev 0)
+++ pkg/R/weightedCor.R 2011-09-18 20:51:03 UTC (rev 241)
@@ -0,0 +1,183 @@
+`weightedCor` <- function(x, ...) {
+ UseMethod("weightedCor")
+}
+
+`weightedCor.default` <- function(x, env, fossil, method = c("rda","cca"),
+ test = TRUE, type = c("simulate","permute"),
+ sim = 999, verbose = TRUE, ...) {
+ ## convert to data matrices
+ x <- data.matrix(x)
+ fossil <- data.matrix(fossil)
+ ## find the FUN
+ method <- match.arg(method)
+ FUN <- match.fun(method)
+ ## match type
+ type <- match.arg(type)
+ ## intersection of species in x and fossil
+ nams <- intersect(colnames(x), colnames(fossil))
+ x <- x[, nams]
+ fossil <- fossil[, nams]
+ ## WA model and optima
+ Args <- head(formals(analogue:::wa.default), -1)
+ dots <- list(x = x, y = env, env = NULL, ...)
+ Args <- modifyList(Args, dots)
+ Args <- lapply(Args, function(x) if(typeof(x) == "language") {eval(x)[1]} else {x})
+ mod <- do.call(analogue:::waFit, Args)
+ opt <- mod$wa.optima
+ ## and predictions for fossil samples
+ if(Args$tol.dw) {
+ pArgs <- list(X = fossil, optima = opt, tol = mod$model.tol,
+ nr = nrow(fossil), nc = ncol(fossil))
+ pFun <- analogue:::WATpred
+ } else {
+ pArgs <- list(X = fossil, optima = opt)
+ pFun <- analogue:::WApred
+ }
+ pred <- drop(analogue:::deshrinkPred(do.call(pFun, pArgs),
+ mod$coefficients,
+ Args$deshrink))
+ ## ordination
+ ord <- rdaFit(fossil, pred)
+ ## axis 1 species scores
+ scrs <- drop(scores(ord, display = "species", scaling = 0,
+ choices = 1))
+ ## mean abundance
+ abund <- colMeans(x)
+
+ ## weighted correlation
+ wtdCorrel <- abs(cov.wt(X <- cbind(opt, scrs), wt = sqrt(abund),
+ cor = TRUE)$cor[1,2])
+ Correl <- abs(cor(X)[1,2])
+
+ ## test, either simulate or permute
+ if(test) {
+ if(type == "permute")
+ warning("`type = \"permute\"` not currently implemented")
+ if(type == "simulate") {
+ if(verbose) {
+ writeLines(paste("Simulating", sim, "Weighted Correlations:"))
+ pb <- txtProgressBar(min = 0, max = sim, style = 3)
+ on.exit(close(pb))
+ on.exit(cat("\n"), add = TRUE)
+ }
+ wtdCorDist <- corDist <- numeric(length = sim)
+ unifs <- matrix(runif(sim * nrow(x)), nrow = sim, byrow = TRUE)
+ for(i in seq_len(sim)) {
+ if(verbose)
+ setTxtProgressBar(pb, i)
+ Args$y <- unifs[i,]
+ rmod <- do.call(analogue:::waFit, Args)
+ ropt <- rmod$wa.optima
+ pArgs$optima <- ropt
+ rpred <- drop(analogue:::deshrinkPred(do.call(pFun, pArgs),
+ rmod$coefficients,
+ Args$deshrink))
+ rord <- rdaFit(fossil, rpred)
+ rscrs <- drop(scores(rord, display = "species",
+ scaling = 0,
+ choices = 1))
+ wtdCorDist[i] <-
+ abs(cov.wt(rX <- cbind(ropt, rscrs), wt = sqrt(abund),
+ cor = TRUE)$cor[1,2])
+ corDist[i] <- abs(cor(rX)[1,2])
+ }
+ }
+ ndist <- list(wtdCorDist = wtdCorDist, corDist = corDist)
+ } else {
+ ndist <- corDist <- wtdCorDist <- NULL
+ }
+
+ ## function call
+ .call <- match.call()
+ .call[[1]] <- as.name("weightedCor")
+
+ ## return object
+ retval <- list(wtdCorrel = wtdCorrel, Correl = Correl,
+ data = data.frame(Optima = opt, SppScores = scrs,
+ meanAbund = abund),
+ ord = ord, model = mod, method = class(ord),
+ ndist = ndist, sim = sim, type = type,
+ env = deparse(substitute(env)),
+ call = .call)
+ class(retval) <- "weightedCor"
+ retval
+}
+
+`plot.weightedCor` <- function(x, type = c("bubble", "null"),
+ weighted = TRUE,
+ size = 0.25,
+ xlab = paste(x$env, "WA Optima"),
+ ylab = "Axis 1 Score",
+ xlim,
+ main = "",
+ sub = NULL,
+ border = "gray75",
+ col = "gray75",
+ obscol = "red",
+ fg = "black", ...) {
+ type <- match.arg(type)
+ if(missing(sub))
+ sub <- with(x, bquote(rho[w] == .(round(wtdCorrel, 3)) ~~~~
+ rho == .(round(Correl, 3))))
+ if(type == "bubble") {
+ with(x$data, symbols(Optima, SppScores, circles = meanAbund,
+ inches = size,
+ xlab = xlab, ylab = ylab, fg = fg, sub = sub, ...))
+ }
+ if(type == "null") {
+ if(weighted) {
+ ndist <- x$ndist$wtdCorDist
+ obs <- x$wtdCorrel
+ } else {
+ ndist <- x$ndist$corDist
+ obs <- x$Correl
+ }
+ if(missing(xlim))
+ xlim <- range(0, ndist, obs)
+ Dens <- density(ndist)
+ Hist <- hist(ndist, plot = FALSE, ...)
+ ylim <- range(0, Hist$density, Dens$y)
+ plot(Hist, freq = FALSE, border = border, col = col, xlab = xlab,
+ ylab = "Density", main = main, xlim = xlim, ylim = ylim,
+ sub = sub, ...)
+ abline(h = 0, col = col)
+ lines(Dens)
+ rug(obs, col = obscol, lwd = 2)
+ rug(obs, col = obscol, lwd = 2, side = 3)
+ box()
+ }
+ invisible(x)
+}
+
+
+`print.weightedCor` <- function(x, digits = 3, ...) {
+ ## compute things we need
+ wtdMsg <- paste("Weighted Correlation:", round(x$wtdCorrel, digits = digits))
+ corMsg <- paste("Correlation :", round(x$Correl, digits = digits))
+ if(TEST <- !is.null(x$ndist)) {
+ wtdMsg <- paste(wtdMsg, " (p = ",
+ format.pval(sum(x$ndist$wtdCorDist >= x$wtdCorrel) /
+ (x$sim + 1)),
+ ")", sep = "")
+ corMsg <- paste(corMsg, " (p = ",
+ format.pval(sum(x$ndist$CorDist >= x$Correl) / (x$sim +1)),
+ ")", sep = "")
+ if(x$type == "simulate")
+ type <- "Simulation"
+ else
+ type <- "Permutation"
+ testMsg <- paste("Test Type :", type)
+ }
+
+ writeLines(strwrap("Weighted correlation of WA Transfer Function",
+ prefix = "\n\t"))
+ writeLines("\nCall:")
+ print(x$call)
+ writeLines("")
+ if(TEST) {
+ writeLines(testMsg)
+ }
+ writeLines(wtdMsg)
+ writeLines(corMsg)
+ writeLines("")
+}
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2011-09-11 18:10:14 UTC (rev 240)
+++ pkg/inst/ChangeLog 2011-09-18 20:51:03 UTC (rev 241)
@@ -1,5 +1,19 @@
analogue Change Log
+Version 0.7-5
+
+ * weightedCor: implements one of the tests from Telford & Birks
+ (2011, QSR) based on the weighted correlation of WA optima and
+ constrained ordination species scores. Has a plot method.
+
+ * rdaFit: Non-user (currently) function that implements RDA
+ without all of the overhead of vegan::rda. As such it doesn't
+ compute PCA axes and does not return all the components described
+ by ?cca.object in package vegan. This function is used principally
+ in weightedCor(). Has a scores() method. rdaFit() is not
+ documented as the exact details of the function and its
+ capabilities remain to be determined.
+
Version 0.7-4
* gradientDist: new function to extract locations along an
Modified: pkg/man/analogue-internal.Rd
===================================================================
--- pkg/man/analogue-internal.Rd 2011-09-11 18:10:14 UTC (rev 240)
+++ pkg/man/analogue-internal.Rd 2011-09-18 20:51:03 UTC (rev 241)
@@ -18,6 +18,8 @@
\alias{WApred}
\alias{WATpred}
\alias{fixUpTol}
+\alias{rdaFit}
+\alias{scores.rdaFit}
\title{Internal analogue Functions}
\description{
Internal analogue functions
Added: pkg/man/weightedCor.Rd
===================================================================
--- pkg/man/weightedCor.Rd (rev 0)
+++ pkg/man/weightedCor.Rd 2011-09-18 20:51:03 UTC (rev 241)
@@ -0,0 +1,123 @@
+\name{weightedCor}
+\alias{weightedCor}
+\alias{weightedCor.default}
+\alias{print.weightedCor}
+\alias{plot.weightedCor}
+\title{
+ Weighted correlation test of WA reconstruction
+}
+\description{
+ Weighted correlation between WA optima from training set and axis 1
+ scores of constrained ordination fitted to fossil data with WA model
+ predictions for fossil samples as constraints.
+}
+\usage{
+\method{weightedCor}{default}(x, env, fossil, method = c("rda", "cca"),
+ test = TRUE, type = c("simulate", "permute"), sim = 999,
+ verbose = TRUE, ...)
+
+\method{plot}{weightedCor}(x,
+ type = c("bubble", "null"),
+ weighted = TRUE,
+ size = 0.25,
+ xlab = paste(x$env, "WA Optima"),
+ ylab = "Axis 1 Score",
+ xlim,
+ main = "",
+ sub = NULL,
+ border = "gray75",
+ col = "gray75",
+ obscol = "red",
+ fg = "black", ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{training set covariates, a matrix-like object usually of
+ species/proxy data. For the \code{plot} method, an object of class
+ \code{"weightedCor"}, the result of a call to \code{weightedCor}.}
+ \item{env}{training set response, a vector usually of environmental
+ data.}
+ \item{fossil}{matrix of fossil/core species/proxy data for which a
+ reconstruction is sought.}
+ \item{method}{constrained ordination method. One of \code{"rda"} and
+ \code{"cca"}. Currently only \code{"rda"} is supported.}
+ \item{test}{logical; should the observed correlation be tested?}
+ \item{type}{the type of test to apply. One of \code{"simulate"} or
+ \code{"permute"}. The latter is currently not implemented. For the
+ \code{plot} method, the type of plot to produce.}
+ \item{sim}{numeric; number of simulations or permutations to permform
+ as part of the test}
+ \item{verbose}{logical; should the progress of the test be shown via a
+ progress bar?}
+ \item{\dots}{arguments passed to other methods. In the case of the
+ \code{plot} method, additional graphical parameters can be
+ supplied.}
+ \item{weighted}{logical; should the null distribution plotted be of
+ the weighted or normal correlation.}
+ \item{size}{numeric; the size of the largest bubble in inches. See
+ \code{\link{symbols}} and argument \code{inches} for details.}
+ \item{xlim,xlab,ylab,main,sub}{graphical parameters with their
+ usual meaning.}
+ \item{border, col}{The border and fill colours for the histogram
+ bars.}
+ \item{fg}{The colour of the bubbles drawn on the bubble plot.}
+ \item{obscol}{The colour of the indicator for the observed
+ correlation.}
+}
+%%\details{
+%% ~~ If necessary, more details than the description above ~~
+%%}
+\value{
+ The \code{plot} method produces a plot on the current
+ device. \code{weightedCor()} returns a list with the following
+ components:
+
+ \item{wtdCorrel,Correl}{numeric; the observed weighted and standard
+ correlation.}
+ \item{data}{data frame; containing the training set WA Optima, axis 1
+ species scores, and mean abundance for each species.}
+ \item{ord}{the fitted constrained ordination.}
+ \item{model}{the fitted WA model.}
+ \item{method}{the ordination method used.}
+ \item{ndist}{the null distribution produced. \code{NULL} if argument
+ \code{test} was \code{FALSE}.}
+ \item{sim}{numeric; the number of simulations or permutations used to
+ test the observed correlations.}
+ \item{type}{the type of test performed.}
+ \item{env}{the deparsed version of \code{env} argument. Used for
+ plotting.}
+ \item{call}{the matched function call.}
+}
+\references{
+ Telford R.J. and Birks, H.J.B. (2011) A novel method for assessing the
+ statistical significance of quantitative reconstructions inferred from
+ biotic assemblages. \emph{Quanternary Science Reviews}
+ \strong{30}:1272-1278.
+}
+
+\author{
+ Gavin L. Simpson
+}
+%%\note{
+%% ~~further notes~~
+%%}
+
+%% ~Make other sections like Warning with \section{Warning }{....} ~
+
+\seealso{
+ \code{\link{wa}} for details on fitting weighted average models.
+}
+\examples{
+data(ImbrieKipp, SumSST, V12.122)
+
+Cor <- weightedCor(ImbrieKipp, env = SumSST,
+ fossil = V12.122, type = "simulate", sim = 49)
+Cor
+
+plot(Cor)
+plot(Cor, type = "null")
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{ ~kwd1 }
+\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line
Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save 2011-09-11 18:10:14 UTC (rev 240)
+++ pkg/tests/Examples/analogue-Ex.Rout.save 2011-09-18 20:51:03 UTC (rev 241)
@@ -1,5 +1,5 @@
-R version 2.13.1 Patched (2011-07-08 r56332)
+R version 2.13.1 Patched (2011-09-13 r57007)
Copyright (C) 2011 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: x86_64-unknown-linux-gnu (64-bit)
@@ -24,12 +24,12 @@
> library('analogue')
Loading required package: vegan
Loading required package: permute
-This is vegan 1.92-1
+This is vegan 2.0-0
Loading required package: lattice
Loading required package: grid
Loading required package: MASS
Loading required package: princurve
-This is analogue 0.7-4
+This is analogue 0.7-5
>
> assign(".oldSearch", search(), pos = 'CheckExEnv')
> cleanEx()
@@ -2371,7 +2371,7 @@
> flush(stderr()); flush(stdout())
>
> ### Name: gradientDist
-> ### Title: Locations of samples along ordination gradients.
+> ### Title: Positions of samples along a unit-length ordination gradient.
> ### Aliases: gradientDist gradientDist.default gradientDist.cca
> ### gradientDist.prcurve
> ### Keywords: multivariate utility
@@ -6464,10 +6464,149 @@
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
+> cleanEx()
+> nameEx("weightedCor")
+> ### * weightedCor
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: weightedCor
+> ### Title: Weighted correlation test of WA reconstruction
+> ### Aliases: weightedCor weightedCor.default print.weightedCor
+> ### plot.weightedCor
+> ### Keywords: ~kwd1 ~kwd2
+>
+> ### ** Examples
+>
+> data(ImbrieKipp, SumSST, V12.122)
+>
+> Cor <- weightedCor(ImbrieKipp, env = SumSST,
++ fossil = V12.122, type = "simulate", sim = 49)
+Simulating 49 Weighted Correlations:
+
+ |
+ | | 0%
+ |
+ |= | 2%
+ |
+ |=== | 4%
+ |
+ |==== | 6%
+ |
+ |====== | 8%
+ |
+ |======= | 10%
+ |
+ |========= | 12%
+ |
+ |========== | 14%
+ |
+ |=========== | 16%
+ |
+ |============= | 18%
+ |
+ |============== | 20%
+ |
+ |================ | 22%
+ |
+ |================= | 24%
+ |
+ |=================== | 27%
+ |
+ |==================== | 29%
+ |
+ |===================== | 31%
+ |
+ |======================= | 33%
+ |
+ |======================== | 35%
+ |
+ |========================== | 37%
+ |
+ |=========================== | 39%
+ |
+ |============================= | 41%
+ |
+ |============================== | 43%
+ |
+ |=============================== | 45%
+ |
+ |================================= | 47%
+ |
+ |================================== | 49%
+ |
+ |==================================== | 51%
+ |
+ |===================================== | 53%
+ |
+ |======================================= | 55%
+ |
+ |======================================== | 57%
+ |
+ |========================================= | 59%
+ |
+ |=========================================== | 61%
+ |
+ |============================================ | 63%
+ |
+ |============================================== | 65%
+ |
+ |=============================================== | 67%
+ |
+ |================================================= | 69%
+ |
+ |================================================== | 71%
+ |
+ |=================================================== | 73%
+ |
+ |===================================================== | 76%
+ |
+ |====================================================== | 78%
+ |
+ |======================================================== | 80%
+ |
+ |========================================================= | 82%
+ |
+ |=========================================================== | 84%
+ |
+ |============================================================ | 86%
+ |
+ |============================================================= | 88%
+ |
+ |=============================================================== | 90%
+ |
+ |================================================================ | 92%
+ |
+ |================================================================== | 94%
+ |
+ |=================================================================== | 96%
+ |
+ |===================================================================== | 98%
+ |
+ |======================================================================| 100%
+
+> Cor
+
+ Weighted correlation of WA Transfer Function
+
+Call:
+weightedCor(x = ImbrieKipp, env = SumSST, fossil = V12.122, type = "simulate",
+ sim = 49)
+
+Test Type : Simulation
+Weighted Correlation: 0.491 (p = 0.56)
+Correlation : 0.437 (p = < 2.22e-16)
+
+>
+> plot(Cor)
+> plot(Cor, type = "null")
+>
+>
+>
> ### * <FOOTER>
> ###
> cat("Time elapsed: ", proc.time() - get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 25.497 1.413 26.934 0 0
+Time elapsed: 20.463 0.592 21.27 0 0
> grDevices::dev.off()
null device
1
More information about the Analogue-commits
mailing list