[rkward-cvs] SF.net SVN: rkward: [1645] trunk/rkward/rkward/plugins/distributions/tests
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Mon Mar 19 21:35:59 UTC 2007
Revision: 1645
http://svn.sourceforge.net/rkward/?rev=1645&view=rev
Author: tfry
Date: 2007-03-19 14:35:58 -0700 (Mon, 19 Mar 2007)
Log Message:
-----------
Updates to the distribution tests:
* adjustments for local()
* more elegant iteration
* move require to preprocess
* no try()s for the length() statements, as these are safe
* indentation fixes
* evaluate each substitute only once, and explicitely in globalenv()
Modified Paths:
--------------
trunk/rkward/rkward/plugins/distributions/tests/ad_test.php
trunk/rkward/rkward/plugins/distributions/tests/cvm_test.php
trunk/rkward/rkward/plugins/distributions/tests/lillie_test.php
trunk/rkward/rkward/plugins/distributions/tests/pearson_test.php
trunk/rkward/rkward/plugins/distributions/tests/sf_test.php
trunk/rkward/rkward/plugins/distributions/tests/shapiro_test.php
Modified: trunk/rkward/rkward/plugins/distributions/tests/ad_test.php
===================================================================
--- trunk/rkward/rkward/plugins/distributions/tests/ad_test.php 2007-03-19 21:35:43 UTC (rev 1644)
+++ trunk/rkward/rkward/plugins/distributions/tests/ad_test.php 2007-03-19 21:35:58 UTC (rev 1645)
@@ -1,33 +1,30 @@
<?
-function preprocess () {
+function preprocess () { ?>
+require(nortest)
+<?
}
function calculate () {
-$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
+ $vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
?>
-require(nortest)
-
-rk.temp.vars <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.vars)), check.names=FALSE)
-local({
-i=0;
-for (rk.temp.var in rk.temp.vars) {
- i = i+1
- rk.temp.results$'Variable Name'[i] <<- rk.get.description (rk.temp.var, is.substitute=TRUE)
- <? if (getRK_val ("length")) { ?>
- try (rk.temp.results$'Length'[i] <<- length (eval (rk.temp.var)))
- <? }
+vars <- list (<? echo ($vars); ?>)
+results <- data.frame ('Variable Name'=rep (NA, length (vars)), check.names=FALSE)
+for (i in 1:length (vars)) {
+ results[i, 'Variable Name'] <- rk.get.description (vars[[i]], is.substitute=TRUE)
+ var <- eval (vars[[i]], envir=globalenv ())
+<? if (getRK_val ("length")) { ?>
+ results[i, 'Length'] <- length (var)
+<? }
if (getRK_val ("nacount")) { ?>
- try (rk.temp.results$'NAs'[i] <<- length (which(is.na(eval (rk.temp.var)))))
- <? } ?>
+ results[i, 'NAs'] <- length (which(is.na(var)))
+<? } ?>
try ({
- rk.temp.test <- ad.test (eval (rk.temp.var))
- rk.temp.results$'Statistic'[i] <<- paste (names (rk.temp.test$statistic), rk.temp.test$statistic, sep=" = ")
- rk.temp.results$'p-value'[i] <<- rk.temp.test$p.value
+ test <- ad.test (var)
+ results[i, 'Statistic'] <- paste (names (test$statistic), test$statistic, sep=" = ")
+ results[i, 'p-value'] <- test$p.value
})
}
-})
<?
}
@@ -35,14 +32,7 @@
?>
rk.header ("Anderson-Darling Normality Test")
-rk.results (rk.temp.results)
+rk.results (results)
<?
}
-
-function cleanup () {
-
-?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
-}
?>
\ No newline at end of file
Modified: trunk/rkward/rkward/plugins/distributions/tests/cvm_test.php
===================================================================
--- trunk/rkward/rkward/plugins/distributions/tests/cvm_test.php 2007-03-19 21:35:43 UTC (rev 1644)
+++ trunk/rkward/rkward/plugins/distributions/tests/cvm_test.php 2007-03-19 21:35:58 UTC (rev 1645)
@@ -1,45 +1,37 @@
<?
- function preprocess () {
- }
+function preprocess () { ?>
+require(nortest)
+<?
+}
- function calculate () {
+function calculate () {
$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
?>
-require(nortest)
-
-rk.temp.vars <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.vars)), check.names=FALSE)
-local({
-i=0;
-for (var in rk.temp.vars) {
- i = i+1
- rk.temp.results$'Variable Name'[i] <<- rk.get.description (var, is.substitute=TRUE)
- <? if (getRK_val ("length")) { ?>
- rk.temp.results$'Length'[i] <<- try (length (eval (var)))
- <? }
+vars <- list (<? echo ($vars); ?>)
+results <- data.frame ('Variable Name'=rep (NA, length (vars)), check.names=FALSE)
+for (i in 1:length (vars)) {
+ results[i, 'Variable Name'] <- rk.get.description (vars[[i]], is.substitute=TRUE)
+ var <- eval (vars[[i]], envir=globalenv ())
+<? if (getRK_val ("length")) { ?>
+ results[i, 'Length'] <- length (var)
+<? }
if (getRK_val ("nacount")) { ?>
- rk.temp.results$'NAs'[i] <- try (length (which(is.na(eval (var)))))
- <? } ?>
+ results[i, 'NAs'] <- length (which(is.na(var)))
+<? } ?>
try ({
- rk.temp.test <- cvm.test (eval (var))
- rk.temp.results$'Statistic'[i] <<- paste (names (rk.temp.test$statistic), rk.temp.test$statistic, sep=" = ")
- rk.temp.results$'p-value'[i] <<- rk.temp.test$p.value
+ test <- cvm.test (var)
+ results[i, 'Statistic'] <- paste (names (test$statistic), test$statistic, sep=" = ")
+ results[i, 'p-value'] <- test$p.value
})
}
-})
<?
- }
- function printout () {
+}
+
+function printout () {
?>
rk.header ("Cramer-von Mises Normality Test")
-rk.results (rk.temp.results)
+rk.results (results)
<?
- }
- function cleanup () {
-
-?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
- }
+}
?>
\ No newline at end of file
Modified: trunk/rkward/rkward/plugins/distributions/tests/lillie_test.php
===================================================================
--- trunk/rkward/rkward/plugins/distributions/tests/lillie_test.php 2007-03-19 21:35:43 UTC (rev 1644)
+++ trunk/rkward/rkward/plugins/distributions/tests/lillie_test.php 2007-03-19 21:35:58 UTC (rev 1645)
@@ -1,45 +1,37 @@
<?
- function preprocess () {
- }
+function preprocess () { ?>
+require (nortest)
+<?
+}
- function calculate () {
+function calculate () {
$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
?>
-require (nortest)
-
-rk.temp.vars <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.vars)), check.names=FALSE)
-local({
-i=0;
-for (var in rk.temp.vars) {
- i = i+1
- rk.temp.results$'Variable Name'[i] <<- rk.get.description (var, is.substitute=TRUE)
- <? if (getRK_val ("length")) { ?>
- rk.temp.results$'Length'[i] <<- try (length (eval (var)))
- <? }
+vars <- list (<? echo ($vars); ?>)
+results <- data.frame ('Variable Name'=rep (NA, length (vars)), check.names=FALSE)
+for (i in 1:length (vars)) {
+ results[i, 'Variable Name'] <- rk.get.description (vars[[i]], is.substitute=TRUE)
+ var <- eval (vars[[i]], envir=globalenv())
+<? if (getRK_val ("length")) { ?>
+ results[i, 'Length'] <- length (var)
+<? }
if (getRK_val ("nacount")) { ?>
- rk.temp.results$'NAs'[i] <<- try (length (which(is.na(eval (var)))))
- <? } ?>
+ results[i, 'NAs'] <- length (which(is.na(var)))
+<? } ?>
try ({
- rk.temp.test <<- lillie.test (eval (var))
- rk.temp.results$'Statistic'[i] <<- paste (names (rk.temp.test$statistic), rk.temp.test$statistic, sep=" = ")
- rk.temp.results$'p-value'[i] <<- rk.temp.test$p.value
+ test <- lillie.test (var)
+ results[i, 'Statistic'] <- paste (names (test$statistic), test$statistic, sep=" = ")
+ results[i, 'p-value'] <- test$p.value
})
}
-})
<?
- }
- function printout () {
+}
+
+function printout () {
?>
rk.header ("Lilliefors (Kolmogorov-Smirnov) Normality test")
-rk.results (rk.temp.results)
+rk.results (results)
<?
- }
- function cleanup () {
-
-?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
- }
+}
?>
\ No newline at end of file
Modified: trunk/rkward/rkward/plugins/distributions/tests/pearson_test.php
===================================================================
--- trunk/rkward/rkward/plugins/distributions/tests/pearson_test.php 2007-03-19 21:35:43 UTC (rev 1644)
+++ trunk/rkward/rkward/plugins/distributions/tests/pearson_test.php 2007-03-19 21:35:58 UTC (rev 1645)
@@ -1,49 +1,41 @@
<?
- function preprocess () {
- }
+function preprocess () { ?>
+require(nortest)
+<?
+}
- function calculate () {
+function calculate () {
$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
$adjust = getRK_val ("adjust");
?>
-require(nortest)
-
-rk.temp.vars <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.vars)), check.names=FALSE)
-local({
-i=0;
-for (var in rk.temp.vars) {
- i = i+1
- rk.temp.results$'Variable Name'[i] <- rk.get.description (var, is.substitute=TRUE)
- <? if (getRK_val ("length")) { ?>
- rk.temp.results$'Length'[i] <<- try (length (eval (var)))
- <? }
+vars <- list (<? echo ($vars); ?>)
+results <- data.frame ('Variable Name'=rep (NA, length (vars)), check.names=FALSE)
+for (i in 1:length (vars)) {
+ results[i, 'Variable Name'] <- rk.get.description (vars[[i]], is.substitute=TRUE)
+ var <- eval (vars[[i]], envir=globalenv ())
+<? if (getRK_val ("length")) { ?>
+ results[i, 'Length'] <- length (var)
+<? }
if (getRK_val ("nacount")) { ?>
- rk.temp.results$'NAs'[i] <<- try (length (which(is.na(eval (var)))))
- <? } ?>
+ results[i, 'NAs'] <- length (which(is.na(var)))
+<? } ?>
try ({
- rk.temp.test <- pearson.test (eval (var), <? echo $adjust; ?>)
- rk.temp.results$'Statistic'[i] <<- paste (names (rk.temp.test$statistic), rk.temp.test$statistic, sep=" = ")
- rk.temp.results$'p-value'[i] <<- rk.temp.test$p.value
- rk.temp.results$'number of classes'[i] <<- rk.temp.test$n.classes
- rk.temp.results$'degrees of freedom'[i] <<- rk.temp.test$df
+ test <- pearson.test (var, <? echo $adjust; ?>)
+ results[i, 'Statistic'] <- paste (names (test$statistic), test$statistic, sep=" = ")
+ results[i, 'p-value'] <- test$p.value
+ results[i, 'number of classes'] <- test$n.classes
+ results[i, 'degrees of freedom'] <- test$df
})
}
-})
<?
- }
- function printout () {
+}
+
+function printout () {
?>
rk.header ("Pearson chi-square Normality Test",
parameters=list ("chi-square distribution with n.classes-3 df (TRUE) or chi-square distribution with n.classes-1 df (FALSE)", "<? getRK ("adjust"); ?>"))
-rk.results (rk.temp.results)
+rk.results (results)
<?
- }
- function cleanup () {
-
-?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
- }
+}
?>
\ No newline at end of file
Modified: trunk/rkward/rkward/plugins/distributions/tests/sf_test.php
===================================================================
--- trunk/rkward/rkward/plugins/distributions/tests/sf_test.php 2007-03-19 21:35:43 UTC (rev 1644)
+++ trunk/rkward/rkward/plugins/distributions/tests/sf_test.php 2007-03-19 21:35:58 UTC (rev 1645)
@@ -1,45 +1,37 @@
<?
- function preprocess () {
- }
+function preprocess () { ?>
+require(nortest)
+<?
+}
- function calculate () {
+function calculate () {
$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
-?>
-require(nortest)
-
-rk.temp.vars <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.vars)), check.names=FALSE)
-local({
-i=0;
-for (var in rk.temp.vars) {
- i = i+1
- rk.temp.results$'Variable Name'[i] <<- rk.get.description (var, is.substitute=TRUE)
- <? if (getRK_val ("length")) { ?>
- rk.temp.results$'Length'[i] <<- try (length (eval (var)))
- <? }
+?>
+vars <- list (<? echo ($vars); ?>)
+results <- data.frame ('Variable Name'=rep (NA, length (vars)), check.names=FALSE)
+for (i in 1:length (vars)) {
+ results[i, 'Variable Name'] <- rk.get.description (vars[[i]], is.substitute=TRUE)
+ var <- eval (vars[[i]], envir=globalenv())
+<? if (getRK_val ("length")) { ?>
+ results[i, 'Length'] <- length (var)
+<? }
if (getRK_val ("nacount")) { ?>
- rk.temp.results$'NAs'[i] <<- try (length (which(is.na(eval (var)))))
- <? } ?>
+ results[i, 'NAs'] <- length (which(is.na(var)))
+<? } ?>
try ({
- rk.temp.test <- sf.test (eval (var))
- rk.temp.results$'Statistic'[i] <<- paste (names (rk.temp.test$statistic), rk.temp.test$statistic, sep=" = ")
- rk.temp.results$'p-value'[i] <<- rk.temp.test$p.value
+ test <- sf.test (var)
+ results[i, 'Statistic'] <- paste (names (test$statistic), test$statistic, sep=" = ")
+ results[i, 'p-value'] <- test$p.value
})
}
-})
<?
- }
- function printout () {
+}
+
+function printout () {
?>
rk.header ("Shapiro-Francia Normality Test")
-rk.results (rk.temp.results)
+rk.results (results)
<?
- }
- function cleanup () {
-
-?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
- }
+}
?>
\ No newline at end of file
Modified: trunk/rkward/rkward/plugins/distributions/tests/shapiro_test.php
===================================================================
--- trunk/rkward/rkward/plugins/distributions/tests/shapiro_test.php 2007-03-19 21:35:43 UTC (rev 1644)
+++ trunk/rkward/rkward/plugins/distributions/tests/shapiro_test.php 2007-03-19 21:35:58 UTC (rev 1645)
@@ -1,44 +1,35 @@
<?
- function preprocess () {
- }
+function preprocess () {
+}
- function calculate () {
+function calculate () {
$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
?>
-
-rk.temp.vars <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.vars)), check.names=FALSE)
-local({
-i=0;
-for (var in rk.temp.vars) {
- i = i+1
- rk.temp.results$'Variable Name'[i] <<- rk.get.description (var, is.substitute=TRUE)
- <? if (getRK_val ("length")) { ?>
- rk.temp.results$'Length'[i] <<- try (length (eval (var)))
- <? }
+vars <- list (<? echo ($vars); ?>)
+results <- data.frame ('Variable Name'=rep (NA, length (vars)), check.names=FALSE)
+for (i in 1:length (vars)) {
+ results[i, 'Variable Name'] <- rk.get.description (vars[[i]], is.substitute=TRUE)
+ var <- eval (vars[[i]], envir=globalenv())
+<? if (getRK_val ("length")) { ?>
+ results[i, 'Length'] <- length (var)
+<? }
if (getRK_val ("nacount")) { ?>
- rk.temp.results$'NAs'[i] <<- try (length (which(is.na(eval (var)))))
- <? } ?>
+ results[i, 'NAs'] <- length (which(is.na(var)))
+<? } ?>
try ({
- rk.temp.test <- shapiro.test (eval (var))
- rk.temp.results$'Statistic'[i] <<- paste (names (rk.temp.test$statistic), rk.temp.test$statistic, sep=" = ")
- rk.temp.results$'p-value'[i] <<- rk.temp.test$p.value
+ test <- shapiro.test (var)
+ results[i, 'Statistic'] <- paste (names (test$statistic), test$statistic, sep=" = ")
+ results[i, 'p-value'] <- test$p.value
})
}
-})
<?
- }
- function printout () {
+}
+
+function printout () {
?>
rk.header ("Shapiro-Wilk Normality Test")
-rk.results (rk.temp.results)
+rk.results (results)
<?
- }
- function cleanup () {
-
-?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
- }
+}
?>
\ No newline at end of file
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the rkward-tracker
mailing list