QScript R Output Functions

From Q
Jump to: navigation, search

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

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_objecs = []; recursiveGetAllRObjectNamesInGroup(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.

saveVariables(analysisName, inputType, expressionPrefix, expressionSuffix, questionType, makeWeight)

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?

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);

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 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 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;
}

function saveVariables(analysisName, inputType, expressionPrefix, expressionSuffix, questionType, makeWeight) {
    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;
    }

    // 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)
    {
        log("'Save variables' cannot be applied to an output with no data file.");
        return false;
    }

    var expression = expressionPrefix + 
                     stringToRName(selected_item.referenceName) + 
                     expressionSuffix;
    
    var new_q_name = preventDuplicateQuestionName(data_file, analysisName + " from " + selected_item.referenceName);
    var new_var_name = cleanVariableName(new_q_name).toLowerCase() + "_";
    new_var_name = randomVariableName(16, new_var_name);
    

    try {
        var new_r_question = data_file.newRQuestion(expression, new_q_name, new_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;
    }
 
    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;
}

See also