# 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.

## Plugin mandatory TODO
#
# - testing!

## Plugin wishlist
#
# - use an <optionset> to provide an arbitrary number of filters by variable
# - allow removing of specified columns in addition to selection of specified columns
# - re-think quotation issues? Use a <matrix> for specifying %in% and !%in% values?
# - allow saving of resulting row-filter expression for later reuse
# - print status summary ("filtered a of b rows, x of y columns, saved as z")
# - split into two plugins (one for rows, one for columns)?

require(rkwarddev)

local({
# set the output directory to overwrite the actual plugin
output.dir <- tempdir()
overwrite <- TRUE
# if you set guess.getters to TRUE, the resulting code willdat need RKWard >= 0.6.0
guess.getter <- TRUE

about.info <- rk.XML.about(
	name="rk.subset",
	author=c(
		person(given="RKWard", family="Team",
			email="rkward-devel@lists.sf.net", role=c("cre")),
		person(given="Meik", family="Michalke",
			email="meik.michalke@hhu.de", role=c("aut")),
		person(given="Thomas", family="Friedrichsmeier",
			email="tfry@users.sf.net", role=c("aut"))),
	about=list(desc="RKWard GUI to define subsets of data objects",
		version="0.02-1", url="http://rkward.sf.net")
)

############
## re-usable objects
############

# for data
var.select <- rk.XML.varselector(label="Select data")
var.data <- rk.XML.varslot(label="Data (data.frame)", source=var.select, classes=c("data.frame"), 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 variable", source=var.select)
sset.filter.drop <- rk.XML.dropdown(label="Keep cases matching rule", options=list(
		"is one of (%in%)"=c(val="%in%"),
		"is not one of (!%in%)"=c(val="!%in%"),
		"is equal (==)"=c(val="==", chk=TRUE),
		"is not equal (!=)"=c(val="!="),
		"is in between"=c(val="range"),
		"is not between"=c(val="!range")
	), id.name="drp_fltr_all")
sset.filter.drop.factor <- rk.XML.dropdown(label="Keep cases matching rule", options=list(
		"is one of (%in%)"=c(val="%in%"),
		"is not one of (!%in%)"=c(val="!%in%"),
		"is equal (==)"=c(val="==", chk=TRUE,
		"is not equal (!=)"=c(val="!="))
	), id.name="drp_fltr_fct")
sset.filter.drop.logical <- rk.XML.dropdown(label="Keep cases matching rule", options=list(
		"is TRUE"=c(val="TRUE", chk=TRUE),
		"is FALSE"=c(val="FALSE")
	), id.name="drp_fltr_lgc")
sset.filter.drop.numeric <- rk.XML.dropdown(label="Keep cases matching rule", options=list(
		"is equal (==)"=c(val="==", chk=TRUE),
		"is not equal (!=)"=c(val="!="),
		"is in between"=c(val="range"),
		"is not between"=c(val="!range")
	), id.name="drp_fltr_num")
lgc.drop.switch <- rk.XML.switch ("case_filter_data_mode", list (
	case=list (standard="any", dynamic_value=id (sset.filter.drop, ".string", js=FALSE)),
	case=list (standard="char_factor", dynamic_value=id (sset.filter.drop.factor, ".string", js=FALSE)),
	case=list (standard="logical", dynamic_value=id (sset.filter.drop.logical, ".string", js=FALSE)),
	case=list (standard="numeric", dynamic_value=id (sset.filter.drop.numeric, ".string", js=FALSE))))
lgc.is.range <- rk.XML.switch (lgc.drop.switch, list (
	case=list (standard="!range", fixed_value="1"),
	case=list (standard="range", fixed_value="1"),
	default=list (fixed_value="0")))
sset.input.filter <- rk.XML.input(label="Value (pasted as-is, use proper quoting!)", required=TRUE)

sset.filter.min <- rk.XML.input(label="Minimum (or empty)")
sset.filter.min.inc <- rk.XML.checkbox (label="Included (>=)", id.name="mininc")
sset.filter.max <- rk.XML.input(label="Maximum (or empty)")
sset.filter.max.inc <- rk.XML.checkbox (label="Included (<=)", id.name="maxinc")	#NOTE: Auto-id bug!
sset.range.options <- rk.XML.row (
	rk.XML.col (sset.filter.min, sset.filter.min.inc),
	rk.XML.col (sset.filter.max, sset.filter.max.inc)
)

frame.filter.var <- rk.XML.frame(
	filter.var,
	sset.filter.drop,
	sset.filter.drop.factor,
	sset.filter.drop.logical,
	sset.filter.drop.numeric,
	sset.input.filter,
	sset.range.options,
	label="Filter rows by variable")

frame.filter.expression <- rk.XML.frame(
	sset.filter.expression <- rk.XML.input ("Expression (or empty)"),
	label="Filter rows by expression", id.name="frame_filter_exp")	# NOTE: Auto-assigned id is duplicate!

# for logic section
lgc.filter.script <- rk.comment(id("
	gui.addChangeCommand(\"", filter.var, ".available\", \"dataChanged()\");
	// this function is called whenever the data was changed
	dataChanged = function(){
			var enableVarInput = \"true\";
			var dataMode = \"any\";
			var thisObject = makeRObject(gui.getValue(\"", filter.var, ".available\"));
			 if(thisObject.classes()){
				if(thisObject.isDataFactor() || thisObject.isDataCharacter()){
					dataMode = \"char_factor\";
				} else if(thisObject.isDataLogical()){
					dataMode = \"logical\";
					// NOTE: not hiding VarInput to avoid nasty flicker
					enableVarInput = \"false\";
				} else if(thisObject.isDataNumeric()){
					dataMode=\"numeric\";
				}
			} else {}
			gui.setValue(\"", sset.filter.drop.factor, ".visible\", dataMode == 'char_factor' ? 'true' : 'false');
			gui.setValue(\"", sset.filter.drop.logical, ".visible\", dataMode == 'logical' ? 'true' : 'false');
			gui.setValue(\"", sset.filter.drop.numeric, ".visible\", dataMode == 'numeric' ? 'true' : 'false');
			gui.setValue(\"", sset.filter.drop, ".visible\", dataMode == 'any' ? 'true' : 'false');
			gui.setValue(\"", sset.input.filter, ".enabled\", enableVarInput);
			gui.setValue(\"case_filter_data_mode\", dataMode);
		}
		dataChanged (); // initialize", js=FALSE))

save.results.sset <- rk.XML.saveobj("Save results to workspace", initial="sset.result", chk=TRUE)

sset.dialog.contents <- rk.XML.row (
	var.select,
	rk.XML.col(
		var.data,
		rk.XML.tabbook (tabs = list (
			"Filter cases"=rk.XML.col(
				frame.filter.var,
				frame.filter.expression,
				rk.XML.stretch()
			), "Filter columns"=rk.XML.col(
				frame.selected.vars,
				rk.XML.stretch()
			))
		),
		save.results.sset
	)
)

sset.full.dialog <- rk.XML.dialog(
	sset.dialog.contents,
	label="Subset of data")

## logic section
lgc.sect.sset <- rk.XML.logic(
		lgc.filter.script,
		rk.XML.connect(governor="current_object", client=var.data, set="available"),
		rk.XML.connect(governor=var.data, client=var.select, get="available", set="root"),
		sset.gov.data <- rk.XML.convert(sources=list(available=var.data), mode=c(notequals="")),
		sset.have.filter.var <- rk.XML.convert(sources=list(available=filter.var), mode=c(notequals="")),
		rk.XML.connect(governor=sset.gov.data, client=frame.selected.vars, set="enabled"),
		rk.XML.connect(governor=sset.gov.data, client=frame.filter.var, set="enabled"),
		rk.XML.connect(governor=sset.gov.data, client=frame.filter.expression, set="enabled"),
		rk.XML.external(id="case_filter_data_mode", "any"),
		lgc.drop.switch,
		lgc.is.range,
		rk.XML.connect(governor=lgc.is.range, client=sset.range.options, set="visible"),
		rk.XML.connect(governor=sset.range.options, get="visible.not", client=sset.input.filter, set="visible"),
		rk.XML.connect(governor=sset.have.filter.var, client=sset.input.filter, set="required"),
		lgc.have.min <- rk.XML.convert(sources=list(text=sset.filter.min), mode=c(notequals="")),
		lgc.have.max <- rk.XML.convert(sources=list(text=sset.filter.max), mode=c(notequals="")),
		lgc.need.min <- rk.XML.convert(sources=list(not=lgc.have.max,lgc.is.range), mode=c(and="")),
		lgc.need.max <- rk.XML.convert(sources=list(not=lgc.have.min,lgc.is.range), mode=c(and="")),
		rk.XML.connect(governor=lgc.need.max, get="", client=sset.filter.max, set="required"),
		rk.XML.connect(governor=lgc.need.min, get="", client=sset.filter.min, set="required")
	)

## JavaScript
sset.js.calc <- id("
	var data = getString ('", var.data, "');
	var filter_var = getString ('", filter.var, ".shortname');
	var filter_expr = getString ('", sset.filter.expression, "');

	echo ('\\tsset.result <- subset(');
	if (data != '') {
		echo ('\\n\\t\\t' + data);

		// row filter
		var row_filter_exp = '';
		if (filter_var != '') {
			var filter_operand = getString ('", lgc.drop.switch, "');
			if (getBoolean ('", lgc.is.range, "')) {
				var range_limit = '';
				var max_range = '';
				var fmin = getString ('", sset.filter.min, "');
				var fmax = getString ('", sset.filter.max, "');
				var fmininc = getBoolean ('", sset.filter.min.inc, "');
				var fmaxinc = getBoolean ('", sset.filter.max.inc, "');
				if (fmin != '') range_limit = filter_var + ' >' + (fmininc ? '= ' : ' ') + fmin;
				if (fmax != '') max_range = filter_var + ' <' + (fmaxinc ? '= ' : ' ') + fmax;
				if (!(max_range == '' || range_limit == '')) range_limit = '(' + range_limit + ') & (' + max_range + ')';
				else range_limit += max_range;

				if (filter_operand == 'range') row_filter_exp += range_limit;
				else row_filter_exp += '!(' + range_limit + ')';
			} else if (getString ('case_filter_data_mode') == 'logical') {
				if (filter_operand == 'TRUE') row_filter_exp += filter_var;
				else row_filter_exp += '!' + filter_var;
			} else {
				var input_filter = getString ('", sset.input.filter, "');
				if (filter_operand == '!%in%') row_filter_exp += '!(' + filter_var + ' %in% ' + input_filter + ')';
				else row_filter_exp += filter_var + ' ' + filter_operand + ' ' + input_filter;
			}
		}
		if (filter_expr != '') {
			if (row_filter_exp != '') row_filter_exp = '(' + row_filter_exp + ') & (' + filter_expr + ')';
			else row_filter_exp = filter_expr;
		}
		if (row_filter_exp != '') echo (',\\n\\t\\t' + row_filter_exp);

		// column filter
		if (getBoolean ('", frame.selected.vars, ".checked')) {
			var selected_vars = getList ('", selected.vars, ".shortname').join (', ');
			if (selected_vars != '') echo (',\\n\\t\\tselect=c (' + selected_vars + ')');
		}
	}
	echo ('\\n\\t)\\n\\n');
", js=FALSE)

#############
## 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,
	guess.getter=guess.getter,
	xml=list(
 		dialog=sset.full.dialog,
  		logic=lgc.sect.sset
		),
	js=list(results.header=FALSE,
		calculate=sset.js.calc),
	rkh=list(
		summary = rk.rkh.summary ("Select a subset of rows and / or columns of a data.frame"),
		usage = rk.rkh.usage ("Select the data.frame to subset. Then specify rules to filter by rows / cases, and / or columns. A data.frame containing only the specified subset is saved to your workspace."),
		settings = rk.rkh.settings (list (
			rk.rkh.setting (var.data, "Select the data.frame to subset."),
			rk.rkh.caption (frame.filter.var),
			rk.rkh.setting (filter.var, "Select a column of the data.frame specifying the condition to filter cases on. Leave empty, if you do not want to filter on a column."),
			rk.rkh.setting (sset.filter.drop, "Select the type of condition. Note that depending on the type of the filter variable, different options are available"),
			rk.rkh.setting (sset.input.filter, "The value to compare against (for condition types equal / not equal, and one of / not one of). Note that this will be pasted as R code, verbatim. This means, you can specify any valid R expression, including the name of another column of the data.frame. However, if you want to compare to fixed strings, you will have to make sure to quote these. E.g. 'c (\"City A\", \"City B\")'."),
			rk.rkh.setting (sset.filter.min, "For comparing against ranges (condition types in between / not in between), minimum and / or maximum values can be specified. If either is omitted, only the other is checked (i.e. greater / smaller than). Note that this will be pasted as R code, verbatim. This means, you can specify any valid R expression, including the name of another column of the data.frame."),
			rk.rkh.setting (sset.filter.min.inc, "Whether the minimum value is contained in the range to check against (i.e. compare 'larger or equal (>=)')."),
			rk.rkh.setting (sset.filter.max, "See above. Maximum value."),
			rk.rkh.setting (sset.filter.max.inc, "Whether the maximum value is contained in the range to check against (i.e. compare 'smaller or equal (<=)')."),
			rk.rkh.caption (frame.filter.expression),
			rk.rkh.setting (sset.filter.expression, "You can also filter rows / cases by a custom R expression. If using this in combination with filtering by a column (see above), both conditions are combined by logical 'and' (&). Leave empty, if you do not want to filter on a custom expression."),
			rk.rkh.caption (frame.selected.vars),
			rk.rkh.setting (frame.selected.vars, "Check this, if you want to remove some columns from the resulting data.frame. Otherwise, all columns will be included."),
			rk.rkh.setting (selected.vars, "Variables to include in the resulting data.frame")
		)),
		related = rk.rkh.related (rk.rkh.link ("subset"))
	),
	pluginmap=list(name="subset_dataframe", hierarchy=list("data")),
	dependencies=rk.XML.dependencies (),
	create=c("pmap", "xml", "js", "rkh"),
	scan=c("saveobj", "settings"),
	overwrite=overwrite,
	tests=FALSE,
	edit=TRUE,
	load=TRUE,
#	show=TRUE,
	hints=FALSE)
})
