[rkward-cvs] SF.net SVN: rkward:[2376] branches/release_branch_0.4.9/rkward/plugins/ plots
sjar at users.sourceforge.net
sjar at users.sourceforge.net
Sun Nov 9 18:32:54 UTC 2008
Revision: 2376
http://rkward.svn.sourceforge.net/rkward/?rev=2376&view=rev
Author: sjar
Date: 2008-11-09 18:32:54 +0000 (Sun, 09 Nov 2008)
Log Message:
-----------
This is an extended version of the Box plot.
* From now on it's possible to show the mean (arithmetic mean only) and the standard deviation (both sites equal only) in a box plot.
Known issues:
* The code works with data from RKWard internal data sheets or data sets of equal length. For user data with unequal length this plot option will fail.
* Moreover some aspects of the "plot options" need to be enabled or disabled.
Modified Paths:
--------------
branches/release_branch_0.4.9/rkward/plugins/plots/box_plot.php
branches/release_branch_0.4.9/rkward/plugins/plots/box_plot.xml
Modified: branches/release_branch_0.4.9/rkward/plugins/plots/box_plot.php
===================================================================
--- branches/release_branch_0.4.9/rkward/plugins/plots/box_plot.php 2008-11-09 18:19:03 UTC (rev 2375)
+++ branches/release_branch_0.4.9/rkward/plugins/plots/box_plot.php 2008-11-09 18:32:54 UTC (rev 2376)
@@ -17,13 +17,51 @@
function doPrintout ($final) {
$xvarsstring = join (", ", split ("\n", getRK_val ("x")));
+ $names_mode = getRK_val ("names_mode");
+ $mean = getRK_val ("mean");
+ $sd = getRK_val ("sd");
+ $horizontal = getRK_val ("orientation");
+ $plot_adds = getRK_val ("plotoptions.code.calculate"); //add grid and alike
+?>
+ data_list <- list (<?echo ($xvarsstring); ?>) #convert single sample variables to list
+<?
+ if ($names_mode == "rexp") {
+ echo ("names(data_list) <- " . getRK_val ("names_exp") . "\n");
+ } else if ($names_mode == "custom") {
+ echo ("names(data_list) <- c (\"" . str_replace (";", "\", \"", trim (getRK_val ("names_custom"))) . "\")\n");
+ }
+
if ($final) {
?>
rk.header ("Boxplot", list ("Variable(s)", rk.get.description (<? echo ($xvarsstring); ?>, paste.sep=", ")))
rk.graph.on()
<? } ?>
-try (boxplot (list (<? echo ($xvarsstring); ?>), notch = <? getRK ("notch") ?>, outline = <? getRK("outline")?>, horizontal = <? getRK("orientation") ?><? getRK ("plotoptions.code.printout"); ?>))
+try (boxplot (data_list, notch = <? getRK ("notch") ?>, outline = <? getRK("outline")?>, horizontal = <? getRK("orientation"); ?><? getRK ("plotoptions.code.printout"); ?>)) #actuall boxplot function
+<? if (($mean == "TRUE") && ($horizontal == "TRUE")) {?>
+ try (points(1:length(data_list) ~ apply(data.frame(<? echo ($xvarsstring); ?>),2,mean,na.rm = TRUE),pch=19, cex = <? getRK ("cex_sd_mean"); ?><? getRK ("sd_mean_color.code.printout"); ?>)) #calculates the mean for all data and adds a point at the corresponding position
+<? } if (($mean == "TRUE") && ($horizontal == "FALSE")) {?>
+ try (points(apply(data.frame(<? echo ($xvarsstring); ?>),2,mean,na.rm = TRUE),pch=19, cex = <? getRK ("cex_sd_mean"); ?><? getRK ("sd_mean_color.code.printout"); ?>)) #calculates the mean for all data and adds a point at the corresponding position
+<? }
+?>
+<? if (($sd == "TRUE") && ($horizontal == "FALSE")) {?>
+ sd_low <- (apply(data.frame(<? echo ($xvarsstring); ?>),2,mean,na.rm = TRUE)) - (apply(data.frame(<? echo ($xvarsstring); ?>),2,sd,na.rm = TRUE))
+ sd_high <- (apply(data.frame(<? echo ($xvarsstring); ?>),2,mean,na.rm = TRUE)) + (apply(data.frame(<? echo ($xvarsstring); ?>),2,sd,na.rm = TRUE))
+ points(sd_low,pch=3, cex = <? getRK ("cex_sd_mean"); ?><? getRK ("sd_mean_color.code.printout"); ?>)
+ points(sd_high,pch=3, cex = <? getRK ("cex_sd_mean"); ?><? getRK ("sd_mean_color.code.printout"); ?>)
+<? } if (($sd == "TRUE") && ($horizontal == "TRUE")) {?>
+ sd_low <- (apply(data.frame(<? echo ($xvarsstring); ?>),2,mean,na.rm = TRUE)) - (apply(data.frame(<? echo ($xvarsstring); ?>),2,sd,na.rm = TRUE))
+ sd_high <- (apply(data.frame(<? echo ($xvarsstring); ?>),2,mean,na.rm = TRUE)) + (apply(data.frame(<? echo ($xvarsstring); ?>),2,sd,na.rm = TRUE))
+ points(1:length(data_list) ~ sd_low,pch=3, cex = <? getRK ("cex_sd_mean"); ?><? getRK ("sd_mean_color.code.printout"); ?>)
+ points(1:length(data_list) ~ sd_high,pch=3, cex = <? getRK ("cex_sd_mean"); ?><? getRK ("sd_mean_color.code.printout"); ?>)
+<? }
+?>
+<? if (!empty ($plot_adds)) { ?>
+
+<? // print the grid() related code
+ printIndented ("\t", $plot_adds);
+ }
+?>
<? if ($final) { ?>
rk.graph.off ()
<? }
Modified: branches/release_branch_0.4.9/rkward/plugins/plots/box_plot.xml
===================================================================
--- branches/release_branch_0.4.9/rkward/plugins/plots/box_plot.xml 2008-11-09 18:19:03 UTC (rev 2375)
+++ branches/release_branch_0.4.9/rkward/plugins/plots/box_plot.xml 2008-11-09 18:32:54 UTC (rev 2376)
@@ -1,35 +1,63 @@
<!DOCTYPE rkplugin>
-<document>
-<code file="box_plot.php" />
-<logic>
- <connect client="plotoptions.xvar" governor="x.available"/>
- <set id="plotoptions.allow_type" to="false"/>
-</logic>
-<dialog label="Boxplot" >
+ <document>
+ <code file="box_plot.php" />
+ <logic>
+ <connect client="plotoptions.xvar" governor="x.available"/>
+ <set id="plotoptions.allow_type" to="true"/>
+ <set id="plotoptions.allow_ylim" to="true"/>
+ <set id="plotoptions.allow_xlim" to="false"/>
+ <set id="plotoptions.allow_log" to="false"/>
+
+ <convert id="custom_names" mode="equals" sources="names_mode.string" standard="custom"/>
+ <convert id="rexp_names" mode="equals" sources="names_mode.string" standard="rexp"/>
+ <connect client="names_custom.visible" governor="rexp_names.not"/>
+ <connect client="names_custom.enabled" governor="custom_names"/>
+ <connect client="names_exp.visible" governor="rexp_names"/>
+ <connect client="names_exp.required" governor="rexp_names"/>
+
+ <set id="plotoptions.allow_grid" to="true"/>
+
+ </logic>
+ <dialog label="Boxplot" >
<tabbook>
- <tab label="Variable(s)" >
- <row>
- <varselector id="vars" />
- <varslot multi="true" type="numeric" source="vars" id="x" label="variable(s):" required="true" />
- </row>
- <preview id="preview"/>
- </tab>
- <tab label="Options" >
- <row>
- <column>
- <radio id="orientation" label="orientation" >
- <option value="TRUE" label="horizontal" />
- <option checked="true" value="FALSE" label="vertical" />
- </radio>
- <checkbox id="notch" label="Draw Notches" checked="false" value="TRUE" value_unchecked="FALSE" />
- <checkbox id="outline" label="Outline" checked="true" value="TRUE" value_unchecked="FALSE" />
-
+ <tab label="Variable(s)" >
+ <row>
+ <varselector id="vars" />
+ <varslot multi="true" type="numeric" source="vars" id="x" label="variable(s):" required="true" />
<stretch/>
- <embed id="plotoptions" component="rkward::plot_options" as_button="true" label="Plot Options" />
- <stretch/>
- </column>
- </row>
- </tab>
+ <frame label="Labels">
+ <radio id="names_mode" label="Labeling" >
+ <option value="default" label="Default labels" checked="true"/>
+ <option value="custom" label="Custom labels"/>
+ <option value="rexp" label="From R expression"/>
+ </radio>
+ <input id="names_exp" label="Expression to use for labels" initial="names (x)"/>
+ <input id="names_custom" label="Labels (separated by ';')" initial="First label;Second label"/>
+ </frame>
+ </row>
+ <preview id="preview"/>
+ </tab>
+ <tab label="Options" >
+ <row>
+ <column>
+ <radio id="orientation" label="orientation" >
+ <option value="TRUE" label="horizontal" />
+ <option checked="true" value="FALSE" label="vertical" />
+ </radio>
+ <checkbox id="notch" label="Draw Notches" checked="false" value="TRUE" value_unchecked="FALSE" />
+ <checkbox id="outline" label="Outline" checked="true" value="TRUE" value_unchecked="FALSE" />
+ <stretch/>
+ </column>
+ <column>
+ <checkbox id="mean" checked="false" value="TRUE" label="show mean" />
+ <checkbox id="sd" checked="false" value="TRUE" label="show standard deviation" />
+ <spinbox type="real" id="cex_sd_mean" label="size" initial="1"/>
+ <embed id="sd_mean_color" component="rkward::color_chooser" label="Color"/>
+ <embed id="plotoptions" component="rkward::plot_options" as_button="true" label="Plot Options" />
+ <stretch/>
+ </column>
+ </row>
+ </tab>
</tabbook>
</dialog>
-</document>
+</document>
\ No newline at end of file
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