[rkward-cvs] SF.net SVN: rkward: [1671] trunk/rkward/rkward/plugins/analysis/outliers

sjar at users.sourceforge.net sjar at users.sourceforge.net
Tue Mar 20 22:31:51 UTC 2007


Revision: 1671
          http://svn.sourceforge.net/rkward/?rev=1671&view=rev
Author:   sjar
Date:     2007-03-20 15:31:51 -0700 (Tue, 20 Mar 2007)

Log Message:
-----------
Updates to obsolate statements in help files 
Updates to outlier 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/analysis/outliers/dixon_test.php
    trunk/rkward/rkward/plugins/analysis/outliers/dixon_test.rkh
    trunk/rkward/rkward/plugins/analysis/outliers/grubbs_test.php
    trunk/rkward/rkward/plugins/analysis/outliers/grubbs_test.rkh

Modified: trunk/rkward/rkward/plugins/analysis/outliers/dixon_test.php
===================================================================
--- trunk/rkward/rkward/plugins/analysis/outliers/dixon_test.php	2007-03-20 21:42:59 UTC (rev 1670)
+++ trunk/rkward/rkward/plugins/analysis/outliers/dixon_test.php	2007-03-20 22:31:51 UTC (rev 1671)
@@ -1,64 +1,58 @@
 <?
-	function preprocess () {
-	}
+function preprocess () { ?>
+require(outliers)
+<?
+}
 
-	function calculate () {
+function calculate () {
 	$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
-
 ?>
-require(outliers)
 
-rk.temp.objects <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.objects)), check.names=FALSE)
-local({
-	i=0;
-	for (sub in rk.temp.objects) {
-		i = i+1
-		rk.temp.results$'Variable Name'[i] <<- rk.get.description (sub, is.substitute=TRUE)
-		var <- na.omit (eval (sub))
-		try ({
-			rk.temp.t <- dixon.test (var, type = <? getRK ("type"); ?>, opposite = <? getRK ("opposite"); ?>, two.sided = <? getRK ("two_sided"); ?>)
-			rk.temp.results$'Dixon Q-statistic'[i] <<- rk.temp.t$statistic["Q"]
-			rk.temp.results$'p-value'[i] <<- rk.temp.t$p.value
-			rk.temp.results$'Alternative'[i] <<- rk.temp.t$"alternative"
-		})
-		<? if (getRK_val ("mean")) { ?>
-		try (rk.temp.results$'Mean'[i] <<- mean (var))
-		<? } ?>
-		<? if (getRK_val ("sd")) { ?>
-		try (rk.temp.results$'Standard Deviation'[i] <<- sd (var))
-		<? } ?>
-		<? if (getRK_val ("median")) { ?>
-		try (rk.temp.results$'Median'[i] <<- median (var))
-		<? } ?>
-		<? if (getRK_val ("min")) { ?>
-		try (rk.temp.results$'Minimum'[i] <<- min (var))
-		<? } ?>
-		<? if (getRK_val ("max")) { ?>
-		try (rk.temp.results$'Maximum'[i] <<- max (var))
-		<? } ?>
-		<? if (getRK_val ("length")) { ?>
-		try (rk.temp.results$'Length'[i] <<- length (eval (sub)))
-		<? }
-		if (getRK_val ("nacount")) { ?>
-		try (rk.temp.results$'NAs'[i] <<- length (which(is.na(eval (sub)))))
-		<? } ?>
-	}
-})
+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 ())
+	results[i, 'Error'] <- tryCatch ({
+		# This is the core of the calculation
+		t <- dixon.test (var, type = <? getRK ("type"); ?>, opposite = <? getRK ("opposite"); ?>, two.sided = <? getRK ("two_sided"); ?>)
+		results[i, 'Dixon Q-statistic'] <- t$statistic["Q"]
+		results[i, 'p-value'] <- t$p.value
+		results[i, 'Alternative Hypothesis']<- rk.describe.alternative (t)
+<?	if (getRK_val ("mean")) { ?>
+		results[i, 'Mean'] <- mean (var)
+<?	} ?>
+<?	if (getRK_val ("sd")) { ?>
+		results[i, 'Standard Deviation'] <-  sd (var)
+<?	} ?>
+<?	if (getRK_val ("median")) { ?>
+		results[i, 'Median'] <- median (var)
+<?	} ?>
+<?	if (getRK_val ("min")) { ?>
+		results[i, 'Minimum'] <- min (var)
+<?	} ?>
+<?	if (getRK_val ("max")) { ?>
+		results[i, 'Maximum'] <- max (var)
+<?	} ?>
+<?	if (getRK_val ("length")) { ?>
+		results[i, 'Length'] <- length (var)
+<?	}
+	if (getRK_val ("nacount")) { ?>
+		results[i, 'NAs'] <- length (which(is.na(var)))
+<? 	} ?>
+		NA				# no error
+	}, error=function (e) e$message)	# catch any errors
+}
+if (all (is.na (results$'Error'))) results$'Error' <- NULL
 <?
