[rkward-cvs] rkward/rkward/plugins/uni1.2 code.php,NONE,1.1 description.xml,NONE,1.1
Pierre
ecoch at users.sourceforge.net
Sat Mar 26 11:33:38 UTC 2005
Update of /cvsroot/rkward/rkward/rkward/plugins/uni1.2
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1098/rkward/plugins/uni1.2
Added Files:
code.php description.xml
Log Message:
Adding a new plugin showing the new feature of the plugin system. (Adrien)
--- NEW FILE: description.xml ---
<!DOCTYPE rkplugin>
<!-- This is a simple example, of how a "plugin" might be configured. --><document>
<entry type="entry" id="bs" label="Basic statistics" />
<!-- The layout-section takes care of the layout of the GUI for this plugin. --> <dialog>
<tabbook>
<tab label="Select variables" >
<column>
<row>
<varselector id="vars" />
<varslot multi="true" type="numeric" source="vars" id="z" label="Variable" required="true" />
</row>
</column>
</tab>
<tab label="Statistics" >
<frame label="General" >
<row>
<checkbox value_unchecked="0" checked="false" value="1" id="nombre" label="Number of observations" />
<checkbox value_unchecked="0" checked="false" value="1" id="nbna" label="Number of missing values" />
</row>
</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="vari" label="Variance" />
<checkbox value_unchecked="0" checked="false" value="1" id="ecartt" label="Sd" />
</row>
</frame>
<frame label="extrema" >
<row>
<column>
<checkbox value_unchecked="0" checked="false" value="1" id="minimum" label="Minimum" />
<checkbox value_unchecked="0" checked="false" value="1" id="maximum" label="Maximum" />
</column>
<column>
<spinbox type="integer" initial="0" min="0" id="nbminimum" max="100" label="Number of minimum values displayed" />
<spinbox type="integer" initial="0" min="0" id="nbmaximum" max="100" label="Number of maximum values displayed" />
</column>
</row>
</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="irq" label="Interquartile Range" />
<checkbox value_unchecked="0" checked="false" value="1" id="quartile" label="Quartile" />
</row>
<row>
<spinbox type="integer" initial="0" min="0" id="autre" max="100" label="Other (eg : for deciles, enter 10)" />
</row>
</frame>
</tab>
<tab label="Robust statistics" >
<column>
<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" depend="mad" />
</row>
</frame>
<frame label="Robust mean" >
<row>
<checkbox checked="false" value="1" id="trim" label="Trimmed Mean" />
<spinbox initial="0.05" id="pourcent" min="0" max="0.5" label="Percentage of trimmed values" depend="trim" />
</row>
</frame>
<frame label="M-Estimator" >
<row>
<checkbox checked="false" value="1" id="huber" label="Huber -M estimator (Require MASS Library)" />
<spinbox initial="1.5" id="winsor" min="0" max="10" label="Winsorize at 'k' sd" depend="huber" />
</row>
<row>
<column>
<checkbox checked="false" value="1" id="customMu" label="Custom Mu value" depend="huber" />
<input size="small" id="mu" label="Enter your value" depend="customMu" />
</column>
<column>
<checkbox checked="false" value="1" id="customS" label="Custom s value" depend="huber" />
<input size="small" id="s" label="S value" depend="customS" />
</column>
</row>
<row>
<column>
<input size="small" intial="1e-6" id="tol" label="Tolerance" depend="huber" />
</column>
<column>
<radio id="initmu" label="Initial value" depend="huber" >
<option value="median" label="Median" />
<option value="mean" label="Mean" />
</radio>
</column>
</row>
</frame>
</column>
</tab>
<tab id="option" label="Options" >
<checkbox value_unchecked="FALSE" checked="true" value="TRUE" id="NA" label="Omit missing values in calculs" />
<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" depend="result" label="Name of the result" />
</tab>
</tabbook>
</dialog>
</document>
--- NEW FILE: code.php ---
<?
function preprocess () {
}
function calculate () {
$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("z"))) . ")";
?>
# we make the calculation
rk.temp.res <- list()
rk.temp.option <- NA
for (rk.temp.var in list (<? echo ($vars); ?>)) {
k <- rk.get.description(rk.temp.var)
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)" ; ?>
<? if (getRK_val ("nbna")) echo "rk.temp.res [[ k ]][['Number of missing values']] <- length(which(is.na(rk.temp.var)))" ; ?>
<? if (getRK_val ("moyenne")) echo "rk.temp.res [[ k ]][['Mean']] <- mean(rk.temp.var,na.rm=".getRK_val("NA").")" ; ?>
<? if (getRK_val ("vari")) echo "rk.temp.res [[ k ]][['Variance']] <- var(rk.temp.var,na.rm=".getRK_val("NA").")" ; ?>
<? if (getRK_val ("ecartt")) echo "rk.temp.res [[ k ]][['Sd']] <- sd(rk.temp.var,na.rm=".getRK_val("NA").")" ; ?>
<? if (getRK_val ("minimum")) echo "rk.temp.res [[ k ]][['Minimum']] <- min(rk.temp.var,na.rm=".getRK_val("NA").")" ; ?>
<? if (getRK_val ("maximum")) echo "rk.temp.res [[ k ]][['Maximum']] <- max(rk.temp.var,na.rm=".getRK_val("NA").")" ; ?>
<? 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 . "]
}" ) ; ?>
<? 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 . "]" ) ; ?>
<? if (getRK_val ("mediane")) echo "rk.temp.res [[ k ]][['Median']] <- median(rk.temp.var,na.rm=".getRK_val("NA").")" ; ?>
<? if (getRK_val ("irq")) echo "rk.temp.res [[ k ]][['Inter Quartile Range']] <- IQR(rk.temp.var,na.rm=".getRK_val("NA").")"; ?>
<? 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")."))" ; ?>
<? 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").")
}" ) ; ?>
#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").")" ) ;?>
<? 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").")" ) ;?>
<? if (getRK_val ("huber") == "1")
echo ("
library(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") );
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 ("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=' = ')" ) ?>
<?
}
function printout () {
// produce the output
?>
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]])) HTML(rk.temp.option)
<?
}
function cleanup () {
?>
rm(rk.temp.res,rk.temp.option,rk.temp.var)
<?
}
?>
More information about the rkward-tracker
mailing list