[rkward-cvs] SF.net SVN: rkward:[4383] branches/external_plugins/rk.subset/inst
m-eik at users.sourceforge.net
m-eik at users.sourceforge.net
Fri Oct 19 16:19:37 UTC 2012
Revision: 4383
http://rkward.svn.sourceforge.net/rkward/?rev=4383&view=rev
Author: m-eik
Date: 2012-10-19 16:19:37 +0000 (Fri, 19 Oct 2012)
Log Message:
-----------
adding subset plugin (rkwarddev script, first draft)
Added Paths:
-----------
branches/external_plugins/rk.subset/inst/rkward/
branches/external_plugins/rk.subset/inst/rkward/rkwarddev_plugin_script.R
Added: branches/external_plugins/rk.subset/inst/rkward/rkwarddev_plugin_script.R
===================================================================
--- branches/external_plugins/rk.subset/inst/rkward/rkwarddev_plugin_script.R (rev 0)
+++ branches/external_plugins/rk.subset/inst/rkward/rkwarddev_plugin_script.R 2012-10-19 16:19:37 UTC (rev 4383)
@@ -0,0 +1,154 @@
+# the plugin code was generated by this script
+# you should not change the plugin code directly, but this script
+# note: this script only creates objects in your workspace,
+# *EXCEPT* for the last call, see below.
+
+require(rkwarddev)
+
+local({
+# set the output directory to overwrite the actual plugin
+output.dir <- tempdir()
+overwrite <- TRUE
+
+about.info <- rk.XML.about(
+ name="rk.subset",
+ author=c(
+ person(given="Meik", family="Michalke",
+ email="meik.michalke at hhu.de", role=c("aut","cre"))),
+ about=list(desc="RKWard GUI to define subsets of data objects",
+ version="0.01-1", url="http://rkward.sf.net"),
+ dependencies=list(rkward.min="0.5.6")
+ )
+
+############
+## re-usable objects
+############
+
+# for data
+var.select <- rk.XML.varselector(label="Select data")
+var.data <- rk.XML.varslot(label="Data (data.frame, matrix or vector)", source=var.select, classes=c("data.frame", "matrix", "vector"), required=TRUE, id.name="var_data")
+
+selected.vars <- rk.XML.varslot(label="Selected variables", source=var.select, multi=TRUE)
+frame.selected.vars <- rk.XML.frame(selected.vars, label="Only use a subset of variables", checkable=TRUE, chk=FALSE)
+
+filter.var <- rk.XML.varslot(label="Filter by", source=var.select)
+sset.filter.drop <- rk.XML.dropdown(label="Filter rule", options=list(
+ "includes (%in%)"=c(val="%in%", chk=TRUE),
+ "does not include (!%in%)"=c(val="!%in%", chk=TRUE),
+ "is not equal (!=)"=c(val="!="),
+ "is less (<)"=c(val="<"),
+ "is less or equal(<=)"=c(val="<="),
+ "is equal (==)"=c(val="==", chk=TRUE),
+ "is greater or equal (>=)"=c(val=">="),
+ "is greater (>)"=c(val=">")
+ ))
+# sset.spin.filter <- rk.XML.spinbox(label="Value", initial=0, real=TRUE)
+sset.input.filter <- rk.XML.input(label="Value (pasted as-is, use proper quoting!)")
+
+frame.filter.var <- rk.XML.frame(
+ filter.var,
+ sset.filter.drop,
+# sset.spin.filter,
+ sset.input.filter,
+ label="Filter rows by variable", checkable=TRUE, chk=FALSE)
+
+# # for logic sections
+# lgc.df.script <- rk.comment(id("
+# gui.addChangeCommand(\"", var.data, ".available\", \"dataChanged()\");
+# // this function is called whenever the data was changed
+# dataChanged = function(){
+# var prepareFrame = \"true\";
+# var selectFrame = \"true\";
+# var thisObject = makeRObject(gui.getValue(\"", var.data, ".available\"));
+# if(thisObject.classes()){
+# if(!thisObject.isDataFrame()){
+# selectFrame = \"false\";
+# if(thisObject.classes().indexOf(\"dist\") != -1){
+# prepareFrame = \"false\";
+# } else {}
+# } else {}
+# } else {}
+# gui.setValue(\"", frame.selected.vars, ".enabled\", selectFrame);
+# gui.setValue(\"", clust.pre.frame, ".enabled\", prepareFrame);
+# }", js=FALSE))
+
+js.frm.subset <- rk.JS.vars(frame.selected.vars, modifiers="checked") # see if the frame is checked
+js.selected.vars <- rk.JS.vars(selected.vars, modifiers="shortname", join="\\\", \\\"") # get selected vars
+js.frm.filter <- rk.JS.vars(frame.filter.var, modifiers="checked") # see if the frame is checked
+
+save.results.sset <- rk.XML.saveobj("Save results to workspace", initial="sset.result")
+
+tab.sset.data <- rk.XML.row(
+ var.select,
+ rk.XML.col(
+ var.data,
+ frame.selected.vars,
+ frame.filter.var,
+ rk.XML.stretch(),
+ save.results.sset
+ )
+ )
+
+sset.full.dialog <- rk.XML.dialog(
+ tab.sset.data,
+ label="Subset of data")
+
+## logic section
+# lgc.sect.sset <- rk.XML.logic(
+# gov.filter.lt <- rk.XML.convert(sources=list(string=sset.filter.drop), mode=c(equals="<"), id.name="lgc_flt_lt"),
+# gov.filter.le <- rk.XML.convert(sources=list(string=sset.filter.drop), mode=c(equals="<="), id.name="lgc_flt_le"),
+# gov.filter.gt <- rk.XML.convert(sources=list(string=sset.filter.drop), mode=c(equals=">"), id.name="lgc_flt_gt"),
+# gov.filter.ge <- rk.XML.convert(sources=list(string=sset.filter.drop), mode=c(equals=">="), id.name="lgc_flt_ge"),
+# gov.filter.numeric <- rk.XML.convert(sources=list(gov.filter.lt, gov.filter.le, gov.filter.gt, gov.filter.ge), mode=c(or="")),
+# lgc.enable.filter.spin <- rk.XML.connect(governor=gov.filter.numeric, client=sset.spin.filter, set="visible"),
+# lgc.enable.filter.spin <- rk.XML.connect(governor=gov.filter.numeric, client=sset.input.filter, set="visible", not=TRUE)
+# )
+
+## JavaScript
+
+sset.js.calc <- rk.paste.JS(
+ js.frm.subset,
+ js.selected.vars,
+ js.frm.filter,
+# js.data.preparation,
+ echo("\tsset.result <- subset("),
+ ite(var.data, echo("\n\t\t", var.data)),
+ ite(id(js.frm.filter, " && ", sset.filter.drop, " != \"!%in%\""),
+ echo(",\n\t\t", filter.var, " ", sset.filter.drop, " ", sset.input.filter),
+ echo(",\n\t\t!", filter.var, " %in% ", sset.input.filter)
+ ),
+ ite(id(js.frm.subset, " && ", js.selected.vars, " != \"\""), echo(",\n\t\tselect=c(\"", js.selected.vars, "\")")),
+# echo(",\n\t\tcenters=", clust.k.spin.numcl),
+# ite(id(clust.k.drop.meth, " != \"Hartigan-Wong\""), echo(",\n\t\talgorithm=\"", clust.k.drop.meth,"\"")),
+# ite(id(clust.k.spin.maxiter, " != 10"), echo(",\n\t\titer.max=", clust.k.spin.maxiter)),
+# ite(id(clust.k.spin.nstart, " != 1"), echo(",\n\t\tnstart=", clust.k.spin.nstart)),
+ echo("\n\t)\n\n")
+)
+
+
+# # print selected subsets, if needed
+# js.prt.subset <- ite(id(js.frm.subset, " & ", js.selected.vars, " != \"\""),
+# echo("\nrk.header(\"Subset of variables included the analysis\", level=3)\nrk.print(list(\"", js.selected.vars, "\"))\n\n"))
+
+#############
+## if you run the following function call, files will be written to tempdir!
+#############
+# this is where it get's serious, that is, here all of the above is put together into one plugin
+
+sset.plugin.dir <<- rk.plugin.skeleton(
+ about.info,
+ path=output.dir,
+ xml=list(
+ dialog=sset.full.dialog#,
+# logic=lgc.sect.sset
+ ),
+ js=list(results.header="\"Data subset\"",
+ calculate=sset.js.calc),
+ pluginmap=list(name="Subset of data objects", hierarchy=list("data")),
+ create=c("pmap", "xml", "js", "desc"),
+ overwrite=overwrite,
+ tests=FALSE,
+# edit=TRUE,
+ load=TRUE)#,
+# show=TRUE)
+})
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