-        }
+}
 
 function printout () {
 ?>
 rk.header ("Dixon test for outlier",
 	parameters=list ("Type", "<? getRK ("type"); ?>", "Opposite", "<? getRK ("opposite"); ?>", "two-sided", "<? getRK ("two_sided"); ?>"))
-rk.results (rk.temp.results)
+rk.results (results)
 <?
 }
 
-function cleanup () {
 ?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
-}
-?>

Modified: trunk/rkward/rkward/plugins/analysis/outliers/dixon_test.rkh
===================================================================
--- trunk/rkward/rkward/plugins/analysis/outliers/dixon_test.rkh	2007-03-20 21:42:59 UTC (rev 1670)
+++ trunk/rkward/rkward/plugins/analysis/outliers/dixon_test.rkh	2007-03-20 22:31:51 UTC (rev 1671)
@@ -10,7 +10,7 @@
 
 	<settings>
 		<caption id="tab_variables"/>
-		<setting id="x">Select the data to be computed. The vectors need to be numeric, and can be of different length but 30 is the limit.</setting>
+		<setting id="x">Select the data to be computed. The vectors need to be numeric, and can be of different length but there is a limit.</setting>
 		<caption id="tab_options"/>
 		<setting id="type">This is specyfying the variant of test to be performed.</setting>
 		<setting id="two_sided">Here you can specify the alternative hypothesis. It must be one of "two-sided" or "not two-sided".</setting>

Modified: trunk/rkward/rkward/plugins/analysis/outliers/grubbs_test.php
===================================================================
--- trunk/rkward/rkward/plugins/analysis/outliers/grubbs_test.php	2007-03-20 21:42:59 UTC (rev 1670)
+++ trunk/rkward/rkward/plugins/analysis/outliers/grubbs_test.php	2007-03-20 22:31:51 UTC (rev 1671)
@@ -1,65 +1,59 @@
 <?
-	function preprocess () {
-	}
+function preprocess () { ?>
+require(outliers)
+<?
+}
 
