[rkward-cvs] SF.net SVN: rkward:[2404] trunk/rkward/rkward/plugins/plots

sjar at users.sourceforge.net sjar at users.sourceforge.net
Thu Feb 19 23:50:52 UTC 2009


Revision: 2404
          http://rkward.svn.sourceforge.net/rkward/?rev=2404&view=rev
Author:   sjar
Date:     2009-02-19 23:50:52 +0000 (Thu, 19 Feb 2009)

Log Message:
-----------
New Feature (status: basically working but needs refinements)
* added further plot options
AND
* added option to show mean and standard deviation (sd) in boxplot
* colour, symbols and symbol size can be defined by the user
	> symbols for sd can be chosen independently
	> if not changed by the user they should be easily recognizable

known issues:
* GUI needs clean-up/rearrangements
* php/R-code uses points() instead of arrows() because the visual impression of a boxplot may suffer otherwise
* works only with input from RKWards table GUI or with data.frames of same length
   won't work with data.frames of different length
	# currently investigated solution is the usage of the plyr package
	Example for the plyr packge with three different data.frames:
		require(plyr)
		List <- list(data.frame(2,1,3,2,4,5), data.frame(2,3,4), data.frame(1,2,4,3,2,4,5,4,2))
		data_of_List<-do.call(rbind.fill, List)
		data_of_List
	# BUT it's not really reasonable to make the plug-in dependent of yet another package, thus open for alternative solutions (maybe loops)

Modified Paths:
--------------
    trunk/rkward/rkward/plugins/plots/box_plot.php
    trunk/rkward/rkward/plugins/plots/box_plot.xml

Modified: trunk/rkward/rkward/plugins/plots/box_plot.php
===================================================================
--- trunk/rkward/rkward/plugins/plots/box_plot.php	2009-02-19 23:48:43 UTC (rev 2403)
+++ trunk/rkward/rkward/plugins/plots/box_plot.php	2009-02-19 23:50:52 UTC (rev 2404)
@@ -17,13 +17,54 @@
 
 function doPrintout ($final) {
 	$xvarsstring = join (", ", split ("\n", getRK_val ("x")));
+	$names_mode = getRK_val ("names_mode");
+	$mean = getRK_val ("mean");
+	$pch_mean = getRK_val ("pch_mean");
+	$sd = getRK_val ("sd");
+	$pch_sd_high = getRK_val ("pch_sd_high");
+	$pch_sd_low = getRK_val ("pch_sd_low");
+	$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=<? echo ($pch_mean); ?>, 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=<? echo ($pch_mean); ?>, 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=<? echo ($pch_sd_low); ?>, cex = <? getRK ("cex_sd_mean"); ?><? getRK ("sd_mean_color.code.printout"); ?>)
+	points(sd_high,pch=<? echo ($pch_sd_high); ?>, 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=<? echo ($pch_sd_low); ?>, cex = <? getRK ("cex_sd_mean"); ?><? getRK ("sd_mean_color.code.printout"); ?>)
+	points(1:length(data_list) ~ sd_high,pch=<? echo ($pch_sd_high); ?>, 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: trunk/rkward/rkward/plugins/plots/box_plot.xml
===================================================================
--- trunk/rkward/rkward/plugins/plots/box_plot.xml	2009-02-19 23:48:43 UTC (rev 2403)
+++ trunk/rkward/rkward/plugins/plots/box_plot.xml	2009-02-19 23:50:52 UTC (rev 2404)
@@ -1,35 +1,74 @@
 <!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>
+					<row>
+						<checkbox id="mean" checked="false" value="TRUE" label="show mean" />
+						<spinbox type="integer" id="pch_mean" label="mean symbol" initial="19"/>
+					</row>
+					<row>
+						<column>
+							<checkbox id="sd" checked="false" value="TRUE" label="show standard deviation" />
+						</column>
+						<column>
+							<spinbox type="integer" id="pch_sd_high" label="standard deviation symbol (upper)" initial="3"/>
+							<spinbox type="integer" id="pch_sd_low" label="standard deviation symbol (lower)" initial="3"/>
+						</column>
+					</row>
+					<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