QScript R Output Functions

From Q
Jump to navigation Jump to 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).

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);
        item.group.moveAfter(new_item, item);
        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 generateDisambiguatedQuestionName(question) {
    return stringToRName(question.dataFile.name) + "$Questions$" + stringToRName(question.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);
}

// Used to identify forbidden names.
// Expensive to check every item in a
// document, so just checking names
// of R Outputs as they are of greatest
// risk for clash.
// Note that the property of having sub
// items is no longer restricted to the
// Report Group type as R items can
// be nested below plots. Hence hasSubitems()
// is used.
function recursiveGetAllRObjectNamesInGroup(group_item, objects_array) {
    var cur_sub_items = group_item.subItems;
    for (var j = 0; j < cur_sub_items.length; j++) {
        if (hasSubItems(cur_sub_items[j])) {
            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 (hasSubItems(cur_sub_items[j])) {
            recursiveGetAllRObjectReferenceNamesInGroup(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;

    let bad_selection_message = 'Select a ' + inputType + ' output.';
    let is_displayr = inDisplayr();

    let 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');
        // By this point allowedRclasses should be an array of strings
        let valid_input = allowedRClasses.some(c => selected_item.outputClasses.indexOf(c) > -1);
        if (!valid_input)
            throw new UserError(bad_selection_message);

    }

    // Look through to underlying model if Ensemble of existing models
    let reference_item = selected_item;
    let r_classes = selected_item.outputClasses;
    if (r_classes.indexOf('MachineLearningEnsemble') > -1 && selected_item.getInput('formModels') != null)
        reference_item = selected_item.getInput('formModels')[0];
    else if (r_classes.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
    let data_file = null;
    if (r_classes.indexOf('FitMaxDiff') > -1 || r_classes.indexOf('MaxDiffEnsemble') > -1)
        data_file = getDataFileFromROutputInput(reference_item, 'formBest');
    else if (r_classes.indexOf('FitChoice') > -1 || r_classes.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.');

    let expression = expressionPrefix +
                     stringToRName(selected_item.referenceName) +
                     expressionSuffix;

    if (variablePrefix === undefined || variablePrefix === null)
        variablePrefix = analysisName;

    let new_q_name = preventDuplicateQuestionName(data_file, analysisName + ' from ' + selected_item.referenceName);
    let temp_var_name = randomVariableName(16); // temporary name, random to (almost) guarantee uniqueness
    let new_r_question;
    try {
        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));

    let data_reduction = new_r_question.dataReduction;
    let sum_rows = data_reduction.netRows;
    if (sum_rows.length > 0) {
        let 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 (!is_displayr) {
        let t = selected_item.group.appendTable();
        t.primary = new_r_question;
        project.report.setSelectedRaw([t]);
    }
    return true;
}

function errorIfExtensionsUnavailableInQVersion(menu_location) {
    const in_displayr = inDisplayr();
    unsupported_version_msg = "Please update Q to use this feature from the extension " +
        " button, or run it from the menu via" +
        correctTerminology("Anything > Advanced Analysis > ") + menu_location + ".";
    if (!in_displayr && Q.fileFormatVersion() < 17.13)
        throw new UserError(unsupported_version_msg);
    return;
}

function isStackedRegression(x) {
    if (typeof x === 'undefined' || x === null) {
        return false;
    }
    if (!(x.type === 'R Output' && x.outputClasses != null)) {
        return false;
    }
    if (x.outputClasses.indexOf('Regression') === -1 || x.data.getAttribute([], 'names').indexOf('stacked') === -1)
        return false;
    return x.data.get('stacked')[0];
}

function createDiagnosticROutputFromSelection(menu_location) {
    let menu_parts = menu_location.split(" > Diagnostic > ");
    const menu_root = menu_parts[0];
    const feature_name = menu_parts[1];
    const required_classes = requiredClassForDiagnostic(menu_root, feature_name);
    const output_name = diagnosticOutputName(feature_name);

    if (Q.fileFormatVersion() <= 19.09 || required_classes == "ChoiceModelDesign")
    {
        // Avoid using appendStandardR in old versions
        const r_output = requireOneValidROutputByClass(required_classes);
        const r_expr = diagnosticRCode(r_output, menu_root, feature_name);
        return createROutput(r_output, r_expr, output_name);
    }

    let page_path = feature_name.split(" > ");
    let page_name = page_path[page_path.length - 1];
    let page_fullpath = directoryForDiagnostics(menu_root) + page_name;
    let selected_items = project.report.selectedRaw();
    let selected_item = selected_items[0];
    // Check Stacked Regression not selected for some diagnostics that are not supported
    const is_stacked_regression = required_classes.some(item => item.endsWith("Regression")) &&
                                  isStackedRegression(selected_item)
    if (is_stacked_regression) {
        const unsupported_diagnostics = [
            "Goodness of Fit",
            "Test Residual Normality (Shapiro-Wilk)",
            "Test Residual Correlation (Durbin-Watson)",
            "Prediction-Accuracy Table"
        ];
        if (unsupported_diagnostics.includes(feature_name)) {
            log(feature_name + " is not supported for stacked regression models.");
            return false;
        }
    }
    const input = {};
    const item_is_valid = selected_item != null && selected_item.type === "R Output" && selected_item.error === null &&
                          selected_item.outputClasses != null &&
                          selected_item.outputClasses.some(item => required_classes.includes(item));
    if (item_is_valid) {
        input[menu_root === 'Dimension Reduction' ? 'inputItem' : 'formInput'] = selected_item.guid;
    }
    // Determine what to do if Displayr user with variable selected or Q user with no selection
    const group_if_null_selected = inDisplayr() ? project.currentPage() : project.report;
    const group = selected_item == null ? group_if_null_selected :
        selected_item.type == 'ReportGroup' ? // Displayr User with no selection or Q with folder selected
            selected_item :
            selected_item.group; // Something is selected
    const plot = group.appendStandardR(page_fullpath, input, project.IsInsertingSingleOutput);
    project.report.setSelectedRaw([plot]);
    return true;
}

function directoryForDiagnostics(menu_root)
{
    switch (menu_root) {
        case 'Regression': return 'Regression - Diagnostic - StandardRPlot - ';
        case 'Machine Learning': return 'Regression - Diagnostic - StandardRPlot - ';
        case 'Dimension Reduction': return 'Dimension Reduction - Diagnostic - Correspondence Analysis ';
        case 'Choice Modeling': return 'Choice Modeling - ';
        case 'Marketing > MaxDiff': return 'Choice Modeling - ';
        case 'Data > Data Set > Combine': return 'Data - Data Set - Combine - Diagnostic - ';
    }
}

function requiredClassForDiagnostic(menu_root, feature_name)
{
    function isExperimentalDesign(feature_name) {
        return /^Experimental Design >/.test(feature_name);
    }

    function requiresLCA(feature_name) {
        return /^Class/.test(feature_name);
    }

    function requiresLDA(feature_name) {
        return feature_name === "Table of Discriminant Function Coefficients";
    }

    function requiresHB(feature_name) {
        return !requiresLCA(feature_name) && feature_name !== "Parameter Statistics Table";
    }

    function requiresLinearRegression(feature_name) {
        return feature_name === "Test Residual Heteroscedasticity";
    }

    switch (menu_root) {
        case "Choice Modeling": return  (isExperimentalDesign(feature_name) ?
            ["ChoiceModelDesign"] : (requiresLCA(feature_name) ?
            ["FitChoiceLCA", "FitChoiceMNL"] :
            (requiresHB(feature_name) ? ["FitChoiceHB"] : ["FitChoice"])));
        case "Marketing > MaxDiff": return (requiresLCA(feature_name) ?
            ["FitMaxDiffLCA", "FitMaxDiffMNL"] :
            (requiresHB(feature_name) ? ["FitMaxDiffHB"] : ["FitMaxDiff"]));
        case "Dimension Reduction": return ["CorrespondenceAnalysis"];
        case "Machine Learning": return (requiresLDA(feature_name) ? ["LDA"]:
           ["MachineLearning", "MachineLearningEnsemble"]);
        case "Regression" : return (requiresLinearRegression(feature_name) ?
            ["LinearRegression"] : ["Regression"]);
        case "Data > Data Set > Combine": return ["MergeDataSetByCase"];
        default: return([]);
    }
}

function diagnosticOutputName(feature_name)
{
    let output_name = feature_name.replace(/\sextension$/, "");
    // remove submenu name if present, e.g. Experimental Design or Plot
    output_name = output_name.replace(/^.*\s>\s/, "");
    output_name = output_name.replace(/\s?Table(\sof\s)?/i,"");
    // Remove "Plot" except for Trace Plots
    output_name = output_name.replace(/\s?Plot(?!s)/i,"");
    output_name = output_name.replace(/Test\sResidual\s/,"");
    output_name = output_name.replace(/\sof\sDesign/i,"");
    output_name = output_name.replace(/\s\(.*\)$/i,"");
    output_name = output_name.replace(/\'/g,"");
    output_name = output_name.toLowerCase();
    output_name = output_name.replace(/\-/g,".").replace(/q\.q/, "qq");
    output_name = output_name.replace(/\s/g,".");
    return output_name;
}

function diagnosticRCode(r_output, menu_root, feature_name) {
    // feature_name = feature_name.replace(/\sextension$/,"");
    let r_name = stringToRName(r_output.referenceName);
    let max_diff = menu_root === "Marketing > MaxDiff";
    let cmodel_pkg = max_diff ? "flipMaxDiff" : "flipChoice";
    switch(feature_name) {
    case "Experimental Design > Balances and Overlaps of Design":
        return "c(d.error = " + r_name + "$d.error, " + r_name +
            "$balances.and.overlaps)";
    case "Experimental Design > Numeric Design":
        return "sapply(" + r_name + "$labeled.design, as.numeric)";
    case "Experimental Design > Parameter Standard Errors of Design":
        return"list(standard.errors = " + r_name + "$standard.errors," +
            "d.error = " + r_name + "$d.error)";
    case "Plot > Cook's Distance":
        return "plot(" + r_name + ", which = 4)";
    case "Plot > Cook's Distance vs Leverage":
        return "plot(" + r_name + ", which = 6)";
    case "Plot > Influence Index":
        return "car::influenceIndexPlot(" + r_name +
            ", id = list(method = 'y', n = 5, cex = 1, location = 'lr'),  " +
            "vars = c('Studentized', 'hat', 'Cook'))";
    case "Plot > Normal Q-Q":
        return "plot(" + r_name + ", which = 2)";
    case "Plot > Residuals vs Fitted":
        return "plot(" + r_name + ", which = 1)";
    case "Plot > Residuals vs Leverage":
        return "plot(" + r_name + ", which = 5)";
    case "Plot > Scale-Location":
        return "plot(" + r_name + ", which = 3)";
    case "Class Parameters Table":
        return (max_diff ?
                "r.name <- flipMaxDiff::ExtractClassParameters(" + r_name + ")" :
                "r.name <- " + r_name + "$coef");
    case "Parameter Statistics Table":
            return "r.name <- " + cmodel_pkg + "::ExtractParameterStats(" + r_name + ")";
    case "Posterior Intervals Plot":
        return "r.name <- " + cmodel_pkg + "::PlotPosteriorIntervals(" + r_name + ")";
    case "Trace Plots":
        return "r.name <- " + cmodel_pkg + "::TracePlots(" + r_name + ")";
    case "Class Preference Shares Table":
        return "r.name <- flipMaxDiff::ExtractPreferenceShares(" + r_name + ")";
    case "Quality Table":
        return "CAQuality(" + r_name + ")";
    case "Prediction-Accuracy Table":
        return "library(flipRegression)\nConfusionMatrix(QInputs(" + r_name + "), " +
                                                        "QFilter, QPopulationWeight)";
    case "Table of Discriminant Function Coefficients":
        return r_name + "$original$discriminant.functions";
    case "Multicollinearity Table (VIF)":
        return "car::vif(" + r_name + ")";
    case "Test Residual Heteroscedasticity":
        return "if (!identical(class(" + r_name + "$original), \"lm\"))\n    stop(\"" +
            "Sorry, you must select an output from 'Regression - Linear Regression' " +
            "to use this diagnostic.\")\n" +
            "flipFormat::SignificanceTest(\n    car::ncvTest(" + r_name +
            "),\n    'Test of Residual Heteroscedasticity (Breusch-Pagan)',\n    " +
            "vars = NULL,\n    reg.name = deparse(substitute(" + r_name + ")),\n    " +
            "reg.sample.description = " + r_name + "$sample.description)";
    case "Test Residual Normality (Shapiro-Wilk)":
        return "flipFormat::SignificanceTest(\n    shapiro.test(resid(" + r_name +
            ")),\n    'Test of Residual Normality (Shapiro-Wilk)',\n    " +
            "vars = NULL,\n    reg.name = '" + r_output.name +
            "',\n    reg.sample.description = " + r_name + "$sample.description)";
    case "Test Residual Serial Correlation (Durbin-Watson)":
        return "flipFormat::SignificanceTest(\n    flipRegression::DurbinWatson(" +
            r_name + "),\n    'Test of Residual Serial Correlation (Durbin-Watson)',\n" +
            "    vars = NULL,\n    reg.name = '" + r_output.name +
            "',\n    reg.sample.description = " + r_name + "$sample.description)";
    }
}

// Use when data.get() or data.getAttribute() are looking for a property
// that may not exist.
// Usage should be the same for get() and getAttribute():
// - If checking something you would obtain by get(), supply the variable path
// - If checking something you would obtain by getAttribute, supply
//   both the variable_path and attruibute
function rPropertyExists(output, variable_path = [], attribute = null) {
   if (output.type === "R Output"){
     try {
         var r_attr = attribute != null ? output.data.getAttribute(variable_path, attribute) : output.data.get(variable_path);
         return true;
     }catch(e) {
         return false;
     }
   }
   return false;
}

function getExpectedClassForChoiceModel(selected_item) {

    let algorithm = rPropertyExists(selected_item, 'algorithm') ? selected_item.data.get('algorithm')[0] : null;

    return selected_item.outputClasses.indexOf('FitChoiceLCA') == -1 &&
                         algorithm == 'LCA'  ? 'FitChoice' : 'FitChoiceLCA';
}


function getExpectedClassForMaxDiff(selected_item) {

    let algorithm = rPropertyExists(selected_item, 'algorithm') ? selected_item.data.get('algorithm')[0] : null;
    let covariate_index = rPropertyExists(selected_item, '', 'names') ? selected_item.data.getAttribute('', 'names').indexOf('covariates.notes') : -1;

    let expected_class = selected_item.outputClasses.indexOf('FitMaxDiffLCA') == -1 &&
                         algorithm == 'Default' &&
                         covariate_index == -1 ? 'FitMaxDiff' : 'FitMaxDiffLCA';

    return expected_class;
}

See also