-	function calculate () {
+function calculate () {
 	$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
-
 ?>
-require(outliers)
 
-rk.temp.objects <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.objects)), check.names=FALSE)
-local({
-	i=0;
-	for (sub in rk.temp.objects) {
-		i = i+1
-		rk.temp.results$'Variable Name'[i] <<- rk.get.description (sub, is.substitute=TRUE)
-		var <- na.omit (eval (sub))
-		try ({
-			rk.temp.t <- grubbs.test (var, type = <? getRK ("type"); ?>, opposite = <? getRK ("opposite"); ?>, two.sided = <? getRK ("two_sided"); ?>)
-			rk.temp.results$'G'[i] <<- rk.temp.t$statistic["G"]
-			rk.temp.results$'U'[i] <<- rk.temp.t$statistic["U"]
-			rk.temp.results$'p-value'[i] <<- rk.temp.t$p.value
-			rk.temp.results$'Alternative Hypothesis'[i] <<- rk.describe.alternative (rk.temp.t)
-		})
-		<? if (getRK_val ("mean")) { ?>
-		try (rk.temp.results$'Mean'[i] <<- mean (var))
-		<? } ?>
-		<? if (getRK_val ("sd")) { ?>
-		try (rk.temp.results$'Standard Deviation'[i] <<- sd (var))
-		<? } ?>
-		<? if (getRK_val ("median")) { ?>
-		try (rk.temp.results$'Median'[i] <<- median (var))
-		<? } ?>
-		<? if (getRK_val ("min")) { ?>
-		try (rk.temp.results$'Minimum'[i] <<- min (var))
-		<? } ?>
-		<? if (getRK_val ("max")) { ?>
-		try (rk.temp.results$'Maximum'[i] <<- max (var))
-		<? } ?>
-		<? if (getRK_val ("length")) { ?>
-		try (rk.temp.results$'Length'[i] <<- length (eval (sub)))
-		<? }
-		if (getRK_val ("nacount")) { ?>
-		try (rk.temp.results$'NAs'[i] <<- length (which(is.na(eval (sub)))))
-		<? } ?>
-	}
-})
+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 ())
+	results[i, 'Error'] <- tryCatch ({
+		# This is the core of the calculation
+		t <- grubbs.test (var, type = <? getRK ("type"); ?>, opposite = <? getRK ("opposite"); ?>, two.sided = <? getRK ("two_sided"); ?>)
+		results[i, 'G'] <- t$statistic["G"]
+		results[i, 'U'] <- t$statistic["U"]
+		results[i, 'p-value'] <- t$p.value
+		results[i, 'Alternative Hypothesis']<- rk.describe.alternative (t)
+<?	if (getRK_val ("mean")) { ?>
+		results[i, 'Mean'] <- mean (var)
+<?	} ?>
+<?	if (getRK_val ("sd")) { ?>
+		results[i, 'Standard Deviation'] <-  sd (var)
+<?	} ?>
+<?	if (getRK_val ("median")) { ?>
+		results[i, 'Median'] <- median (var)
+<?	} ?>
+<?	if (getRK_val ("min")) { ?>
+		results[i, 'Minimum'] <- min (var)
+<?	} ?>
+<?	if (getRK_val ("max")) { ?>
+		results[i, 'Maximum'] <- max (var)
+<?	} ?>
+<?	if (getRK_val ("length")) { ?>
+		results[i, 'Length'] <- length (var)
+<?	}
+	if (getRK_val ("nacount")) { ?>
+		results[i, 'NAs'] <- length (which(is.na(var)))
+<? 	} ?>
+		NA				# no error
+	}, error=function (e) e$message)	# catch any errors
+}
+if (all (is.na (results$'Error'))) results$'Error' <- NULL
 <?
-        }
+}
 
 function printout () {
 ?>
 rk.header ("Grubbs tests for one or two outliers in data sample",
 	parameters=list ("Type", "<? getRK ("type"); ?>", "Opposite", "<? getRK ("opposite"); ?>", "two-sided", "<? getRK ("two_sided"); ?>"))
-rk.results (rk.temp.results)
+rk.results (results)
 <?
 }
 
-function cleanup () {
 ?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
-}
-?>

Modified: trunk/rkward/rkward/plugins/analysis/outliers/grubbs_test.rkh
===================================================================
--- trunk/rkward/rkward/plugins/analysis/outliers/grubbs_test.rkh	2007-03-20 21:42:59 UTC (rev 1670)
+++ trunk/rkward/rkward/plugins/analysis/outliers/grubbs_test.rkh	2007-03-20 22:31:51 UTC (rev 1671)
@@ -10,7 +10,7 @@
 
 	<settings>
 		<caption id="tab_variables"/>
-		<setting id="x">Select the data to be computed. The vectors need to be numeric, and can be of different length but 30 is the limit.</setting>
+		<setting id="x">Select the data to be computed. The vectors need to be numeric, and can be of different length but there is a limit.</setting>
 		<caption id="tab_options"/>
 		<setting id="type">This is specyfying the variant of test to be performed. Please refere to the R-help here.</setting>
 		<setting id="two_sided">Here you can specify the alternative hypothesis. It must be one of "two-sided" or "not two-sided"</setting>


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