[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