[Analogue-commits] r401 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 11 18:42:55 CET 2014
Author: gsimpson
Date: 2014-02-11 18:42:54 +0100 (Tue, 11 Feb 2014)
New Revision: 401
Modified:
pkg/R/internal.R
pkg/R/plot.timetrack.R
Log:
clean up (remove) some commented code chunks
Modified: pkg/R/internal.R
===================================================================
--- pkg/R/internal.R 2014-01-02 05:28:49 UTC (rev 400)
+++ pkg/R/internal.R 2014-02-11 17:42:54 UTC (rev 401)
@@ -53,19 +53,6 @@
## drop - drop spurious zero distance ##
## ##
###########################################################################
-#cummean <- function(dis, y, drop = TRUE)
-# {
-# nas <- is.na(dis)
-# ord <- order(dis[!nas])
-# if(drop) {
-# dis <- dis[!nas][ord][-1]
-# y <- y[!nas][ord][-1]
-# } else {
-# dis <- dis[!nas][ord]
-# y <- y[!nas][ord]
-# }
-# cumsum(y) / 1:length(dis)
-# }
cummean <- function(dis, y, drop = TRUE, kmax) {
if(missing(kmax))
kmax <- length(y)
@@ -118,12 +105,6 @@
## n - number of sections to break env gradient into ##
## ##
###########################################################################
-##maxBias <- function(error, y, n = 10)
-## {
-## groups <- cut(y, breaks = n, labels = 1:n)
-## bias <- aggregate(error, list(group = groups), mean)$x
-## bias[which.max(abs(bias))]
-## }
maxBias <- function(error, y, n = 10)
{
groups <- cut.default(y, breaks = n, labels = 1:n)
@@ -167,12 +148,11 @@
## w.avg - fast weighted mean function with no checks
`w.avg` <- function(x, env) {
opt <- ColSums(x * env) / ColSums(x)
- ##opt <- .colSums(x * env) / .colSums(x)
names(opt) <- colnames(x)
opt
}
-## fast rowSums and colSums functiosn without the checking
+## fast rowSums and colSums functions without the checking
`RowSums` <- function(x, na.rm = FALSE) {
dn <- dim(x)
p <- dn[2]
@@ -187,17 +167,11 @@
.colSums(x, n, dn, na.rm)
}
-## deshrinking function given deshrinking coefs and a method
-##`deshrink.pred` <- function(x, coef) {
-## coef[1] + x * coef[2]
-##}
-
## w.tol --- computes weighted standard deviations AKA tolerances
w.tol <- function(x, env, opt, useN2 = TRUE) {
## x = species abundances
## env = vector of response var
## opt = weighted average optima
- ##tol <- sqrt(ColSums(x * outer(env, opt, "-")^2) / ColSums(x))
nr <- NROW(x)
nc <- NCOL(x)
tol <- .C("WTOL", x = as.double(env), w = as.double(x),
Modified: pkg/R/plot.timetrack.R
===================================================================
--- pkg/R/plot.timetrack.R 2014-01-02 05:28:49 UTC (rev 400)
+++ pkg/R/plot.timetrack.R 2014-02-11 17:42:54 UTC (rev 401)
@@ -1,4 +1,4 @@
-`plot.timetrack` <- function(x, choices = 1:2,
+`plot.timetrack` <- function(x, choices = 1:2,
display = c("wa","lc"),
order,
ptype = c("l", "p", "o", "b"),
@@ -13,13 +13,9 @@
pass <- fitted(x, type = "passive", choices = choices)
xlim <- range(scrs[,1], pass[,1])
ylim <- range(scrs[,2], pass[,2])
- ## plt <- plot(x$ord, choices = choices, scaling = x$scaling,
- ## type = "p", display = display, ...,
- ## ylim = ylim, xlim = xlim,
- ## pch = pch[1], col = col[1])
plt <- plot(x$ord, choices = choices, scaling = x$scaling,
type = "n", display = display, ...,
- ylim = ylim, xlim = xlim)
+ ylim = ylim, xlim = xlim)
points(scrs, pch = pch[1], col = col[1], ...)
if(!missing(order)) {
if(length(order) != NROW(pass))
More information about the Analogue-commits
mailing list