[Pastecs-commits] r6 - in pkg: . R

[noreply at r-forge.r-project.org]

Author: phgrosjean
Date: 2013-01-24 16:58:51 +0100 (Thu, 24 Jan 2013)
New Revision: 6

Modified:
   pkg/DESCRIPTION
   pkg/R/pgleissberg.R
Log:
No more assignment to .GlobalEnv in pgleissberg()

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-01-21 15:24:03 UTC (rev 5)
+++ pkg/DESCRIPTION	2013-01-24 15:58:51 UTC (rev 6)
@@ -1,9 +1,9 @@
 Package: pastecs
 Title: Package for Analysis of Space-Time Ecological Series
-Version: 1.3-12
-Date: 2013-01-21
+Version: 1.3-13
+Date: 2013-01-24
 Author: Frederic Ibanez <ibanez at obs-vlfr.fr>, Philippe Grosjean <phgrosjean at sciviews.org> & Michele Etienne <etienne at obs-vlfr.fr>
-Description: Regulation, decomposition and analysis of space-time series. The pastecs library is a PNEC-Art4 and IFREMER (Benoit Beliaeff <Benoit.Beliaeff at ifremer.fr>) initiative to bring PASSTEC 2000 (http://www.obs-vlfr.fr/~enseigne/anado/passtec/passtec.htm) functionnalities to R.
+Description: Regulation, decomposition and analysis of space-time series. The pastecs library is a PNEC-Art4 and IFREMER (Benoit Beliaeff <Benoit.Beliaeff at ifremer.fr>) initiative to bring PASSTEC 2000 (http://www.obs-vlfr.fr/~enseigne/anado/passtec/passtec.htm) functionalities to R.
 URL: http://www.sciviews.org/pastecs
 Encoding: latin1
 Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>

Modified: pkg/R/pgleissberg.R
===================================================================
--- pkg/R/pgleissberg.R	2013-01-21 15:24:03 UTC (rev 5)
+++ pkg/R/pgleissberg.R	2013-01-24 15:58:51 UTC (rev 6)
@@ -1,5 +1,28 @@
-"pgleissberg" <-
-function(n, k, lower.tail=TRUE, two.tailed=FALSE) {
+.gleissberg.calc <- function (n = 50, k = 48)
+{
+	Gleiss <- matrix(0, n - 2, k + 1)
+	N <- nrow(Gleiss)
+	K <- ncol(Gleiss)
+	Gleiss[,1] <- 2
+	Gleiss[1, 2] <- 4
+	for (n in 2:N) {
+		Gleiss[n, 2] <- 2*Gleiss[n-1, 2] + 2*Gleiss[n-1, 1]
+		for (k in 3:K) {
+			for (n in (k-1):N) {
+				Gleiss[n, k] <- k*Gleiss[n-1, k] + 2*Gleiss[n-1,k-1] + (n-k+2)*Gleiss[n-1, k-2]
+			}
+		}
+	}
+	Gleiss <- Gleiss / gamma(4:51)		# gamma(n + 1) is equivalent to n!
+	# This is the probability, giving any (n, k) pair... but we want a table of right-tailed cumulated probabilities
+	Gleiss <- t(apply(t(Gleiss), 2, cumsum))
+	as.matrix(Gleiss)
+}
+
+.gleissberg.table <- .gleissberg.calc()
+
+pgleissberg <- function (n, k, lower.tail=TRUE, two.tailed=FALSE)
+{
 	# Make sure n and k have same length
 	if (length(n) > length(k)) k <- rep(k, length.out=length(n))
 	if (length(n) < length(k)) n <- rep(n, length.out=length(k))
@@ -32,54 +55,10 @@
 			rescalc[Norm] <- resnorm
 		}
 		if (sum(!Norm) > 0) {
-			# Calculate exact Gleissberg distribution
-			# This is normally loaded from gleissberg.table
-			# but if it fails, it can be recalculated with:
-			"gleissberg.calc" <- function() {
-				n <- 50
-				k <- 48
-				Gleiss <- matrix(0, n - 2, k + 1)
-				N <- nrow(Gleiss)
-				K <- ncol(Gleiss)
-				Gleiss[,1] <- 2
-				Gleiss[1, 2] <- 4
-				for (n in 2:N) {
-					Gleiss[n, 2] <- 2*Gleiss[n-1, 2] + 2*Gleiss[n-1, 1]
-					for (k in 3:K) {
-						for (n in (k-1):N) {
-							Gleiss[n, k] <- k*Gleiss[n-1, k] + 2*Gleiss[n-1,k-1] + (n-k+2)*Gleiss[n-1, k-2]
-						}
-					}
-				}
-				Gleiss <- Gleiss / gamma(4:51)		# gamma(n + 1) is equivalent to n!
-				# This is the probability, giving any (n, k) pair... but we want a table of right-tailed cumulated probabilities
-				Gleiss <- t(apply(t(Gleiss), 2, cumsum))
-				assign(".gleissberg.table", Gleiss, envir = .GlobalEnv)	
-				invisible(NULL)
-			}
-			
 			# Determination of Gleissberg probability
 			ng <- ncalc[!Norm]
 			kg <- kcalc[!Norm]
-			if (exists("is.R") && is.function(is.R) && is.R()) {	# We are in R
-				if (length(objects(envir=.GlobalEnv, all.names=TRUE, pattern=".gleissberg.table")) == 0) {	# Table not found
-					try(data(gleissberg.table))
-					if (length(objects(envir=.GlobalEnv, all.names=TRUE, pattern=".gleissberg.table")) == 0) {	# Table still not found
-						cat("Creating Gleissberg distribution table...\n\n")
-						if (R.Version()$os == "Win32") {flush.console()}
-						gleissberg.calc()
-					}
-				}
-			} else {												# We are in S+
-				if (exists(".gleissberg.table") == FALSE) {	# Table not found
-					try(data(gleissberg.table))
-					if (exists(".gleissberg.table") == FALSE) {	# Table still not found
-						cat("Creating Gleissberg distribution table...\n\n")
-						gleissberg.calc()
-					}
-				}
-			}
-			.gleissberg.table <- as.matrix(.gleissberg.table)
+			
 			if (two.tailed == TRUE) { 	# two-sided probability
 				# As Gleissberg distribution is asymmetric, we have to calculate both sides independently
 				mu <- 2 / 3 * (ng - 2)