[rkward-cvs] SF.net SVN: rkward: [1641] trunk/rkward/rkward/plugins/uni1.2
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Mon Mar 19 20:57:08 UTC 2007
Revision: 1641
http://svn.sourceforge.net/rkward/?rev=1641&view=rev
Author: tfry
Date: 2007-03-19 13:57:07 -0700 (Mon, 19 Mar 2007)
Log Message:
-----------
local() adjustments and some fixes to basic statistics plugin
I think this plugin should really be split up. It is overly complex, and I already found a number of bugs that have
probably been long-standing, but were never reported.
Modified Paths:
--------------
trunk/rkward/rkward/plugins/uni1.2/code.php
trunk/rkward/rkward/plugins/uni1.2/description.xml
Modified: trunk/rkward/rkward/plugins/uni1.2/code.php
===================================================================
--- trunk/rkward/rkward/plugins/uni1.2/code.php 2007-03-19 19:57:21 UTC (rev 1640)
+++ trunk/rkward/rkward/plugins/uni1.2/code.php 2007-03-19 20:57:07 UTC (rev 1641)
@@ -1,96 +1,93 @@
<?
- function preprocess () {
- }
-
- function calculate () {
+function preprocess () {
+}
+
+function calculate () {
$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("z"))) . ")";
if (getRK_val ("narm")) $narm = "na.rm=TRUE";
else $name = "na.rm=FALSE";
?>
-rk.temp.vars <- list (<? echo ($vars); ?>)
-rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.vars)), check.names=FALSE)
+vars <- list (<? echo ($vars); ?>)
+results <- data.frame ('Variable Name'=rep (NA, length (vars)), check.names=FALSE)
-rk.temp.i <- 0
-for (rk.temp.var in rk.temp.vars) {
- rk.temp.i <- rk.temp.i + 1
- rk.temp.results[['Variable Name']][rk.temp.i] <- rk.get.description(rk.temp.var, is.substitute=TRUE)
- rk.temp.var <- eval(rk.temp.var)
+for (i in 1:length (vars)) {
+ var <- eval (vars[[i]], envir=globalenv());
+ results[i, 'Variable Name'] <- rk.get.description(vars[[i]], is.substitute=TRUE)
<? if (getRK_val ("nombre")) { ?>
- rk.temp.results[['Number of obs']][rk.temp.i] <- length(rk.temp.var)
+ results[i, 'Number of obs'] <- length(var)
<? }
if (getRK_val ("nbna")) { ?>
- rk.temp.results[['Number of missing values']][rk.temp.i] <- length(which(is.na(rk.temp.var)))
+ results[i, 'Number of missing values'] <- length(which(is.na(var)))
<? }
- if (getRK_val ("moyenne")) { ?>
- rk.temp.results[['Mean']][rk.temp.i] <- mean(rk.temp.var,<? echo ($narm); ?>)
+ if (getRK_val ("mean")) { ?>
+ results[i, 'Mean'] <- mean(var,<? echo ($narm); ?>)
<? }
if (getRK_val ("vari")) { ?>
- rk.temp.results[['Variance']][rk.temp.i] <- var(rk.temp.var,<? echo ($narm); ?>)
+ results[i, 'Variance'] <- var(var,<? echo ($narm); ?>)
<? }
- if (getRK_val ("ecartt")) { ?>
- rk.temp.results[['Sd']][rk.temp.i] <- sd(rk.temp.var,<? echo ($narm); ?>)
+ if (getRK_val ("sd")) { ?>
+ results[i, 'Sd'] <- sd(var,<? echo ($narm); ?>)
<? }
if (getRK_val ("minimum")) { ?>
- rk.temp.results[['Minimum']][rk.temp.i] <- min(rk.temp.var,<? echo ($narm); ?>)
+ results[i, 'Minimum'] <- min(var,<? echo ($narm); ?>)
<? }
if (getRK_val ("maximum")) { ?>
- rk.temp.results[['Maximum']][rk.temp.i] <- max(rk.temp.var,<? echo ($narm); ?>)
+ results[i, 'Maximum'] <- max(var,<? echo ($narm); ?>)
<? }
if (($nmin = getRK_val ("nbminimum")) != "0") { ?>
- if (length (rk.temp.var) >= <? echo ($nmin); ?>) {
- rk.temp.results[['Minimum values']][rk.temp.i] <- paste (sort(rk.temp.var, decreasing=FALSE, na.last=TRUE) [1:<? echo ($nmin); ?>])
+ if (length (var) >= <? echo ($nmin); ?>) {
+ results[i, 'Minimum values'] <- paste (sort(var, decreasing=FALSE, na.last=TRUE) [1:<? echo ($nmin); ?>])
}
<? }
if (($nmax = getRK_val ("nbmaximum")) != "0") { ?>
- if (length (rk.temp.var) >= <? echo ($nmin); ?>) {
- rk.temp.results[['Maximum values']][rk.temp.i] <- paste (sort(rk.temp.var, decreasing=TRUE, na.last=TRUE) [1:<? echo ($nmin); ?>])
+ if (length (var) >= <? echo ($nmin); ?>) {
+ results[i, 'Maximum values'] <- paste (sort(var, decreasing=TRUE, na.last=TRUE) [1:<? echo ($nmin); ?>])
}
<? }
- if (getRK_val ("mediane")) { ?>
- rk.temp.results[['Median']][rk.temp.i] <- median(rk.temp.var,<? echo ($narm); ?>)
+ if (getRK_val ("median")) { ?>
+ results[i, 'Median'] <- median(var,<? echo ($narm); ?>)
<? }
if (getRK_val ("irq")) { ?>
- rk.temp.results[['Inter Quartile Range']][rk.temp.i] <- IQR(rk.temp.var,<? echo ($narm); ?>)
+ results[i, 'Inter Quartile Range'] <- IQR(var,<? echo ($narm); ?>)
<? }
if (getRK_val ("quartile")) { ?>
- rk.temp.temp <- quantile (rk.temp.var,<? echo ($narm); ?>)
- rk.temp.results[['Quartiles']][rk.temp.i] <- paste (names (rk.temp.temp), rk.temp.temp, sep=": ", collapse=" ")
+ temp <- quantile (var,<? echo ($narm); ?>)
+ results[i, 'Quartiles'] <- paste (names (temp), temp, sep=": ", collapse=" ")
<? }
if (($nautre = getRK_val ("autre")) != "0") { ?>
- rk.temp.temp <- quantile (rk.temp.var, probs=seq (0, 1, length.out=<? echo ($nautre); ?>), <? echo ($narm); ?>)
- rk.temp.results[['Quantiles']][rk.temp.i] <- paste (names (rk.temp.temp), rk.temp.temp, sep=": ", collapse=" ")
+ temp <- quantile (var, probs=seq (0, 1, length.out=<? echo ($nautre); ?>), <? echo ($narm); ?>)
+ results[i, 'Quantiles'] <- paste (names (temp), temp, sep=": ", collapse=" ")
<? } ?>
#robust statistics
<? if (getRK_val ("trim") == "1") { ?>
- rk.temp.results[['Trimmed Mean']][rk.temp.i] <- mean (rk.temp.var, trim="<? getRK ("pourcent"); ?>", <? echo ($narm); ?>)
+ results[i, 'Trimmed Mean'] <- mean (var, trim=<? getRK ("pourcent"); ?>, <? echo ($narm); ?>)
<? }
if (getRK_val ("mad") == "1") { ?>
- rk.temp.results[['Median Absolute Deviation']][rk.temp.i] <- mad (rk.temp.var, constant = "<? getRK ("constMad"); ?>", <? echo ($narm); ?>)
+ results[i, 'Median Absolute Deviation'] <- mad (var, constant=<? getRK ("constMad"); ?>, <? echo ($narm); ?>)
<? }
if (getRK_val ("huber") == "1") { ?>
require ("MASS")
- rk.temp.temp <- list (c('Location Estimate','Mad scale estimate'), c(NA,NA))
+ temp <- list (c('Location Estimate','Mad scale estimate'), c(NA,NA))
try({
- rk.temp.temp[[2]] <- hubers (rk.temp.var, k = <? getRK ("winsor"); ?>,tol=<? getRK ("tol"); ?><?
+ temp <- hubers (var, k = <? getRK ("winsor"); ?>,tol=<? getRK ("tol"); ?><?
if (getRK_val("customMu")=="1") echo (", mu=".getRK_val("mu"));
if (getRK_val("customS")=="1") echo (", s=".getRK_val("s"));
echo (",initmu =".getRK_val("initmu")."(rk.temp.var)") ?>)
})
- rk.temp.results[['Huber M-Estimator']][rk.temp.i] <- paste (rk.temp.temp[[1]], rk.temp.temp[[2]], sep=": ", collapse=" ")
+ results[i, 'Huber M-Estimator'] <- paste (temp[[1]], temp[[2]], sep=": ", collapse=" ")
<? } ?>
}
<? if (getRK_val ("result") == "1") { ?>
# store results
-'<? getRK ("nom"); ?>' <- rk.temp.results
+'<? getRK ("nom"); ?>' <- results
<? } ?>
<?
- }
-
- function printout () {
- // produce the output
+}
+
+function printout () {
?>
rk.header ("Univariate statistics", parameters=list (
"Remove Missing values", <? if (getRK_val ("narm")) echo ("TRUE"); else echo ("FALSE"); ?>
@@ -113,15 +110,7 @@
<? } ?>
))
-rk.results (rk.temp.results)
+rk.results (results)
<?
- }
-
- function cleanup () {
+}
?>
-rm (rk.temp.results)
-rm (rk.temp.i)
-try (rm (rk.temp.temp))
-<?
- }
-?>
Modified: trunk/rkward/rkward/plugins/uni1.2/description.xml
===================================================================
--- trunk/rkward/rkward/plugins/uni1.2/description.xml 2007-03-19 19:57:21 UTC (rev 1640)
+++ trunk/rkward/rkward/plugins/uni1.2/description.xml 2007-03-19 20:57:07 UTC (rev 1641)
@@ -1,5 +1,6 @@
<!DOCTYPE rkplugin>
-<!-- This is a simple example, of how a "plugin" might be configured. --><document>
+<!-- TODO: This plugin should really be split up. It is overly complex. -->
+<document>
<code file="code.php"/>
<logic>
<connect client="constMad.enabled" governor="mad.state" />
@@ -37,9 +38,9 @@
</frame>
<frame label="Moments" >
<row>
- <checkbox value_unchecked="0" checked="false" value="1" id="moyenne" label="Mean" />
+ <checkbox value_unchecked="0" checked="false" value="1" id="mean" label="Mean" />
<checkbox value_unchecked="0" checked="false" value="1" id="vari" label="Variance" />
- <checkbox value_unchecked="0" checked="false" value="1" id="ecartt" label="Sd" />
+ <checkbox value_unchecked="0" checked="false" value="1" id="sd" label="Sd" />
</row>
</frame>
<frame label="extrema" >
@@ -56,7 +57,7 @@
</frame>
<frame label="Quantile" >
<row>
- <checkbox value_unchecked="0" checked="false" value="1" id="mediane" label="Median" />
+ <checkbox value_unchecked="0" checked="false" value="1" id="median" label="Median" />
<checkbox value_unchecked="0" checked="false" value="1" id="irq" label="Interquartile Range" />
<checkbox value_unchecked="0" checked="false" value="1" id="quartile" label="Quartile" />
</row>
@@ -70,7 +71,7 @@
<frame label="Dispersion" >
<row>
<checkbox checked="false" value="1" id="mad" label="Median Absolute Deviation" />
- <input size="small" intial="1.4628" id="constMad" label="Constant" />
+ <spinbox type="real" initial="1.4628" id="constMad" label="Constant" />
</row>
</frame>
<frame label="Robust mean" >
@@ -110,8 +111,8 @@
</tab>
<tab id="option" label="Options" >
<checkbox value_unchecked="0" checked="true" value="1" id="narm" label="Omit missing values" />
- <checkbox checked="false" value="1" id="result" label="Get the result in the console" />
- <input size="medium" intial="rk.univariate" id="nom" label="Name of the result" />
+ <checkbox checked="false" value="1" id="result" label="Store results" />
+ <saveobject intial="rk.univariate" id="nom" label="Name of the result" />
<stretch/>
</tab>
</tabbook>
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