[Analogue-commits] r263 - in pkg: . R inst man tests/Examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Apr 16 23:32:10 CEST 2012
Author: gsimpson
Date: 2012-04-16 23:32:09 +0200 (Mon, 16 Apr 2012)
New Revision: 263
Modified:
pkg/DESCRIPTION
pkg/R/fixUpTol.R
pkg/R/wa.R
pkg/R/wa.formula.R
pkg/inst/ChangeLog
pkg/man/wa.Rd
pkg/tests/Examples/analogue-Ex.Rout.save
Log:
add replacement by mean tolerance for small tolerances in WA models
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-04-13 22:46:53 UTC (rev 262)
+++ pkg/DESCRIPTION 2012-04-16 21:32:09 UTC (rev 263)
@@ -1,7 +1,7 @@
Package: analogue
Type: Package
Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.9-1
+Version: 0.9-2
Date: $Date$
Depends: R (>= 2.15.0), stats, graphics, vegan (>= 1.17-12), lattice, grid,
MASS, princurve
Modified: pkg/R/fixUpTol.R
===================================================================
--- pkg/R/fixUpTol.R 2012-04-13 22:46:53 UTC (rev 262)
+++ pkg/R/fixUpTol.R 2012-04-16 21:32:09 UTC (rev 263)
@@ -22,7 +22,8 @@
switch(small.tol,
fraction = frac,
absolute = min.tol,
- min = min(tol[tol >= min.tol], na.rm = TRUE))
+ min = min(tol[tol >= min.tol], na.rm = TRUE),
+ mean = mean(tol[tol >= min.tol], na.rm = TRUE))
}
- return(tol)
+ tol
}
Modified: pkg/R/wa.R
===================================================================
--- pkg/R/wa.R 2012-04-13 22:46:53 UTC (rev 262)
+++ pkg/R/wa.R 2012-04-16 21:32:09 UTC (rev 263)
@@ -5,7 +5,7 @@
deshrink = c("inverse", "classical", "expanded", "none"),
tol.dw = FALSE, useN2 = TRUE,
na.tol = c("min","mean","max"),
- small.tol = c("min","fraction","absolute"),
+ small.tol = c("min","mean","fraction","absolute"),
min.tol = NULL, f = 0.1, ...)
{
## x = species abundances (weights), env = response vector
Modified: pkg/R/wa.formula.R
===================================================================
--- pkg/R/wa.formula.R 2012-04-13 22:46:53 UTC (rev 262)
+++ pkg/R/wa.formula.R 2012-04-16 21:32:09 UTC (rev 263)
@@ -2,7 +2,7 @@
deshrink = c("inverse", "classical", "expanded", "none"),
tol.dw = FALSE, useN2 = TRUE,
na.tol = c("min","mean","max"),
- small.tol = c("min","fraction","absolute"),
+ small.tol = c("min","mean","fraction","absolute"),
min.tol = NULL, f = 0.1, ...,
model = FALSE) {
## set default deshrinking to inverse if no supplied
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2012-04-13 22:46:53 UTC (rev 262)
+++ pkg/inst/ChangeLog 2012-04-16 21:32:09 UTC (rev 263)
@@ -1,5 +1,10 @@
analogue Change Log
+Version 0.9-2
+
+ * wa: small tolerances can now be replaced by the mean
+ tolerance of the set of tolerances that are not small.
+
Version 0.9-1
* splitSample: new function to sample a test set from across
Modified: pkg/man/wa.Rd
===================================================================
--- pkg/man/wa.Rd 2012-04-13 22:46:53 UTC (rev 262)
+++ pkg/man/wa.Rd 2012-04-16 21:32:09 UTC (rev 263)
@@ -20,13 +20,13 @@
deshrink = c("inverse", "classical", "expanded", "none"),
tol.dw = FALSE, useN2 = TRUE,
na.tol = c("min","mean","max"),
- small.tol = c("min","fraction","absolute"),
+ small.tol = c("min","mean","fraction","absolute"),
min.tol = NULL, f = 0.1, ...)
\method{wa}{formula}(formula, data, subset, na.action,
deshrink = c("inverse", "classical", "expanded", "none"),
tol.dw = FALSE, useN2 = TRUE, na.tol = c("min","mean","max"),
- small.tol = c("min","fraction","absolute"), min.tol = NULL,
+ small.tol = c("min","mean","fraction","absolute"), min.tol = NULL,
f = 0.1,..., model = FALSE)
\method{fitted}{wa}(object, \dots)
@@ -105,6 +105,9 @@
\code{min.tol}. With this method, the replaced values will be no
smaller than any other observed tolerance. This is the default in
\pkg{analogue}.}
+ \item{\code{mean} }{small tolerances are replaced by the average
+ observed tolerance from the set that are greater than, or equal
+ to, \code{min.tol}.}
\item{\code{fraction} }{small tolerances are replaced by the
fraction, \code{f}, of the observed environmental gradient in the
training set, \code{env}.}
@@ -186,6 +189,12 @@
## compare actual tolerances to working values
with(mod2, rbind(tolerances, model.tol))
+
+## tolerance DW
+mod3 <- wa(SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE,
+ min.tol = 2, small.tol = "mean")
+mod3
+
}
\keyword{methods}
\keyword{models}
Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save 2012-04-13 22:46:53 UTC (rev 262)
+++ pkg/tests/Examples/analogue-Ex.Rout.save 2012-04-16 21:32:09 UTC (rev 263)
@@ -1,5 +1,5 @@
-R version 2.15.0 Patched (2012-03-30 r58877)
+R version 2.15.0 Patched (2012-04-14 r59019) -- "Easter Beagle"
Copyright (C) 2012 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: x86_64-unknown-linux-gnu (64-bit)
@@ -29,7 +29,7 @@
Loading required package: grid
Loading required package: MASS
Loading required package: princurve
-This is analogue 0.9-0
+This is analogue 0.9-2
>
> assign(".oldSearch", search(), pos = 'CheckExEnv')
> cleanEx()
@@ -1146,7 +1146,8 @@
>
> ### Name: caterpillarPlot
> ### Title: Caterpillar plot of species' WA optima and tolerance range.
-> ### Aliases: caterpillarPlot
+> ### Aliases: caterpillarPlot caterpillarPlot.default
+> ### caterpillarPlot.data.frame caterpillarPlot.wa
> ### Keywords: hplot
>
> ### ** Examples
@@ -4392,6 +4393,9 @@
Other G.quin G.hirsu
5.112464 4.268777 3.942135
>
+> ## caterpillar plot
+> caterpillarPlot(opt, tol)
+>
> ## convert to data frame
> as.data.frame(opt)
Opt
@@ -4787,6 +4791,11 @@
wa> par(mfrow = c(1,1))
+wa> ## caterpillar plot of optima and tolerances
+wa> caterpillarPlot(mod) ## observed tolerances
+
+wa> caterpillarPlot(mod, type = "model") ## with tolerances used in WA model
+
wa> ## tolerance DW
wa> mod2 <- wa(SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE,
wa+ min.tol = 2, small.tol = "min")
@@ -4824,6 +4833,29 @@
C.nitid S.dehis G.digit Other G.quin G.hirsu
tolerances 1.461725 3.84473 3.108881 5.112464 4.268777 3.942135
model.tol 2.124799 3.84473 3.108881 5.112464 4.268777 3.942135
+
+wa> ## tolerance DW
+wa> mod3 <- wa(SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE,
+wa+ min.tol = 2, small.tol = "mean")
+
+wa> mod3
+
+ Weighted Averaging Transfer Function
+
+Call:
+wa(formula = SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE, small.tol = "mean",
+
+ min.tol = 2)
+
+Deshrinking : Inverse
+Tolerance DW : Yes
+No. samples : 61
+No. species : 27
+
+Performance:
+ RMSE R-squared Avg. Bias Max. Bias
+ 1.9924 0.9194 0.0000 -2.5992
+
>
> ## the model performance statistics
> performance(mod)
@@ -5830,6 +5862,11 @@
wa> par(mfrow = c(1,1))
+wa> ## caterpillar plot of optima and tolerances
+wa> caterpillarPlot(mod) ## observed tolerances
+
+wa> caterpillarPlot(mod, type = "model") ## with tolerances used in WA model
+
wa> ## tolerance DW
wa> mod2 <- wa(SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE,
wa+ min.tol = 2, small.tol = "min")
@@ -5867,6 +5904,29 @@
C.nitid S.dehis G.digit Other G.quin G.hirsu
tolerances 1.461725 3.84473 3.108881 5.112464 4.268777 3.942135
model.tol 2.124799 3.84473 3.108881 5.112464 4.268777 3.942135
+
+wa> ## tolerance DW
+wa> mod3 <- wa(SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE,
+wa+ min.tol = 2, small.tol = "mean")
+
+wa> mod3
+
+ Weighted Averaging Transfer Function
+
+Call:
+wa(formula = SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE, small.tol = "mean",
+
+ min.tol = 2)
+
+Deshrinking : Inverse
+Tolerance DW : Yes
+No. samples : 61
+No. species : 27
+
+Performance:
+ RMSE R-squared Avg. Bias Max. Bias
+ 1.9924 0.9194 0.0000 -2.5992
+
>
> ## diagnostics for the WA model
> par(mfrow = c(1,2))
@@ -6388,6 +6448,67 @@
>
>
> cleanEx()
+> nameEx("splitSample")
+> ### * splitSample
+>
+> flush(stderr()); flush(stdout())
+>
+> ### Name: splitSample
+> ### Title: Select samples from along an environmental gradient
+> ### Aliases: splitSample
+> ### Keywords: manip utilities
+>
+> ### ** Examples
+>
+> data(swappH)
+>
+> ## take a test set of 20 samples along the pH gradient
+> test1 <- splitSample(swappH, chunk = 10, take = 20)
+> test1
+ [1] 27 29 85 115 43 146 121 93 102 5 64 155 75 44 122 54 162 165 123
+[20] 129
+attr(,"lengths")
+ [1] 2 2 2 2 2 2 2 2 2 2
+> swappH[test1]
+ 6.21 61 HOLMEV1 RLGH2 ACH1 SCOATT1 S131 LCSU1 LOD1 115.11
+ 4.616 4.600 4.700 4.800 5.101 5.000 5.220 5.350 5.547 5.682
+ DOI1 TINK1 GLAS1 ARR1 S141 BYCH1 WHIN1 WOOD1 S151 S21
+ 5.899 5.966 6.240 6.179 6.380 6.440 6.899 6.782 7.250 7.160
+>
+> ## take a larger sample where some chunks don't have many samples
+> ## do random filling
+> set.seed(3)
+> test2 <- splitSample(swappH, chunk = 10, take = 70, fill = "random")
+> test2
+ [1] 99 72 17 68 36 21 1 52 7 34 150 151 9 101 149 109 135 105 43
+[20] 76 103 113 108 10 87 60 128 55 157 63 41 71 153 32 77 132 31 154
+[39] 125 110 100 64 75 96 158 30 58 73 145 23 120 20 122 47 86 143 14
+[58] 57 111 46 162 165 74 118 133 129 164 18 45 123
+attr(,"lengths")
+ [1] 7 7 7 7 7 7 7 8 7 6
+> swappH[test2]
+ LJOSV1 FLE1 3.11 ENO1 82.11 4.11 1.21 BUGE1
+ 4.410 4.538 4.600 4.543 4.619 4.381 4.491 4.840
+ 121 80.11 SKOMAKV1 STRO1 17.21 LLGH1 SKE2 NAGA1
+ 4.800 4.730 4.670 4.837 4.912 4.642 5.100 5.038
+ S271 MACA1 ACH1 GLYN1 LOWT1 RIEC1 MUCK1 18.11
+ 5.130 5.022 5.101 4.920 5.000 5.266 5.417 5.441
+ IRD1 COR1 S201 CFYN1 UAI1 DIWA1 89.11 FINL1
+ 5.260 5.328 5.490 5.470 5.767 5.720 5.766 5.756
+ TEAN1 71 GOD1 S241 66.11 TECW1 S171 OCHI1
+ 5.700 5.700 5.660 5.990 5.990 6.060 5.810 5.953
+ LLDU1 DOI1 GLAS1 LENY1 UIS1 65.21 CLYD1 GARN1
+ 5.800 5.899 6.240 6.240 6.209 6.175 6.140 6.250
+ S91 44.21 S121 37.11 S141 BARL1 INVA1 S71
+ 6.200 6.600 6.510 6.494 6.380 6.430 6.586 6.460
+ 20.11 CLON1 PARC1 BARE1 WHIN1 WOOD1 GEIR1 S11
+ 6.577 6.942 6.800 6.748 6.899 6.782 6.760 6.840
+ S251 S21 WHIT1 3.511 ARTH1 S151
+ 6.970 7.160 7.031 7.000 7.093 7.250
+>
+>
+>
+> cleanEx()
> nameEx("stdError")
> ### * stdError
>
@@ -6871,6 +6992,10 @@
> plot(mod)
> par(mfrow = c(1,1))
>
+> ## caterpillar plot of optima and tolerances
+> caterpillarPlot(mod) ## observed tolerances
+> caterpillarPlot(mod, type = "model") ## with tolerances used in WA model
+>
> ## tolerance DW
> mod2 <- wa(SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE,
+ min.tol = 2, small.tol = "min")
@@ -6908,8 +7033,31 @@
tolerances 1.461725 3.84473 3.108881 5.112464 4.268777 3.942135
model.tol 2.124799 3.84473 3.108881 5.112464 4.268777 3.942135
>
+> ## tolerance DW
+> mod3 <- wa(SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE,
++ min.tol = 2, small.tol = "mean")
+> mod3
+
+ Weighted Averaging Transfer Function
+
+Call:
+wa(formula = SumSST ~ ., data = ImbrieKipp, tol.dw = TRUE, small.tol = "mean",
+
+ min.tol = 2)
+
+Deshrinking : Inverse
+Tolerance DW : Yes
+No. samples : 61
+No. species : 27
+
+Performance:
+ RMSE R-squared Avg. Bias Max. Bias
+ 1.9924 0.9194 0.0000 -2.5992
+
>
>
+>
+>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("weightedCor")
@@ -7053,7 +7201,7 @@
> ### * <FOOTER>
> ###
> cat("Time elapsed: ", proc.time() - get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 15.815 0.248 16.505 0 0
+Time elapsed: 15.256 0.187 16.245 0 0
> grDevices::dev.off()
null device
1
More information about the Analogue-commits
mailing list