[rkward-cvs] SF.net SVN: rkward: [1082] trunk/rkward/rkward/plugins
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Sun Jan 7 18:50:15 UTC 2007
Revision: 1082
http://svn.sourceforge.net/rkward/?rev=1082&view=rev
Author: tfry
Date: 2007-01-07 10:50:15 -0800 (Sun, 07 Jan 2007)
Log Message:
-----------
Plugin coding style
Modified Paths:
--------------
trunk/rkward/rkward/plugins/plots/scatterplot.php
trunk/rkward/rkward/plugins/plots/stripchart_plot.php
trunk/rkward/rkward/plugins/simple_anova/code.php
trunk/rkward/rkward/plugins/uni1.2/code.php
trunk/rkward/rkward/plugins/uni1.2/description.xml
Modified: trunk/rkward/rkward/plugins/plots/scatterplot.php
===================================================================
--- trunk/rkward/rkward/plugins/plots/scatterplot.php 2007-01-07 17:42:53 UTC (rev 1081)
+++ trunk/rkward/rkward/plugins/plots/scatterplot.php 2007-01-07 18:50:15 UTC (rev 1082)
@@ -29,7 +29,7 @@
rk.temp$Xval <- <? if (getRK_val("columns") == "custoCol" ) echo (getRK_val("Xscale") . "\n"); else echo ("c(" . $x . ")\n"); ?>
rk.temp$Yval <- <? if (getRK_val("rows") == "custoRow" ) echo (getRK_val("Yscale") . "\n"); else echo ("c(" . $y . ")\n"); ?>
-<? # verification (chiant mais doit \xEAtre fait)?>
+<? # verification (is this needed?) ?>
rk.temp$ok <- TRUE
if (length(rk.temp$Xvar) != length(rk.temp$Yvar)) {
rk.temp$ok <- FALSE ;
@@ -37,8 +37,8 @@
}
# find range of X/Y values needed
-rk.temp$Xdef <- c(min(rk.temp$Xval,na.rm=TRUE), max(rk.temp$Xval,na.rm=TRUE))
-rk.temp$Ydef <- c(min(rk.temp$Yval,na.rm=TRUE), max(rk.temp$Yval,na.rm=TRUE))
+rk.temp$Xdef <- range (rk.temp$Xval, na.rm=TRUE)
+rk.temp$Ydef <- range (rk.temp$Yval, na.rm=TRUE)
rk.temp$type <- rep (<? echo ($type_string); ?>, length.out=length (rk.temp$Xvar));
rk.temp$col <- rep (<? echo ($col); ?>, length.out=length (rk.temp$Xvar));
Modified: trunk/rkward/rkward/plugins/plots/stripchart_plot.php
===================================================================
--- trunk/rkward/rkward/plugins/plots/stripchart_plot.php 2007-01-07 17:42:53 UTC (rev 1081)
+++ trunk/rkward/rkward/plugins/plots/stripchart_plot.php 2007-01-07 18:50:15 UTC (rev 1082)
@@ -3,28 +3,23 @@
}
function calculate () {
-?> length.temp <- length (<? getRK ("x"); ?>);
- method.temp <- c("<? getRK ("method"); ?>");
-<?
}
function printout () {
$x = getRK_val ("x");
$g = getRK_val ("g");
- $method = getRK_val ("method");
+ $method = '"' . getRK_val ("method") . '"';
$jitter = getRK_val ("jitter");
$offset = getRK_val ("offset");
+ $vertical = getRK_val ("vertical");
?>
-rk.header ("Stripchart", list ("Variable", rk.get.description (<? echo ($x); ?>), "Length", length.temp, "Method", method.temp, "Jitter", <? echo ($jitter); ?>, "Plot drawn vertically", <? getRK ("vertical"); ?>, "Offset", <? getRK ("offset"); ?>))
+rk.header ("Stripchart", list ("Variable", rk.get.description (<? echo ($x); ?>), "Method", <? echo ($method); ?>, "Jitter", <? echo ($jitter); ?>, "Plot drawn vertically", <? echo ($vertical); ?>, "Offset", <? echo ($offset); ?>))
rk.graph.on ()
-stripchart (<? echo ($x); ?> ~ (<? echo ($g); ?>), vertical= <? getRK ("vertical"); ?>, method = "<? getRK ("method"); ?>", jitter = <? echo ($jitter); ?>, offset = <? echo ($offset); ?> <? getRK ("plotoptions.code.printout"); ?>)
+stripchart (<? echo ($x); ?> ~ (<? echo ($g); ?>), vertical=<? echo ($vertical); ?>, method = <? echo ($method); ?>, jitter = <? echo ($jitter); ?>, offset = <? echo ($offset); ?> <? getRK ("plotoptions.code.printout"); ?>)
rk.graph.off ()
<?
}
function cleanup () {
-?> rm (length.temp)
- rm (method.temp)
-<?
}
?>
Modified: trunk/rkward/rkward/plugins/simple_anova/code.php
===================================================================
--- trunk/rkward/rkward/plugins/simple_anova/code.php 2007-01-07 17:42:53 UTC (rev 1081)
+++ trunk/rkward/rkward/plugins/simple_anova/code.php 2007-01-07 18:50:15 UTC (rev 1082)
@@ -10,7 +10,8 @@
}
function printout () {
-?>cat ("<h1>TODO: format Output</h1>")
+?>
+rk.header ("Simple Anova")
rk.print (rk.temp.anova)
<?
}
Modified: trunk/rkward/rkward/plugins/uni1.2/code.php
===================================================================
--- trunk/rkward/rkward/plugins/uni1.2/code.php 2007-01-07 17:42:53 UTC (rev 1081)
+++ trunk/rkward/rkward/plugins/uni1.2/code.php 2007-01-07 18:50:15 UTC (rev 1082)
@@ -4,119 +4,123 @@
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";
?>
-# we make the calculation
-rk.temp.res <- list()
+rk.temp.vars <- list (<? echo ($vars); ?>)
+rk.temp.results <- data.frame ('Variable Name'=rep (NA, length (rk.temp.vars)), check.names=FALSE)
+
rk.temp.option <- NA
-for (rk.temp.var in list (<? echo ($vars); ?>)) {
- k <- rk.get.description(rk.temp.var, is.substitute=TRUE)
+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)
- rk.temp.res [[ k ]] <- list()
- <? if (getRK_val ("nombre"))
- echo "rk.temp.res [[ k ]][['Number of obs']] <- length(rk.temp.var)\n";
- if (getRK_val ("nbna"))
- echo "rk.temp.res [[ k ]][['Number of missing values']] <- length(which(is.na(rk.temp.var)))\n" ;
- if (getRK_val ("moyenne"))
- echo "rk.temp.res [[ k ]][['Mean']] <- mean(rk.temp.var,na.rm=".getRK_val("NA").")\n" ;
- if (getRK_val ("vari"))
- echo "rk.temp.res [[ k ]][['Variance']] <- var(rk.temp.var,na.rm=".getRK_val("NA").")\n" ;
- if (getRK_val ("ecartt"))
- echo "rk.temp.res [[ k ]][['Sd']] <- sd(rk.temp.var,na.rm=".getRK_val("NA").")\n" ;
- if (getRK_val ("minimum"))
- echo "rk.temp.res [[ k ]][['Minimum']] <- min(rk.temp.var,na.rm=".getRK_val("NA").")\n" ;
- if (getRK_val ("maximum"))
- echo "rk.temp.res [[ k ]][['Maximum']] <- max(rk.temp.var,na.rm=".getRK_val("NA").")\n" ;
- if (($nmin = getRK_val ("nbminimum")) != "0")
- echo (" if ( length(rk.temp.var) >= " . $nmin .") {
- rk.temp.res [[ k ]][['Minimum values']] <- list()
- rk.temp.res [[ k ]][['Minimum values']][[1]] <- c(1:" . $nmin . ")
- rk.temp.res [[ k ]][['Minimum values']][[2]] <- sort(rk.temp.var, decreasing=FALSE,na.last=TRUE) [1:" . $nmin . "]
- }\n" ) ;
- if (($nmax = getRK_val ("nbmaximum")) != "0")
- echo (" if ( length(rk.temp.var) >= " . $nmax .")
- rk.temp.res [[ k ]][['Maximum values']] <- list()
- rk.temp.res [[ k ]][['Maximum values']][[1]] <- c(1:" . $nmax . ")
- rk.temp.res [[ k ]][['Maximum values']][[2]] <- sort(rk.temp.var, decreasing=TRUE,na.last=TRUE) [1:" . $nmax . "]\n" ) ;
- if (getRK_val ("mediane")) echo "rk.temp.res [[ k ]][['Median']] <- median(rk.temp.var,na.rm=".getRK_val("NA").")\n" ;
- if (getRK_val ("irq")) echo "rk.temp.res [[ k ]][['Inter Quartile Range']] <- IQR(rk.temp.var,na.rm=".getRK_val("NA").")\n";
- if (getRK_val ("quartile")) echo
- "rk.temp.res [[ k ]] [['Quartiles']] <- list()
- rk.temp.res [[ k ]] [['Quartiles']] [[2]] <- quantile(rk.temp.var,na.rm=".getRK_val("NA").")
- rk.temp.res [[ k ]] [['Quartiles']] [[1]] <- names(quantile(rk.temp.var,na.rm=".getRK_val("NA")."))\n" ;
- if (($nautre = getRK_val ("autre")) != "0") echo (" if ( length(rk.temp.var) >= " . $nautre .") {
- rk.temp.res [[ k ]][['Other']] <- list()
- rk.temp.res [[ k ]][['Other']][[1]] <- paste(seq(0,100,le=" . $nautre . "),'%')
- rk.temp.res [[ k ]] [['Other']] [[2]] <- quantile(rk.temp.var,probs=seq(0,1,le=" . $nautre . "), na.rm=".getRK_val("NA").")
- }\n" ) ; ?>
+
+<? if (getRK_val ("nombre")) { ?>
+ rk.temp.results[['Number of obs']][rk.temp.i] <- length(rk.temp.var)
+<? }
+ if (getRK_val ("nbna")) { ?>
+ rk.temp.results[['Number of missing values']][rk.temp.i] <- length(which(is.na(rk.temp.var)))
+<? }
+ if (getRK_val ("moyenne")) { ?>
+ rk.temp.results[['Mean']][rk.temp.i] <- mean(rk.temp.var,<? echo ($narm); ?>)
+<? }
+ if (getRK_val ("vari")) { ?>
+ rk.temp.results[['Variance']][rk.temp.i] <- var(rk.temp.var,<? echo ($narm); ?>)
+<? }
+ if (getRK_val ("ecartt")) { ?>
+ rk.temp.results[['Sd']][rk.temp.i] <- sd(rk.temp.var,<? echo ($narm); ?>)
+<? }
+ if (getRK_val ("minimum")) { ?>
+ rk.temp.results[['Minimum']][rk.temp.i] <- min(rk.temp.var,<? echo ($narm); ?>)
+<? }
+ if (getRK_val ("maximum")) { ?>
+ rk.temp.results[['Maximum']][rk.temp.i] <- max(rk.temp.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 (($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 (getRK_val ("mediane")) { ?>
+ rk.temp.results[['Median']][rk.temp.i] <- median(rk.temp.var,<? echo ($narm); ?>)
+<? }
+ if (getRK_val ("irq")) { ?>
+ rk.temp.results[['Inter Quartile Range']][rk.temp.i] <- IQR(rk.temp.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=" ")
+<? }
+ if (($nautre = getRK_val ("autre")) != "0") { ?>
+ rk.temp.temp <- quantile (rk.temp.var, probs=seq (0, 1, lenght.out=<? echo ($nautre); ?>), <? echo ($narm); ?>)
+ rk.temp.results[['Quantiles']][rk.temp.i] <- paste (names (rk.temp.temp), rk.temp.temp, sep=": ",
+<? } ?>
#robust statistics
- <? if (getRK_val ("trim") == "1")
- echo ("rk.temp.res [[ k ]][['Trimmed Mean']] <- mean(rk.temp.var,trim= ". getRK_val("pourcent") . " ,na.rm=".getRK_val("NA").")\n" ) ;
- if (getRK_val ("mad") == "1")
- echo ("rk.temp.res [[ k ]][['Median Absolute Deviation']] <- mad(rk.temp.var, constant = ". getRK_val("constMad") . " ,na.rm=".getRK_val("NA").")\n" ) ;
- if (getRK_val ("huber") == "1") echo ("
- require (\"MASS\")
- rk.temp.res [[ k ]][['Huber M-Estimator']] <- list()
- rk.temp.res [[ k ]][['Huber M-Estimator']] [[1]] <- c('Location Estimate','Mad scale estimate')
- rk.temp.res [[ k ]][['Huber M-Estimator']] [[2]] <- c(NA,NA)
- try(rk.temp.res [[ k ]][['Huber M-Estimator']] [[2]] <- hubers (rk.temp.var, k = " . getRK_val("winsor") . ",tol=".getRK_val("tol")." )\n");
- if (getRK_val(customMu)=="1") echo (",mu=".getRK_val("mu")) ;
- if (getRK_val(customS)=="1") echo (",s=".getRK_val("s")) ;
- if (getRK_val ("huber") == "1") echo (",initmu =".getRK_val("initmu")."(rk.temp.var)))")
- ?>
- rm(k)
+<? if (getRK_val ("trim") == "1") { ?>
+ rk.temp.results[['Trimmed Mean']][rk.temp.i] <- mean (rk.temp.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); ?>)
+<? }
+ if (getRK_val ("huber") == "1") { ?>
+ require ("MASS")
+ rk.temp.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"); ?>"<?
+ if (getRK_val(customMu)=="1") echo (",mu=".getRK_val("mu"));
+ if (getRK_val(customS)=="1") echo (",s=".getRK_val("s"));
+ if (getRK_val ("huber") == "1") 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=" ")
+<? } ?>
}
-
- <? if (getRK_val ("result") == "1") echo( getRK_val("nom")."<- rk.temp.res") ?>
- <? getRK_val("option") ?>
- <? if (getRK_val("option")=="1") echo("
- rk.temp.option <- list()
- rk.temp.option [['Remove missing value from calcul ']] <- paste( 'Remove missing value from calcul',". getRK_val("NA") . ",sep=' = ')" ) ?>
- <? if (getRK_val("option")=="1" && getRK_val("trim")=="1" ) echo("rk.temp.option [['Trimmed value for trimmed mean']] <- paste('Trimmed value for trimmed mean',". getRK_val("pourcent") . ",sep=' = ')"); ?>
- <? if (getRK_val("option")=="1" && getRK_val("mad")=="1" ) echo("rk.temp.option [['Constant for the MAD estimation ']] <- paste('Constant for the MAD estimation '," . getRK_val("constMad") . ",sep=' = ')" ) ?>
- <? if (getRK_val("option")=="1" && getRK_val("huber")=="1" ) echo("
- rk.temp.option [['Winsorized values for Huber estimator ']] <- paste('Winsorized values for Huber estimator' ," . getRK_val("winsor") . ",sep=' = ')" ."
- rk.temp.option [['Tolerance in Huber estimator ']] <- paste( 'Tolerance in Huber estimator '," .getRK_val("tol") . ",sep=' = ')" )?>
- <? if (getRK_val("option")=="1" && getRK_val("huber")=="1" && getRK_val("customMu")=="1" ) echo ("rk.temp.option [['Mu for Huber estimator ']] <- paste('Mu for Huber estimator' ,".getRK_val("mu") . ",sep=' = ')" )?>
- <? if (getRK_val("option")=="1" && getRK_val("huber")=="1" && getRK_val("customS")=="1" ) echo ("rk.temp.option [['S for Huber estimator ']] <- paste('S for Huber estimator' ,".getRK_val("s") . ",sep=' = ')" )?>
- <? if (getRK_val("option")=="1" && getRK_val("huber")=="1" ) echo ("rk.temp.option [['Inial value']] <- paste('Inial value' ,'".getRK_val("initmu") . "',sep=' = ')" ) ?>
-
-
-
+<? if (getRK_val ("result") == "1") { ?>
+# store results
+'<? getRK ("nom"); ?>' <- rk.temp.results
+<? } ?>
<?
}
function printout () {
// produce the output
?>
+rk.header ("Univariate statistics", parameters=list (
+"Remove Missing values", <? if (getRK_val ("narm")) echo ("TRUE"); else echo ("FALSE"); ?>
+<? if (getRK_val("trim")=="1") { ?>
+, "Trimmed value for trimmed mean", "<? getRK ("pourcent"); ?>"
+<? }
+ if (getRK_val("mad")=="1") { ?>
+, "Constant for the MAD estimation", "<? getRK ("constMad"); ?>"
+<? }
+ if (getRK_val("huber")=="1") { ?>
+, "Winsorized values for Huber estimator", "<? getRK ("winsor"); ?>"
+, "Tolerance in Huber estimator", "<? getRK ("tol"); ?>"
+<? if (getRK_val ("customMU")=="1") { ?>
+, "Mu for Huber estimator", "<? getRK ("mu"); ?>"
+<? }
+ if (getRK_val ("customS")=="1") { ?>
+, "S for Huber estimator", "<? getRK ("s"); ?>"
+<? } ?>
+, "Initial value", "<? getRK ("initmu"); ?>"
+<? } ?>
+))
-cat(paste("<h1>Univariate statistics of ","</h1>\n",sep=""))
-
-for (rk.temp.var in names(rk.temp.res )) {
- cat(paste("<h1>Univariate statistics of ",rk.temp.var,"</h1>\n",sep=""))
- cat ("<table border=\"1\">")
- for (i in names(rk.temp.res[[rk.temp.var]])) {
- if (i %in% c('Quartiles','Minimum values','Maximum values','Other','Huber M-Estimator'))
- {
- cat(paste("<tr><td>",i,"</td></tr>\n",sep=""))
- cat(paste("<tr><td>",rk.temp.res[[rk.temp.var]][[i]][[1]],"</td><td>",rk.temp.res[[rk.temp.var]][[i]][[2]],"</td></tr>\n",sep=""))
- }
- else
- cat(paste("<tr><td>",i ,"</td><td>",rk.temp.res[[rk.temp.var]][[i]],"</td></tr>\n",sep=""))
- }
- cat("</table>")
-}
-if ( ! is.na(rk.temp.option[[1]])) rk.print(rk.temp.option)
-
+rk.results (rk.temp.results)
<?
}
function cleanup () {
?>
-
-rm(rk.temp.res,rk.temp.option,rk.temp.var)
-
+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-01-07 17:42:53 UTC (rev 1081)
+++ trunk/rkward/rkward/plugins/uni1.2/description.xml 2007-01-07 18:50:15 UTC (rev 1082)
@@ -109,7 +109,7 @@
</column>
</tab>
<tab id="option" label="Options" >
- <checkbox value_unchecked="FALSE" checked="true" value="TRUE" id="NA" label="Omit missing values in calculs" />
+ <checkbox value_unchecked="0" checked="true" value="1" id="narm" label="Omit missing values" />
<checkbox checked="false" value="1" id="option" label="Print options in output" />
<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" />
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