QScript R Output Functions
This page contains functions for use in QScript which interact with R Outputs in the Report.
To make these functions available when writing a QScript or Rule see JavaScript Reference.
checkSelectedItemClassCustomMessage(required_class, bad_selection_message)
Same as checkSelectedItemClass except that the bad selection message can be specified.
checkSelectedItemClass(required_class)
This function checks the selected R Output to make sure that it is of a specific class or classes. If so, it is returned. If not or multiple items are selected or a single item that is not of required_class then null is returned. required_class may be a string or array of strings.
checkROutputIsValid(selected_item)
This function checks an R Output to make sure that it is ready for use, for example by R Variables. If the input selected_item has an error, has not been calculated yet, or is not an R Output then this function provides a message and returns false. Otherwise it returns true.
createROutput(item, expression, output_name_suffix)
Create an new R output from R code expression. The new output is given the name of item with a suffix of .output_name_suffix and potentially an integer to guarantee uniqueness.
generateDisambiguatedVariableName(variable)
Generates a string that allows the R code to tell two variables apart when they have identical variable names but live in different data files.
generateUniqueRObjectName(name)
Generates a unique name by adding an integer suffix to the supplied argument (if necessary).
generateUniqueRObjectReferenceName(name)
Generates a unique reference name by adding an integer suffix to the supplied argument (if necessary). Assumes input name is already a valid reference name.
isKeywordWithDots(text)
This function returns true if text is an R keyword, followed by zero or more dots. Otherwise returns false. Used by stringToRName.
isRName(text)
This function returns true if text is a valid R name, otherwise returns false.
recursiveGetAllRObjectNamesInGroup(group_item, object_array)
This function adds all of the names of R objects in group_item to the array object_array. The function is called recursive because it obtains objects from the subgroups of the specified group by applying itself to each subgroup.
You should always supply an existing array variable:
var group_1_objects = []; recursiveGetAllRObjectNamesInGroup(group_1, group_1_objects);
recursiveGetAllRObjectReferenceNamesInGroup(group_item, object_array)
This function adds all of the reference names of R objects in group_item to the array object_array. The function is called recursive because it obtains objects from the subgroups of the specified group by applying itself to each subgroup.
You should always supply an existing array variable:
var group_1_objects = []; recursiveGetAllRObjectReferenceNamesInGroup(group_1, group_1_objects);
stringToRName(text)
This functions returns the R name of an R output given it's reference name. This R name can be used to refer to the R output in R code.
choiceModelDataFile(selected_choice_model)
Attempts to extract the DataFile object associated with inputs to selected_choice_model. Returns null if unsuccessful.
nameSequentialVariables(variables, base_name)
Names variables using the base_name and the suffix "_1", "_2", etc, if there is more than one variable. If there is conflict with existing variable names, add another suffix with a number that avoids conflict before the variable index suffix, e.g., "_1_1", "_1_2", etc. If there is only one variable, no suffix is added to base_name unless there is conflict with existing variable names.
saveVariables(analysisName, inputType, expressionPrefix, expressionSuffix, questionType, makeWeight, variablePrefix, allowedRClasses)
Saves variables to data file based on the user's selection of an R output.
analysisName Name of analysis performed. This is used for the Question name.
inputType Name of the type of input expected. This is used in the error message if the user selects an inappropriate object.
expressionPrefix The part of the R code used to create the object which comes before the selected item.
expressionSuffix The part of the R code used to create the object which comes after the selected item.
questionType The question type of the variables to be saved. If not supplied (null) it will be Numeric.
makeWeight Should the created question be tagged to be a weight?
variablePrefix Prefix used to generate variable name. Indices are added after this prefix when there are multiple variables or name conflicts with existing variables.
allowedRClasses A string or array of strings that specify which classes are permitted for the selected R output before the R code to save the variables is executed.
Example:
saveVariables("Predicted values", "Regression", "predict(", ")", null);
saveVariables("Segment membership", "K-means Cluster Analysis", "predict(", ")", "Pick One");
saveVariables("Utilities (mean zero)", "Latent Class Analysis, Hierarchical Bayes or Ensemble Choice Model", "input.choicemodel = ", "\n" + "if (!is.null(input.choicemodel$simulated.respondent.parameters)) stop()\n" + "flipChoice::Utilities(input.choicemodel, scaling = 'Mean = 0', attr.order = 'As is', output = 'Data')", null);
saveVariables("Fitted values", "Regression", "predict(", ")", null, null, "fitted_vals", "Regression")
Source Code
includeWeb("QScript Selection Functions");
includeWeb("QScript Utility Functions");
function checkSelectedItemClassCustomMessage(required_class, bad_selection_message) {
if (required_class.constructor !== Array)
required_class = [required_class];
var n = required_class.length;
if (n > 1) {
var class_string = required_class.slice(0, n - 1).join(", ") + " or " + required_class[n - 1];
} else
var class_string = required_class[0];
if (bad_selection_message == null)
bad_selection_message = "Select a " + class_string + " output and then choose this option again.";
var item = getSelectedROutputFromPage(required_class);
if (item == null)
log(bad_selection_message);
return item;
}
function checkSelectedItemClass(required_class) {
return checkSelectedItemClassCustomMessage(required_class, null);
}
function checkROutputIsValid(selected_item) {
if (Q.fileFormatVersion() <= 9.23)
return true; //We cannot perform this check in Q5.0.3 and earlier
var web_mode = (!!Q.isOnTheWeb && Q.isOnTheWeb());
if (selected_item.type === "R Output") {
if (selected_item.error === null && selected_item.outputClasses === null) {
// Get user input
if (!web_mode) {
var recalculate = confirm("The selected R Output must be calculated before continuing.\nWould you like to do so now?");
if (recalculate == true) {
selected_item.update();
} else {
log("The selected R Output has not been calculated.");
return false;
}
} else {
log("The selected R Output has not been calculated. It must be calculated before continuing.");
return false;
}
}
if (selected_item.error !== null) {
log("There is an error with your R Output that must be fixed first: " + selected_item.error);
return false;
}
} else {
log("The selected item is not an R Output.");
return false;
}
return true;
}
function createROutput(item, expression, output_name_suffix) {
try {
var new_item = item.group.appendR(expression);
new_item.updating = "Automatic";
new_item.name = generateUniqueRObjectName(item.name + "." + output_name_suffix);
project.report.setSelectedRaw([new_item]);
} catch(e) {
log("Failed to run R code and create output.");
return false;
}
return true;
}
function generateDisambiguatedVariableName(variable) {
return stringToRName(variable.question.dataFile.name) + "$Variables$" + stringToRName(variable.name);
}
function generateUniqueRObjectName(name) {
var r_objects = [];
recursiveGetAllRObjectNamesInGroup(project.report, r_objects);
if (r_objects.indexOf(name) == -1)
return name;
var nonce = 1;
while (r_objects.indexOf(name + "." + nonce.toString()) != -1)
++nonce;
return name + "." + nonce.toString();
}
function generateUniqueRObjectReferenceName(name) {
var r_objects = [];
recursiveGetAllRObjectReferenceNamesInGroup(project.report, r_objects);
if (r_objects.indexOf(name) == -1)
return name;
var nonce = 1;
while (r_objects.indexOf(name + "." + nonce.toString()) != -1)
++nonce;
return name + "." + nonce.toString();
}
function isKeywordWithDots(text) {
return new RegExp(/^in\.*$/).test(text) ||
new RegExp(/^if\.*$/).test(text) ||
new RegExp(/^else\.*$/).test(text) ||
new RegExp(/^for\.*$/).test(text) ||
new RegExp(/^while\.*$/).test(text) ||
new RegExp(/^repeat\.*$/).test(text) ||
new RegExp(/^next\.*$/).test(text) ||
new RegExp(/^break\.*$/).test(text) ||
new RegExp(/^NULL\.*$/).test(text) ||
new RegExp(/^NA\.*$/).test(text) ||
new RegExp(/^NA_integer\.*$/).test(text) ||
new RegExp(/^NA_real\.*$/).test(text) ||
new RegExp(/^NA_complex\.*$/).test(text) ||
new RegExp(/^NA_character\.*$/).test(text) ||
new RegExp(/^Inf\.*$/).test(text) ||
new RegExp(/^NaN\.*$/).test(text) ||
new RegExp(/^function\.*$/).test(text) ||
new RegExp(/^TRUE\.*$/).test(text) ||
new RegExp(/^FALSE\.*$/).test(text);
}
function isRName(text) {
return new RegExp(/^(\.[a-z_A-Z_.]|[a-zA-Z])[a-zA-Z0-9_.]*$/).test(text);
}
function recursiveGetAllRObjectNamesInGroup(group_item, objects_array) {
var cur_sub_items = group_item.subItems;
for (var j = 0; j < cur_sub_items.length; j++) {
if (cur_sub_items[j].type == 'ReportGroup') {
recursiveGetAllRObjectNamesInGroup(cur_sub_items[j], objects_array);
}
else if (cur_sub_items[j].type == 'R Output') {
objects_array.push(cur_sub_items[j].name);
}
}
}
function recursiveGetAllRObjectReferenceNamesInGroup(group_item, objects_array) {
var cur_sub_items = group_item.subItems;
for (var j = 0; j < cur_sub_items.length; j++) {
if (cur_sub_items[j].type == 'ReportGroup') {
recursiveGetAllRObjectNamesInGroup(cur_sub_items[j], objects_array);
}
else if (cur_sub_items[j].type == 'R Output') {
objects_array.push(cur_sub_items[j].referenceName);
}
}
}
function stringToRName(text) {
if (isKeywordWithDots(text))
return text + '.';
var escaped = text.replace(/\\/, "\\\\").replace(/`/, "\\`");
return isRName(escaped) ? escaped : "`" + escaped + "`";
}
function choiceModelDataFile(selected_choice_model) {
var reference_item = selected_choice_model;
// Look through to underlying model if Ensemble
if (selected_choice_model.outputClasses.indexOf("ChoiceEnsemble") > -1)
reference_item = selected_choice_model.getInput("formModels")[0];
var data_file = getDataFileFromROutputInput(reference_item, "formExperiment");
if (data_file == null) {
data_file = getDataFileFromROutputInput(reference_item, "formChoices");
if (data_file == null)
data_file = getDataFileFromROutputInput(reference_item, "formRespondentID");
}
return data_file;
}
// Names sequential variables as base_name_1, base_name_2, etc.
// In the event of a conflict with any of those names,
// try the names base_name_x_1, base_name_x_2, etc, where
// x = 1,2,3,....
function nameSequentialVariables(variables, base_name) {
var data_file = variables[0].question.dataFile;
base_name = cleanVariableName(base_name);
var suffix_num = 0;
while (true) {
// Define suffix
var suffix = "";
if (suffix_num > 0)
suffix = "_" + suffix_num;
// Check for conflict with current suffix
var has_conflict = false;
if (variables.length > 1)
{
var _varName = function(i) {
return base_name + suffix + "_" + (i + 1);
};
for (var i = 0; i < variables.length; i++)
{
if (data_file.getVariableByName(_varName(i)) != null)
{
has_conflict = true;
break;
}
}
}
else
{
var _varName = function(i) {
return base_name + suffix;
};
if (data_file.getVariableByName(_varName(0)) != null)
has_conflict = true;
}
if (!has_conflict)
{
// No conflict found, rename variables
variables.forEach(function(v, i) {
v.name = _varName(i);
});
return;
}
else
suffix_num += 1;
}
}
function saveVariables(analysisName, inputType, expressionPrefix, expressionSuffix, questionType, makeWeight, variablePrefix, allowedRClasses) {
if (makeWeight === undefined || makeWeight === null)
makeWeight = false;
var bad_selection_message = "Select a " + inputType + " output.";
var web_mode = (!!Q.isOnTheWeb && Q.isOnTheWeb());
var selected_item = getSelectedROutputFromPage([]);
if (selected_item === null) {
log(bad_selection_message);
return false;
}
// Check R class if last argument is provided
if (allowedRClasses != undefined || allowedRClasses != null)
{
// Coerce single string to array of strings
if (typeof allowedRClasses === "string")
allowedRClasses = [allowedRClasses];
// Check the input isn't an array of strings and throw an error
if (!(Array.isArray(allowedRClasses) && allowedRClasses.every(c => typeof c === "string"))) {
throw new UserError("The allowedRClasses argument needs to be an array of strings specifying the possible R output classes to use the saveVariables function");
return false;
}
// By this point allowedRclasses should be an array of strings
var valid_input = allowedRClasses.some(c => selected_item.outputClasses.indexOf(c) > -1);
if (!valid_input) {
throw new UserError("The allowedRClasses argument was specified as " + allowedRClasses.join(", ") + "; however the selected item has class " + selected_item.outputClasses.join(", "));
return false;
}
}
// Look through to underlying model if Ensemble of existing models
var reference_item = selected_item;
if (selected_item.outputClasses.indexOf("MachineLearningEnsemble") > -1 && selected_item.getInput("formModels") != null)
reference_item = selected_item.getInput("formModels")[0];
else if (selected_item.outputClasses.indexOf("MaxDiffEnsemble") > -1)
reference_item = selected_item.getInput("formModels")[0];
// The last dependant is used instead of the first because the first may be from the design data set
var data_file = null;
if (selected_item.outputClasses.indexOf("FitMaxDiff") > -1 || selected_item.outputClasses.indexOf("MaxDiffEnsemble") > -1)
data_file = getDataFileFromROutputInput(reference_item, "formBest");
else if (selected_item.outputClasses.indexOf("FitChoice") > -1 || selected_item.outputClasses.indexOf("ChoiceEnsemble") > -1)
data_file = choiceModelDataFile(reference_item);
else
data_file = getDataFileFromItemDependants(reference_item);
if (data_file == null)
{
throw new UserError("'Save variables' cannot be applied to an output with no data file.");
return false;
}
var expression = expressionPrefix +
stringToRName(selected_item.referenceName) +
expressionSuffix;
if (variablePrefix === undefined || variablePrefix === null)
variablePrefix = analysisName;
var new_q_name = preventDuplicateQuestionName(data_file, analysisName + " from " + selected_item.referenceName);
var temp_var_name = randomVariableName(16); // temporary name, random to (almost) guarantee uniqueness
try {
var new_r_question = data_file.newRQuestion(expression, new_q_name, temp_var_name, null);
if (questionType != null)
new_r_question.questionType = questionType;
} catch (e) {
log(analysisName + " could not be created from this item: " + e);
return false;
}
// Replace temporary variable names
nameSequentialVariables(new_r_question.variables,
cleanVariableName(variablePrefix));
var data_reduction = new_r_question.dataReduction;
var sum_rows = data_reduction.netRows;
if (sum_rows.length > 0) {
var sum_codes = sum_rows.map(function (x) { return data_reduction.rowLabels[x]; });
data_reduction.hide(sum_codes[0]);
}
if (makeWeight)
new_r_question.isWeight = true;
// In Q, select the table showing the new variable.
if (!web_mode) {
var t = selected_item.group.appendTable();
t.primary = new_r_question;
project.report.setSelectedRaw([t]);
}
return true;
}