QScript Functions for Choice Modeling

From Q
Jump to navigation Jump to search

This page contains functions used by QScript which work with choice models.

Source Code

function createChoiceSimulator(userSpecifiedNumberAlternatives, multiple_selection) {

    includeWeb('QScript R Output Functions');
    includeWeb('QScript Selection Functions');
    includeWeb('QScript Functions to Generate Outputs');
    
    function rCodeAsString(scenario, pref_name) {
        var r_expr = scenario;
        r_expr += "))\n scenario <- lapply(scenario, function(x) x[vapply(x, length, 0L) != 0])\r\n"; // rm empty comboboxes
        r_expr += "scenario <- lapply(scenario, function(x) x[vapply(x, length, 0L) != 0])\n";
        r_expr += "share.adjustment <- if (formCalibrateToShares && formScaleToShares){\n";
        r_expr += "                        \"Scale then calibrate\"\n";
        r_expr += "                    }else if (formCalibrateToShares){\n"; 
        r_expr += "                        \"Calibrate\"\n";
        r_expr += "                    }else if (formScaleToShares){\n";
        r_expr += "                        \"Scale\"\n";
        r_expr += "                    }else\n" +
            "                        \"None\"\n" +
            "n.alt <- length(scenario)\n" + 
            "n.resp <- if (is.null(formChoiceModel$subset)){\n" +
            "              formChoiceModel$n.respondents\n" + 
            "          }else\n" +
            "              length(formChoiceModel$subset)\r\n" +                     
            "createOffset <- function(mat, n.resp, n.alt)\n" + 
            "{\n" + 
            "    if (is.null(dim(mat)) || NROW(mat) != n.resp || NCOL(mat) != n.alt)\n" +
            "        stop(sQuote(\"Availability\"), \" must be a table with \", n.resp,\n" + 
            "             \" rows and \", n.alt, \" columns.\")\n" +
            "    if (!all(is.na(mat) | mat == 1  | mat == 0))\n" +
            "        stop(sQuote(\"Availability\"),\n" + 
            "             \" may only contain the values 0, 1, TRUE, FALSE, NA, or NaN.\")\n" +
            "    out <- matrix(0, n.resp, n.alt)\n" + 
            "    out[is.na(mat) | !mat] <- -Inf\n" + 
            "    out\n" +
            "}\r\n" + 
            "if (!is.null(formAvailability)){\n" + 
            "    offset <- createOffset(formAvailability, n.resp, n.alt)\n" + 
            "}else\n" +
            "    offset <- NULL\r\n" +                 
            "if (!is.null(get0(\"formOffset\")) && nchar(formOffset))\n" +
            "{\n" +
            "    off <- flipU::ConvertCommaSeparatedStringToVector(formOffset)\n" +
            "    if (length(off) != n.alt || anyNA(off <- as.numeric(off)))\n" +
            "        stop(\"The specified utilities need be \", n.alt,\n" +
            "             \" comma-separated, numeric values\")\n" + 
            "    off <- matrix(off, nrow = n.resp, ncol = n.alt, byrow = TRUE)\n" +
            "    if (!is.null(offset)){\n" +
            "        offset <- offset + off\n" +
            "    }else\n" +
            "        offset <- off\n" +
            "}\r\n" + 
            "if (!is.null(get0(\"formScale\")) && formScale != 1)\n" +
            "{\n" +
            "    scale <- rep(formScale, n.resp)\n" +
            "}else\n" +
            "    scale <- NULL\r\n" + 
            "warns <- testthat::capture_warnings(resp.shares <- predict(formChoiceModel,\n" +
            "                      scenario = scenario,\n" + 
            "                      rule = tolower(formRule),\n" +
            "                      share.adjustment = share.adjustment,\n" +
            "                      shares = get0(\"formShares\"),\n" +
            "                      scale = scale,\n" +
            "                      offset = offset,\n" + 
            "                      optimx.controls = list(abstol = 1e-7, maxit = 1000)))\n" +
            "if (share.adjustment == \"Scale then calibrate\" && length(warns) >= 2L){\n" +
            "    warning(warns[1])\n" +
            "    warning(warns[2])\n" +
            "}else if (length(warns) >= 1L)\n" + 
            "    warning(warns[1])\r\n" + 
            "wgt <- if (is.null(QPopulationWeight)) rep.int(1L, n.resp) else QPopulationWeight\n" +
            "resp.shares <-  sweep(resp.shares, 2, wgt, \"*\")\n" + 
            "if (length(QFilter) == n.resp)\n" +
            "    resp.shares <- resp.shares[, QFilter, , drop = FALSE]\n";
        r_expr += pref_name + " <- apply(resp.shares, c(1, 3), mean, na.rm = TRUE) * 100";
        return r_expr
    }

    function guiControlsAsString(multiple_selection) {
        return "controls = [];\n" + 
        "var db = form.dropBox({name: \"formChoiceModel\", label: \"Choice model\",\n" + 
        "                  required: true, multi: false,\n" +
        "                  prompt: \"Select an output from Choice Modeling - Hierarchical Bayes, Latent Class Analysis, or Multinomial Logit\",\n" +
        "                  types: [\"RItem:FitChoice\"]});\n" +
        "controls.push(db);\n" +
        "var rule = form.comboBox({name: \"formRule\", label: \"Rule\",\n" + 
        "                          prompt: \"Type of choice model to fit\",\n" +
        "                          alternatives: [\"Logit respondent\",\n" +
        "                                         \"Logit draw\",\n" +
        "                                         \"First choice respondent\",\n" +
        "                                         \"First choice draw\"],\n" +
        "                          default_value: \"Logit respondent\"});\n" +
        "controls.push(rule);\n" +
        "var availability = form.dropBox({label: \"Availability\",\n" +
        "                  types:[\"Table\", \"RItem:matrix,data.frame\"],\n" +
        "                  prompt: \"A matrix of TRUE/FALSE or 0/1 values of respondents to exclude from each scenario\",\n" +
        "                  name: \"formAvailability\", required: false,\n" +
        "                  multi: false});\n" +
        "controls.push(availability);\n" +
        "var calibrate = form.checkBox({label: \"Calibrate to shares\",\n" +  
        "                               prompt: \"Adds constants to the utilities computed for each scenario, \" +\n" + 
        "                                       \"such that the simulators shares add up to the shares provided\",\n" +
        "                               name: \"formCalibrateToShares\", default_value: false});\n" +
        "var scale = form.checkBox({label: \"Scale to shares\",\n" +
        "                           prompt: \"Calculates the scale factor (also known as lambda, and the exponent) \" +\n" + 
        "                           \"that best predicts shares\",\n" +
        "                            name: \"formScaleToShares\", default_value: false});\n" +
        "if (calibrate.getValue() || scale.getValue())\n" + 
        "     var tb = form.textBox({name: \"formShares\",\n" +
        "                            label: \"Shares\",\n" +
        "                            prompt: \"Enter shares, separate by commas, that sum to 1\",\n" +
        "                            required: true})\n" +
        "var utilities = form.textBox({name: \"formOffset\",\n" +
        "                    label: \"Calibration factors\",\n" +
        "                    prompt: \"(Optional) Enter utilities to be added to the scenarios.\",\n" +
        "                    required: false});\n" +     
        "if (scale.getValue()) {\n" +
        "    controls.push(tb);\n" +
        "    controls.push(scale);\n" + 
        "    controls.push(calibrate);\n" +
        "    if (!calibrate.getValue())\n" +
        "        controls.push(utilities);\n" +
        "}else {\n" +
        "    controls.push(scale);\n" +
        "    var nup = form.numericUpDown({name: \"formScale\",\n" +
        "                        label: \"Scale factor\",\n" +
        "                        default_value: 1,\n" +
        "                        increment: 0.0001,\n" +
        "                        minimum: 0});\n" +
        "    controls.push(nup);\n" + 
        "    if (calibrate.getValue()) {\n" +
        "        controls.push(tb);\n" +
        "        controls.push(calibrate);\n" +
        "    }else {\n" + 
        "        controls.push(calibrate);\n" +
        "        controls.push(utilities);\n" +
        "    }\n" +    
        "}\n" + 
        "form.setInputControls(controls);\n" + 
        (multiple_selection ? "form.setHeading(\"Choice Optimizer\");" : "form.setHeading(\"Choice Simulator\");");
    }
    
    function generateUniqueComboBoxName(name) {

        var combo_boxes = [];
        recursiveGetAllComboBoxNamesInGroup(project.report, combo_boxes);
        
        if (combo_boxes.indexOf(name) == -1)
            return name;
        
        var nonce = 1;
        while (combo_boxes.indexOf(name + "." + nonce.toString()) != -1)
            ++nonce;
        
        return name + "." + nonce.toString();
    }

    function recursiveGetAllComboBoxNamesInGroup(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') {
                recursiveGetAllComboBoxNamesInGroup(cur_sub_items[j], objects_array);
            }
            else if (cur_sub_items[j].type == 'Control')  {
                objects_array.push(cur_sub_items[j].name);
            }
        }
    }

    function createArray(length) {
        var arr = new Array(length || 0),
            i = length;

        if (arguments.length > 1) {
            var args = Array.prototype.slice.call(arguments, 1);
            while (i--) arr[length - 1 - i] = createArray.apply(this, args);
        }

        return arr;
    }

    function getChoiceModelOptions(choiceModel, userSpecifiedNumberAlternatives, multiple_selection) {

        this_item = choiceModel;

        var n_alternatives = this_item.data.get("n.alternatives");
        var n_attributes = this_item.data.get("n.attributes");
        var attributes = this_item.data.getAttribute("attribute.levels", "names");

        var script_type = multiple_selection ? "optimizer" : "simulator";
        var none_options_labels = this_item.data.getAttribute("none.alternatives", "names");
        if (userSpecifiedNumberAlternatives == 1 && !none_options_labels.length) {
            alert("Cannot create a one alternative " + script_type + " for a choice model with no 'None' alternative");
            return false;
        }

        var exclude_alternative_attr_requested = false;
        var exclude_none = false;
        var none_with_no_ASCs = this_item.data.get(["attribute.levels", attributes[0]]).filter(e => none_options_labels.indexOf(e) == -1).length == 1;
        if(this_item.data.getAttribute("attribute.levels", "names")[0] === "Alternative" && !none_with_no_ASCs)
            exclude_alternative_attr_requested = !askYesNo("Would you like to include the Alternative attribute?");
        if(none_options_labels.length && userSpecifiedNumberAlternatives > 1)
            exclude_none = !askYesNo("Would you like to include the 'None' alternative?");
        
        var alternatives = [];
        for (var j = 0; j < userSpecifiedNumberAlternatives; j++)
            alternatives.push("Alternative " + (j+1));

        levels = [];
        var level_count = 0;
        var exclude_first_attribute = false;
        for (var i = 0; i < attributes.length; i++) {
            var currentLevels = this_item.data.get(["attribute.levels", attributes[i]]);
            // level_count needs to account for 'None' parameters to properly
	    // index into the processed.data components below; however, we don't
	    // want to show them as an option in the combo box if the user
	    // requests the alternative attribute be shown, so we filter
	    // them from levels	    
            if (currentLevels.length > 0) {
		level_count = level_count + currentLevels.length - 1;
                if (i == 0)
                {
                    currentLevels = currentLevels.filter(e => none_options_labels.indexOf(e) == -1); 
                    exclude_first_attribute = exclude_alternative_attr_requested || currentLevels.length == 1; // Others (appears when there are "none of these" alternatives with no ASCs)
                }
                levels.push(currentLevels);
            } else {
                // Numeric attribute
                // Work out max and min values, then generate four levels at (roughly)
                // even intervals, rounded to 2 decimal places because
                // values usually represent dollars.
                level_count ++;
                var min;
                var max;
                try {
                    var range = this_item.data.get(["processed.data", "parameter.range"]);             
                    min = range[i][0];
                    max = range[i][1];
                } catch (e) {
                    var min_array = this_item.data.get(["processed.data", "parameter.min"]);
                    var max_array = this_item.data.get(["processed.data", "parameter.max"]);
                    min = min_array[level_count - 1];
                    max = max_array[level_count - 1];
                }

                min = Math.ceil(100 * min) / 100;
                max = Math.floor(100 * max) / 100;
                var interval = (max - min) / 4;
                levels.push([min, Math.floor(100 * (min + interval)) / 100, Math.floor( 100 * (min + 2 * interval)) / 100, max]);
            }
        }

        if (exclude_none)
            none_options_labels = [];

        var simulatorOptions = {attributes: attributes, 
            alternatives: alternatives, 
            noneOptionsLabels: none_options_labels, 
            levels: levels, 
            choiceOutput: this_item,
            excludeFirstAttribute: exclude_first_attribute                    
        }

        return simulatorOptions;
    }

    function buildSimulator(options, selected_item, multiple_selection) {

        const attributes  = options.attributes;
        const choiceAlternatives = options.alternatives
        const noneAlternatives = options.noneOptionsLabels;
        const levels = options.levels;
        const selected_item_name = options.choiceOutput.referenceName;
        const exclude_first_attribute = options.excludeFirstAttribute;
        
        const alternatives = choiceAlternatives.concat(noneAlternatives);
        const numberOfColumns = alternatives.length;
        const numberOfRows = exclude_first_attribute ? attributes.length - 1 : attributes.length;

        // Create page and title
        const pageName = multiple_selection ? "Optimizer" : "Simulator";
        const page = options.choiceOutput.group.group.appendPage('TitleOnly');
        page.group.moveAfter(page, options.choiceOutput.group);
        page.name = pageName;
        var titleText = page.subItems[0];
        titleText.text = pageName;
        
        // Figure out layout values.

        // Work out height of rows
        var testText = page.appendText();
        testText.text = "Text";
        const optionRowHeight = testText.height;
        testText.deleteItem();

        const rowPad = 10;

        // Work out height needed for simulator options

        const optionHeightNeeded = (numberOfRows + 3) * (optionRowHeight + rowPad);
        const titleHeightNeeded = titleText.height + rowPad;

        // If going over page
        var topMargin
        if (page.height < (optionHeightNeeded + titleHeightNeeded)) {
            titleText.top = 0;
            topMargin = titleText.top + titleText.height + 5;
        } else {
            topMargin = titleText.top + titleText.height + 10 + (optionRowHeight + rowPad);
        }
        
        // Width        
        const leftMargin = 7;
        const rightMargin = 7;
        const wUnit = (page.width - leftMargin - rightMargin) / (numberOfColumns + 1);

        // Create a grid of combos
        const combos = createArray(numberOfColumns, numberOfRows);
        let lastRowTop = 0;
        let lastRowHeight = 0;

        for (let x = 0; x < numberOfColumns; x++) {
            let above;

            const text = page.appendText();
            text.left = wUnit * (x + 1) + 5 + leftMargin;
            text.top = topMargin + 5;
            text.width = wUnit - 10;
            text.text = isNaN(alternatives[x]) ? alternatives[x]  : ("Alternative " + alternatives[x]);
            above = text;

            if (x < choiceAlternatives.length) {
                for (let y = 0; y < numberOfRows; y++) {
                    let attribute_index = exclude_first_attribute ? y + 1 : y;
                    combo = page.appendControl("Combobox");
                    combo.selectionMode = multiple_selection ? 'MultipleSelection' : 'SingleSelection';
                    combo.whenItemListChanges = 'SelectFirst';
                    combo.itemList = levels[attribute_index];
                    combo.selectedItems = [levels[attribute_index][0]];
                    combo.placeholderText = levels[attribute_index][0];
                    combo.width = wUnit - 10;
                    combo.left = wUnit * (x + 1) + 5 + leftMargin;
                    combo.top = above.top + above.height + rowPad;
                    combo.name = generateUniqueComboBoxName("c" + attributes[attribute_index].replace(/\W/g,"_") + "." + (x + 1));
                    combos[x][y] = combo;
                    if (x === 0) {
                        const text = page.appendText();
                        text.left = 5 + leftMargin;
                        text.top = combo.top;
                        text.width = wUnit - 10;
                        text.text = attributes[attribute_index];

                        if (y == numberOfRows - 1) {
                            lastRowTop = combo.top + combo.height + rowPad;
                            lastRowHeight = combo.height;
                        }
                    }
                    above = combo;
                }
            }
        }

        const text = page.appendText();
        text.left = 5 + leftMargin;
        text.top = lastRowTop;
        text.width = wUnit - 10;
        text.text = 'Preference Share';
        above = text;

        var controls = combos.map(function(a1) {
            return a1.map(function(a2) {
                return a2.name;
            })
        });

        // Create R output to compute market shares

        var n_alternatives = alternatives.length;
        var r_temp = "scenario = list(";
        for (var i = 0; i < n_alternatives; i++) {
            r_temp += "'" + alternatives[i] + "' = list("
            if (i >= choiceAlternatives.length) {// This is a none-of-these alternative
                r_temp += "'" + attributes[0] + "' = '" + noneAlternatives[i - choiceAlternatives.length] + "'";
            } else {
                for (var j = 0; j < numberOfRows; j++) {
                    let attribute_index = exclude_first_attribute ? j + 1 : j;
                    r_temp += "'" + attributes[attribute_index] + "' = " + controls[i][j];
                    
                    if (j < numberOfRows - 1) 
                        r_temp += ",";   
                }
            }
            if (i < n_alternatives-1)
                r_temp += "),\r\n";
        }
            
        var pref_name = generateUniqueRObjectName('preference.shares'); 
        var r_expression = rCodeAsString(r_temp, pref_name); 

        var pref_shares = page.appendR(r_expression);
        pref_shares.setCodeForGuiControls(guiControlsAsString(multiple_selection));
        pref_shares.setGuiControlInputRaw("formChoiceModel", selected_item.guid);
        
        if (!multiple_selection) {
            pref_shares.top = page.height + 5;
            pref_shares.left = 0;
            pref_shares.height = 100;
            pref_shares.width = 70;
            pref_shares.hiddenFromExportedViews = true;
            pref_shares.update();

            // Adding R outputs to display the shares under each column
            for (let x = 0; x < numberOfColumns; x++) {
                const rOutput = page.appendR(`${pref_shares.name}[, ${x + 1}]`);
                rOutput.left = wUnit * (x + 1) + 5 + leftMargin;
                rOutput.top = lastRowTop;
                rOutput.width = wUnit - 10;
                rOutput.height = lastRowHeight * 10;
            }
        }else {
            pref_shares.top = lastRowTop;
            pref_shares.left = wUnit + 5 + leftMargin;
            pref_shares.height = lastRowHeight * 10;
            pref_shares.width = numberOfColumns*wUnit;
            pref_shares.update();            
        }
        project.report.setSelectedRaw([pref_shares]);
    }
    var selected_item = checkSelectedItemClassCustomMessage("FitChoice", "Select an output that has been created with Insert > Choice Modeling.");
    if (selected_item === null)
        return false;
    
    var simulatorOptions = getChoiceModelOptions(selected_item, userSpecifiedNumberAlternatives, multiple_selection);
    if (simulatorOptions === false) // error from requesting one-alternative simulator with no 'None'
        return false;

    buildSimulator(simulatorOptions, selected_item, multiple_selection);

    return true; 
}

See also

See also