[rkward-cvs] SF.net SVN: rkward: [1624] trunk/rkward/rkward/plugins/descriptive/ descriptive_statistics.php

[tfry at users.sourceforge.net]

Revision: 1624
          http://svn.sourceforge.net/rkward/?rev=1624&view=rev
Author:   tfry
Date:     2007-03-18 14:54:13 -0700 (Sun, 18 Mar 2007)

Log Message:
-----------
adjust descriptives plugin to running inside local(), some prettifcations, and minor corrections

Modified Paths:
--------------
    trunk/rkward/rkward/plugins/descriptive/descriptive_statistics.php

Modified: trunk/rkward/rkward/plugins/descriptive/descriptive_statistics.php
===================================================================
--- trunk/rkward/rkward/plugins/descriptive/descriptive_statistics.php	2007-03-18 21:31:48 UTC (rev 1623)
+++ trunk/rkward/rkward/plugins/descriptive/descriptive_statistics.php	2007-03-18 21:54:13 UTC (rev 1624)
@@ -1,78 +1,76 @@
 <?
-	function preprocess () {
-	}
-	
-	function calculate () {
-		global $mad_type;
-		global $constMad;
+function preprocess () {
+}
 
-		$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
-		$trim = getRK_val ("trim"); //the fraction (0 to 0.5) of observations to be trimmed from each end of x before the mean is computed
-		$constMad = getRK_val ("constMad");
-		$mad_type = getRK_val ("mad_type");
+function calculate () {
+	global $mad_type;
+	global $constMad;
 
+	$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
+	$trim = getRK_val ("trim"); //the fraction (0 to 0.5) of observations to be trimmed from each end of x before the mean is computed
+	$constMad = getRK_val ("constMad");
+	$mad_type = getRK_val ("mad_type");
+
 ?>
-rk.temp.vars <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Object'=rep (NA, length (rk.temp.vars)))
-i=0;
-for (rk.temp.var in rk.temp.vars) {
-	i = i+1
-	rk.temp.results$'Object'[i] <- rk.get.description (rk.temp.var, is.substitute=TRUE)
+vars <- list (<? echo ($vars); ?>)
+results <- data.frame ('Object'=rep (NA, length (vars)))
+for (i in 1:length (vars)) {
+	results[i, 'Object'] <- rk.get.description (vars[[i]], is.substitute=TRUE)
+	var <- eval (vars[[i]], envir=globalenv())	# fetch the real object
+
+	# we wrap each single call in a "try" statement to always continue on errors.
 <?
-		if (getRK_val ("mean")) { ?>
-	rk.temp.results$mean[i] <- try (mean (eval (rk.temp.var), trim = <?echo ($trim) ;?>, na.rm=TRUE))
-<?		}
-		if (getRK_val ("median")) { ?>
-	rk.temp.results$median[i] <- try (median (eval (rk.temp.var), na.rm=TRUE))
-<?		}
-		if (getRK_val ("range")) { ?>
+	if (getRK_val ("mean")) { ?>
+	results[i, 'mean'] <- try (mean (var, trim = <?echo ($trim) ;?>, na.rm=TRUE))
+<?	}
+	if (getRK_val ("median")) { ?>
+	results[i, 'median'] <- try (median (var, na.rm=TRUE))
+<?	}
+	if (getRK_val ("range")) { ?>
 	try ({
-		rk.temp.range <- try (range (eval (rk.temp.var), na.rm=TRUE))
-		rk.temp.results$min[i] <- rk.temp.range[1]
-		rk.temp.results$max[i] <- rk.temp.range[2]
+		range <- try (range (var, na.rm=TRUE))
+		results[i, 'min'] <- range[1]
+		results[i, 'max'] <- range[2]
 	})
-<?		}
-		if (getRK_val ("sd")) { ?>
-	rk.temp.results$'standard deviation'[i] <- try (sd (eval (rk.temp.var), na.rm=TRUE))
-<?		}
-		if (getRK_val ("sum")) { ?>
-	rk.temp.results$sum[i] <- try (sum (eval (rk.temp.var), na.rm=TRUE))
-<?		}
-		if (getRK_val ("prod")) { ?>
-	rk.temp.results$prod[i] <- try (prod (eval (rk.temp.var), na.rm=TRUE))
-<?		}
-		if (getRK_val ("mad")) { ?>
-	rk.temp.results$'Median Absolute Deviation'[i] <- try (mad (eval (rk.temp.var), constant = <? echo ($constMad);
-			if ($mad_type == "low") echo (", low=TRUE");
-			elseif ($mad_type == "high") echo (", high=TRUE"); ?>, na.rm=TRUE))
-<?		}
-		if (getRK_val ("length")) { ?>
-	rk.temp.results$'length of sample'[i] <- try (length (eval (rk.temp.var)))
-<?		}
-		if (getRK_val ("nacount")) { ?>
-	rk.temp.results$'number of NAs'[i] <- try (length (which(is.na(eval (rk.temp.var)))))
-<?		} ?>
-}<?
-	}
+<?	}
+	if (getRK_val ("sd")) { ?>
+	results[i, 'standard deviation'] <- try (sd (var, na.rm=TRUE))
+<?	}
+	if (getRK_val ("sum")) { ?>
+	results[i, 'sum'] <- try (sum (var, na.rm=TRUE))
+<?	}
+	if (getRK_val ("prod")) { ?>
+	results[i, 'product'] <- try (prod (var, na.rm=TRUE))
+<?	}
+	if (getRK_val ("mad")) { ?>
+	results[i, 'Median Absolute Deviation'] <- try (mad (var, constant = <? echo ($constMad);
+		if ($mad_type == "low") echo (", low=TRUE");
+		elseif ($mad_type == "high") echo (", high=TRUE"); ?>, na.rm=TRUE))
+<?	}
+	if (getRK_val ("length")) { ?>
+	results[i, 'length of sample'] <- try (length (var))
+<?	}
+	if (getRK_val ("nacount")) { ?>
+	results[i, 'number of NAs'] <- try (length (which(is.na(var))))
+<?	} ?>
+}
+<?
+}
 	
-	function printout () {
-		global $mad_type;
-		global $constMad;
+function printout () {
+	global $mad_type;
+	global $constMad;
 ?>
-rk.header ("Descriptive statistics", parameters=list ("Trim of mean", <?getRK ("trim") ;?><? if (getRK_val ("mad")) { ?>,
-					"Median Absolute Deviation",
-					paste ("constant:", <?echo ($constMad) ;?>, <?
-						if ($mad_type == "low") echo ('"lo-median"');
-						elseif ($mad_type == '"hi-median"');
-						else echo ('"average"'); ?>)<? } ?>))
+rk.header ("Descriptive statistics", parameters=list (
+               "Trim of mean", <?getRK ("trim") ;?><? if (getRK_val ("mad")) { ?>,
+               "Median Absolute Deviation",
+               paste ("constant:", <?echo ($constMad) ;?>, <?
+	if ($mad_type == "low") echo ('"lo-median"');
+	elseif ($mad_type == "high") echo ('"hi-median"');
+	else echo ('"average"'); ?>)<? } ?>))
 
-rk.results (rk.temp.results)
+rk.results (results)
 <?
-	}
-	
-	function cleanup () {
+}
+
 ?>
-rm (list=grep ("^rk.temp", ls (), value=TRUE))
-<?
-	}
-?>


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