[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