[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