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

[sjar at users.sourceforge.net]

Revision: 1673
          http://svn.sourceforge.net/rkward/?rev=1673&view=rev
Author:   sjar
Date:     2007-03-20 16:11:39 -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/chisq_out_test.php
    trunk/rkward/rkward/plugins/analysis/outliers/chisq_out_test.rkh

Modified: trunk/rkward/rkward/plugins/analysis/outliers/chisq_out_test.php
===================================================================
--- trunk/rkward/rkward/plugins/analysis/outliers/chisq_out_test.php	2007-03-20 22:57:20 UTC (rev 1672)
+++ trunk/rkward/rkward/plugins/analysis/outliers/chisq_out_test.php	2007-03-20 23:11:39 UTC (rev 1673)
@@ -1,66 +1,61 @@
 <?
-	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 <- chisq.out.test (var, opposite = <? getRK ("opposite"); ?>, variance = var (var))
-			rk.temp.variance <- var (var)
-			rk.temp.results$'X-squared'[i] <<- rk.temp.t$statistic
-			rk.temp.results$'p-value'[i] <<- rk.temp.t$p.value
-			rk.temp.results$'Alternative Hypothesis'[i] <<- rk.describe.alternative(rk.temp.t)
-			rk.temp.results$'Variance'[i] <<- rk.temp.variance
-		})
-		<? 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 <- na.omit(eval (vars[[i]], envir=globalenv ()))
+	# var_w_na is similiar to var but NAs are not removed
+	var_w_na <- eval (vars[[i]], envir=globalenv ())
+	results[i, 'Error'] <- tryCatch ({
+		# This is the core of the calculation
+		t <- chisq.out.test (var, opposite = <? getRK ("opposite"); ?>, variance = var (var))
+		results[i, 'X-squared'] <- t$statistic
+		results[i, 'p-value'] <- t$p.value
+		results[i, 'Alternative Hypothesis']<- rk.describe.alternative (t)
+		results[i, 'Variance'] <- var (var)
+<?	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_w_na)))
+<? 	} ?>
+		NA				# no error
+	}, error=function (e) e$message)	# catch any errors
+}
+if (all (is.na (results$'Error'))) results$'Error' <- NULL
 <?
-        }
+}
 
 function printout () {
 ?>
 rk.header ("Chi-squared test for outlier",
 	parameters=list ("Opposite", "<? getRK ("opposite"); ?>"))
-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/chisq_out_test.rkh
===================================================================
--- trunk/rkward/rkward/plugins/analysis/outliers/chisq_out_test.rkh	2007-03-20 22:57:20 UTC (rev 1672)
+++ trunk/rkward/rkward/plugins/analysis/outliers/chisq_out_test.rkh	2007-03-20 23:11:39 UTC (rev 1673)
@@ -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. For the calculation missing values are removed from the data.</setting>
+		<setting id="x">Select the data to be computed. The vectors need to be numeric, and can be of different length. For the calculation missing values are removed from the data.</setting>
 		<caption id="tab_options"/>
 		<setting id="opposite">Check if you want not the value with largest difference from the mean, but opposite (lowest, if most suspicious is highest etc.).</setting>
 		<setting id="mean">If checked this will calculate you the arithmetic mean is an additional out put. However, this will not effect your results but is just an optional information.</setting>


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.