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

tfry at users.sourceforge.net tfry at users.sourceforge.net
Sun Dec 11 09:12:17 UTC 2011


Revision: 4095
          http://rkward.svn.sourceforge.net/rkward/?rev=4095&view=rev
Author:   tfry
Date:     2011-12-11 09:12:17 +0000 (Sun, 11 Dec 2011)
Log Message:
-----------
Clean up the code for the new mean options a bit

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

Modified: trunk/rkward/rkward/plugins/plots/box_plot.js
===================================================================
--- trunk/rkward/rkward/plugins/plots/box_plot.js	2011-12-11 00:18:10 UTC (rev 4094)
+++ trunk/rkward/rkward/plugins/plots/box_plot.js	2011-12-11 09:12:17 UTC (rev 4095)
@@ -55,37 +55,25 @@
 		echo ('rk.graph.on()\n');
 	}
 	echo ('try (boxplot (data_list' + boxwex + positions + ', notch = ' + getValue ("notch") + ', outline = ' + getValue("outline") + ', horizontal = ' + getValue("orientation") + getValue ("plotoptions.code.printout") + ')) #actual boxplot function\n');
-	if (mean == "TRUE" & (getValue ("type_of_mean") =="arithmetic_mean")) {
+	if (mean == "TRUE") {
+		var mean_fun = "mean";	// arithmetic mean
+		if (getValue ("type_of_mean") =="geometric_mean") {
+			echo('	geo_mean <- function (x) {prod(na.omit(x))^1/length(na.omit(x))}	#Calculate geometric mean\n');
+			mean_fun = "geo_mean";
+		} else if (getValue ("type_of_mean") =="harmonic_mean") {
+			echo('	har_mean <- function (x) {(1 / mean(1 / na.omit(x)))}	#Calculate harmonic mean\n');
+			mean_fun = "har_mean";
+		} else if (getValue ("type_of_mean") =="interquantile_mean") {
+			echo('	interq_mean <- function (x) {sum(quantile(x, probs=c(0.25), na.rm=TRUE), quantile(x, probs=c(0.75), na.rm=TRUE)) / 2}	#Calculate interquantile mean\n');
+			mean_fun = "interq_mean";
+		}
+
 		if (horizontal) {
-			echo ('	try (points(1:length(data_list) ~ sapply(data_list,mean,na.rm = TRUE), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
+		  echo ('	try (points(1:length(data_list) ~ sapply(data_list,interq_mean), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
 		} else {
-			echo ('	try (points(sapply(data_list,mean,na.rm = TRUE), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
+		  echo ('	try (points(sapply(data_list,' + mean_fun + '), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
 		}
 	}
-	if (mean == "TRUE" & (getValue ("type_of_mean") =="geometric_mean")) {
-	  echo('	geo_mean <- function (x) {prod(na.omit(x))^1/length(na.omit(x))}	#Calculate geometric mean\n');
-	  if (horizontal) {
-	    echo ('	try (points(1:length(data_list) ~ sapply(data_list,geo_mean), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
-	  } else {
-	    echo ('	try (points(sapply(data_list,geo_mean), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
-	  }
-	}
-	if (mean == "TRUE" & (getValue ("type_of_mean") =="harmonic_mean")) {
-	  echo('	har_mean <- function (x) {(1 / mean(1 / na.omit(x)))}	#Calculate harmonic mean\n');
-	  if (horizontal) {
-	    echo ('	try (points(1:length(data_list) ~ sapply(data_list,har_mean), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
-	  } else {
-	    echo ('	try (points(sapply(data_list,har_mean), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
-	  }
-	}
-	if (mean == "TRUE" & (getValue ("type_of_mean") =="interquantile_mean")) {
-	  echo('	interq_mean <- function (x) {sum(quantile(x, probs=c(0.25), na.rm=T), quantile(x, probs=c(0.75), na.rm=TRUE)) / 2}	#Calculate interquantile mean\n');
-	  if (horizontal) {
-	    echo ('	try (points(1:length(data_list) ~ sapply(data_list,interq_mean), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
-	  } else {
-	    echo ('	try (points(sapply(data_list,interq_mean), pch=' + pch_mean + ', cex = ' + getValue ("cex_sd_mean") + getValue ("sd_mean_color.code.printout") + ')) #calculates the mean for all data and adds a point at the corresponding position\n');
-	  }
-	}
 
 	if (sd == "TRUE") {
 		echo ('	sd_low <- (sapply(data_list,mean,na.rm = TRUE)) - (sapply(data_list,sd,na.rm = TRUE))\n');

Modified: trunk/rkward/rkward/plugins/plots/box_plot.xml
===================================================================
--- trunk/rkward/rkward/plugins/plots/box_plot.xml	2011-12-11 00:18:10 UTC (rev 4094)
+++ trunk/rkward/rkward/plugins/plots/box_plot.xml	2011-12-11 09:12:17 UTC (rev 4095)
@@ -22,6 +22,7 @@
 		<connect client="names_custom.enabled" governor="custom_names"/>
 		<connect client="names_exp.visible" governor="rexp_names"/>
 
+		<connect client="type_of_mean.enabled" governor="mean.state"/>
 		<connect client="pch_mean.enabled" governor="mean.state"/>
 		<connect client="pch_sd_high.enabled" governor="sd.state"/>
 		<connect client="pch_sd_low.enabled" governor="sd.state"/>

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