/*! glpk.js - v4.49.0 * https://github.com/hgourvest/glpk.js * Copyright (c) 2013 Henri Gourvest; Licensed GPLv2 */ (function(exports) { function xassert(test){ if (!test){ throw new Error('assert'); } } var /** @const */GLP_DEBUG = false, /** @const */DBL_MAX = Number.MAX_VALUE, /** @const */DBL_MIN = Number.MIN_VALUE, /** @const */DBL_DIG = 16, /** @const */INT_MAX = 0x7FFFFFFF, /** @const */DBL_EPSILON = 0.22204460492503131E-15, /** @const */CHAR_BIT = 1; var /** CAUTION: DO NOT CHANGE THE LIMITS BELOW */ /** @const */ M_MAX = 100000000, /* = 100*10^6 */ /* maximal number of rows in the problem object */ /** @const */ N_MAX = 100000000, /* = 100*10^6 */ /* maximal number of columns in the problem object */ /** @const */ NNZ_MAX = 500000000; /* = 500*10^6 */ /* maximal number of constraint coefficients in the problem object */ /** @const */ var XEOF = -1; function xerror(message){ throw new Error(message); } var xprintf = function(data){ }; exports["glp_get_print_func"] = function(){return xprintf}; exports["glp_set_print_func"] = function(value){xprintf = value}; function xcopyObj(dest, src){ for (var prop in src){dest[prop] = src[prop];} } function xcopyArr(dest, destFrom, src, srcFrom, count){ for (; count > 0; destFrom++, srcFrom++, count--){dest[destFrom] = src[srcFrom];} } function xfillArr(dest, destFrom, value, count){ for (; count > 0; destFrom++, count--){dest[destFrom] = value;} } function xfillObjArr(dest, destFrom, count){ for (; count > 0; destFrom++, count--){dest[destFrom] = {}} } function xtime(){ var d = new Date(); return d.getTime(); } function xdifftime(to, from){ return (to - from) / 1000; } function xqsort(base, idx, num, compar){ var tmp = new Array(num); xcopyArr(tmp, 0, base, idx, num); tmp.sort(compar); xcopyArr(base, idx, tmp, 0, num); } var global_env = {}; function get_env_ptr(){ return global_env; } var glp_version = exports["glp_version"] = function(){ return GLP_MAJOR_VERSION + "." + GLP_MINOR_VERSION; }; function isspace(c){ return (" \t\n\v\f\r".indexOf(c) >= 0) } function iscntrl(c){ var code = (typeof c == 'string')?c.charCodeAt(0):-1; return ((code >= 0x00 && code <= 0x1f) || code == 0x7f) } function isalpha(c){ var code = (typeof c == 'string')?c.charCodeAt(0):-1; return (code >= 0x41 && code <= 0x5A)|| (code >= 0x61 && code <= 0x7A) } function isalnum(c){ var code = (typeof c == 'string')?c.charCodeAt(0):-1; return (code >= 0x41 && code <= 0x5A)|| (code >= 0x61 && code <= 0x7A) || (code >= 0x30 && code <= 0x39) } function isdigit(c){ var code = (typeof c == 'string')?c.charCodeAt(0):-1; return (code >= 0x30 && code <= 0x39) } function strchr(str, c){ return str.indexOf(c) } function tolower(c){ return c.toLowerCase(); } function sprintf () { // http://kevin.vanzonneveld.net // + original by: Ash Searle (http://hexmen.com/blog/) // + namespaced by: Michael White (http://getsprink.com) // + tweaked by: Jack // + improved by: Kevin van Zonneveld (http://kevin.vanzonneveld.net) // + input by: Paulo Freitas // + improved by: Kevin van Zonneveld (http://kevin.vanzonneveld.net) // + input by: Brett Zamir (http://brett-zamir.me) // + improved by: Kevin van Zonneveld (http://kevin.vanzonneveld.net) // + improved by: Dj // + improved by: Allidylls // * example 1: sprintf("%01.2f", 123.1); // * returns 1: 123.10 // * example 2: sprintf("[%10s]", 'monkey'); // * returns 2: '[ monkey]' // * example 3: sprintf("[%'#10s]", 'monkey'); // * returns 3: '[####monkey]' // * example 4: sprintf("%d", 123456789012345); // * returns 4: '123456789012345' var regex = /%%|%(\d+\$)?([-+\'#0 ]*)(\*\d+\$|\*|\d+)?(\.(\*\d+\$|\*|\d+))?([scboxXuideEfFgG])/g; var a = arguments, i = 0, format = a[i++]; // pad() var pad = function (str, len, chr, leftJustify) { if (!chr) { chr = ' '; } var padding = (str.length >= len) ? '' : Array(1 + len - str.length >>> 0).join(chr); return leftJustify ? str + padding : padding + str; }; // justify() var justify = function (value, prefix, leftJustify, minWidth, zeroPad, customPadChar) { var diff = minWidth - value.length; if (diff > 0) { if (leftJustify || !zeroPad) { value = pad(value, minWidth, customPadChar, leftJustify); } else { value = value.slice(0, prefix.length) + pad('', diff, '0', true) + value.slice(prefix.length); } } return value; }; // formatBaseX() var formatBaseX = function (value, base, prefix, leftJustify, minWidth, precision, zeroPad) { // Note: casts negative numbers to positive ones var number = value >>> 0; prefix = prefix && number && { '2': '0b', '8': '0', '16': '0x' }[base] || ''; value = prefix + pad(number.toString(base), precision || 0, '0', false); return justify(value, prefix, leftJustify, minWidth, zeroPad); }; // formatString() var formatString = function (value, leftJustify, minWidth, precision, zeroPad, customPadChar) { if (precision != null) { value = value.slice(0, precision); } return justify(value, '', leftJustify, minWidth, zeroPad, customPadChar); }; // doFormat() var doFormat = function (substring, valueIndex, flags, minWidth, _, precision, type) { var number; var prefix; var method; var textTransform; var value; if (substring == '%%') { return '%'; } // parse flags var leftJustify = false, positivePrefix = '', zeroPad = false, prefixBaseX = false, customPadChar = ' '; var flagsl = flags.length; for (var j = 0; flags && j < flagsl; j++) { switch (flags.charAt(j)) { case ' ': positivePrefix = ' '; break; case '+': positivePrefix = '+'; break; case '-': leftJustify = true; break; case "'": customPadChar = flags.charAt(j + 1); break; case '0': zeroPad = true; break; case '#': prefixBaseX = true; break; } } // parameters may be null, undefined, empty-string or real valued // we want to ignore null, undefined and empty-string values if (!minWidth) { minWidth = 0; } else if (minWidth == '*') { minWidth = +a[i++]; } else if (minWidth.charAt(0) == '*') { minWidth = +a[minWidth.slice(1, -1)]; } else { minWidth = +minWidth; } // Note: undocumented perl feature: if (minWidth < 0) { minWidth = -minWidth; leftJustify = true; } if (!isFinite(minWidth)) { throw new Error('sprintf: (minimum-)width must be finite'); } if (!precision) { precision = 'fFeE'.indexOf(type) > -1 ? 6 : (type == 'd') ? 0 : undefined; } else if (precision == '*') { precision = +a[i++]; } else if (precision.charAt(0) == '*') { precision = +a[precision.slice(1, -1)]; } else { precision = +precision; } // grab value using valueIndex if required? value = valueIndex ? a[valueIndex.slice(0, -1)] : a[i++]; switch (type) { case 's': return formatString(String(value), leftJustify, minWidth, precision, zeroPad, customPadChar); case 'c': return formatString(String.fromCharCode(+value), leftJustify, minWidth, precision, zeroPad); case 'b': return formatBaseX(value, 2, prefixBaseX, leftJustify, minWidth, precision, zeroPad); case 'o': return formatBaseX(value, 8, prefixBaseX, leftJustify, minWidth, precision, zeroPad); case 'x': return formatBaseX(value, 16, prefixBaseX, leftJustify, minWidth, precision, zeroPad); case 'X': return formatBaseX(value, 16, prefixBaseX, leftJustify, minWidth, precision, zeroPad).toUpperCase(); case 'u': return formatBaseX(value, 10, prefixBaseX, leftJustify, minWidth, precision, zeroPad); case 'i': case 'd': number = +value || 0; number = Math.round(number - number % 1); // Plain Math.round doesn't just truncate prefix = number < 0 ? '-' : positivePrefix; value = prefix + pad(String(Math.abs(number)), precision, '0', false); return justify(value, prefix, leftJustify, minWidth, zeroPad); case 'e': case 'E': case 'f': // Should handle locales (as per setlocale) case 'F': case 'g': case 'G': number = +value; prefix = number < 0 ? '-' : positivePrefix; method = ['toExponential', 'toFixed', 'toPrecision']['efg'.indexOf(type.toLowerCase())]; textTransform = ['toString', 'toUpperCase']['eEfFgG'.indexOf(type) % 2]; value = prefix + Math.abs(number)[method](precision); return justify(value, prefix, leftJustify, minWidth, zeroPad)[textTransform](); default: return substring; } }; return format.replace(regex, doFormat); } /* glpapi.h */ var /** @const */ GLP_PROB_MAGIC = 0xD7D9D6C2; function create_prob(lp){ lp.magic = GLP_PROB_MAGIC; //lp.pool = dmp_create_pool(); lp.parms = null; lp.tree = null; /* LP/MIP data */ lp.name = null; lp.obj = null; lp.dir = GLP_MIN; lp.c0 = 0.0; lp.m_max = 100; lp.n_max = 200; lp.m = lp.n = 0; lp.nnz = 0; lp.row = new Array(1+lp.m_max); lp.col = new Array(1+lp.n_max); lp.r_tree = {}; lp.c_tree = {}; /* basis factorization */ lp.valid = 0; lp.head = new Int32Array(1+lp.m_max); lp.bfcp = null; lp.bfd = null; /* basic solution (LP) */ lp.pbs_stat = lp.dbs_stat = GLP_UNDEF; lp.obj_val = 0.0; lp.it_cnt = 0; lp.some = 0; /* interior-point solution (LP) */ lp.ipt_stat = GLP_UNDEF; lp.ipt_obj = 0.0; /* integer solution (MIP) */ lp.mip_stat = GLP_UNDEF; lp.mip_obj = 0.0; } var glp_create_prob = exports["glp_create_prob"] = function(){ var lp = {}; create_prob(lp); return lp; }; var glp_set_prob_name = exports["glp_set_prob_name"] = function(lp, name){ var tree = lp.tree; if (tree != null && tree.reason != 0) xerror("glp_set_prob_name: operation not allowed"); lp.name = name; }; var glp_set_obj_name = exports["glp_set_obj_name"] = function(lp, name){ var tree = lp.tree; if (tree != null && tree.reason != 0) xerror("glp_set_obj_name: operation not allowed"); lp.obj = name; }; var glp_set_obj_dir = exports["glp_set_obj_dir"] = function(lp, dir){ var tree = lp.tree; if (tree != null && tree.reason != 0) xerror("glp_set_obj_dir: operation not allowed"); if (!(dir == GLP_MIN || dir == GLP_MAX)) xerror("glp_set_obj_dir: dir = " + dir + "; invalid direction flag"); lp.dir = dir; }; var glp_add_rows = exports["glp_add_rows"] = function (lp, nrs){ var tree = lp.tree; var row; /* determine new number of rows */ if (nrs < 1) xerror("glp_add_rows: nrs = " + nrs + "; invalid number of rows"); if (nrs > M_MAX - lp.m) xerror("glp_add_rows: nrs = " + nrs + "; too many rows"); var m_new = lp.m + nrs; /* increase the room, if necessary */ if (lp.m_max < m_new){ while (lp.m_max < m_new){ lp.m_max += lp.m_max; xassert(lp.m_max > 0); } lp.row.length = 1+lp.m_max; /* do not forget about the basis header */ lp.head = new Int32Array(1+lp.m_max); } /* add new rows to the end of the row list */ for (var i = lp.m+1; i <= m_new; i++) { /* create row descriptor */ lp.row[i] = row = {}; row.i = i; row.name = null; row.node = null; row.level = 0; row.origin = 0; row.klass = 0; if (tree != null) { switch (tree.reason) { case 0: break; case GLP_IROWGEN: xassert(tree.curr != null); row.level = tree.curr.level; row.origin = GLP_RF_LAZY; break; case GLP_ICUTGEN: xassert(tree.curr != null); row.level = tree.curr.level; row.origin = GLP_RF_CUT; break; default: xassert(tree != tree); } } row.type = GLP_FR; row.lb = row.ub = 0.0; row.ptr = null; row.rii = 1.0; row.stat = GLP_BS; row.bind = 0; row.prim = row.dual = 0.0; row.pval = row.dval = 0.0; row.mipx = 0.0; } /* set new number of rows */ lp.m = m_new; /* invalidate the basis factorization */ lp.valid = 0; if (tree != null && tree.reason != 0) tree.reopt = 1; /* return the ordinal number of the first row added */ return m_new - nrs + 1; }; var glp_add_cols = exports["glp_add_cols"] = function(lp, ncs){ var tree = lp.tree; var col; if (tree != null && tree.reason != 0) xerror("glp_add_cols: operation not allowed"); /* determine new number of columns */ if (ncs < 1) xerror("glp_add_cols: ncs = " + ncs + "; invalid number of columns"); if (ncs > N_MAX - lp.n) xerror("glp_add_cols: ncs = " + ncs + "; too many columns"); var n_new = lp.n + ncs; /* increase the room, if necessary */ if (lp.n_max < n_new) { while (lp.n_max < n_new) { lp.n_max += lp.n_max; xassert(lp.n_max > 0); } lp.col.length = 1+lp.n_max; } /* add new columns to the end of the column list */ for (var j = lp.n+1; j <= n_new; j++) { /* create column descriptor */ lp.col[j] = col = {}; col.j = j; col.name = null; col.node = null; col.kind = GLP_CV; col.type = GLP_FX; col.lb = col.ub = 0.0; col.coef = 0.0; col.ptr = null; col.sjj = 1.0; col.stat = GLP_NS; col.bind = 0; /* the basis may remain valid */ col.prim = col.dual = 0.0; col.pval = col.dval = 0.0; col.mipx = 0.0; } /* set new number of columns */ lp.n = n_new; /* return the ordinal number of the first column added */ return n_new - ncs + 1; }; var glp_set_row_name = exports["glp_set_row_name"] = function(lp, i, name) { var tree = lp.tree; if (!(1 <= i && i <= lp.m)) xerror("glp_set_row_name: i = " + i + "; row number out of range"); var row = lp.row[i]; if (tree != null && tree.reason != 0){ xassert(tree.curr != null); xassert(row.level == tree.curr.level); } if (row.name != null){ delete(lp.r_tree[row.name]); row.name = null; } if (name != null){ row.name = name; lp.r_tree[row.name] = row; } }; var glp_set_col_name = exports["glp_set_col_name"] = function(lp, j, name){ var tree = lp.tree; if (tree != null && tree.reason != 0) xerror("glp_set_col_name: operation not allowed"); if (!(1 <= j && j <= lp.n)) xerror("glp_set_col_name: j = " + j + "; column number out of range"); var col = lp.col[j]; if (col.name != null){ delete(lp.c_tree[col.name]); col.name = null; } if (name != null){ col.name = name; lp.c_tree[col.name] = col; } }; var glp_set_row_bnds = exports["glp_set_row_bnds"] = function(lp, i, type, lb, ub){ if (!(1 <= i && i <= lp.m)) xerror("glp_set_row_bnds: i = " + i + "; row number out of range"); var row = lp.row[i]; row.type = type; switch (type){ case GLP_FR: row.lb = row.ub = 0.0; if (row.stat != GLP_BS) row.stat = GLP_NF; break; case GLP_LO: row.lb = lb; row.ub = 0.0; if (row.stat != GLP_BS) row.stat = GLP_NL; break; case GLP_UP: row.lb = 0.0; row.ub = ub; if (row.stat != GLP_BS) row.stat = GLP_NU; break; case GLP_DB: row.lb = lb; row.ub = ub; if (!(row.stat == GLP_BS || row.stat == GLP_NL || row.stat == GLP_NU)) row.stat = (Math.abs(lb) <= Math.abs(ub) ? GLP_NL : GLP_NU); break; case GLP_FX: row.lb = row.ub = lb; if (row.stat != GLP_BS) row.stat = GLP_NS; break; default: xerror("glp_set_row_bnds: i = " + i + "; type = " + type + "; invalid row type"); } }; var glp_set_col_bnds = exports["glp_set_col_bnds"] = function(lp, j, type, lb, ub){ if (!(1 <= j && j <= lp.n)) xerror("glp_set_col_bnds: j = " + j + "; column number out of range"); var col = lp.col[j]; col.type = type; switch (type){ case GLP_FR: col.lb = col.ub = 0.0; if (col.stat != GLP_BS) col.stat = GLP_NF; break; case GLP_LO: col.lb = lb; col.ub = 0.0; if (col.stat != GLP_BS) col.stat = GLP_NL; break; case GLP_UP: col.lb = 0.0; col.ub = ub; if (col.stat != GLP_BS) col.stat = GLP_NU; break; case GLP_DB: col.lb = lb; col.ub = ub; if (!(col.stat == GLP_BS || col.stat == GLP_NL || col.stat == GLP_NU)) col.stat = (Math.abs(lb) <= Math.abs(ub) ? GLP_NL : GLP_NU); break; case GLP_FX: col.lb = col.ub = lb; if (col.stat != GLP_BS) col.stat = GLP_NS; break; default: xerror("glp_set_col_bnds: j = " + j + "; type = " + type + "; invalid column type"); } }; var glp_set_obj_coef = exports["glp_set_obj_coef"] = function(lp, j, coef){ var tree = lp.tree; if (tree != null && tree.reason != 0) xerror("glp_set_obj_coef: operation not allowed"); if (!(0 <= j && j <= lp.n)) xerror("glp_set_obj_coef: j = " + j + "; column number out of range"); if (j == 0) lp.c0 = coef; else lp.col[j].coef = coef; }; var glp_set_mat_row = exports["glp_set_mat_row"] = function(lp, i, len, ind, val){ var tree = lp.tree; var col, aij, next, j, k; /* obtain pointer to i-th row */ if (!(1 <= i && i <= lp.m)) xerror("glp_set_mat_row: i = " + i + "; row number out of range"); var row = lp.row[i]; if (tree != null && tree.reason != 0){ xassert(tree.curr != null); xassert(row.level == tree.curr.level); } /* remove all existing elements from i-th row */ while (row.ptr != null){ /* take next element in the row */ aij = row.ptr; /* remove the element from the row list */ row.ptr = aij.r_next; /* obtain pointer to corresponding column */ col = aij.col; /* remove the element from the column list */ if (aij.c_prev == null) col.ptr = aij.c_next; else aij.c_prev.c_next = aij.c_next; if (aij.c_next != null) aij.c_next.c_prev = aij.c_prev; /* return the element to the memory pool */ lp.nnz--; /* if the corresponding column is basic, invalidate the basis factorization */ if (col.stat == GLP_BS) lp.valid = 0; } /* store new contents of i-th row */ if (!(0 <= len && len <= lp.n)) xerror("glp_set_mat_row: i = " + i + "; len = " + len + "; invalid row length "); if (len > NNZ_MAX - lp.nnz) xerror("glp_set_mat_row: i = " + i + "; len = " + len + "; too many constraint coefficients"); for (k = 1; k <= len; k++){ /* take number j of corresponding column */ j = ind[k]; /* obtain pointer to j-th column */ if (!(1 <= j && j <= lp.n)) xerror("glp_set_mat_row: i = " + i + "; ind[" + k + "] = " + j + "; column index out of range"); col = lp.col[j]; /* if there is element with the same column index, it can only be found in the beginning of j-th column list */ if (col.ptr != null && col.ptr.row.i == i) xerror("glp_set_mat_row: i = " + i + "; ind[" + k + "] = " + j + "; duplicate column indices not allowed"); /* create new element */ aij = {}; lp.nnz++; aij.row = row; aij.col = col; aij.val = val[k]; /* add the new element to the beginning of i-th row and j-th column lists */ aij.r_prev = null; aij.r_next = row.ptr; aij.c_prev = null; aij.c_next = col.ptr; if (aij.r_next != null) aij.r_next.r_prev = aij; if (aij.c_next != null) aij.c_next.c_prev = aij; row.ptr = col.ptr = aij; /* if the corresponding column is basic, invalidate the basis factorization */ if (col.stat == GLP_BS && aij.val != 0.0) lp.valid = 0; } /* remove zero elements from i-th row */ for (aij = row.ptr; aij != null; aij = next) { next = aij.r_next; if (aij.val == 0.0) { /* remove the element from the row list */ if (aij.r_prev == null) row.ptr = next; else aij.r_prev.r_next = next; if (next != null) next.r_prev = aij.r_prev; /* remove the element from the column list */ xassert(aij.c_prev == null); aij.col.ptr = aij.c_next; if (aij.c_next != null) aij.c_next.c_prev = null; /* return the element to the memory pool */ lp.nnz--; } } }; var glp_set_mat_col = exports["glp_set_mat_col"] = function(lp, j, len, ind, val){ var tree = lp.tree; var row, aij, next; var i, k; if (tree != null && tree.reason != 0) xerror("glp_set_mat_col: operation not allowed"); /* obtain pointer to j-th column */ if (!(1 <= j && j <= lp.n)) xerror("glp_set_mat_col: j = " + j + "; column number out of range"); var col = lp.col[j]; /* remove all existing elements from j-th column */ while (col.ptr != null) { /* take next element in the column */ aij = col.ptr; /* remove the element from the column list */ col.ptr = aij.c_next; /* obtain pointer to corresponding row */ row = aij.row; /* remove the element from the row list */ if (aij.r_prev == null) row.ptr = aij.r_next; else aij.r_prev.r_next = aij.r_next; if (aij.r_next != null) aij.r_next.r_prev = aij.r_prev; /* return the element to the memory pool */ lp.nnz--; } /* store new contents of j-th column */ if (!(0 <= len && len <= lp.m)) xerror("glp_set_mat_col: j = " + j + "; len = " + len + "; invalid column length"); if (len > NNZ_MAX - lp.nnz) xerror("glp_set_mat_col: j = " + j + "; len = " + len + "; too many constraint coefficients"); for (k = 1; k <= len; k++){ /* take number i of corresponding row */ i = ind[k]; /* obtain pointer to i-th row */ if (!(1 <= i && i <= lp.m)) xerror("glp_set_mat_col: j = " + j + "; ind[" + k + "] = " + i + "; row index out of range"); row = lp.row[i]; /* if there is element with the same row index, it can only be found in the beginning of i-th row list */ if (row.ptr != null && row.ptr.col.j == j) xerror("glp_set_mat_col: j = " + j + "; ind[" + k + "] = " + i + "; duplicate row indices not allowed"); /* create new element */ aij = {}; lp.nnz++; aij.row = row; aij.col = col; aij.val = val[k]; /* add the new element to the beginning of i-th row and j-th column lists */ aij.r_prev = null; aij.r_next = row.ptr; aij.c_prev = null; aij.c_next = col.ptr; if (aij.r_next != null) aij.r_next.r_prev = aij; if (aij.c_next != null) aij.c_next.c_prev = aij; row.ptr = col.ptr = aij; } /* remove zero elements from j-th column */ for (aij = col.ptr; aij != null; aij = next) { next = aij.c_next; if (aij.val == 0.0) { /* remove the element from the row list */ xassert(aij.r_prev == null); aij.row.ptr = aij.r_next; if (aij.r_next != null) aij.r_next.r_prev = null; /* remove the element from the column list */ if (aij.c_prev == null) col.ptr = next; else aij.c_prev.c_next = next; if (next != null) next.c_prev = aij.c_prev; /* return the element to the memory pool */ lp.nnz--; } } /* if j-th column is basic, invalidate the basis factorization */ if (col.stat == GLP_BS) lp.valid = 0; }; var glp_load_matrix = exports["glp_load_matrix"] = function(lp, ne, ia, ja, ar){ var tree = lp.tree; var row, col, aij, next; var i, j, k; if (tree != null && tree.reason != 0) xerror("glp_load_matrix: operation not allowed"); /* clear the constraint matrix */ for (i = 1; i <= lp.m; i++){ row = lp.row[i]; while (row.ptr != null){ aij = row.ptr; row.ptr = aij.r_next; lp.nnz--; } } xassert(lp.nnz == 0); for (j = 1; j <= lp.n; j++) lp.col[j].ptr = null; /* load the new contents of the constraint matrix and build its row lists */ if (ne < 0) xerror("glp_load_matrix: ne = " + ne + "; invalid number of constraint coefficients"); if (ne > NNZ_MAX) xerror("glp_load_matrix: ne = " + ne + "; too many constraint coefficients"); for (k = 1; k <= ne; k++){ /* take indices of new element */ i = ia[k]; j = ja[k]; /* obtain pointer to i-th row */ if (!(1 <= i && i <= lp.m)) xerror("glp_load_matrix: ia[" + k + "] = " + i + "; row index out of range"); row = lp.row[i]; /* obtain pointer to j-th column */ if (!(1 <= j && j <= lp.n)) xerror("glp_load_matrix: ja[" + k + "] = " + j + "; column index out of range"); col = lp.col[j]; /* create new element */ aij = {}; lp.nnz++; aij.row = row; aij.col = col; aij.val = ar[k]; /* add the new element to the beginning of i-th row list */ aij.r_prev = null; aij.r_next = row.ptr; if (aij.r_next != null) aij.r_next.r_prev = aij; row.ptr = aij; } xassert(lp.nnz == ne); /* build column lists of the constraint matrix and check elements with identical indices */ for (i = 1; i <= lp.m; i++){ for (aij = lp.row[i].ptr; aij != null; aij = aij.r_next){ /* obtain pointer to corresponding column */ col = aij.col; /* if there is element with identical indices, it can only be found in the beginning of j-th column list */ if (col.ptr != null && col.ptr.row.i == i){ for (k = 1; k <= ne; k++) if (ia[k] == i && ja[k] == col.j) break; xerror("glp_load_mat: ia[" + k + "] = " + i + "; ja[" + k + "] = " + col.j + "; duplicate indices not allowed"); } /* add the element to the beginning of j-th column list */ aij.c_prev = null; aij.c_next = col.ptr; if (aij.c_next != null) aij.c_next.c_prev = aij; col.ptr = aij; } } /* remove zero elements from the constraint matrix */ for (i = 1; i <= lp.m; i++) { row = lp.row[i]; for (aij = row.ptr; aij != null; aij = next) { next = aij.r_next; if (aij.val == 0.0) { /* remove the element from the row list */ if (aij.r_prev == null) row.ptr = next; else aij.r_prev.r_next = next; if (next != null) next.r_prev = aij.r_prev; /* remove the element from the column list */ if (aij.c_prev == null) aij.col.ptr = aij.c_next; else aij.c_prev.c_next = aij.c_next; if (aij.c_next != null) aij.c_next.c_prev = aij.c_prev; /* return the element to the memory pool */ lp.nnz--; } } } /* invalidate the basis factorization */ lp.valid = 0; }; var glp_check_dup = exports["glp_check_dup"] = function(m, n, ne, ia, ja){ var i, j, k, ptr, next, ret; var flag; if (m < 0) xerror("glp_check_dup: m = %d; invalid parameter"); if (n < 0) xerror("glp_check_dup: n = %d; invalid parameter"); if (ne < 0) xerror("glp_check_dup: ne = %d; invalid parameter"); if (ne > 0 && ia == null) xerror("glp_check_dup: ia = " + ia + "; invalid parameter"); if (ne > 0 && ja == null) xerror("glp_check_dup: ja = " + ja + "; invalid parameter"); for (k = 1; k <= ne; k++){ i = ia[k]; j = ja[k]; if (!(1 <= i && i <= m && 1 <= j && j <= n)){ ret = -k; return ret; } } if (m == 0 || n == 0) { ret = 0; return ret; } /* allocate working arrays */ ptr = new Int32Array(1+m); next = new Int32Array(1+ne); flag = new Int8Array(1+n); /* build row lists */ for (k = 1; k <= ne; k++){ i = ia[k]; next[k] = ptr[i]; ptr[i] = k; } /* check for duplicate elements */ for (i = 1; i <= m; i++){ for (k = ptr[i]; k != 0; k = next[k]){ j = ja[k]; if (flag[j]){ /* find first element (i,j) */ for (k = 1; k <= ne; k++) if (ia[k] == i && ja[k] == j) break; xassert(k <= ne); /* find next (duplicate) element (i,j) */ for (k++; k <= ne; k++) if (ia[k] == i && ja[k] == j) break; xassert(k <= ne); ret = +k; return ret; } flag[j] = 1; } /* clear column flags */ for (k = ptr[i]; k != 0; k = next[k]) flag[ja[k]] = 0; } /* no duplicate element found */ ret = 0; return ret; }; var glp_sort_matrix = exports["glp_sort_matrix"] = function(P){ var aij; var i, j; if (P == null || P.magic != GLP_PROB_MAGIC) xerror("glp_sort_matrix: P = " + P + "; invalid problem object"); /* rebuild row linked lists */ for (i = P.m; i >= 1; i--) P.row[i].ptr = null; for (j = P.n; j >= 1; j--){ for (aij = P.col[j].ptr; aij != null; aij = aij.c_next){ i = aij.row.i; aij.r_prev = null; aij.r_next = P.row[i].ptr; if (aij.r_next != null) aij.r_next.r_prev = aij; P.row[i].ptr = aij; } } /* rebuild column linked lists */ for (j = P.n; j >= 1; j--) P.col[j].ptr = null; for (i = P.m; i >= 1; i--){ for (aij = P.row[i].ptr; aij != null; aij = aij.r_next){ j = aij.col.j; aij.c_prev = null; aij.c_next = P.col[j].ptr; if (aij.c_next != null) aij.c_next.c_prev = aij; P.col[j].ptr = aij; } } }; var glp_del_rows = exports["glp_del_rows"] = function(lp, nrs, num){ var tree = lp.tree; var row; var i, k, m_new; /* mark rows to be deleted */ if (!(1 <= nrs && nrs <= lp.m)) xerror("glp_del_rows: nrs = " + nrs + "; invalid number of rows"); for (k = 1; k <= nrs; k++){ /* take the number of row to be deleted */ i = num[k]; /* obtain pointer to i-th row */ if (!(1 <= i && i <= lp.m)) xerror("glp_del_rows: num[" + k + "] = " + i + "; row number out of range"); row = lp.row[i]; if (tree != null && tree.reason != 0){ if (!(tree.reason == GLP_IROWGEN || tree.reason == GLP_ICUTGEN)) xerror("glp_del_rows: operation not allowed"); xassert(tree.curr != null); if (row.level != tree.curr.level) xerror("glp_del_rows: num[" + k + "] = " + i + "; invalid attempt to delete row created not in current subproblem"); if (row.stat != GLP_BS) xerror("glp_del_rows: num[" + k + "] = " + i + "; invalid attempt to delete active row (constraint)"); tree.reinv = 1; } /* check that the row is not marked yet */ if (row.i == 0) xerror("glp_del_rows: num[" + k + "] = " + i + "; duplicate row numbers not allowed"); /* erase symbolic name assigned to the row */ glp_set_row_name(lp, i, null); xassert(row.node == null); /* erase corresponding row of the constraint matrix */ glp_set_mat_row(lp, i, 0, null, null); xassert(row.ptr == null); /* mark the row to be deleted */ row.i = 0; } /* delete all marked rows from the row list */ m_new = 0; for (i = 1; i <= lp.m; i++){ /* obtain pointer to i-th row */ row = lp.row[i]; /* check if the row is marked */ if (row.i != 0){ /* it is not marked; keep it */ row.i = ++m_new; lp.row[row.i] = row; } } /* set new number of rows */ lp.m = m_new; /* invalidate the basis factorization */ lp.valid = 0; }; var glp_del_cols = exports["glp_del_cols"] = function(lp, ncs, num){ var tree = lp.tree; var col; var j, k, n_new; if (tree != null && tree.reason != 0) xerror("glp_del_cols: operation not allowed"); /* mark columns to be deleted */ if (!(1 <= ncs && ncs <= lp.n)) xerror("glp_del_cols: ncs = " + ncs + "; invalid number of columns"); for (k = 1; k <= ncs; k++){ /* take the number of column to be deleted */ j = num[k]; /* obtain pointer to j-th column */ if (!(1 <= j && j <= lp.n)) xerror("glp_del_cols: num[" + k + "] = " + j + "; column number out of range"); col = lp.col[j]; /* check that the column is not marked yet */ if (col.j == 0) xerror("glp_del_cols: num[" + k + "] = " + j + "; duplicate column numbers not allowed"); /* erase symbolic name assigned to the column */ glp_set_col_name(lp, j, null); xassert(col.node == null); /* erase corresponding column of the constraint matrix */ glp_set_mat_col(lp, j, 0, null, null); xassert(col.ptr == null); /* mark the column to be deleted */ col.j = 0; /* if it is basic, invalidate the basis factorization */ if (col.stat == GLP_BS) lp.valid = 0; } /* delete all marked columns from the column list */ n_new = 0; for (j = 1; j <= lp.n; j++) { /* obtain pointer to j-th column */ col = lp.col[j]; /* check if the column is marked */ if (col.j != 0){ /* it is not marked; keep it */ col.j = ++n_new; lp.col[col.j] = col; } } /* set new number of columns */ lp.n = n_new; /* if the basis header is still valid, adjust it */ if (lp.valid){ var m = lp.m; var head = lp.head; for (j = 1; j <= n_new; j++){ k = lp.col[j].bind; if (k != 0){ xassert(1 <= k && k <= m); head[k] = m + j; } } } }; var glp_copy_prob = exports["glp_copy_prob"] = function(dest, prob, names){ var tree = dest.tree; var bfcp = {}; var i, j, len, ind; var val; if (tree != null && tree.reason != 0) xerror("glp_copy_prob: operation not allowed"); if (dest == prob) xerror("glp_copy_prob: copying problem object to itself not allowed"); if (!(names == GLP_ON || names == GLP_OFF)) xerror("glp_copy_prob: names = " + names + "; invalid parameter"); glp_erase_prob(dest); if (names && prob.name != null) glp_set_prob_name(dest, prob.name); if (names && prob.obj != null) glp_set_obj_name(dest, prob.obj); dest.dir = prob.dir; dest.c0 = prob.c0; if (prob.m > 0) glp_add_rows(dest, prob.m); if (prob.n > 0) glp_add_cols(dest, prob.n); glp_get_bfcp(prob, bfcp); glp_set_bfcp(dest, bfcp); dest.pbs_stat = prob.pbs_stat; dest.dbs_stat = prob.dbs_stat; dest.obj_val = prob.obj_val; dest.some = prob.some; dest.ipt_stat = prob.ipt_stat; dest.ipt_obj = prob.ipt_obj; dest.mip_stat = prob.mip_stat; dest.mip_obj = prob.mip_obj; var to, from; for (i = 1; i <= prob.m; i++){ to = dest.row[i]; from = prob.row[i]; if (names && from.name != null) glp_set_row_name(dest, i, from.name); to.type = from.type; to.lb = from.lb; to.ub = from.ub; to.rii = from.rii; to.stat = from.stat; to.prim = from.prim; to.dual = from.dual; to.pval = from.pval; to.dval = from.dval; to.mipx = from.mipx; } ind = new Int32Array(1+prob.m); val = new Float64Array(1+prob.m); for (j = 1; j <= prob.n; j++){ to = dest.col[j]; from = prob.col[j]; if (names && from.name != null) glp_set_col_name(dest, j, from.name); to.kind = from.kind; to.type = from.type; to.lb = from.lb; to.ub = from.ub; to.coef = from.coef; len = glp_get_mat_col(prob, j, ind, val); glp_set_mat_col(dest, j, len, ind, val); to.sjj = from.sjj; to.stat = from.stat; to.prim = from.prim; to.dual = from.dual; to.pval = from.pval; to.dval = from.dval; to.mipx = from.mipx; } }; var glp_erase_prob = exports["glp_erase_prob"] = function(lp){ var tree = lp.tree; if (tree != null && tree.reason != 0) xerror("glp_erase_prob: operation not allowed"); delete_prob(lp); create_prob(lp); }; function delete_prob(lp){ lp.magic = 0x3F3F3F3F; lp.parms = null; xassert(lp.tree == null); lp.row = null; lp.col = null; lp.r_tree = null; lp.c_tree = null; lp.head = null; lp.bfcp = null; lp.bfd = null; } var glp_get_prob_name = exports["glp_get_prob_name"] = function(lp){ return lp.name; }; var glp_get_obj_name = exports["glp_get_obj_name"] = function(lp){ return lp.obj; }; var glp_get_obj_dir = exports["glp_get_obj_dir"] = function(lp){ return lp.dir; }; var glp_get_num_rows = exports["glp_get_num_rows"] = function(lp){ return lp.m; }; var glp_get_num_cols = exports["glp_get_num_cols"] = function(lp){ return lp.n; }; var glp_get_row_name = exports["glp_get_row_name"] = function(lp, i){ if (!(1 <= i && i <= lp.m)) xerror("glp_get_row_name: i = " + i + "; row number out of range"); return lp.row[i].name; }; var glp_get_col_name = exports["glp_get_col_name"] = function(lp, j){ if (!(1 <= j && j <= lp.n)) xerror("glp_get_col_name: j = " + j + "; column number out of range"); return lp.col[j].name; }; var glp_get_row_type = exports["glp_get_row_type"] = function(lp, i){ if (!(1 <= i && i <= lp.m)) xerror("glp_get_row_type: i = " + i + "; row number out of range"); return lp.row[i].type; }; var glp_get_row_lb = exports["glp_get_row_lb"] = function(lp, i){ var lb; if (!(1 <= i && i <= lp.m)) xerror("glp_get_row_lb: i = " + i + "; row number out of range"); switch (lp.row[i].type){ case GLP_FR: case GLP_UP: lb = -DBL_MAX; break; case GLP_LO: case GLP_DB: case GLP_FX: lb = lp.row[i].lb; break; default: xassert(lp != lp); } return lb; }; var glp_get_row_ub = exports["glp_get_row_ub"] = function(lp, i){ var ub; if (!(1 <= i && i <= lp.m)) xerror("glp_get_row_ub: i = " + i + "; row number out of range"); switch (lp.row[i].type){ case GLP_FR: case GLP_LO: ub = +DBL_MAX; break; case GLP_UP: case GLP_DB: case GLP_FX: ub = lp.row[i].ub; break; default: xassert(lp != lp); } return ub; }; var glp_get_col_type = exports["glp_get_col_type"] = function(lp, j) { if (!(1 <= j && j <= lp.n)) xerror("glp_get_col_type: j = " + j + "; column number out of range"); return lp.col[j].type; }; var glp_get_col_lb = exports["glp_get_col_lb"] = function(lp, j){ var lb; if (!(1 <= j && j <= lp.n)) xerror("glp_get_col_lb: j = " + j + "; column number out of range"); switch (lp.col[j].type){ case GLP_FR: case GLP_UP: lb = -DBL_MAX; break; case GLP_LO: case GLP_DB: case GLP_FX: lb = lp.col[j].lb; break; default: xassert(lp != lp); } return lb; }; var glp_get_col_ub = exports["glp_get_col_ub"] = function(lp, j){ var ub; if (!(1 <= j && j <= lp.n)) xerror("glp_get_col_ub: j = " + j + "; column number out of range"); switch (lp.col[j].type){ case GLP_FR: case GLP_LO: ub = +DBL_MAX; break; case GLP_UP: case GLP_DB: case GLP_FX: ub = lp.col[j].ub; break; default: xassert(lp != lp); } return ub; }; var glp_get_obj_coef = exports["glp_get_obj_coef"] = function(lp, j){ if (!(0 <= j && j <= lp.n)) xerror("glp_get_obj_coef: j = " + j + "; column number out of range"); return j == 0 ? lp.c0 : lp.col[j].coef; }; var glp_get_num_nz = exports["glp_get_num_nz"] = function (lp){ return lp.nnz; }; var glp_get_mat_row = exports["glp_get_mat_row"] = function(lp, i, ind, val){ var aij; var len; if (!(1 <= i && i <= lp.m)) xerror("glp_get_mat_row: i = " + i + "; row number out of range"); len = 0; for (aij = lp.row[i].ptr; aij != null; aij = aij.r_next){ len++; if (ind != null) ind[len] = aij.col.j; if (val != null) val[len] = aij.val; } xassert(len <= lp.n); return len; }; var glp_get_mat_col = exports["glp_get_mat_col"] = function(lp, j, ind, val){ var aij; var len; if (!(1 <= j && j <= lp.n)) xerror("glp_get_mat_col: j = " + j + "; column number out of range"); len = 0; for (aij = lp.col[j].ptr; aij != null; aij = aij.c_next){ len++; if (ind != null) ind[len] = aij.row.i; if (val != null) val[len] = aij.val; } xassert(len <= lp.m); return len; }; var glp_create_index = exports["glp_create_index"] = function(lp){ var row; var col; var i, j; /* create row name index */ if (lp.r_tree == null){ lp.r_tree = {}; for (i = 1; i <= lp.m; i++){ row = lp.row[i]; if (row.name != null){ lp.r_tree[row.name] = row; } } } /* create column name index */ if (lp.c_tree == null) { lp.c_tree = {}; for (j = 1; j <= lp.n; j++){ col = lp.col[j]; if (col.name != null){ lp.c_tree[col.name] = col; } } } }; var glp_find_row = exports["glp_find_row"] = function(lp, name){ var i = 0; if (lp.r_tree == null) xerror("glp_find_row: row name index does not exist"); var row = lp.r_tree[name]; if (row) i = row.i; return i; }; var glp_find_col = exports["glp_find_col"] = function(lp, name){ var j = 0; if (lp.c_tree == null) xerror("glp_find_col: column name index does not exist"); var col = lp.c_tree[name]; if (col) j = col.j; return j; }; var glp_delete_index = exports["glp_delete_index"] = function(lp){ lp.r_tree = null; lp.r_tree = null; }; var glp_set_rii = exports["glp_set_rii"] = function(lp, i, rii){ if (!(1 <= i && i <= lp.m)) xerror("glp_set_rii: i = " + i + "; row number out of range"); if (rii <= 0.0) xerror("glp_set_rii: i = " + i + "; rii = " + rii + "; invalid scale factor"); if (lp.valid && lp.row[i].rii != rii){ for (var aij = lp.row[i].ptr; aij != null; aij = aij.r_next){ if (aij.col.stat == GLP_BS){ /* invalidate the basis factorization */ lp.valid = 0; break; } } } lp.row[i].rii = rii; }; var glp_set_sjj = exports["glp_set_sjj"] = function(lp, j, sjj){ if (!(1 <= j && j <= lp.n)) xerror("glp_set_sjj: j = " + j + "; column number out of range"); if (sjj <= 0.0) xerror("glp_set_sjj: j = " + j + "; sjj = " + sjj + "; invalid scale factor"); if (lp.valid && lp.col[j].sjj != sjj && lp.col[j].stat == GLP_BS){ /* invalidate the basis factorization */ lp.valid = 0; } lp.col[j].sjj = sjj; }; var glp_get_rii = exports["glp_get_rii"] = function(lp, i){ if (!(1 <= i && i <= lp.m)) xerror("glp_get_rii: i = " + i + "; row number out of range"); return lp.row[i].rii; }; var glp_get_sjj = exports["glp_get_sjj"] = function(lp, j){ if (!(1 <= j && j <= lp.n)) xerror("glp_get_sjj: j = " + j + "; column number out of range"); return lp.col[j].sjj; }; var glp_unscale_prob = exports["glp_unscale_prob"] = function(lp){ var m = glp_get_num_rows(lp); var n = glp_get_num_cols(lp); var i, j; for (i = 1; i <= m; i++) glp_set_rii(lp, i, 1.0); for (j = 1; j <= n; j++) glp_set_sjj(lp, j, 1.0); }; var glp_set_row_stat = exports["glp_set_row_stat"] = function(lp, i, stat){ var row; if (!(1 <= i && i <= lp.m)) xerror("glp_set_row_stat: i = " + i + "; row number out of range"); if (!(stat == GLP_BS || stat == GLP_NL || stat == GLP_NU || stat == GLP_NF || stat == GLP_NS)) xerror("glp_set_row_stat: i = " + i + "; stat = " + stat + "; invalid status"); row = lp.row[i]; if (stat != GLP_BS){ switch (row.type){ case GLP_FR: stat = GLP_NF; break; case GLP_LO: stat = GLP_NL; break; case GLP_UP: stat = GLP_NU; break; case GLP_DB: if (stat != GLP_NU) stat = GLP_NL; break; case GLP_FX: stat = GLP_NS; break; default: xassert(row != row); } } if (row.stat == GLP_BS && stat != GLP_BS || row.stat != GLP_BS && stat == GLP_BS){ /* invalidate the basis factorization */ lp.valid = 0; } row.stat = stat; }; var glp_set_col_stat = exports["glp_set_col_stat"] = function(lp, j, stat){ var col; if (!(1 <= j && j <= lp.n)) xerror("glp_set_col_stat: j = " + j + "; column number out of range"); if (!(stat == GLP_BS || stat == GLP_NL || stat == GLP_NU || stat == GLP_NF || stat == GLP_NS)) xerror("glp_set_col_stat: j = " + j + "; stat = " + stat + "; invalid status"); col = lp.col[j]; if (stat != GLP_BS){ switch (col.type){ case GLP_FR: stat = GLP_NF; break; case GLP_LO: stat = GLP_NL; break; case GLP_UP: stat = GLP_NU; break; case GLP_DB: if (stat != GLP_NU) stat = GLP_NL; break; case GLP_FX: stat = GLP_NS; break; default: xassert(col != col); } } if (col.stat == GLP_BS && stat != GLP_BS || col.stat != GLP_BS && stat == GLP_BS){ /* invalidate the basis factorization */ lp.valid = 0; } col.stat = stat; }; var glp_std_basis = exports["glp_std_basis"] = function(lp){ var i, j; /* make all auxiliary variables basic */ for (i = 1; i <= lp.m; i++) glp_set_row_stat(lp, i, GLP_BS); /* make all structural variables non-basic */ for (j = 1; j <= lp.n; j++){ var col = lp.col[j]; if (col.type == GLP_DB && Math.abs(col.lb) > Math.abs(col.ub)) glp_set_col_stat(lp, j, GLP_NU); else glp_set_col_stat(lp, j, GLP_NL); } }; var glp_simplex = exports["glp_simplex"] = function(P, parm){ function solve_lp(P, parm){ /* solve LP directly without using the preprocessor */ var ret; if (!glp_bf_exists(P)){ ret = glp_factorize(P); if (ret == 0){ } else if (ret == GLP_EBADB){ if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: initial basis is invalid"); } else if (ret == GLP_ESING){ if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: initial basis is singular"); } else if (ret == GLP_ECOND){ if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: initial basis is ill-conditioned"); } else xassert(ret != ret); if (ret != 0) return ret; } if (parm.meth == GLP_PRIMAL) ret = spx_primal(P, parm); else if (parm.meth == GLP_DUALP) { ret = spx_dual(P, parm); if (ret == GLP_EFAIL && P.valid) ret = spx_primal(P, parm); } else if (parm.meth == GLP_DUAL) ret = spx_dual(P, parm); else xassert(parm != parm); return ret; } function preprocess_and_solve_lp(P, parm){ /* solve LP using the preprocessor */ var npp; var lp = null; var bfcp = {}; var ret; function post(){ /* postprocess solution from the transformed LP */ npp_postprocess(npp, lp); /* the transformed LP is no longer needed */ lp = null; /* store solution to the original problem */ npp_unload_sol(npp, P); /* the original LP has been successfully solved */ ret = 0; return ret; } if (parm.msg_lev >= GLP_MSG_ALL) xprintf("Preprocessing..."); /* create preprocessor workspace */ npp = npp_create_wksp(); /* load original problem into the preprocessor workspace */ npp_load_prob(npp, P, GLP_OFF, GLP_SOL, GLP_OFF); /* process LP prior to applying primal/dual simplex method */ ret = npp_simplex(npp, parm); if (ret == 0) { } else if (ret == GLP_ENOPFS) { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO PRIMAL FEASIBLE SOLUTION"); } else if (ret == GLP_ENODFS) { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO DUAL FEASIBLE SOLUTION"); } else xassert(ret != ret); if (ret != 0) return ret; /* build transformed LP */ lp = glp_create_prob(); npp_build_prob(npp, lp); /* if the transformed LP is empty, it has empty solution, which is optimal */ if (lp.m == 0 && lp.n == 0) { lp.pbs_stat = lp.dbs_stat = GLP_FEAS; lp.obj_val = lp.c0; if (parm.msg_lev >= GLP_MSG_ON && parm.out_dly == 0) { xprintf(P.it_cnt + ": obj = " + lp.obj_val + " infeas = 0.0"); } if (parm.msg_lev >= GLP_MSG_ALL) xprintf("OPTIMAL SOLUTION FOUND BY LP PREPROCESSOR"); return post(); } if (parm.msg_lev >= GLP_MSG_ALL) { xprintf(lp.m + " row" + (lp.m == 1 ? "" : "s") + ", " + lp.n + " column" + (lp.n == 1 ? "" : "s") + ", " + lp.nnz + " non-zero" + (lp.nnz == 1 ? "" : "s") + ""); } /* inherit basis factorization control parameters */ glp_get_bfcp(P, bfcp); glp_set_bfcp(lp, bfcp); /* scale the transformed problem */ { var env = get_env_ptr(); var term_out = env.term_out; if (!term_out || parm.msg_lev < GLP_MSG_ALL) env.term_out = GLP_OFF; else env.term_out = GLP_ON; glp_scale_prob(lp, GLP_SF_AUTO); env.term_out = term_out; } /* build advanced initial basis */ { env = get_env_ptr(); term_out = env.term_out; if (!term_out || parm.msg_lev < GLP_MSG_ALL) env.term_out = GLP_OFF; else env.term_out = GLP_ON; glp_adv_basis(lp, 0); env.term_out = term_out; } /* solve the transformed LP */ lp.it_cnt = P.it_cnt; ret = solve_lp(lp, parm); P.it_cnt = lp.it_cnt; /* only optimal solution can be postprocessed */ if (!(ret == 0 && lp.pbs_stat == GLP_FEAS && lp.dbs_stat == GLP_FEAS)){ if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: unable to recover undefined or non-optimal solution"); if (ret == 0){ if (lp.pbs_stat == GLP_NOFEAS) ret = GLP_ENOPFS; else if (lp.dbs_stat == GLP_NOFEAS) ret = GLP_ENODFS; else xassert(lp != lp); } return ret; } return post(); } function trivial_lp(P, parm){ /* solve trivial LP which has empty constraint matrix */ var row, col; var i, j; var p_infeas, d_infeas, zeta; P.valid = 0; P.pbs_stat = P.dbs_stat = GLP_FEAS; P.obj_val = P.c0; P.some = 0; p_infeas = d_infeas = 0.0; /* make all auxiliary variables basic */ for (i = 1; i <= P.m; i++){ row = P.row[i]; row.stat = GLP_BS; row.prim = row.dual = 0.0; /* check primal feasibility */ if (row.type == GLP_LO || row.type == GLP_DB || row.type == GLP_FX){ /* row has lower bound */ if (row.lb > + parm.tol_bnd){ P.pbs_stat = GLP_NOFEAS; if (P.some == 0 && parm.meth != GLP_PRIMAL) P.some = i; } if (p_infeas < + row.lb) p_infeas = + row.lb; } if (row.type == GLP_UP || row.type == GLP_DB || row.type == GLP_FX){ /* row has upper bound */ if (row.ub < - parm.tol_bnd){ P.pbs_stat = GLP_NOFEAS; if (P.some == 0 && parm.meth != GLP_PRIMAL) P.some = i; } if (p_infeas < - row.ub) p_infeas = - row.ub; } } /* determine scale factor for the objective row */ zeta = 1.0; for (j = 1; j <= P.n; j++) { col = P.col[j]; if (zeta < Math.abs(col.coef)) zeta = Math.abs(col.coef); } zeta = (P.dir == GLP_MIN ? +1.0 : -1.0) / zeta; /* make all structural variables non-basic */ function lo(){col.stat = GLP_NL; col.prim = col.lb} function up(){col.stat = GLP_NU; col.prim = col.ub} for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.type == GLP_FR){ col.stat = GLP_NF; col.prim = 0.0; } else if (col.type == GLP_LO) lo(); else if (col.type == GLP_UP) up(); else if (col.type == GLP_DB) { if (zeta * col.coef > 0.0) lo(); else if (zeta * col.coef < 0.0) up(); else if (Math.abs(col.lb) <= Math.abs(col.ub)) lo(); else up(); } else if (col.type == GLP_FX){ col.stat = GLP_NS; col.prim = col.lb; } col.dual = col.coef; P.obj_val += col.coef * col.prim; /* check dual feasibility */ if (col.type == GLP_FR || col.type == GLP_LO){ /* column has no upper bound */ if (zeta * col.dual < - parm.tol_dj){ P.dbs_stat = GLP_NOFEAS; if (P.some == 0 && parm.meth == GLP_PRIMAL) P.some = P.m + j; } if (d_infeas < - zeta * col.dual) d_infeas = - zeta * col.dual; } if (col.type == GLP_FR || col.type == GLP_UP) { /* column has no lower bound */ if (zeta * col.dual > + parm.tol_dj) { P.dbs_stat = GLP_NOFEAS; if (P.some == 0 && parm.meth == GLP_PRIMAL) P.some = P.m + j; } if (d_infeas < + zeta * col.dual) d_infeas = + zeta * col.dual; } } /* simulate the simplex solver output */ if (parm.msg_lev >= GLP_MSG_ON && parm.out_dly == 0){ xprintf("~" + P.it_cnt + ": obj = " + P.obj_val + " infeas = " + (parm.meth == GLP_PRIMAL ? p_infeas : d_infeas) + ""); } if (parm.msg_lev >= GLP_MSG_ALL && parm.out_dly == 0){ if (P.pbs_stat == GLP_FEAS && P.dbs_stat == GLP_FEAS) xprintf("OPTIMAL SOLUTION FOUND"); else if (P.pbs_stat == GLP_NOFEAS) xprintf("PROBLEM HAS NO FEASIBLE SOLUTION"); else if (parm.meth == GLP_PRIMAL) xprintf("PROBLEM HAS UNBOUNDED SOLUTION"); else xprintf("PROBLEM HAS NO DUAL FEASIBLE SOLUTION"); } } /* solve LP problem with the simplex method */ var i, j, ret; /* check problem object */ if (P == null || P.magic != GLP_PROB_MAGIC) xerror("glp_simplex: P = " + P + "; invalid problem object"); if (P.tree != null && P.tree.reason != 0) xerror("glp_simplex: operation not allowed"); /* check control parameters */ if (parm == null){ parm = new SMCP(); } if (!(parm.msg_lev == GLP_MSG_OFF || parm.msg_lev == GLP_MSG_ERR || parm.msg_lev == GLP_MSG_ON || parm.msg_lev == GLP_MSG_ALL || parm.msg_lev == GLP_MSG_DBG)) xerror("glp_simplex: msg_lev = " + parm.msg_lev + "; invalid parameter"); if (!(parm.meth == GLP_PRIMAL || parm.meth == GLP_DUALP || parm.meth == GLP_DUAL)) xerror("glp_simplex: meth = " + parm.meth + "; invalid parameter"); if (!(parm.pricing == GLP_PT_STD || parm.pricing == GLP_PT_PSE)) xerror("glp_simplex: pricing = " + parm.pricing + "; invalid parameter"); if (!(parm.r_test == GLP_RT_STD || parm.r_test == GLP_RT_HAR)) xerror("glp_simplex: r_test = " + parm.r_test + "; invalid parameter"); if (!(0.0 < parm.tol_bnd && parm.tol_bnd < 1.0)) xerror("glp_simplex: tol_bnd = " + parm.tol_bnd + "; invalid parameter"); if (!(0.0 < parm.tol_dj && parm.tol_dj < 1.0)) xerror("glp_simplex: tol_dj = " + parm.tol_dj + "; invalid parameter"); if (!(0.0 < parm.tol_piv && parm.tol_piv < 1.0)) xerror("glp_simplex: tol_piv = " + parm.tol_piv + "; invalid parameter"); if (parm.it_lim < 0) xerror("glp_simplex: it_lim = " + parm.it_lim + "; invalid parameter"); if (parm.tm_lim < 0) xerror("glp_simplex: tm_lim = " + parm.tm_lim + "; invalid parameter"); if (parm.out_frq < 1) xerror("glp_simplex: out_frq = " + parm.out_frq + "; invalid parameter"); if (parm.out_dly < 0) xerror("glp_simplex: out_dly = " + parm.out_dly + "; invalid parameter"); if (!(parm.presolve == GLP_ON || parm.presolve == GLP_OFF)) xerror("glp_simplex: presolve = " + parm.presolve + "; invalid parameter"); /* basic solution is currently undefined */ P.pbs_stat = P.dbs_stat = GLP_UNDEF; P.obj_val = 0.0; P.some = 0; /* check bounds of double-bounded variables */ for (i = 1; i <= P.m; i++) { var row = P.row[i]; if (row.type == GLP_DB && row.lb >= row.ub) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: row " + i + ": lb = " + row.lb + ", ub = " + row.ub + "; incorrect bounds"); ret = GLP_EBOUND; return ret; } } for (j = 1; j <= P.n; j++) { var col = P.col[j]; if (col.type == GLP_DB && col.lb >= col.ub) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_simplex: column " + j + ": lb = " + col.lb + ", ub = " + col.ub + "; incorrect bounds"); ret = GLP_EBOUND; return ret; } } /* solve LP problem */ if (parm.msg_lev >= GLP_MSG_ALL) { xprintf("GLPK Simplex Optimizer, v" + glp_version() + ""); xprintf(P.m + " row" + (P.m == 1 ? "" : "s") + ", " + P.n + " column" + (P.n == 1 ? "" : "s") + ", " + P.nnz + " non-zero" + (P.nnz == 1 ? "" : "s") + ""); } if (P.nnz == 0){ trivial_lp(P, parm); ret = 0; } else if (!parm.presolve) ret = solve_lp(P, parm); else ret = preprocess_and_solve_lp(P, parm); /* return to the application program */ return ret; }; /*********************************************************************** * NAME * * glp_init_smcp - initialize simplex method control parameters * * SYNOPSIS * * void glp_init_smcp(glp_smcp *parm); * * DESCRIPTION * * The routine glp_init_smcp initializes control parameters, which are * used by the simplex solver, with default values. * * Default values of the control parameters are stored in a glp_smcp * structure, which the parameter parm points to. */ var SMCP = exports["SMCP"] = /**@constructor*/ function(options){ options = options || {}; this.msg_lev = options["msg_lev"] || GLP_MSG_ALL; this.meth = options["meth"] || GLP_PRIMAL; this.pricing = options["pricing"] || GLP_PT_PSE; this.r_test = options["r_test"] || GLP_RT_HAR; this.tol_bnd = options["tol_bnd"] || 1e-7; this.tol_dj = options["tol_dj"] || 1e-7; this.tol_piv = options["tol_piv"] || 1e-10; this.obj_ll = options["obj_ll"] || -DBL_MAX; this.obj_ul = options["obj_ul"] || +DBL_MAX; this.it_lim = options["it_lim"] || INT_MAX; this.tm_lim = options["tm_lim"] || INT_MAX; this.out_frq = options["out_frq"] || 500; this.out_dly = options["out_dly"] || 0; this.presolve = options["presolve"] || GLP_OFF; }; /*********************************************************************** * NAME * * glp_get_status - retrieve generic status of basic solution * * SYNOPSIS * * int glp_get_status(glp_prob *lp); * * RETURNS * * The routine glp_get_status reports the generic status of the basic * solution for the specified problem object as follows: * * GLP_OPT - solution is optimal; * GLP_FEAS - solution is feasible; * GLP_INFEAS - solution is infeasible; * GLP_NOFEAS - problem has no feasible solution; * GLP_UNBND - problem has unbounded solution; * GLP_UNDEF - solution is undefined. */ var glp_get_status = exports["glp_get_status"] = function(lp){ var status; status = glp_get_prim_stat(lp); switch (status) { case GLP_FEAS: switch (glp_get_dual_stat(lp)) { case GLP_FEAS: status = GLP_OPT; break; case GLP_NOFEAS: status = GLP_UNBND; break; case GLP_UNDEF: case GLP_INFEAS: //status = status; break; default: xassert(lp != lp); } break; case GLP_UNDEF: case GLP_INFEAS: case GLP_NOFEAS: //status = status; break; default: xassert(lp != lp); } return status; }; var glp_get_prim_stat = exports["glp_get_prim_stat"] = function(lp){ return lp.pbs_stat; }; var glp_get_dual_stat = exports["glp_get_dual_stat"] = function(lp){ return lp.dbs_stat; }; var glp_get_obj_val = exports["glp_get_obj_val"] = function(lp){ return lp.obj_val; }; var glp_get_row_stat = exports["glp_get_row_stat"] = function(lp, i){ if (!(1 <= i && i <= lp.m)) xerror("glp_get_row_stat: i = " + i + "; row number out of range"); return lp.row[i].stat; }; var glp_get_row_prim = exports["glp_get_row_prim"] = function(lp, i){ if (!(1 <= i && i <= lp.m)) xerror("glp_get_row_prim: i = " + i + "; row number out of range"); return lp.row[i].prim; }; var glp_get_row_dual = exports["glp_get_row_dual"] = function(lp, i){ if (!(1 <= i && i <= lp.m)) xerror("glp_get_row_dual: i = " + i + "; row number out of range"); return lp.row[i].dual; }; var glp_get_col_stat = exports["glp_get_col_stat"] = function(lp, j){ if (!(1 <= j && j <= lp.n)) xerror("glp_get_col_stat: j = " + j + "; column number out of range"); return lp.col[j].stat; }; var glp_get_col_prim = exports["glp_get_col_prim"] = function(lp, j){ if (!(1 <= j && j <= lp.n)) xerror("glp_get_col_prim: j = " + j + "; column number out of range"); return lp.col[j].prim; }; var glp_get_col_dual = exports["glp_get_col_dual"] = function(lp, j){ if (!(1 <= j && j <= lp.n)) xerror("glp_get_col_dual: j = " + j + "; column number out of range"); return lp.col[j].dual; }; var glp_get_unbnd_ray = exports["glp_get_unbnd_ray"] = function(lp){ var k = lp.some; xassert(k >= 0); if (k > lp.m + lp.n) k = 0; return k; }; var glp_set_col_kind = exports["glp_set_col_kind"] = function(mip, j, kind){ if (!(1 <= j && j <= mip.n)) xerror("glp_set_col_kind: j = " + j + "; column number out of range"); var col = mip.col[j]; switch (kind) { case GLP_CV: col.kind = GLP_CV; break; case GLP_IV: col.kind = GLP_IV; break; case GLP_BV: col.kind = GLP_IV; if (!(col.type == GLP_DB && col.lb == 0.0 && col.ub == 1.0)) glp_set_col_bnds(mip, j, GLP_DB, 0.0, 1.0); break; default: xerror("glp_set_col_kind: j = " + j + "; kind = " + kind + "; invalid column kind"); } }; var glp_get_col_kind = exports["glp_get_col_kind"] = function(mip, j){ if (!(1 <= j && j <= mip.n)) xerror("glp_get_col_kind: j = " + j + "; column number out of range"); var col = mip.col[j]; var kind = col.kind; switch (kind) { case GLP_CV: break; case GLP_IV: if (col.type == GLP_DB && col.lb == 0.0 && col.ub == 1.0) kind = GLP_BV; break; default: xassert(kind != kind); } return kind; }; var glp_get_num_int = exports["glp_get_num_int"] = function(mip){ var col; var count = 0; for (var j = 1; j <= mip.n; j++) { col = mip.col[j]; if (col.kind == GLP_IV) count++; } return count; }; var glp_get_num_bin = exports["glp_get_num_bin"] = function(mip){ var col; var count = 0; for (var j = 1; j <= mip.n; j++) { col = mip.col[j]; if (col.kind == GLP_IV && col.type == GLP_DB && col.lb == 0.0 && col.ub == 1.0) count++; } return count; }; var glp_intopt = exports["glp_intopt"] = function(P, parm){ function solve_mip(P, parm){ /* solve MIP directly without using the preprocessor */ var T; var ret; /* optimal basis to LP relaxation must be provided */ if (glp_get_status(P) != GLP_OPT) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: optimal basis to initial LP relaxation not provided"); ret = GLP_EROOT; return ret; } /* it seems all is ok */ if (parm.msg_lev >= GLP_MSG_ALL) xprintf("Integer optimization begins..."); /* create the branch-and-bound tree */ T = ios_create_tree(P, parm); /* solve the problem instance */ ret = ios_driver(T); /* delete the branch-and-bound tree */ ios_delete_tree(T); /* analyze exit code reported by the mip driver */ if (ret == 0) { if (P.mip_stat == GLP_FEAS) { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("INTEGER OPTIMAL SOLUTION FOUND"); P.mip_stat = GLP_OPT; } else { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO INTEGER FEASIBLE SOLUTION"); P.mip_stat = GLP_NOFEAS; } } else if (ret == GLP_EMIPGAP) { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("RELATIVE MIP GAP TOLERANCE REACHED; SEARCH TERMINATED"); } else if (ret == GLP_ETMLIM) { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED"); } else if (ret == GLP_EFAIL) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: cannot solve current LP relaxation"); } else if (ret == GLP_ESTOP) { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("SEARCH TERMINATED BY APPLICATION"); } else xassert(ret != ret); return ret; } function preprocess_and_solve_mip(P, parm){ /* solve MIP using the preprocessor */ var env = get_env_ptr(); var term_out = env.term_out; var npp; var mip = null; var bfcp = {}; var ret; function post(){ npp_postprocess(npp, mip); /* the transformed MIP is no longer needed */ mip = null; /* store solution to the original problem */ npp_unload_sol(npp, P); return ret; } if (parm.msg_lev >= GLP_MSG_ALL) xprintf("Preprocessing..."); /* create preprocessor workspace */ npp = npp_create_wksp(); /* load original problem into the preprocessor workspace */ npp_load_prob(npp, P, GLP_OFF, GLP_MIP, GLP_OFF); /* process MIP prior to applying the branch-and-bound method */ if (!term_out || parm.msg_lev < GLP_MSG_ALL) env.term_out = GLP_OFF; else env.term_out = GLP_ON; ret = npp_integer(npp, parm); env.term_out = term_out; if (ret == 0) { } else if (ret == GLP_ENOPFS) { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO PRIMAL FEASIBLE SOLUTION"); } else if (ret == GLP_ENODFS) { if (parm.msg_lev >= GLP_MSG_ALL) xprintf("LP RELAXATION HAS NO DUAL FEASIBLE SOLUTION"); } else xassert(ret != ret); if (ret != 0) return ret; /* build transformed MIP */ mip = glp_create_prob(); npp_build_prob(npp, mip); /* if the transformed MIP is empty, it has empty solution, which is optimal */ if (mip.m == 0 && mip.n == 0) { mip.mip_stat = GLP_OPT; mip.mip_obj = mip.c0; if (parm.msg_lev >= GLP_MSG_ALL) { xprintf("Objective value = " + mip.mip_obj + ""); xprintf("INTEGER OPTIMAL SOLUTION FOUND BY MIP PREPROCESSOR"); } return post(); } /* display some statistics */ if (parm.msg_lev >= GLP_MSG_ALL) { var ni = glp_get_num_int(mip); var nb = glp_get_num_bin(mip); var s; xprintf(mip.m + " row" + (mip.m == 1 ? "" : "s") + ", " + mip.n + " column" + (mip.n == 1 ? "" : "s") + ", " + mip.nnz + " non-zero" + (mip.nnz == 1 ? "" : "s") + ""); if (nb == 0) s = "none of"; else if (ni == 1 && nb == 1) s = ""; else if (nb == 1) s = "one of"; else if (nb == ni) s = "all of"; else s = nb + " of"; xprintf(ni + " integer variable" + (ni == 1 ? "" : "s") + ", " + s + " which " + (nb == 1 ? "is" : "are") + " binary"); } /* inherit basis factorization control parameters */ glp_get_bfcp(P, bfcp); glp_set_bfcp(mip, bfcp); /* scale the transformed problem */ if (!term_out || parm.msg_lev < GLP_MSG_ALL) env.term_out = GLP_OFF; else env.term_out = GLP_ON; glp_scale_prob(mip, GLP_SF_GM | GLP_SF_EQ | GLP_SF_2N | GLP_SF_SKIP); env.term_out = term_out; /* build advanced initial basis */ if (!term_out || parm.msg_lev < GLP_MSG_ALL) env.term_out = GLP_OFF; else env.term_out = GLP_ON; glp_adv_basis(mip, 0); env.term_out = term_out; /* solve initial LP relaxation */ if (parm.msg_lev >= GLP_MSG_ALL) xprintf("Solving LP relaxation..."); var smcp = new SMCP(); //glp_init_smcp(smcp); smcp.msg_lev = parm.msg_lev; mip.it_cnt = P.it_cnt; ret = glp_simplex(mip, smcp); P.it_cnt = mip.it_cnt; if (ret != 0) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: cannot solve LP relaxation"); ret = GLP_EFAIL; return ret; } /* check status of the basic solution */ ret = glp_get_status(mip); if (ret == GLP_OPT) ret = 0; else if (ret == GLP_NOFEAS) ret = GLP_ENOPFS; else if (ret == GLP_UNBND) ret = GLP_ENODFS; else xassert(ret != ret); if (ret != 0) return ret; /* solve the transformed MIP */ mip.it_cnt = P.it_cnt; ret = solve_mip(mip, parm); P.it_cnt = mip.it_cnt; /* only integer feasible solution can be postprocessed */ if (!(mip.mip_stat == GLP_OPT || mip.mip_stat == GLP_FEAS)) { P.mip_stat = mip.mip_stat; return ret; } return post(); } /* solve MIP problem with the branch-and-bound method */ var i, j, ret, col; /* check problem object */ if (P == null || P.magic != GLP_PROB_MAGIC) xerror("glp_intopt: P = " + P + "; invalid problem object"); if (P.tree != null) xerror("glp_intopt: operation not allowed"); /* check control parameters */ if (parm == null){ parm = new IOCP(); //glp_init_iocp(parm); } if (!(parm.msg_lev == GLP_MSG_OFF || parm.msg_lev == GLP_MSG_ERR || parm.msg_lev == GLP_MSG_ON || parm.msg_lev == GLP_MSG_ALL || parm.msg_lev == GLP_MSG_DBG)) xerror("glp_intopt: msg_lev = " + parm.msg_lev + "; invalid parameter"); if (!(parm.br_tech == GLP_BR_FFV || parm.br_tech == GLP_BR_LFV || parm.br_tech == GLP_BR_MFV || parm.br_tech == GLP_BR_DTH || parm.br_tech == GLP_BR_PCH)) xerror("glp_intopt: br_tech = " + parm.br_tech + "; invalid parameter"); if (!(parm.bt_tech == GLP_BT_DFS || parm.bt_tech == GLP_BT_BFS || parm.bt_tech == GLP_BT_BLB || parm.bt_tech == GLP_BT_BPH)) xerror("glp_intopt: bt_tech = " + parm.bt_tech + "; invalid parameter"); if (!(0.0 < parm.tol_int && parm.tol_int < 1.0)) xerror("glp_intopt: tol_int = " + parm.tol_int + "; invalid parameter"); if (!(0.0 < parm.tol_obj && parm.tol_obj < 1.0)) xerror("glp_intopt: tol_obj = " + parm.tol_obj + "; invalid parameter"); if (parm.tm_lim < 0) xerror("glp_intopt: tm_lim = " + parm.tm_lim + "; invalid parameter"); if (parm.out_frq < 0) xerror("glp_intopt: out_frq = " + parm.out_frq + "; invalid parameter"); if (parm.out_dly < 0) xerror("glp_intopt: out_dly = " + parm.out_dly + "; invalid parameter"); if (!(0 <= parm.cb_size && parm.cb_size <= 256)) xerror("glp_intopt: cb_size = " + parm.cb_size + "; invalid parameter"); if (!(parm.pp_tech == GLP_PP_NONE || parm.pp_tech == GLP_PP_ROOT || parm.pp_tech == GLP_PP_ALL)) xerror("glp_intopt: pp_tech = " + parm.pp_tech + "; invalid parameter"); if (parm.mip_gap < 0.0) xerror("glp_intopt: mip_gap = " + parm.mip_gap + "; invalid parameter"); if (!(parm.mir_cuts == GLP_ON || parm.mir_cuts == GLP_OFF)) xerror("glp_intopt: mir_cuts = " + parm.mir_cuts + "; invalid parameter"); if (!(parm.gmi_cuts == GLP_ON || parm.gmi_cuts == GLP_OFF)) xerror("glp_intopt: gmi_cuts = " + parm.gmi_cuts + "; invalid parameter"); if (!(parm.cov_cuts == GLP_ON || parm.cov_cuts == GLP_OFF)) xerror("glp_intopt: cov_cuts = " + parm.cov_cuts + "; invalid parameter"); if (!(parm.clq_cuts == GLP_ON || parm.clq_cuts == GLP_OFF)) xerror("glp_intopt: clq_cuts = " + parm.clq_cuts + "; invalid parameter"); if (!(parm.presolve == GLP_ON || parm.presolve == GLP_OFF)) xerror("glp_intopt: presolve = " + parm.presolve + "; invalid parameter"); if (!(parm.binarize == GLP_ON || parm.binarize == GLP_OFF)) xerror("glp_intopt: binarize = " + parm.binarize + "; invalid parameter"); if (!(parm.fp_heur == GLP_ON || parm.fp_heur == GLP_OFF)) xerror("glp_intopt: fp_heur = " + parm.fp_heur + "; invalid parameter"); /* integer solution is currently undefined */ P.mip_stat = GLP_UNDEF; P.mip_obj = 0.0; /* check bounds of double-bounded variables */ for (i = 1; i <= P.m; i++) { var row = P.row[i]; if (row.type == GLP_DB && row.lb >= row.ub) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: row " + i + ": lb = " + row.lb + ", ub = " + row.ub + "; incorrect bounds"); ret = GLP_EBOUND; return ret; } } for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.type == GLP_DB && col.lb >= col.ub) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: column " + j + ": lb = " + col.lb + ", ub = " + col.ub + "; incorrect bounds"); ret = GLP_EBOUND; return ret; } } /* bounds of all integer variables must be integral */ for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.kind != GLP_IV) continue; if (col.type == GLP_LO || col.type == GLP_DB) { if (col.lb != Math.floor(col.lb)) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: integer column " + j + " has non-integer lower bound " + col.lb + ""); ret = GLP_EBOUND; return ret; } } if (col.type == GLP_UP || col.type == GLP_DB) { if (col.ub != Math.floor(col.ub)) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: integer column " + j + " has non-integer upper bound " + col.ub + ""); ret = GLP_EBOUND; return ret; } } if (col.type == GLP_FX) { if (col.lb != Math.floor(col.lb)) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("glp_intopt: integer column " + j + " has non-integer fixed value " + col.lb + ""); ret = GLP_EBOUND; return ret; } } } /* solve MIP problem */ if (parm.msg_lev >= GLP_MSG_ALL) { var ni = glp_get_num_int(P); var nb = glp_get_num_bin(P); var s; xprintf("GLPK Integer Optimizer, v" + glp_version() + ""); xprintf(P.m + " row" + (P.m == 1 ? "" : "s") + ", " + P.n + " column" + (P.n == 1 ? "" : "s") + ", " + P.nnz + " non-zero" + (P.nnz == 1 ? "" : "s") + ""); if (nb == 0) s = "none of"; else if (ni == 1 && nb == 1) s = ""; else if (nb == 1) s = "one of"; else if (nb == ni) s = "all of"; else s = nb + " of"; xprintf(ni + " integer variable" + (ni == 1 ? "" : "s") + ", " + s + " which " + (nb == 1 ? "is" : "are") + " binary"); } if (!parm.presolve) ret = solve_mip(P, parm); else ret = preprocess_and_solve_mip(P, parm); /* return to the application program */ return ret; }; var IOCP = exports["IOCP"] = /**@constructor*/ function(options){ options = options || {}; this.msg_lev = options["msg_lev"] || GLP_MSG_ALL; this.br_tech = options["br_tech"] || GLP_BR_DTH; this.bt_tech = options["bt_tech"] || GLP_BT_BLB; this.tol_int = options["tol_int"] || 1e-5; this.tol_obj = options["tol_obj"] || 1e-7; this.tm_lim = options["tm_lim"] || INT_MAX; this.out_frq = options["out_frq"] || 5000; this.out_dly = options["out_dly"] || 10000; this.cb_func = options["cb_func"] || null; this.cb_info = options["cb_info"] || null; this.cb_size = options["cb_size"] || 0; this.pp_tech = options["pp_tech"] || GLP_PP_ALL; this.mip_gap = options["mip_gap"] || 0.0; this.mir_cuts = options["mir_cuts"] || GLP_OFF; this.gmi_cuts = options["gmi_cuts"] || GLP_OFF; this.cov_cuts = options["cov_cuts"] || GLP_OFF; this.clq_cuts = options["clq_cuts"] || GLP_OFF; this.presolve = options["presolve"] || GLP_OFF; this.binarize = options["binarize"] || GLP_OFF; this.fp_heur = options["fp_heur"] || GLP_OFF; }; /* var glp_init_iocp = exports["glp_init_iocp"] = function(parm){ parm.msg_lev = GLP_MSG_ALL; parm.br_tech = GLP_BR_DTH; parm.bt_tech = GLP_BT_BLB; parm.tol_int = 1e-5; parm.tol_obj = 1e-7; parm.tm_lim = INT_MAX; parm.out_frq = 5000; parm.out_dly = 10000; parm.cb_func = null; parm.cb_info = null; parm.cb_size = 0; parm.pp_tech = GLP_PP_ALL; parm.mip_gap = 0.0; parm.mir_cuts = GLP_OFF; parm.gmi_cuts = GLP_OFF; parm.cov_cuts = GLP_OFF; parm.clq_cuts = GLP_OFF; parm.presolve = GLP_OFF; parm.binarize = GLP_OFF; parm.fp_heur = GLP_OFF; }; */ var glp_mip_status = exports["glp_mip_status"] = function(mip){ return mip.mip_stat; }; var glp_mip_obj_val = exports["glp_mip_obj_val"] = function(mip){ return mip.mip_obj; }; var glp_mip_row_val = exports["glp_mip_row_val"] = function(mip, i){ if (!(1 <= i && i <= mip.m)) xerror("glp_mip_row_val: i = " + i + "; row number out of range"); return mip.row[i].mipx; }; var glp_mip_col_val = exports["glp_mip_col_val"] = function(mip, j){ if (!(1 <= j && j <= mip.n)) xerror("glp_mip_col_val: j = " + j + "; column number out of range"); return mip.col[j].mipx; }; function glp_check_kkt(P, sol, cond, callback){ /* check feasibility and optimality conditions */ var m = P.m; var n = P.n; var row, col, aij; var i, j, ae_ind, re_ind; var e, sp, sn, t, ae_max, re_max; if (!(sol == GLP_SOL || sol == GLP_IPT || sol == GLP_MIP)) xerror("glp_check_kkt: sol = " + sol + "; invalid solution indicator"); if (!(cond == GLP_KKT_PE || cond == GLP_KKT_PB || cond == GLP_KKT_DE || cond == GLP_KKT_DB || cond == GLP_KKT_CS)) xerror("glp_check_kkt: cond = " + cond + "; invalid condition indicator "); ae_max = re_max = 0.0; ae_ind = re_ind = 0; if (cond == GLP_KKT_PE) { /* xR - A * xS = 0 */ for (i = 1; i <= m; i++) { row = P.row[i]; sp = sn = 0.0; /* t := xR[i] */ if (sol == GLP_SOL) t = row.prim; else if (sol == GLP_IPT) t = row.pval; else if (sol == GLP_MIP) t = row.mipx; else xassert(sol != sol); if (t >= 0.0) sp += t; else sn -= t; for (aij = row.ptr; aij != null; aij = aij.r_next) { col = aij.col; /* t := - a[i,j] * xS[j] */ if (sol == GLP_SOL) t = - aij.val * col.prim; else if (sol == GLP_IPT) t = - aij.val * col.pval; else if (sol == GLP_MIP) t = - aij.val * col.mipx; else xassert(sol != sol); if (t >= 0.0) sp += t; else sn -= t; } /* absolute error */ e = Math.abs(sp - sn); if (ae_max < e){ ae_max = e; ae_ind = i; } /* relative error */ e /= (1.0 + sp + sn); if (re_max < e){ re_max = e; re_ind = i; } } } else if (cond == GLP_KKT_PB) { /* lR <= xR <= uR */ for (i = 1; i <= m; i++) { row = P.row[i]; /* t := xR[i] */ if (sol == GLP_SOL) t = row.prim; else if (sol == GLP_IPT) t = row.pval; else if (sol == GLP_MIP) t = row.mipx; else xassert(sol != sol); /* check lower bound */ if (row.type == GLP_LO || row.type == GLP_DB || row.type == GLP_FX) { if (t < row.lb) { /* absolute error */ e = row.lb - t; if (ae_max < e){ ae_max = e; ae_ind = i; } /* relative error */ e /= (1.0 + Math.abs(row.lb)); if (re_max < e){ re_max = e; re_ind = i; } } } /* check upper bound */ if (row.type == GLP_UP || row.type == GLP_DB || row.type == GLP_FX) { if (t > row.ub) { /* absolute error */ e = t - row.ub; if (ae_max < e){ ae_max = e; ae_ind = i; } /* relative error */ e /= (1.0 + Math.abs(row.ub)); if (re_max < e){ re_max = e; re_ind = i; } } } } /* lS <= xS <= uS */ for (j = 1; j <= n; j++) { col = P.col[j]; /* t := xS[j] */ if (sol == GLP_SOL) t = col.prim; else if (sol == GLP_IPT) t = col.pval; else if (sol == GLP_MIP) t = col.mipx; else xassert(sol != sol); /* check lower bound */ if (col.type == GLP_LO || col.type == GLP_DB || col.type == GLP_FX) { if (t < col.lb) { /* absolute error */ e = col.lb - t; if (ae_max < e){ ae_max = e; ae_ind = m+j; } /* relative error */ e /= (1.0 + Math.abs(col.lb)); if (re_max < e){ re_max = e; re_ind = m+j; } } } /* check upper bound */ if (col.type == GLP_UP || col.type == GLP_DB || col.type == GLP_FX) { if (t > col.ub) { /* absolute error */ e = t - col.ub; if (ae_max < e){ ae_max = e; ae_ind = m+j; } /* relative error */ e /= (1.0 + Math.abs(col.ub)); if (re_max < e){ re_max = e; re_ind = m+j; } } } } } else if (cond == GLP_KKT_DE) { /* A' * (lambdaR - cR) + (lambdaS - cS) = 0 */ for (j = 1; j <= n; j++) { col = P.col[j]; sp = sn = 0.0; /* t := lambdaS[j] - cS[j] */ if (sol == GLP_SOL) t = col.dual - col.coef; else if (sol == GLP_IPT) t = col.dval - col.coef; else xassert(sol != sol); if (t >= 0.0) sp += t; else sn -= t; for (aij = col.ptr; aij != null; aij = aij.c_next) { row = aij.row; /* t := a[i,j] * (lambdaR[i] - cR[i]) */ if (sol == GLP_SOL) t = aij.val * row.dual; else if (sol == GLP_IPT) t = aij.val * row.dval; else xassert(sol != sol); if (t >= 0.0) sp += t; else sn -= t; } /* absolute error */ e = Math.abs(sp - sn); if (ae_max < e){ ae_max = e; ae_ind = m+j; } /* relative error */ e /= (1.0 + sp + sn); if (re_max < e){ re_max = e; re_ind = m+j; } } } else if (cond == GLP_KKT_DB) { /* check lambdaR */ for (i = 1; i <= m; i++) { row = P.row[i]; /* t := lambdaR[i] */ if (sol == GLP_SOL) t = row.dual; else if (sol == GLP_IPT) t = row.dval; else xassert(sol != sol); /* correct sign */ if (P.dir == GLP_MIN) t = + t; else if (P.dir == GLP_MAX) t = - t; else xassert(P != P); /* check for positivity */ if (row.stat == GLP_NF || row.stat == GLP_NL) { if (t < 0.0) { e = - t; if (ae_max < e){ ae_max = re_max = e; ae_ind = re_ind = i; } } } /* check for negativity */ if (row.stat == GLP_NF || row.stat == GLP_NU) { if (t > 0.0) { e = + t; if (ae_max < e){ ae_max = re_max = e; ae_ind = re_ind = i; } } } } /* check lambdaS */ for (j = 1; j <= n; j++) { col = P.col[j]; /* t := lambdaS[j] */ if (sol == GLP_SOL) t = col.dual; else if (sol == GLP_IPT) t = col.dval; else xassert(sol != sol); /* correct sign */ if (P.dir == GLP_MIN) t = + t; else if (P.dir == GLP_MAX) t = - t; else xassert(P != P); /* check for positivity */ if (col.stat == GLP_NF || col.stat == GLP_NL) { if (t < 0.0) { e = - t; if (ae_max < e){ ae_max = re_max = e; ae_ind = re_ind = m+j; } } } /* check for negativity */ if (col.stat == GLP_NF || col.stat == GLP_NU) { if (t > 0.0) { e = + t; if (ae_max < e){ ae_max = re_max = e; ae_ind = re_ind = m+j; } } } } } else xassert(cond != cond); callback(ae_max, ae_ind, re_max, re_ind); } var glp_bf_exists = exports["glp_bf_exists"] = function(lp){ return (lp.m == 0 || lp.valid); }; var glp_factorize = exports["glp_factorize"] = function(lp){ function b_col(lp, j, ind, val){ var m = lp.m; var aij; var k, len; xassert(1 <= j && j <= m); /* determine the ordinal number of basic auxiliary or structural variable x[k] corresponding to basic variable xB[j] */ k = lp.head[j]; /* build j-th column of the basic matrix, which is k-th column of the scaled augmented matrix (I | -R*A*S) */ if (k <= m) { /* x[k] is auxiliary variable */ len = 1; ind[1] = k; val[1] = 1.0; } else { /* x[k] is structural variable */ len = 0; for (aij = lp.col[k-m].ptr; aij != null; aij = aij.c_next) { len++; ind[len] = aij.row.i; val[len] = - aij.row.rii * aij.val * aij.col.sjj; } } return len; } var m = lp.m; var n = lp.n; var row = lp.row; var col = lp.col; var head = lp.head; var j, k, stat, ret; /* invalidate the basis factorization */ lp.valid = 0; /* build the basis header */ j = 0; for (k = 1; k <= m+n; k++) { if (k <= m) { stat = row[k].stat; row[k].bind = 0; } else { stat = col[k-m].stat; col[k-m].bind = 0; } if (stat == GLP_BS) { j++; if (j > m) { /* too many basic variables */ ret = GLP_EBADB; return ret; } head[j] = k; if (k <= m) row[k].bind = j; else col[k-m].bind = j; } } if (j < m) { /* too few basic variables */ ret = GLP_EBADB; return ret; } /* try to factorize the basis matrix */ if (m > 0) { if (lp.bfd == null) { lp.bfd = bfd_create_it(); copy_bfcp(lp); } switch (bfd_factorize(lp.bfd, m, lp.head, b_col, lp)) { case 0: /* ok */ break; case BFD_ESING: /* singular matrix */ ret = GLP_ESING; return ret; case BFD_ECOND: /* ill-conditioned matrix */ ret = GLP_ECOND; return ret; default: xassert(lp != lp); } lp.valid = 1; } /* factorization successful */ ret = 0; /* bring the return code to the calling program */ return ret; }; var glp_bf_updated = exports["glp_bf_updated"] = function(lp){ if (!(lp.m == 0 || lp.valid)) xerror("glp_bf_update: basis factorization does not exist"); return (lp.m == 0 ? 0 : bfd_get_count(lp.bfd)); }; var glp_get_bfcp = exports["glp_get_bfcp"] = function(lp, parm){ var bfcp = lp.bfcp; if (bfcp == null) { parm.type = GLP_BF_FT; parm.lu_size = 0; parm.piv_tol = 0.10; parm.piv_lim = 4; parm.suhl = GLP_ON; parm.eps_tol = 1e-15; parm.max_gro = 1e+10; parm.nfs_max = 100; parm.upd_tol = 1e-6; parm.nrs_max = 100; parm.rs_size = 0; } else xcopyObj(parm, bfcp); }; function copy_bfcp(lp){ var parm = {}; glp_get_bfcp(lp, parm); bfd_set_parm(lp.bfd, parm); } var glp_set_bfcp = exports["glp_set_bfcp"] = function(lp, parm){ var bfcp = lp.bfcp; if (parm == null) { /* reset to default values */ if (bfcp != null) lp.bfcp = null; } else { /* set to specified values */ if (bfcp == null) bfcp = lp.bfcp = {}; xcopyObj(bfcp, parm); if (!(bfcp.type == GLP_BF_FT || bfcp.type == GLP_BF_BG || bfcp.type == GLP_BF_GR)) xerror("glp_set_bfcp: type = " + bfcp.type + "; invalid parameter"); if (bfcp.lu_size < 0) xerror("glp_set_bfcp: lu_size = " + bfcp.lu_size + "; invalid parameter"); if (!(0.0 < bfcp.piv_tol && bfcp.piv_tol < 1.0)) xerror("glp_set_bfcp: piv_tol = " + bfcp.piv_tol + "; invalid parameter"); if (bfcp.piv_lim < 1) xerror("glp_set_bfcp: piv_lim = " + bfcp.piv_lim + "; invalid parameter"); if (!(bfcp.suhl == GLP_ON || bfcp.suhl == GLP_OFF)) xerror("glp_set_bfcp: suhl = " + bfcp.suhl + "; invalid parameter"); if (!(0.0 <= bfcp.eps_tol && bfcp.eps_tol <= 1e-6)) xerror("glp_set_bfcp: eps_tol = " + bfcp.eps_tol + "; invalid parameter"); if (bfcp.max_gro < 1.0) xerror("glp_set_bfcp: max_gro = " + bfcp.max_gro + "; invalid parameter"); if (!(1 <= bfcp.nfs_max && bfcp.nfs_max <= 32767)) xerror("glp_set_bfcp: nfs_max = " + bfcp.nfs_max + "; invalid parameter"); if (!(0.0 < bfcp.upd_tol && bfcp.upd_tol < 1.0)) xerror("glp_set_bfcp: upd_tol = " + bfcp.upd_tol + "; invalid parameter"); if (!(1 <= bfcp.nrs_max && bfcp.nrs_max <= 32767)) xerror("glp_set_bfcp: nrs_max = " + bfcp.nrs_max + "; invalid parameter"); if (bfcp.rs_size < 0) xerror("glp_set_bfcp: rs_size = " + bfcp.nrs_max + "; invalid parameter"); if (bfcp.rs_size == 0) bfcp.rs_size = 20 * bfcp.nrs_max; } if (lp.bfd != null) copy_bfcp(lp); }; var glp_get_bhead = exports["glp_get_bhead"] = function(lp, k){ if (!(lp.m == 0 || lp.valid)) xerror("glp_get_bhead: basis factorization does not exist"); if (!(1 <= k && k <= lp.m)) xerror("glp_get_bhead: k = " + k + "; index out of range"); return lp.head[k]; }; var glp_get_row_bind = exports["glp_get_row_bind"] = function(lp, i){ if (!(lp.m == 0 || lp.valid)) xerror("glp_get_row_bind: basis factorization does not exist"); if (!(1 <= i && i <= lp.m)) xerror("glp_get_row_bind: i = " + i + "; row number out of range"); return lp.row[i].bind; }; var glp_get_col_bind = exports["glp_get_col_bind"] = function(lp, j){ if (!(lp.m == 0 || lp.valid)) xerror("glp_get_col_bind: basis factorization does not exist"); if (!(1 <= j && j <= lp.n)) xerror("glp_get_col_bind: j = " + j + "; column number out of range"); return lp.col[j].bind; }; var glp_ftran = exports["glp_ftran"] = function(lp, x){ var m = lp.m; var row = lp.row; var col = lp.col; var i, k; /* B*x = b ===> (R*B*SB)*(inv(SB)*x) = R*b ===> B"*x" = b", where b" = R*b, x = SB*x" */ if (!(m == 0 || lp.valid)) xerror("glp_ftran: basis factorization does not exist"); /* b" := R*b */ for (i = 1; i <= m; i++) x[i] *= row[i].rii; /* x" := inv(B")*b" */ if (m > 0) bfd_ftran(lp.bfd, x); /* x := SB*x" */ for (i = 1; i <= m; i++) { k = lp.head[i]; if (k <= m) x[i] /= row[k].rii; else x[i] *= col[k-m].sjj; } }; var glp_btran = exports["glp_btran"] = function(lp, x){ var m = lp.m; var row = lp.row; var col = lp.col; var i, k; /* B'*x = b ===> (SB*B'*R)*(inv(R)*x) = SB*b ===> (B")'*x" = b", where b" = SB*b, x = R*x" */ if (!(m == 0 || lp.valid)) xerror("glp_btran: basis factorization does not exist"); /* b" := SB*b */ for (i = 1; i <= m; i++) { k = lp.head[i]; if (k <= m) x[i] /= row[k].rii; else x[i] *= col[k-m].sjj; } /* x" := inv[(B")']*b" */ if (m > 0) bfd_btran(lp.bfd, x); /* x := R*x" */ for (i = 1; i <= m; i++) x[i] *= row[i].rii; }; var glp_warm_up = exports["glp_warm_up"] = function(P){ var row; var col; var aij; var i, j, type, stat, ret; var eps, temp, work; /* invalidate basic solution */ P.pbs_stat = P.dbs_stat = GLP_UNDEF; P.obj_val = 0.0; P.some = 0; for (i = 1; i <= P.m; i++) { row = P.row[i]; row.prim = row.dual = 0.0; } for (j = 1; j <= P.n; j++) { col = P.col[j]; col.prim = col.dual = 0.0; } /* compute the basis factorization, if necessary */ if (!glp_bf_exists(P)) { ret = glp_factorize(P); if (ret != 0) return ret; } /* allocate working array */ work = new Float64Array(1+P.m); /* determine and store values of non-basic variables, compute vector (- N * xN) */ for (i = 1; i <= P.m; i++) { row = P.row[i]; if (row.stat == GLP_BS) continue; else if (row.stat == GLP_NL) row.prim = row.lb; else if (row.stat == GLP_NU) row.prim = row.ub; else if (row.stat == GLP_NF) row.prim = 0.0; else if (row.stat == GLP_NS) row.prim = row.lb; else xassert(row != row); /* N[j] is i-th column of matrix (I|-A) */ work[i] -= row.prim; } for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.stat == GLP_BS) continue; else if (col.stat == GLP_NL) col.prim = col.lb; else if (col.stat == GLP_NU) col.prim = col.ub; else if (col.stat == GLP_NF) col.prim = 0.0; else if (col.stat == GLP_NS) col.prim = col.lb; else xassert(col != col); /* N[j] is (m+j)-th column of matrix (I|-A) */ if (col.prim != 0.0) { for (aij = col.ptr; aij != null; aij = aij.c_next) work[aij.row.i] += aij.val * col.prim; } } /* compute vector of basic variables xB = - inv(B) * N * xN */ glp_ftran(P, work); /* store values of basic variables, check primal feasibility */ P.pbs_stat = GLP_FEAS; for (i = 1; i <= P.m; i++) { row = P.row[i]; if (row.stat != GLP_BS) continue; row.prim = work[row.bind]; type = row.type; if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { eps = 1e-6 + 1e-9 * Math.abs(row.lb); if (row.prim < row.lb - eps) P.pbs_stat = GLP_INFEAS; } if (type == GLP_UP || type == GLP_DB || type == GLP_FX) { eps = 1e-6 + 1e-9 * Math.abs(row.ub); if (row.prim > row.ub + eps) P.pbs_stat = GLP_INFEAS; } } for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.stat != GLP_BS) continue; col.prim = work[col.bind]; type = col.type; if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { eps = 1e-6 + 1e-9 * Math.abs(col.lb); if (col.prim < col.lb - eps) P.pbs_stat = GLP_INFEAS; } if (type == GLP_UP || type == GLP_DB || type == GLP_FX) { eps = 1e-6 + 1e-9 * Math.abs(col.ub); if (col.prim > col.ub + eps) P.pbs_stat = GLP_INFEAS; } } /* compute value of the objective function */ P.obj_val = P.c0; for (j = 1; j <= P.n; j++) { col = P.col[j]; P.obj_val += col.coef * col.prim; } /* build vector cB of objective coefficients at basic variables */ for (i = 1; i <= P.m; i++) work[i] = 0.0; for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.stat == GLP_BS) work[col.bind] = col.coef; } /* compute vector of simplex multipliers pi = inv(B') * cB */ glp_btran(P, work); /* compute and store reduced costs of non-basic variables d[j] = c[j] - N'[j] * pi, check dual feasibility */ P.dbs_stat = GLP_FEAS; for (i = 1; i <= P.m; i++) { row = P.row[i]; if (row.stat == GLP_BS) { row.dual = 0.0; continue; } /* N[j] is i-th column of matrix (I|-A) */ row.dual = - work[i]; stat = row.stat; temp = (P.dir == GLP_MIN ? + row.dual : - row.dual); if ((stat == GLP_NF || stat == GLP_NL) && temp < -1e-5 || (stat == GLP_NF || stat == GLP_NU) && temp > +1e-5) P.dbs_stat = GLP_INFEAS; } for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.stat == GLP_BS) { col.dual = 0.0; continue; } /* N[j] is (m+j)-th column of matrix (I|-A) */ col.dual = col.coef; for (aij = col.ptr; aij != null; aij = aij.c_next) col.dual += aij.val * work[aij.row.i]; stat = col.stat; temp = (P.dir == GLP_MIN ? + col.dual : - col.dual); if ((stat == GLP_NF || stat == GLP_NL) && temp < -1e-5 || (stat == GLP_NF || stat == GLP_NU) && temp > +1e-5) P.dbs_stat = GLP_INFEAS; } /* free working array */ return 0; }; var glp_eval_tab_row = exports["glp_eval_tab_row"] = function(lp, k, ind, val){ var m = lp.m; var n = lp.n; var i, t, len, lll, iii; var alfa, rho, vvv; if (!(m == 0 || lp.valid)) xerror("glp_eval_tab_row: basis factorization does not exist"); if (!(1 <= k && k <= m+n)) xerror("glp_eval_tab_row: k = " + k + "; variable number out of range"); /* determine xB[i] which corresponds to x[k] */ if (k <= m) i = glp_get_row_bind(lp, k); else i = glp_get_col_bind(lp, k-m); if (i == 0) xerror("glp_eval_tab_row: k = " + k + "; variable must be basic"); xassert(1 <= i && i <= m); /* allocate working arrays */ rho = new Float64Array(1+m); iii = new Int32Array(1+m); vvv = new Float64Array(1+m); /* compute i-th row of the inverse; see (8) */ rho[i] = 1.0; glp_btran(lp, rho); /* compute i-th row of the simplex table */ len = 0; for (k = 1; k <= m+n; k++) { if (k <= m) { /* x[k] is auxiliary variable, so N[k] is a unity column */ if (glp_get_row_stat(lp, k) == GLP_BS) continue; /* compute alfa[i,j]; see (9) */ alfa = - rho[k]; } else { /* x[k] is structural variable, so N[k] is a column of the original constraint matrix A with negative sign */ if (glp_get_col_stat(lp, k-m) == GLP_BS) continue; /* compute alfa[i,j]; see (9) */ lll = glp_get_mat_col(lp, k-m, iii, vvv); alfa = 0.0; for (t = 1; t <= lll; t++) alfa += rho[iii[t]] * vvv[t]; } /* store alfa[i,j] */ if (alfa != 0.0) { len++; ind[len] = k; val[len] = alfa; } } xassert(len <= n); /* return to the calling program */ return len; }; var glp_eval_tab_col = exports["glp_eval_tab_col"] = function(lp, k, ind, val){ var m = lp.m; var n = lp.n; var t, len, stat; var col; if (!(m == 0 || lp.valid)) xerror("glp_eval_tab_col: basis factorization does not exist"); if (!(1 <= k && k <= m+n)) xerror("glp_eval_tab_col: k = " + k + "; variable number out of range"); if (k <= m) stat = glp_get_row_stat(lp, k); else stat = glp_get_col_stat(lp, k-m); if (stat == GLP_BS) xerror("glp_eval_tab_col: k = " + k + "; variable must be non-basic"); /* obtain column N[k] with negative sign */ col = new Float64Array(1+m); if (k <= m) { /* x[k] is auxiliary variable, so N[k] is a unity column */ col[k] = -1.0; } else { /* x[k] is structural variable, so N[k] is a column of the original constraint matrix A with negative sign */ len = glp_get_mat_col(lp, k-m, ind, val); for (t = 1; t <= len; t++) col[ind[t]] = val[t]; } /* compute column of the simplex table, which corresponds to the specified non-basic variable x[k] */ glp_ftran(lp, col); len = 0; for (t = 1; t <= m; t++) { if (col[t] != 0.0) { len++; ind[len] = glp_get_bhead(lp, t); val[len] = col[t]; } } /* return to the calling program */ return len; }; var glp_transform_row = exports["glp_transform_row"] = function(P, len, ind, val){ var i, j, k, m, n, t, lll, iii; var alfa, a, aB, rho, vvv; if (!glp_bf_exists(P)) xerror("glp_transform_row: basis factorization does not exist "); m = glp_get_num_rows(P); n = glp_get_num_cols(P); /* unpack the row to be transformed to the array a */ a = new Float64Array(1+n); if (!(0 <= len && len <= n)) xerror("glp_transform_row: len = " + len + "; invalid row length"); for (t = 1; t <= len; t++) { j = ind[t]; if (!(1 <= j && j <= n)) xerror("glp_transform_row: ind[" + t + "] = " + j + "; column index out of range"); if (val[t] == 0.0) xerror("glp_transform_row: val[" + t + "] = 0; zero coefficient not allowed"); if (a[j] != 0.0) xerror("glp_transform_row: ind[" + t + "] = " + j + "; duplicate column indices not allowed"); a[j] = val[t]; } /* construct the vector aB */ aB = new Float64Array(1+m); for (i = 1; i <= m; i++) { k = glp_get_bhead(P, i); /* xB[i] is k-th original variable */ xassert(1 <= k && k <= m+n); aB[i] = (k <= m ? 0.0 : a[k-m]); } /* solve the system B'*rho = aB to compute the vector rho */ rho = aB; glp_btran(P, rho); /* compute coefficients at non-basic auxiliary variables */ len = 0; for (i = 1; i <= m; i++) { if (glp_get_row_stat(P, i) != GLP_BS) { alfa = - rho[i]; if (alfa != 0.0) { len++; ind[len] = i; val[len] = alfa; } } } /* compute coefficients at non-basic structural variables */ iii = new Int32Array(1+m); vvv = new Float64Array(1+m); for (j = 1; j <= n; j++) { if (glp_get_col_stat(P, j) != GLP_BS) { alfa = a[j]; lll = glp_get_mat_col(P, j, iii, vvv); for (t = 1; t <= lll; t++) alfa += vvv[t] * rho[iii[t]]; if (alfa != 0.0) { len++; ind[len] = m+j; val[len] = alfa; } } } xassert(len <= n); return len; }; var glp_transform_col = exports["glp_transform_col"] = function(P, len, ind, val){ var i, m, t; var a, alfa; if (!glp_bf_exists(P)) xerror("glp_transform_col: basis factorization does not exist "); m = glp_get_num_rows(P); /* unpack the column to be transformed to the array a */ a = new Float64Array(1+m); if (!(0 <= len && len <= m)) xerror("glp_transform_col: len = " + len + "; invalid column length"); for (t = 1; t <= len; t++) { i = ind[t]; if (!(1 <= i && i <= m)) xerror("glp_transform_col: ind[" + t + "] = " + i + "; row index out of range"); if (val[t] == 0.0) xerror("glp_transform_col: val[" + t + "] = 0; zero coefficient not allowed"); if (a[i] != 0.0) xerror("glp_transform_col: ind[" + t + "] = " + i + "; duplicate row indices not allowed"); a[i] = val[t]; } /* solve the system B*a = alfa to compute the vector alfa */ alfa = a; glp_ftran(P, alfa); /* store resultant coefficients */ len = 0; for (i = 1; i <= m; i++) { if (alfa[i] != 0.0) { len++; ind[len] = glp_get_bhead(P, i); val[len] = alfa[i]; } } return len; }; var glp_prim_rtest = exports["glp_prim_rtest"] = function(P, len, ind, val, dir, eps){ var k, m, n, piv, t, type, stat; var alfa, big, beta, lb, ub, temp, teta; if (glp_get_prim_stat(P) != GLP_FEAS) xerror("glp_prim_rtest: basic solution is not primal feasible "); if (!(dir == +1 || dir == -1)) xerror("glp_prim_rtest: dir = " + dir + "; invalid parameter"); if (!(0.0 < eps && eps < 1.0)) xerror("glp_prim_rtest: eps = " + eps + "; invalid parameter"); m = glp_get_num_rows(P); n = glp_get_num_cols(P); /* initial settings */ piv = 0; teta = DBL_MAX; big = 0.0; /* walk through the entries of the specified column */ for (t = 1; t <= len; t++) { /* get the ordinal number of basic variable */ k = ind[t]; if (!(1 <= k && k <= m+n)) xerror("glp_prim_rtest: ind[" + t + "] = " + k + "; variable number out of range"); /* determine type, bounds, status and primal value of basic variable xB[i] = x[k] in the current basic solution */ if (k <= m) { type = glp_get_row_type(P, k); lb = glp_get_row_lb(P, k); ub = glp_get_row_ub(P, k); stat = glp_get_row_stat(P, k); beta = glp_get_row_prim(P, k); } else { type = glp_get_col_type(P, k-m); lb = glp_get_col_lb(P, k-m); ub = glp_get_col_ub(P, k-m); stat = glp_get_col_stat(P, k-m); beta = glp_get_col_prim(P, k-m); } if (stat != GLP_BS) xerror("glp_prim_rtest: ind[" + t + "] = " + k + "; non-basic variable not allowed"); /* determine influence coefficient at basic variable xB[i] in the explicitly specified column and turn to the case of increasing the variable x in order to simplify the program logic */ alfa = (dir > 0 ? + val[t] : - val[t]); /* analyze main cases */ if (type == GLP_FR) { /* xB[i] is free variable */ continue; } else if (type == GLP_LO) { /* xB[i] has an lower bound */ if (alfa > - eps) continue; temp = (lb - beta) / alfa; } else if (type == GLP_UP) { /* xB[i] has an upper bound */ if (alfa < + eps) continue; temp = (ub - beta) / alfa; } else if (type == GLP_DB) { /* xB[i] has both lower and upper bounds */ if (alfa < 0.0) { /* xB[i] has an lower bound */ if (alfa > - eps) continue; temp = (lb - beta) / alfa; } else { /* xB[i] has an upper bound */ if (alfa < + eps) continue; temp = (ub - beta) / alfa; } } else if (type == GLP_FX) { /* xB[i] is fixed variable */ if (- eps < alfa && alfa < + eps) continue; temp = 0.0; } else xassert(type != type); /* if the value of the variable xB[i] violates its lower or upper bound (slightly, because the current basis is assumed to be primal feasible), temp is negative; we can think this happens due to round-off errors and the value is exactly on the bound; this allows replacing temp by zero */ if (temp < 0.0) temp = 0.0; /* apply the minimal ratio test */ if (teta > temp || teta == temp && big < Math.abs(alfa)){ piv = t; teta = temp; big = Math.abs(alfa); } } /* return index of the pivot element chosen */ return piv; }; var glp_dual_rtest = exports["glp_dual_rtest"] = function(P, len, ind, val, dir, eps){ var k, m, n, piv, t, stat; var alfa, big, cost, obj, temp, teta; if (glp_get_dual_stat(P) != GLP_FEAS) xerror("glp_dual_rtest: basic solution is not dual feasible"); if (!(dir == +1 || dir == -1)) xerror("glp_dual_rtest: dir = " + dir + "; invalid parameter"); if (!(0.0 < eps && eps < 1.0)) xerror("glp_dual_rtest: eps = " + eps + "; invalid parameter"); m = glp_get_num_rows(P); n = glp_get_num_cols(P); /* take into account optimization direction */ obj = (glp_get_obj_dir(P) == GLP_MIN ? +1.0 : -1.0); /* initial settings */ piv = 0; teta = DBL_MAX; big = 0.0; /* walk through the entries of the specified row */ for (t = 1; t <= len; t++) { /* get ordinal number of non-basic variable */ k = ind[t]; if (!(1 <= k && k <= m+n)) xerror("glp_dual_rtest: ind[" + t + "] = " + k + "; variable number out of range"); /* determine status and reduced cost of non-basic variable x[k] = xN[j] in the current basic solution */ if (k <= m) { stat = glp_get_row_stat(P, k); cost = glp_get_row_dual(P, k); } else { stat = glp_get_col_stat(P, k-m); cost = glp_get_col_dual(P, k-m); } if (stat == GLP_BS) xerror("glp_dual_rtest: ind[" + t + "] = " + k + "; basic variable not allowed"); /* determine influence coefficient at non-basic variable xN[j] in the explicitly specified row and turn to the case of increasing the variable x in order to simplify the program logic */ alfa = (dir > 0 ? + val[t] : - val[t]); /* analyze main cases */ if (stat == GLP_NL) { /* xN[j] is on its lower bound */ if (alfa < + eps) continue; temp = (obj * cost) / alfa; } else if (stat == GLP_NU) { /* xN[j] is on its upper bound */ if (alfa > - eps) continue; temp = (obj * cost) / alfa; } else if (stat == GLP_NF) { /* xN[j] is non-basic free variable */ if (- eps < alfa && alfa < + eps) continue; temp = 0.0; } else if (stat == GLP_NS) { /* xN[j] is non-basic fixed variable */ continue; } else xassert(stat != stat); /* if the reduced cost of the variable xN[j] violates its zero bound (slightly, because the current basis is assumed to be dual feasible), temp is negative; we can think this happens due to round-off errors and the reduced cost is exact zero; this allows replacing temp by zero */ if (temp < 0.0) temp = 0.0; /* apply the minimal ratio test */ if (teta > temp || teta == temp && big < Math.abs(alfa)){ piv = t; teta = temp; big = Math.abs(alfa); } } /* return index of the pivot element chosen */ return piv; }; function _glp_analyze_row(P, len, ind, val, type, rhs, eps, callback){ var t, k, dir, piv, ret = 0; var x, dx, y, dy, dz; if (P.pbs_stat == GLP_UNDEF) xerror("glp_analyze_row: primal basic solution components are undefined"); if (P.dbs_stat != GLP_FEAS) xerror("glp_analyze_row: basic solution is not dual feasible"); /* compute the row value y = sum alfa[j] * xN[j] in the current basis */ if (!(0 <= len && len <= P.n)) xerror("glp_analyze_row: len = " + len + "; invalid row length"); y = 0.0; for (t = 1; t <= len; t++) { /* determine value of x[k] = xN[j] in the current basis */ k = ind[t]; if (!(1 <= k && k <= P.m+P.n)) xerror("glp_analyze_row: ind[" + t + "] = " + k + "; row/column index out of range"); if (k <= P.m) { /* x[k] is auxiliary variable */ if (P.row[k].stat == GLP_BS) xerror("glp_analyze_row: ind[" + t + "] = " + k + "; basic auxiliary variable is not allowed"); x = P.row[k].prim; } else { /* x[k] is structural variable */ if (P.col[k-P.m].stat == GLP_BS) xerror("glp_analyze_row: ind[" + t + "] = " + k + "; basic structural variable is not allowed"); x = P.col[k-P.m].prim; } y += val[t] * x; } /* check if the row is primal infeasible in the current basis, i.e. the constraint is violated at the current point */ if (type == GLP_LO) { if (y >= rhs) { /* the constraint is not violated */ ret = 1; return ret; } /* in the adjacent basis y goes to its lower bound */ dir = +1; } else if (type == GLP_UP) { if (y <= rhs) { /* the constraint is not violated */ ret = 1; return ret; } /* in the adjacent basis y goes to its upper bound */ dir = -1; } else xerror("glp_analyze_row: type = " + type + "; invalid parameter"); /* compute dy = y.new - y.old */ dy = rhs - y; /* perform dual ratio test to determine which non-basic variable should enter the adjacent basis to keep it dual feasible */ piv = glp_dual_rtest(P, len, ind, val, dir, eps); if (piv == 0) { /* no dual feasible adjacent basis exists */ ret = 2; return ret; } /* non-basic variable x[k] = xN[j] should enter the basis */ k = ind[piv]; xassert(1 <= k && k <= P.m+P.n); /* determine its value in the current basis */ if (k <= P.m) x = P.row[k].prim; else x = P.col[k-P.m].prim; /* compute dx = x.new - x.old = dy / alfa[j] */ xassert(val[piv] != 0.0); dx = dy / val[piv]; /* compute dz = z.new - z.old = d[j] * dx, where d[j] is reduced cost of xN[j] in the current basis */ if (k <= P.m) dz = P.row[k].dual * dx; else dz = P.col[k-P.m].dual * dx; /* store the analysis results */ callback(piv, x, dx, y, dy, dz); return ret; } var glp_analyze_bound = exports["glp_analyze_bound"] = function(P, k, callback){ var row; var col; var m, n, stat, kase, p, len, piv, ind; var x, new_x, ll, uu, xx, delta, val; var value1, var1, value2, var2; value1 = var1 = value2 = var2 = null; function store(){ /* store analysis results */ if (kase < 0) { value1 = new_x; var1 = p; } else { value2 = new_x; var2 = p; } } /* sanity checks */ if (P == null || P.magic != GLP_PROB_MAGIC) xerror("glp_analyze_bound: P = " + P + "; invalid problem object"); m = P.m; n = P.n; if (!(P.pbs_stat == GLP_FEAS && P.dbs_stat == GLP_FEAS)) xerror("glp_analyze_bound: optimal basic solution required"); if (!(m == 0 || P.valid)) xerror("glp_analyze_bound: basis factorization required"); if (!(1 <= k && k <= m+n)) xerror("glp_analyze_bound: k = " + k + "; variable number out of range"); /* retrieve information about the specified non-basic variable x[k] whose active bound is to be analyzed */ if (k <= m) { row = P.row[k]; stat = row.stat; x = row.prim; } else { col = P.col[k-m]; stat = col.stat; x = col.prim; } if (stat == GLP_BS) xerror("glp_analyze_bound: k = " + k + "; basic variable not allowed "); /* allocate working arrays */ ind = new Int32Array(1+m); val = new Float64Array(1+m); /* compute column of the simplex table corresponding to the non-basic variable x[k] */ len = glp_eval_tab_col(P, k, ind, val); xassert(0 <= len && len <= m); /* perform analysis */ for (kase = -1; kase <= +1; kase += 2) { /* kase < 0 means active bound of x[k] is decreasing; kase > 0 means active bound of x[k] is increasing */ /* use the primal ratio test to determine some basic variable x[p] which reaches its bound first */ piv = glp_prim_rtest(P, len, ind, val, kase, 1e-9); if (piv == 0) { /* nothing limits changing the active bound of x[k] */ p = 0; new_x = (kase < 0 ? -DBL_MAX : +DBL_MAX); store(); continue; } /* basic variable x[p] limits changing the active bound of x[k]; determine its value in the current basis */ xassert(1 <= piv && piv <= len); p = ind[piv]; if (p <= m) { row = P.row[p]; ll = glp_get_row_lb(P, row.i); uu = glp_get_row_ub(P, row.i); stat = row.stat; xx = row.prim; } else { col = P.col[p-m]; ll = glp_get_col_lb(P, col.j); uu = glp_get_col_ub(P, col.j); stat = col.stat; xx = col.prim; } xassert(stat == GLP_BS); /* determine delta x[p] = bound of x[p] - value of x[p] */ if (kase < 0 && val[piv] > 0.0 || kase > 0 && val[piv] < 0.0) { /* delta x[p] < 0, so x[p] goes toward its lower bound */ xassert(ll != -DBL_MAX); delta = ll - xx; } else { /* delta x[p] > 0, so x[p] goes toward its upper bound */ xassert(uu != +DBL_MAX); delta = uu - xx; } /* delta x[p] = alfa[p,k] * delta x[k], so new x[k] = x[k] + delta x[k] = x[k] + delta x[p] / alfa[p,k] is the value of x[k] in the adjacent basis */ xassert(val[piv] != 0.0); new_x = x + delta / val[piv]; store(); } callback(value1, var1, value2, var2) }; var glp_analyze_coef = exports["glp_analyze_coef"] = function(P, k, callback){ var row, col; var m, n, type, stat, kase, p, q, dir, clen, cpiv, rlen, rpiv, cind, rind; var lb, ub, coef, x, lim_coef, new_x, d, delta, ll, uu, xx, rval, cval; var coef1 = null, var1 = null, value1 = null, coef2 = null, var2 = null, value2 = null; function store(){ /* store analysis results */ if (kase < 0) { coef1 = lim_coef; var1 = q; value1 = new_x; } else { coef2 = lim_coef; var2 = q; value2 = new_x; } } /* sanity checks */ if (P == null || P.magic != GLP_PROB_MAGIC) xerror("glp_analyze_coef: P = " + P + "; invalid problem object"); m = P.m; n = P.n; if (!(P.pbs_stat == GLP_FEAS && P.dbs_stat == GLP_FEAS)) xerror("glp_analyze_coef: optimal basic solution required"); if (!(m == 0 || P.valid)) xerror("glp_analyze_coef: basis factorization required"); if (!(1 <= k && k <= m+n)) xerror("glp_analyze_coef: k = " + k + "; variable number out of range"); /* retrieve information about the specified basic variable x[k] whose objective coefficient c[k] is to be analyzed */ if (k <= m) { row = P.row[k]; type = row.type; lb = row.lb; ub = row.ub; coef = 0.0; stat = row.stat; x = row.prim; } else { col = P.col[k-m]; type = col.type; lb = col.lb; ub = col.ub; coef = col.coef; stat = col.stat; x = col.prim; } if (stat != GLP_BS) xerror("glp_analyze_coef: k = " + k + "; non-basic variable not allowed"); /* allocate working arrays */ cind = new Int32Array(1+m); cval = new Float64Array(1+m); rind = new Int32Array(1+n); rval = new Float64Array(1+n); /* compute row of the simplex table corresponding to the basic variable x[k] */ rlen = glp_eval_tab_row(P, k, rind, rval); xassert(0 <= rlen && rlen <= n); /* perform analysis */ for (kase = -1; kase <= +1; kase += 2) { /* kase < 0 means objective coefficient c[k] is decreasing; kase > 0 means objective coefficient c[k] is increasing */ /* note that decreasing c[k] is equivalent to increasing dual variable lambda[k] and vice versa; we need to correctly set the dir flag as required by the routine glp_dual_rtest */ if (P.dir == GLP_MIN) dir = - kase; else if (P.dir == GLP_MAX) dir = + kase; else xassert(P != P); /* use the dual ratio test to determine non-basic variable x[q] whose reduced cost d[q] reaches zero bound first */ rpiv = glp_dual_rtest(P, rlen, rind, rval, dir, 1e-9); if (rpiv == 0) { /* nothing limits changing c[k] */ lim_coef = (kase < 0 ? -DBL_MAX : +DBL_MAX); q = 0; /* x[k] keeps its current value */ new_x = x; store(); continue; } /* non-basic variable x[q] limits changing coefficient c[k]; determine its status and reduced cost d[k] in the current basis */ xassert(1 <= rpiv && rpiv <= rlen); q = rind[rpiv]; xassert(1 <= q && q <= m+n); if (q <= m) { row = P.row[q]; stat = row.stat; d = row.dual; } else { col = P.col[q-m]; stat = col.stat; d = col.dual; } /* note that delta d[q] = new d[q] - d[q] = - d[q], because new d[q] = 0; delta d[q] = alfa[k,q] * delta c[k], so delta c[k] = delta d[q] / alfa[k,q] = - d[q] / alfa[k,q] */ xassert(rval[rpiv] != 0.0); delta = - d / rval[rpiv]; /* compute new c[k] = c[k] + delta c[k], which is the limiting value of the objective coefficient c[k] */ lim_coef = coef + delta; /* let c[k] continue decreasing/increasing that makes d[q] dual infeasible and forces x[q] to enter the basis; to perform the primal ratio test we need to know in which direction x[q] changes on entering the basis; we determine that analyzing the sign of delta d[q] (see above), since d[q] may be close to zero having wrong sign */ /* let, for simplicity, the problem is minimization */ if (kase < 0 && rval[rpiv] > 0.0 || kase > 0 && rval[rpiv] < 0.0) { /* delta d[q] < 0, so d[q] being non-negative will become negative, so x[q] will increase */ dir = +1; } else { /* delta d[q] > 0, so d[q] being non-positive will become positive, so x[q] will decrease */ dir = -1; } /* if the problem is maximization, correct the direction */ if (P.dir == GLP_MAX) dir = - dir; /* check that we didn't make a silly mistake */ if (dir > 0) xassert(stat == GLP_NL || stat == GLP_NF); else xassert(stat == GLP_NU || stat == GLP_NF); /* compute column of the simplex table corresponding to the non-basic variable x[q] */ clen = glp_eval_tab_col(P, q, cind, cval); /* make x[k] temporarily free (unbounded) */ if (k <= m) { row = P.row[k]; row.type = GLP_FR; row.lb = row.ub = 0.0; } else { col = P.col[k-m]; col.type = GLP_FR; col.lb = col.ub = 0.0; } /* use the primal ratio test to determine some basic variable which leaves the basis */ cpiv = glp_prim_rtest(P, clen, cind, cval, dir, 1e-9); /* restore original bounds of the basic variable x[k] */ if (k <= m) { row = P.row[k]; row.type = type; row.lb = lb; row.ub = ub; } else { col = P.col[k-m]; col.type = type; col.lb = lb; col.ub = ub; } if (cpiv == 0) { /* non-basic variable x[q] can change unlimitedly */ if (dir < 0 && rval[rpiv] > 0.0 || dir > 0 && rval[rpiv] < 0.0) { /* delta x[k] = alfa[k,q] * delta x[q] < 0 */ new_x = -DBL_MAX; } else { /* delta x[k] = alfa[k,q] * delta x[q] > 0 */ new_x = +DBL_MAX; } store(); continue; } /* some basic variable x[p] limits changing non-basic variable x[q] in the adjacent basis */ xassert(1 <= cpiv && cpiv <= clen); p = cind[cpiv]; xassert(1 <= p && p <= m+n); xassert(p != k); if (p <= m) { row = P.row[p]; xassert(row.stat == GLP_BS); ll = glp_get_row_lb(P, row.i); uu = glp_get_row_ub(P, row.i); xx = row.prim; } else { col = P.col[p-m]; xassert(col.stat == GLP_BS); ll = glp_get_col_lb(P, col.j); uu = glp_get_col_ub(P, col.j); xx = col.prim; } /* determine delta x[p] = new x[p] - x[p] */ if (dir < 0 && cval[cpiv] > 0.0 || dir > 0 && cval[cpiv] < 0.0) { /* delta x[p] < 0, so x[p] goes toward its lower bound */ xassert(ll != -DBL_MAX); delta = ll - xx; } else { /* delta x[p] > 0, so x[p] goes toward its upper bound */ xassert(uu != +DBL_MAX); delta = uu - xx; } /* compute new x[k] = x[k] + alfa[k,q] * delta x[q], where delta x[q] = delta x[p] / alfa[p,q] */ xassert(cval[cpiv] != 0.0); new_x = x + (rval[rpiv] / cval[cpiv]) * delta; store(); } callback(coef1, var1, value1, coef2, var2, value2) }; var glp_ios_reason = exports["glp_ios_reason"] = function(tree){ return tree.reason; }; var glp_ios_get_prob = exports["glp_ios_get_prob"] = function(tree){ return tree.mip; }; function glp_ios_tree_size(tree, callback){ callback(tree.a_cnt, tree.n_cnt, tree.t_cnt); } function glp_ios_curr_node(tree){ /* obtain pointer to the current subproblem */ var node = tree.curr; /* return its reference number */ return node == null ? 0 : node.p; } function glp_ios_next_node(tree, p){ function doError(){ xerror("glp_ios_next_node: p = " + p + "; invalid subproblem reference number"); } var node; if (p == 0) { /* obtain pointer to the first active subproblem */ node = tree.head; } else { /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree.nslots)) doError(); node = tree.slot[p].node; if (node == null) doError(); /* the specified subproblem must be active */ if (node.count != 0) xerror("glp_ios_next_node: p = " + p + "; subproblem not in the active list"); /* obtain pointer to the next active subproblem */ node = node.next; } /* return the reference number */ return node == null ? 0 : node.p; } function glp_ios_prev_node(tree, p){ var node; function doError(){ xerror("glp_ios_prev_node: p = " + p + "; invalid subproblem reference number") } if (p == 0) { /* obtain pointer to the last active subproblem */ node = tree.tail; } else { /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree.nslots)) doError(); node = tree.slot[p].node; if (node == null) doError(); /* the specified subproblem must be active */ if (node.count != 0) xerror("glp_ios_prev_node: p = " + p + "; subproblem not in the active list"); /* obtain pointer to the previous active subproblem */ node = node.prev; } /* return the reference number */ return node == null ? 0 : node.p; } function glp_ios_up_node(tree, p){ var node; function doError(){ xerror("glp_ios_up_node: p = " + p + "; invalid subproblem reference number") } /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree.nslots)) doError(); node = tree.slot[p].node; if (node == null) doError(); /* obtain pointer to the parent subproblem */ node = node.up; /* return the reference number */ return node == null ? 0 : node.p; } function glp_ios_node_level(tree, p){ var node; function doError(){ xerror("glp_ios_node_level: p = " + p + "; invalid subproblem reference number") } /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree.nslots)) doError(); node = tree.slot[p].node; if (node == null) doError(); /* return the node level */ return node.level; } function glp_ios_node_bound(tree, p){ var node; function doError(){ xerror("glp_ios_node_bound: p = " + p + "; invalid subproblem reference number") } /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree.nslots)) doError(); node = tree.slot[p].node; if (node == null) doError(); /* return the node local bound */ return node.bound; } function glp_ios_best_node(tree){ return ios_best_node(tree); } function glp_ios_mip_gap(tree){ return ios_relative_gap(tree); } function glp_ios_node_data(tree, p) { var node; function doError(){ xerror("glp_ios_node_level: p = " + p + "; invalid subproblem reference number") } /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree.nslots)) doError(); node = tree.slot[p].node; if (node == null) doError(); /* return pointer to the application-specific data */ return node.data; } function glp_ios_row_attr(tree, i, attr){ var row; if (!(1 <= i && i <= tree.mip.m)) xerror("glp_ios_row_attr: i = " + i + "; row number out of range"); row = tree.mip.row[i]; attr.level = row.level; attr.origin = row.origin; attr.klass = row.klass; } function glp_ios_pool_size(tree){ /* determine current size of the cut pool */ if (tree.reason != GLP_ICUTGEN) xerror("glp_ios_pool_size: operation not allowed"); xassert(tree.local != null); return tree.local.size; } function glp_ios_add_row(tree, name, klass, flags, len, ind, val, type, rhs){ /* add row (constraint) to the cut pool */ var num; if (tree.reason != GLP_ICUTGEN) xerror("glp_ios_add_row: operation not allowed"); xassert(tree.local != null); num = ios_add_row(tree, tree.local, name, klass, flags, len, ind, val, type, rhs); return num; } function glp_ios_del_row(tree, i){ /* remove row (constraint) from the cut pool */ if (tree.reason != GLP_ICUTGEN) xerror("glp_ios_del_row: operation not allowed"); ios_del_row(tree.local, i); } function glp_ios_clear_pool(tree){ /* remove all rows (constraints) from the cut pool */ if (tree.reason != GLP_ICUTGEN) xerror("glp_ios_clear_pool: operation not allowed"); ios_clear_pool(tree.local); } function glp_ios_can_branch(tree, j){ if (!(1 <= j && j <= tree.mip.n)) xerror("glp_ios_can_branch: j = " + j + "; column number out of range"); return tree.non_int[j]; } function glp_ios_branch_upon(tree, j, sel){ if (!(1 <= j && j <= tree.mip.n)) xerror("glp_ios_branch_upon: j = " + j + "; column number out of range"); if (!(sel == GLP_DN_BRNCH || sel == GLP_UP_BRNCH || sel == GLP_NO_BRNCH)) xerror("glp_ios_branch_upon: sel = " + sel + ": invalid branch selection flag"); if (!(tree.non_int[j])) xerror("glp_ios_branch_upon: j = " + j + "; variable cannot be used to branch upon"); if (tree.br_var != 0) xerror("glp_ios_branch_upon: branching variable already chosen"); tree.br_var = j; tree.br_sel = sel; } function glp_ios_select_node(tree, p){ var node; function doError(){ xerror("glp_ios_select_node: p = " + p + "; invalid subproblem reference number") } /* obtain pointer to the specified subproblem */ if (!(1 <= p && p <= tree.nslots)) doError(); node = tree.slot[p].node; if (node == null) doError(); /* the specified subproblem must be active */ if (node.count != 0) xerror("glp_ios_select_node: p = " + p + "; subproblem not in the active list"); /* no subproblem must be selected yet */ if (tree.next_p != 0) xerror("glp_ios_select_node: subproblem already selected"); /* select the specified subproblem to continue the search */ tree.next_p = p; } function glp_ios_heur_sol(tree, x){ var mip = tree.mip; var m = tree.orig_m; var n = tree.n; var i, j; var obj; xassert(mip.m >= m); xassert(mip.n == n); /* check values of integer variables and compute value of the objective function */ obj = mip.c0; for (j = 1; j <= n; j++) { var col = mip.col[j]; if (col.kind == GLP_IV) { /* provided value must be integral */ if (x[j] != Math.floor(x[j])) return 1; } obj += col.coef * x[j]; } /* check if the provided solution is better than the best known integer feasible solution */ if (mip.mip_stat == GLP_FEAS) { switch (mip.dir) { case GLP_MIN: if (obj >= tree.mip.mip_obj) return 1; break; case GLP_MAX: if (obj <= tree.mip.mip_obj) return 1; break; default: xassert(mip != mip); } } /* it is better; store it in the problem object */ if (tree.parm.msg_lev >= GLP_MSG_ON) xprintf("Solution found by heuristic: " + obj + ""); mip.mip_stat = GLP_FEAS; mip.mip_obj = obj; for (j = 1; j <= n; j++) mip.col[j].mipx = x[j]; for (i = 1; i <= m; i++) { var row = mip.row[i]; var aij; row.mipx = 0.0; for (aij = row.ptr; aij != null; aij = aij.r_next) row.mipx += aij.val * aij.col.mipx; } return 0; } function glp_ios_terminate(tree){ if (tree.parm.msg_lev >= GLP_MSG_DBG) xprintf("The search is prematurely terminated due to application request"); tree.stop = 1; } /* glpapi14.c (processing models in GNU MathProg language) */ var glp_mpl_alloc_wksp = exports["glp_mpl_alloc_wksp"] = function(){ /* allocate the MathProg translator workspace */ return mpl_initialize(); }; var _glp_mpl_init_rand = exports["_glp_mpl_init_rand"] = function (tran, seed){ if (tran.phase != 0) xerror("glp_mpl_init_rand: invalid call sequence\n"); rng_init_rand(tran.rand, seed); }; var glp_mpl_read_model = exports["glp_mpl_read_model"] = function(tran, name, callback, skip){ /* read and translate model section */ var ret; if (tran.phase != 0) xerror("glp_mpl_read_model: invalid call sequence"); ret = mpl_read_model(tran, name, callback, skip); if (ret == 1 || ret == 2) ret = 0; else if (ret == 4) ret = 1; else xassert(ret != ret); return ret; }; var glp_mpl_read_model_from_string = exports["glp_mpl_read_model_from_string"] = function(tran, name, str, skip){ var pos = 0; return glp_mpl_read_model(tran, name, function(){ if (pos < str.length){ return str[pos++]; } else return -1; }, skip ) }; var glp_mpl_read_data = exports["glp_mpl_read_data"] = function(tran, name, callback){ /* read and translate data section */ var ret; if (!(tran.phase == 1 || tran.phase == 2)) xerror("glp_mpl_read_data: invalid call sequence"); ret = mpl_read_data(tran, name, callback); if (ret == 2) ret = 0; else if (ret == 4) ret = 1; else xassert(ret != ret); return ret; }; var glp_mpl_read_data_from_string = exports["glp_mpl_read_data_from_string"] = function(tran, name, str){ var pos = 0; return glp_mpl_read_data(tran, name, function(){ if (pos < str.length){ return str[pos++]; } else return -1; } ) }; var glp_mpl_generate = exports["glp_mpl_generate"] = function(tran, name, callback, tablecb){ /* generate the model */ var ret; if (!(tran.phase == 1 || tran.phase == 2)) xerror("glp_mpl_generate: invalid call sequence\n"); ret = mpl_generate(tran, name, callback, tablecb); if (ret == 3) ret = 0; else if (ret == 4) ret = 1; return ret; }; var glp_mpl_build_prob = exports["glp_mpl_build_prob"] = function(tran, prob){ /* build LP/MIP problem instance from the model */ var m, n, i, j, t, kind, type, len, ind; var lb, ub, val; if (tran.phase != 3) xerror("glp_mpl_build_prob: invalid call sequence\n"); /* erase the problem object */ glp_erase_prob(prob); /* set problem name */ glp_set_prob_name(prob, mpl_get_prob_name(tran)); /* build rows (constraints) */ m = mpl_get_num_rows(tran); if (m > 0) glp_add_rows(prob, m); for (i = 1; i <= m; i++) { /* set row name */ glp_set_row_name(prob, i, mpl_get_row_name(tran, i)); /* set row bounds */ type = mpl_get_row_bnds(tran, i, function(l,u){lb=l; ub=u}); switch (type) { case MPL_FR: type = GLP_FR; break; case MPL_LO: type = GLP_LO; break; case MPL_UP: type = GLP_UP; break; case MPL_DB: type = GLP_DB; break; case MPL_FX: type = GLP_FX; break; default: xassert(type != type); } if (type == GLP_DB && Math.abs(lb - ub) < 1e-9 * (1.0 + Math.abs(lb))) { type = GLP_FX; if (Math.abs(lb) <= Math.abs(ub)) ub = lb; else lb = ub; } glp_set_row_bnds(prob, i, type, lb, ub); /* warn about non-zero constant term */ if (mpl_get_row_c0(tran, i) != 0.0) xprintf("glp_mpl_build_prob: row " + mpl_get_row_name(tran, i) + "; constant term " + mpl_get_row_c0(tran, i) + " ignored"); } /* build columns (variables) */ n = mpl_get_num_cols(tran); if (n > 0) glp_add_cols(prob, n); for (j = 1; j <= n; j++) { /* set column name */ glp_set_col_name(prob, j, mpl_get_col_name(tran, j)); /* set column kind */ kind = mpl_get_col_kind(tran, j); switch (kind) { case MPL_NUM: break; case MPL_INT: case MPL_BIN: glp_set_col_kind(prob, j, GLP_IV); break; default: xassert(kind != kind); } /* set column bounds */ type = mpl_get_col_bnds(tran, j, function(l,u){lb=l; ub=u}); switch (type) { case MPL_FR: type = GLP_FR; break; case MPL_LO: type = GLP_LO; break; case MPL_UP: type = GLP_UP; break; case MPL_DB: type = GLP_DB; break; case MPL_FX: type = GLP_FX; break; default: xassert(type != type); } if (kind == MPL_BIN) { if (type == GLP_FR || type == GLP_UP || lb < 0.0) lb = 0.0; if (type == GLP_FR || type == GLP_LO || ub > 1.0) ub = 1.0; type = GLP_DB; } if (type == GLP_DB && Math.abs(lb - ub) < 1e-9 * (1.0 + Math.abs(lb))) { type = GLP_FX; if (Math.abs(lb) <= Math.abs(ub)) ub = lb; else lb = ub; } glp_set_col_bnds(prob, j, type, lb, ub); } /* load the constraint matrix */ ind = new Int32Array(1+n); val = new Float64Array(1+n); for (i = 1; i <= m; i++) { len = mpl_get_mat_row(tran, i, ind, val); glp_set_mat_row(prob, i, len, ind, val); } /* build objective function (the first objective is used) */ for (i = 1; i <= m; i++) { kind = mpl_get_row_kind(tran, i); if (kind == MPL_MIN || kind == MPL_MAX) { /* set objective name */ glp_set_obj_name(prob, mpl_get_row_name(tran, i)); /* set optimization direction */ glp_set_obj_dir(prob, kind == MPL_MIN ? GLP_MIN : GLP_MAX); /* set constant term */ glp_set_obj_coef(prob, 0, mpl_get_row_c0(tran, i)); /* set objective coefficients */ len = mpl_get_mat_row(tran, i, ind, val); for (t = 1; t <= len; t++) glp_set_obj_coef(prob, ind[t], val[t]); break; } } }; var glp_mpl_postsolve = exports["glp_mpl_postsolve"] = function(tran, prob, sol){ /* postsolve the model */ var i, j, m, n, stat, ret; var prim, dual; if (!(tran.phase == 3 && !tran.flag_p)) xerror("glp_mpl_postsolve: invalid call sequence"); if (!(sol == GLP_SOL || sol == GLP_IPT || sol == GLP_MIP)) xerror("glp_mpl_postsolve: sol = " + sol + "; invalid parameter"); m = mpl_get_num_rows(tran); n = mpl_get_num_cols(tran); if (!(m == glp_get_num_rows(prob) && n == glp_get_num_cols(prob))) xerror("glp_mpl_postsolve: wrong problem object\n"); if (!mpl_has_solve_stmt(tran)) return 0; for (i = 1; i <= m; i++) { if (sol == GLP_SOL) { stat = glp_get_row_stat(prob, i); prim = glp_get_row_prim(prob, i); dual = glp_get_row_dual(prob, i); } else if (sol == GLP_IPT) { stat = 0; prim = glp_ipt_row_prim(prob, i); dual = glp_ipt_row_dual(prob, i); } else if (sol == GLP_MIP) { stat = 0; prim = glp_mip_row_val(prob, i); dual = 0.0; } else xassert(sol != sol); if (Math.abs(prim) < 1e-9) prim = 0.0; if (Math.abs(dual) < 1e-9) dual = 0.0; mpl_put_row_soln(tran, i, stat, prim, dual); } for (j = 1; j <= n; j++) { if (sol == GLP_SOL) { stat = glp_get_col_stat(prob, j); prim = glp_get_col_prim(prob, j); dual = glp_get_col_dual(prob, j); } else if (sol == GLP_IPT) { stat = 0; prim = glp_ipt_col_prim(prob, j); dual = glp_ipt_col_dual(prob, j); } else if (sol == GLP_MIP) { stat = 0; prim = glp_mip_col_val(prob, j); dual = 0.0; } else xassert(sol != sol); if (Math.abs(prim) < 1e-9) prim = 0.0; if (Math.abs(dual) < 1e-9) dual = 0.0; mpl_put_col_soln(tran, j, stat, prim, dual); } ret = mpl_postsolve(tran); if (ret == 3) ret = 0; else if (ret == 4) ret = 1; return ret; }; function avl_create_tree(fcmp, info) { /* create AVL tree */ var tree = {}; //tree.pool = dmp_create_pool(); tree.root = null; tree.fcmp = fcmp; tree.info = info; tree.size = 0; tree.height = 0; return tree; } function avl_strcmp(info, key1, key2) { /* compare character string keys */ if (key1 == key2) return 0; else if (key1 > key2) return 1; else return -1; } function avl_insert_node(tree, key) { /* insert new node into AVL tree */ var p, q, r, flag; /* find an appropriate point for insertion */ p = null; q = tree.root; while (q != null) { p = q; if (tree.fcmp(tree.info, key, p.key) <= 0) { flag = 0; q = p.left; p.rank++; } else { flag = 1; q = p.right; } } /* create new node and insert it into the tree */ r = {}; r.key = key; r.type = 0; r.link = null; r.rank = 1; r.up = p; r.flag = (p == null ? 0 : flag); r.bal = 0; r.left = null; r.right = null; tree.size++; if (p == null) tree.root = r; else if (flag == 0) p.left = r; else p.right = r; /* go upstairs to the root and correct all subtrees affected by insertion */ while (p != null) { if (flag == 0) { /* the height of the left subtree of [p] is increased */ if (p.bal > 0) { p.bal = 0; break; } if (p.bal < 0) { rotate_subtree(tree, p); break; } p.bal = -1; flag = p.flag; p = p.up; } else { /* the height of the right subtree of [p] is increased */ if (p.bal < 0) { p.bal = 0; break; } if (p.bal > 0) { rotate_subtree(tree, p); break; } p.bal = +1; flag = p.flag; p = p.up; } } /* if the root has been reached, the height of the entire tree is increased */ if (p == null) tree.height++; return r; } function avl_set_node_type(node, type) { /* assign the type field of specified node */ node.type = type; } function avl_set_node_link(node, link) { /* assign the link field of specified node */ node.link = link; } function avl_find_node(tree, key) { /* find node in AVL tree */ var p, c; p = tree.root; while (p != null) { c = tree.fcmp(tree.info, key, p.key); if (c == 0) break; p = (c < 0 ? p.left : p.right); } return p; } function avl_get_node_type(node) { /* retrieve the type field of specified node */ return node.type; } function avl_get_node_link(node) { /* retrieve the link field of specified node */ return node.link; } function find_next_node(tree, node) { /* find next node in AVL tree */ var p, q; if (tree.root == null) return null; p = node; q = (p == null ? tree.root : p.right); if (q == null) { /* go upstairs from the left subtree */ for (;;) { q = p.up; if (q == null) break; if (p.flag == 0) break; p = q; } } else { /* go downstairs into the right subtree */ for (;;) { p = q.left; if (p == null) break; q = p; } } return q; } function avl_delete_node(tree, node) { /* delete specified node from AVL tree */ var f, p, q, r, s, x, y, flag; p = node; /* if both subtrees of the specified node are non-empty, the node should be interchanged with the next one, at least one subtree of which is always empty */ if (p.left != null && p.right != null){ f = p.up; q = p.left; r = find_next_node(tree, p); s = r.right; if (p.right == r) { if (f == null) tree.root = r; else if (p.flag == 0) f.left = r; else f.right = r; r.rank = p.rank; r.up = f; r.flag = p.flag; r.bal = p.bal; r.left = q; r.right = p; q.up = r; p.rank = 1; p.up = r; p.flag = 1; p.bal = (s == null ? 0 : +1); p.left = null; p.right = s; if (s != null) s.up = p; } else { x = p.right; y = r.up; if (f == null) tree.root = r; else if (p.flag == 0) f.left = r; else f.right = r; r.rank = p.rank; r.up = f; r.flag = p.flag; r.bal = p.bal; r.left = q; r.right = x; q.up = r; x.up = r; y.left = p; p.rank = 1; p.up = y; p.flag = 0; p.bal = (s == null ? 0 : +1); p.left = null; p.right = s; if (s != null) s.up = p; } } /* now the specified node [p] has at least one empty subtree; go upstairs to the root and adjust the rank field of all nodes affected by deletion */ q = p; f = q.up; while (f != null) { if (q.flag == 0) f.rank--; q = f; f = q.up; } /* delete the specified node from the tree */ f = p.up; flag = p.flag; q = p.left != null ? p.left : p.right; if (f == null) tree.root = q; else if (flag == 0) f.left = q; else f.right = q; if (q != null){q.up = f; q.flag = flag} tree.size--; /* go upstairs to the root and correct all subtrees affected by deletion */ while (f != null) { if (flag == 0) { /* the height of the left subtree of [f] is decreased */ if (f.bal == 0) { f.bal = +1; break; } if (f.bal < 0) f.bal = 0; else { f = rotate_subtree(tree, f); if (f.bal < 0) break; } flag = f.flag; f = f.up; } else { /* the height of the right subtree of [f] is decreased */ if (f.bal == 0) { f.bal = -1; break; } if (f.bal > 0) f.bal = 0; else { f = rotate_subtree(tree, f); if (f.bal > 0) break; } flag = f.flag; f = f.up; } } /* if the root has been reached, the height of the entire tree is decreased */ if (f == null) tree.height--; } function rotate_subtree(tree, node) { /* restore balance of AVL subtree */ var f, p, q, r, x, y; xassert(node != null); p = node; if (p.bal < 0) { /* perform negative (left) rotation */ f = p.up; q = p.left; r = q.right; if (q.bal <= 0) { /* perform single negative rotation */ if (f == null) tree.root = q; else if (p.flag == 0) f.left = q; else f.right = q; p.rank -= q.rank; q.up = f; q.flag = p.flag; q.bal++; q.right = p; p.up = q; p.flag = 1; p.bal = -q.bal; p.left = r; if (r != null){r.up = p; r.flag = 0} node = q; } else { /* perform double negative rotation */ x = r.left; y = r.right; if (f == null) tree.root = r; else if (p.flag == 0) f.left = r; else f.right = r; p.rank -= (q.rank + r.rank); r.rank += q.rank; p.bal = (r.bal >= 0 ? 0 : +1); q.bal = (r.bal <= 0 ? 0 : -1); r.up = f; r.flag = p.flag; r.bal = 0; r.left = q; r.right = p; p.up = r; p.flag = 1; p.left = y; q.up = r; q.flag = 0; q.right = x; if (x != null){x.up = q; x.flag = 1} if (y != null){y.up = p; y.flag = 0} node = r; } } else { /* perform positive (right) rotation */ f = p.up; q = p.right; r = q.left; if (q.bal >= 0) { /* perform single positive rotation */ if (f == null) tree.root = q; else if (p.flag == 0) f.left = q; else f.right = q; q.rank += p.rank; q.up = f; q.flag = p.flag; q.bal--; q.left = p; p.up = q; p.flag = 0; p.bal = -q.bal; p.right = r; if (r != null){r.up = p; r.flag = 1} node = q; } else { /* perform double positive rotation */ x = r.left; y = r.right; if (f == null) tree.root = r; else if (p.flag == 0) f.left = r; else f.right = r; q.rank -= r.rank; r.rank += p.rank; p.bal = (r.bal <= 0 ? 0 : -1); q.bal = (r.bal >= 0 ? 0 : +1); r.up = f; r.flag = p.flag; r.bal = 0; r.left = p; r.right = q; p.up = r; p.flag = 0; p.right = x; q.up = r; q.flag = 1; q.left = y; if (x != null){x.up = p; x.flag = 1} if (y != null){y.up = q; y.flag = 0} node = r; } } return node; } /* return codes: */ var BFD_ESING = 1, /* singular matrix */ BFD_ECOND = 2, /* ill-conditioned matrix */ BFD_ECHECK = 3, /* insufficient accuracy */ BFD_ELIMIT = 4, /* update limit reached */ BFD_EROOM = 5; /* SVA overflow */ function bfd_create_it(){ var bfd = {}; bfd.valid = 0; bfd.type = GLP_BF_FT; bfd.fhv = null; bfd.lpf = null; bfd.lu_size = 0; bfd.piv_tol = 0.10; bfd.piv_lim = 4; bfd.suhl = 1; bfd.eps_tol = 1e-15; bfd.max_gro = 1e+10; bfd.nfs_max = 100; bfd.upd_tol = 1e-6; bfd.nrs_max = 100; bfd.rs_size = 1000; bfd.upd_lim = -1; bfd.upd_cnt = 0; return bfd; } function bfd_set_parm(bfd, parm){ /* change LP basis factorization control parameters */ xassert(bfd != null); bfd.type = parm.type; bfd.lu_size = parm.lu_size; bfd.piv_tol = parm.piv_tol; bfd.piv_lim = parm.piv_lim; bfd.suhl = parm.suhl; bfd.eps_tol = parm.eps_tol; bfd.max_gro = parm.max_gro; bfd.nfs_max = parm.nfs_max; bfd.upd_tol = parm.upd_tol; bfd.nrs_max = parm.nrs_max; bfd.rs_size = parm.rs_size; } function bfd_factorize(bfd, m, bh, col, info){ var luf; var nov, ret; xassert(bfd != null); xassert(1 <= m && m <= M_MAX); /* invalidate the factorization */ bfd.valid = 0; /* create the factorization, if necessary */ nov = 0; switch (bfd.type) { case GLP_BF_FT: bfd.lpf = null; if (bfd.fhv == null){ bfd.fhv = fhv_create_it(); nov = 1; } break; case GLP_BF_BG: case GLP_BF_GR: bfd.fhv = null; if (bfd.lpf == null){ bfd.lpf = lpf_create_it(); nov = 1; } break; default: xassert(bfd != bfd); } /* set control parameters specific to LUF */ if (bfd.fhv != null) luf = bfd.fhv.luf; else if (bfd.lpf != null) luf = bfd.lpf.luf; else xassert(bfd != bfd); if (nov) luf.new_sva = bfd.lu_size; luf.piv_tol = bfd.piv_tol; luf.piv_lim = bfd.piv_lim; luf.suhl = bfd.suhl; luf.eps_tol = bfd.eps_tol; luf.max_gro = bfd.max_gro; /* set control parameters specific to FHV */ if (bfd.fhv != null) { if (nov) bfd.fhv.hh_max = bfd.nfs_max; bfd.fhv.upd_tol = bfd.upd_tol; } /* set control parameters specific to LPF */ if (bfd.lpf != null) { if (nov) bfd.lpf.n_max = bfd.nrs_max; if (nov) bfd.lpf.v_size = bfd.rs_size; } /* try to factorize the basis matrix */ if (bfd.fhv != null) { switch (fhv_factorize(bfd.fhv, m, col, info)) { case 0: break; case FHV_ESING: ret = BFD_ESING; return ret; case FHV_ECOND: ret = BFD_ECOND; return ret; default: xassert(bfd != bfd); } } else if (bfd.lpf != null) { switch (lpf_factorize(bfd.lpf, m, bh, col, info)) { case 0: /* set the Schur complement update type */ switch (bfd.type) { case GLP_BF_BG: /* Bartels-Golub update */ bfd.lpf.scf.t_opt = SCF_TBG; break; case GLP_BF_GR: /* Givens rotation update */ bfd.lpf.scf.t_opt = SCF_TGR; break; default: xassert(bfd != bfd); } break; case LPF_ESING: ret = BFD_ESING; return ret; case LPF_ECOND: ret = BFD_ECOND; return ret; default: xassert(bfd != bfd); } } else xassert(bfd != bfd); /* the basis matrix has been successfully factorized */ bfd.valid = 1; bfd.upd_cnt = 0; ret = 0; /* return to the calling program */ return ret; } function bfd_ftran(bfd, x){ xassert(bfd != null); xassert(bfd.valid); if (bfd.fhv != null) fhv_ftran(bfd.fhv, x); else if (bfd.lpf != null) lpf_ftran(bfd.lpf, x); else xassert(bfd != bfd); } function bfd_btran(bfd, x){ xassert(bfd != null); xassert(bfd.valid); if (bfd.fhv != null) fhv_btran(bfd.fhv, x); else if (bfd.lpf != null) lpf_btran(bfd.lpf, x); else xassert(bfd != bfd); } function bfd_update_it(bfd, j, bh, len, ind, idx, val){ var ret; xassert(bfd != null); xassert(bfd.valid); /* try to update the factorization */ if (bfd.fhv != null) { switch (fhv_update_it(bfd.fhv, j, len, ind, idx, val)) { case 0: break; case FHV_ESING: bfd.valid = 0; ret = BFD_ESING; return ret; case FHV_ECHECK: bfd.valid = 0; ret = BFD_ECHECK; return ret; case FHV_ELIMIT: bfd.valid = 0; ret = BFD_ELIMIT; return ret; case FHV_EROOM: bfd.valid = 0; ret = BFD_EROOM; return ret; default: xassert(bfd != bfd); } } else if (bfd.lpf != null) { switch (lpf_update_it(bfd.lpf, j, bh, len, ind, idx, val)) { case 0: break; case LPF_ESING: bfd.valid = 0; ret = BFD_ESING; return ret; case LPF_ELIMIT: bfd.valid = 0; ret = BFD_ELIMIT; return ret; default: xassert(bfd != bfd); } } else xassert(bfd != bfd); /* the factorization has been successfully updated */ /* increase the update count */ bfd.upd_cnt++; ret = 0; /* return to the calling program */ return ret; } function bfd_get_count(bfd){ /* determine factorization update count */ xassert(bfd != null); xassert(bfd.valid); return bfd.upd_cnt; } function check_parm(func, parm){ /* check control parameters */ xassert(func != null); xassert(parm != null); } var CHAR_SET = "!\"#$%&()/,.;?@_`'{}|~"; /* characters, which may appear in symbolic names */ var glp_read_lp = exports["glp_read_lp"] = function(P, parm, callback){ var T_EOF = 0x00, /* end of file */ T_MINIMIZE = 0x01, /* keyword 'minimize' */ T_MAXIMIZE = 0x02, /* keyword 'maximize' */ T_SUBJECT_TO = 0x03, /* keyword 'subject to' */ T_BOUNDS = 0x04, /* keyword 'bounds' */ T_GENERAL = 0x05, /* keyword 'general' */ T_INTEGER = 0x06, /* keyword 'integer' */ T_BINARY = 0x07, /* keyword 'binary' */ T_END = 0x08, /* keyword 'end' */ T_NAME = 0x09, /* symbolic name */ T_NUMBER = 0x0A, /* numeric constant */ T_PLUS = 0x0B, /* delimiter '+' */ T_MINUS = 0x0C, /* delimiter '-' */ T_COLON = 0x0D, /* delimiter ':' */ T_LE = 0x0E, /* delimiter '<=' */ T_GE = 0x0F, /* delimiter '>=' */ T_EQ = 0x10; /* delimiter '=' */ function error(csa, fmt){ /* print error message and terminate processing */ throw new Error(csa.count + ": " + fmt); } function warning(csa, fmt) { /* print warning message and continue processing */ xprintf(csa.count + ": warning: " + fmt); } function read_char(csa){ /* read next character from input file */ var c; xassert(csa.c != XEOF); if (csa.c == '\n') csa.count++; c = csa.callback(); if (c < 0) { if (csa.c == '\n') { csa.count--; c = XEOF; } else { warning(csa, "missing final end of line"); c = '\n'; } } else if (c == '\n'){ } else if (isspace(c)) c = ' '; else if (iscntrl(c)) error(csa, "invalid control character " + c.charCodeAt(0)); csa.c = c; } function add_char(csa){ /* append current character to current token */ csa.image += csa.c; read_char(csa); } function the_same(s1, s2) { /* compare two character strings ignoring case sensitivity */ return (s1.toLowerCase() == s2.toLowerCase())?1:0; } function scan_token(csa){ /* scan next token */ var flag; csa.token = -1; csa.image = ""; csa.value = 0.0; function name(){ /* symbolic name */ csa.token = T_NAME; while (isalnum(csa.c) || strchr(CHAR_SET, csa.c) >= 0) add_char(csa); if (flag) { /* check for keyword */ if (the_same(csa.image, "minimize")) csa.token = T_MINIMIZE; else if (the_same(csa.image, "minimum")) csa.token = T_MINIMIZE; else if (the_same(csa.image, "min")) csa.token = T_MINIMIZE; else if (the_same(csa.image, "maximize")) csa.token = T_MAXIMIZE; else if (the_same(csa.image, "maximum")) csa.token = T_MAXIMIZE; else if (the_same(csa.image, "max")) csa.token = T_MAXIMIZE; else if (the_same(csa.image, "subject")) { if (csa.c == ' ') { read_char(csa); if (tolower(csa.c) == 't') { csa.token = T_SUBJECT_TO; csa.image += ' '; add_char(csa); if (tolower(csa.c) != 'o') error(csa, "keyword `subject to' incomplete"); add_char(csa); if (isalpha(csa.c)) error(csa, "keyword `" + csa.image + csa.c + "...' not recognized"); } } } else if (the_same(csa.image, "such")) { if (csa.c == ' ') { read_char(csa); if (tolower(csa.c) == 't') { csa.token = T_SUBJECT_TO; csa.image += ' '; add_char(csa); if (tolower(csa.c) != 'h') error(csa, "keyword `such that' incomplete"); add_char(csa); if (tolower(csa.c) != 'a') error(csa, "keyword `such that' incomplete"); add_char(csa); if (tolower(csa.c) != 't') error(csa, "keyword `such that' incomplete"); add_char(csa); if (isalpha(csa.c)) error(csa, "keyword `" + csa.image + csa.c + "...' not recognized"); } } } else if (the_same(csa.image, "st")) csa.token = T_SUBJECT_TO; else if (the_same(csa.image, "s.t.")) csa.token = T_SUBJECT_TO; else if (the_same(csa.image, "st.")) csa.token = T_SUBJECT_TO; else if (the_same(csa.image, "bounds")) csa.token = T_BOUNDS; else if (the_same(csa.image, "bound")) csa.token = T_BOUNDS; else if (the_same(csa.image, "general")) csa.token = T_GENERAL; else if (the_same(csa.image, "generals")) csa.token = T_GENERAL; else if (the_same(csa.image, "gen")) csa.token = T_GENERAL; else if (the_same(csa.image, "integer")) csa.token = T_INTEGER; else if (the_same(csa.image, "integers")) csa.token = T_INTEGER; else if (the_same(csa.image, "int")) csa.token = T_INTEGER; else if (the_same(csa.image, "binary")) csa.token = T_BINARY; else if (the_same(csa.image, "binaries")) csa.token = T_BINARY; else if (the_same(csa.image, "bin")) csa.token = T_BINARY; else if (the_same(csa.image, "end")) csa.token = T_END; } } while (true){ flag = 0; /* skip non-significant characters */ while (csa.c == ' ') read_char(csa); /* recognize and scan current token */ if (csa.c == XEOF) csa.token = T_EOF; else if (csa.c == '\n') { read_char(csa); /* if the next character is letter, it may begin a keyword */ if (isalpha(csa.c)) { flag = 1; name(); } else continue; } else if (csa.c == '\\') { /* comment; ignore everything until end-of-line */ while (csa.c != '\n') read_char(csa); continue; } else if (isalpha(csa.c) || csa.c != '.' && strchr(CHAR_SET, csa.c) >= 0){ name(); } else if (isdigit(csa.c) || csa.c == '.') { /* numeric constant */ csa.token = T_NUMBER; /* scan integer part */ while (isdigit(csa.c)) add_char(csa); /* scan optional fractional part (it is mandatory, if there is no integer part) */ if (csa.c == '.') { add_char(csa); if (csa.image.length == 1 && !isdigit(csa.c)) error(csa, "invalid use of decimal point"); while (isdigit(csa.c)) add_char(csa); } /* scan optional decimal exponent */ if (csa.c == 'e' || csa.c == 'E') { add_char(csa); if (csa.c == '+' || csa.c == '-') add_char(csa); if (!isdigit(csa.c)) error(csa, "numeric constant `" + csa.image + "' incomplete"); while (isdigit(csa.c)) add_char(csa); } /* convert the numeric constant to floating-point */ csa.value = Number(csa.image); if (csa.value == Number.NaN) error(csa, "numeric constant `" + csa.image + "' out of range"); } else if (csa.c == '+'){ csa.token = T_PLUS; add_char(csa); } else if (csa.c == '-'){ csa.token = T_MINUS; add_char(csa); } else if (csa.c == ':'){ csa.token = T_COLON; add_char(csa); } else if (csa.c == '<') { csa.token = T_LE; add_char(csa); if (csa.c == '=') add_char(csa); } else if (csa.c == '>') { csa.token = T_GE; add_char(csa); if (csa.c == '=') add_char(csa); } else if (csa.c == '=') { csa.token = T_EQ; add_char(csa); if (csa.c == '<'){ csa.token = T_LE; add_char(csa); } else if (csa.c == '>'){ csa.token = T_GE; add_char(csa); } } else error(csa, "character `" + csa.c + "' not recognized"); break } /* skip non-significant characters */ while (csa.c == ' ') read_char(csa); } function find_col(csa, name){ /* find column by its symbolic name */ var j = glp_find_col(csa.P, name); if (j == 0) { /* not found; create new column */ j = glp_add_cols(csa.P, 1); glp_set_col_name(csa.P, j, name); /* enlarge working arrays, if necessary */ if (csa.n_max < j) { var n_max = csa.n_max; var ind = csa.ind; var val = csa.val; var flag = csa.flag; var lb = csa.lb; var ub = csa.ub; csa.n_max += csa.n_max; csa.ind = new Int32Array(1+csa.n_max); xcopyArr(csa.ind, 1, ind, 1, n_max); csa.val = new Float64Array(1+csa.n_max); xcopyArr(csa.val, 1, val, 1, n_max); csa.flag = new Int8Array(1+csa.n_max); xfillArr(csa.flag, 1, 0, csa.n_max); xcopyArr(csa.flag, 1, flag, 1, n_max); csa.lb = new Float64Array(1+csa.n_max); xcopyArr(csa.lb, 1, lb, 1, n_max); csa.ub = new Float64Array(1+csa.n_max); xcopyArr(csa.ub, 1, ub, 1, n_max); } csa.lb[j] = +DBL_MAX; csa.ub[j] = -DBL_MAX; } return j; } function parse_linear_form(csa){ var j, k, len = 0, newlen; var s, coef; while(true){ /* parse an optional sign */ if (csa.token == T_PLUS){ s = +1.0; scan_token(csa); } else if (csa.token == T_MINUS){ s = -1.0; scan_token(csa); } else s = +1.0; /* parse an optional coefficient */ if (csa.token == T_NUMBER){ coef = csa.value; scan_token(csa); } else coef = 1.0; /* parse a variable name */ if (csa.token != T_NAME) error(csa, "missing variable name"); /* find the corresponding column */ j = find_col(csa, csa.image); /* check if the variable is already used in the linear form */ if (csa.flag[j]) error(csa, "multiple use of variable `" + csa.image + "' not allowed"); /* add new term to the linear form */ len++; csa.ind[len] = j; csa.val[len] = s * coef; /* and mark that the variable is used in the linear form */ csa.flag[j] = 1; scan_token(csa); /* if the next token is a sign, there is another term */ if (csa.token == T_PLUS || csa.token == T_MINUS) continue; /* clear marks of the variables used in the linear form */ for (k = 1; k <= len; k++) csa.flag[csa.ind[k]] = 0; /* remove zero coefficients */ newlen = 0; for (k = 1; k <= len; k++) { if (csa.val[k] != 0.0) { newlen++; csa.ind[newlen] = csa.ind[k]; csa.val[newlen] = csa.val[k]; } } break; } return newlen; } function parse_objective(csa){ /* parse objective sense */ var k, len; /* parse the keyword 'minimize' or 'maximize' */ if (csa.token == T_MINIMIZE) glp_set_obj_dir(csa.P, GLP_MIN); else if (csa.token == T_MAXIMIZE) glp_set_obj_dir(csa.P, GLP_MAX); else xassert(csa != csa); scan_token(csa); /* parse objective name */ if (csa.token == T_NAME && csa.c == ':') { /* objective name is followed by a colon */ glp_set_obj_name(csa.P, csa.image); scan_token(csa); xassert(csa.token == T_COLON); scan_token(csa); } else { /* objective name is not specified; use default */ glp_set_obj_name(csa.P, "obj"); } /* parse linear form */ len = parse_linear_form(csa); for (k = 1; k <= len; k++) glp_set_obj_coef(csa.P, csa.ind[k], csa.val[k]); } function parse_constraints(csa){ var i, len, type; var s; /* parse the keyword 'subject to' */ xassert(csa.token == T_SUBJECT_TO); scan_token(csa); while (true){ /* create new row (constraint) */ i = glp_add_rows(csa.P, 1); /* parse row name */ if (csa.token == T_NAME && csa.c == ':') { /* row name is followed by a colon */ if (glp_find_row(csa.P, csa.image) != 0) error(csa, "constraint `" + csa.image + "' multiply defined"); glp_set_row_name(csa.P, i, csa.image); scan_token(csa); xassert(csa.token == T_COLON); scan_token(csa); } else { /* row name is not specified; use default */ glp_set_row_name(csa.P, i, "r." + csa.count); } /* parse linear form */ len = parse_linear_form(csa); glp_set_mat_row(csa.P, i, len, csa.ind, csa.val); /* parse constraint sense */ if (csa.token == T_LE){ type = GLP_UP; scan_token(csa); } else if (csa.token == T_GE){ type = GLP_LO; scan_token(csa); } else if (csa.token == T_EQ){ type = GLP_FX; scan_token(csa); } else error(csa, "missing constraint sense"); /* parse right-hand side */ if (csa.token == T_PLUS){ s = +1.0; scan_token(csa); } else if (csa.token == T_MINUS){ s = -1.0; scan_token(csa); } else s = +1.0; if (csa.token != T_NUMBER) error(csa, "missing right-hand side"); glp_set_row_bnds(csa.P, i, type, s * csa.value, s * csa.value); /* the rest of the current line must be empty */ if (!(csa.c == '\n' || csa.c == XEOF)) error(csa, "invalid symbol(s) beyond right-hand side"); scan_token(csa); /* if the next token is a sign, numeric constant, or a symbolic name, here is another constraint */ if (csa.token == T_PLUS || csa.token == T_MINUS || csa.token == T_NUMBER || csa.token == T_NAME) continue; break; } } function set_lower_bound(csa, j, lb){ /* set lower bound of j-th variable */ if (csa.lb[j] != +DBL_MAX) { warning(csa, "lower bound of variable `" + glp_get_col_name(csa.P, j) + "' redefined"); } csa.lb[j] = lb; } function set_upper_bound(csa, j, ub){ /* set upper bound of j-th variable */ if (csa.ub[j] != -DBL_MAX) { warning(csa, "upper bound of variable `" + glp_get_col_name(csa.P, j) + "' redefined"); } csa.ub[j] = ub; } function parse_bounds(csa){ var j, lb_flag; var lb, s; /* parse the keyword 'bounds' */ xassert(csa.token == T_BOUNDS); scan_token(csa); while (true){ /* bound definition can start with a sign, numeric constant, or a symbolic name */ if (!(csa.token == T_PLUS || csa.token == T_MINUS || csa.token == T_NUMBER || csa.token == T_NAME)) return; /* parse bound definition */ if (csa.token == T_PLUS || csa.token == T_MINUS) { /* parse signed lower bound */ lb_flag = 1; s = (csa.token == T_PLUS ? +1.0 : -1.0); scan_token(csa); if (csa.token == T_NUMBER){ lb = s * csa.value; scan_token(csa); } else if (the_same(csa.image, "infinity") || the_same(csa.image, "inf")) { if (s > 0.0) error(csa, "invalid use of `+inf' as lower bound"); lb = -DBL_MAX; scan_token(csa); } else error(csa, "missing lower bound"); } else if (csa.token == T_NUMBER) { /* parse unsigned lower bound */ lb_flag = 1; lb = csa.value; scan_token(csa); } else { /* lower bound is not specified */ lb_flag = 0; } /* parse the token that should follow the lower bound */ if (lb_flag) { if (csa.token != T_LE) error(csa, "missing `<', `<=', or `=<' after lower bound"); scan_token(csa); } /* parse variable name */ if (csa.token != T_NAME) error(csa, "missing variable name"); j = find_col(csa, csa.image); /* set lower bound */ if (lb_flag) set_lower_bound(csa, j, lb); scan_token(csa); /* parse the context that follows the variable name */ if (csa.token == T_LE) { /* parse upper bound */ scan_token(csa); if (csa.token == T_PLUS || csa.token == T_MINUS) { /* parse signed upper bound */ s = (csa.token == T_PLUS ? +1.0 : -1.0); scan_token(csa); if (csa.token == T_NUMBER) { set_upper_bound(csa, j, s * csa.value); scan_token(csa); } else if (the_same(csa.image, "infinity") || the_same(csa.image, "inf")) { if (s < 0.0) error(csa, "invalid use of `-inf' as upper bound"); set_upper_bound(csa, j, +DBL_MAX); scan_token(csa); } else error(csa, "missing upper bound"); } else if (csa.token == T_NUMBER) { /* parse unsigned upper bound */ set_upper_bound(csa, j, csa.value); scan_token(csa); } else error(csa, "missing upper bound"); } else if (csa.token == T_GE) { /* parse lower bound */ if (lb_flag) { /* the context '... <= x >= ...' is invalid */ error(csa, "invalid bound definition"); } scan_token(csa); if (csa.token == T_PLUS || csa.token == T_MINUS) { /* parse signed lower bound */ s = (csa.token == T_PLUS ? +1.0 : -1.0); scan_token(csa); if (csa.token == T_NUMBER) { set_lower_bound(csa, j, s * csa.value); scan_token(csa); } else if (the_same(csa.image, "infinity") || the_same(csa.image, "inf") == 0) { if (s > 0.0) error(csa, "invalid use of `+inf' as lower bound"); set_lower_bound(csa, j, -DBL_MAX); scan_token(csa); } else error(csa, "missing lower bound"); } else if (csa.token == T_NUMBER) { /* parse unsigned lower bound */ set_lower_bound(csa, j, csa.value); scan_token(csa); } else error(csa, "missing lower bound"); } else if (csa.token == T_EQ) { /* parse fixed value */ if (lb_flag) { /* the context '... <= x = ...' is invalid */ error(csa, "invalid bound definition"); } scan_token(csa); if (csa.token == T_PLUS || csa.token == T_MINUS) { /* parse signed fixed value */ s = (csa.token == T_PLUS ? +1.0 : -1.0); scan_token(csa); if (csa.token == T_NUMBER) { set_lower_bound(csa, j, s * csa.value); set_upper_bound(csa, j, s * csa.value); scan_token(csa); } else error(csa, "missing fixed value"); } else if (csa.token == T_NUMBER) { /* parse unsigned fixed value */ set_lower_bound(csa, j, csa.value); set_upper_bound(csa, j, csa.value); scan_token(csa); } else error(csa, "missing fixed value"); } else if (the_same(csa.image, "free")) { /* parse the keyword 'free' */ if (lb_flag) { /* the context '... <= x free ...' is invalid */ error(csa, "invalid bound definition"); } set_lower_bound(csa, j, -DBL_MAX); set_upper_bound(csa, j, +DBL_MAX); scan_token(csa); } else if (!lb_flag) { /* neither lower nor upper bounds are specified */ error(csa, "invalid bound definition"); } } } function parse_integer(csa){ var j, binary; /* parse the keyword 'general', 'integer', or 'binary' */ if (csa.token == T_GENERAL){ binary = 0; scan_token(csa); } else if (csa.token == T_INTEGER){ binary = 0; scan_token(csa); } else if (csa.token == T_BINARY){ binary = 1; scan_token(csa); } else xassert(csa != csa); /* parse list of variables (may be empty) */ while (csa.token == T_NAME) { /* find the corresponding column */ j = find_col(csa, csa.image); /* change kind of the variable */ glp_set_col_kind(csa.P, j, GLP_IV); /* set 0-1 bounds for the binary variable */ if (binary) { set_lower_bound(csa, j, 0.0); set_upper_bound(csa, j, 1.0); } scan_token(csa); } } /* read problem data in CPLEX LP format */ var csa = {}; var ret; xprintf("Reading problem data"); if (parm == null){ parm = {}; } /* check control parameters */ check_parm("glp_read_lp", parm); /* initialize common storage area */ csa.P = P; csa.parm = parm; csa.callback = callback; csa.count = 0; csa.c = '\n'; csa.token = T_EOF; csa.image = ""; csa.value = 0.0; csa.n_max = 100; csa.ind = new Int32Array(1+csa.n_max); csa.val = new Float64Array(1+csa.n_max); csa.flag = new Int8Array(1+csa.n_max); xfillArr(csa.flag, 1, 0, csa.n_max); csa.lb = new Float64Array(1+csa.n_max); csa.ub = new Float64Array(1+csa.n_max); /* erase problem object */ glp_erase_prob(P); glp_create_index(P); /* scan very first token */ scan_token(csa); /* parse definition of the objective function */ if (!(csa.token == T_MINIMIZE || csa.token == T_MAXIMIZE)) error(csa, "`minimize' or `maximize' keyword missing"); parse_objective(csa); /* parse constraints section */ if (csa.token != T_SUBJECT_TO) error(csa, "constraints section missing"); parse_constraints(csa); /* parse optional bounds section */ if (csa.token == T_BOUNDS) parse_bounds(csa); /* parse optional general, integer, and binary sections */ while (csa.token == T_GENERAL || csa.token == T_INTEGER || csa.token == T_BINARY) parse_integer(csa); /* check for the keyword 'end' */ if (csa.token == T_END) scan_token(csa); else if (csa.token == T_EOF) warning(csa, "keyword `end' missing"); else error(csa, "symbol " + csa.image + " in wrong position"); /* nothing must follow the keyword 'end' (except comments) */ if (csa.token != T_EOF) error(csa, "extra symbol(s) detected beyond `end'"); /* set bounds of variables */ { var j, type; var lb, ub; for (j = 1; j <= P.n; j++) { lb = csa.lb[j]; ub = csa.ub[j]; if (lb == +DBL_MAX) lb = 0.0; /* default lb */ if (ub == -DBL_MAX) ub = +DBL_MAX; /* default ub */ if (lb == -DBL_MAX && ub == +DBL_MAX) type = GLP_FR; else if (ub == +DBL_MAX) type = GLP_LO; else if (lb == -DBL_MAX) type = GLP_UP; else if (lb != ub) type = GLP_DB; else type = GLP_FX; glp_set_col_bnds(csa.P, j, type, lb, ub); } } /* print some statistics */ xprintf(P.m + " row" + (P.m == 1 ? "" : "s") + ", " + P.n + " column" + (P.n == 1 ? "" : "s") + ", " + P.nnz + " non-zero" + (P.nnz == 1 ? "" : "s")); if (glp_get_num_int(P) > 0) { var ni = glp_get_num_int(P); var nb = glp_get_num_bin(P); if (ni == 1) { if (nb == 0) xprintf("One variable is integer"); else xprintf("One variable is binary"); } else { var line = ni + " integer variables, "; if (nb == 0) line += "none"; else if (nb == 1) line += "one"; else if (nb == ni) line += "all"; else line += nb; xprintf(line + " of which " + (nb == 1 ? "is" : "are") + " binary"); } } xprintf(csa.count + " lines were read"); /* problem data has been successfully read */ glp_delete_index(P); glp_sort_matrix(P); ret = 0; function done(){ if (ret != 0) glp_erase_prob(P); return ret; } return done(); }; var glp_write_lp = exports["glp_write_lp"] = function(P, parm, callback){ function check_name(name){ /* check if specified name is valid for CPLEX LP format */ if (name[0] == '.') return 1; if (isdigit((name[0]))) return 1; for (var i = 0; i < name.length; i++) { if (!isalnum(name[i]) && strchr(CHAR_SET, name[i]) < 0) return 1; } return 0; /* name is ok */ } function adjust_name(name){ /* attempt to adjust specified name to make it valid for CPLEX LP format */ for (var i = 0; i < name.length; i++) { if (name[i] == ' ') name[i] = '_'; else if (name[i] == '-') name[i] = '~'; else if (name[i] == '[') name[i] = '('; else if (name[i] == ']') name[i] = ')'; } } function row_name(csa, i){ /* construct symbolic name of i-th row (constraint) */ var name; if (i == 0) name = glp_get_obj_name(csa.P); else name = glp_get_row_name(csa.P, i); if (name == null) return fake(); adjust_name(name); if (check_name(name)) return fake(); return name; function fake(){ if (i == 0) return "obj"; else return "r_" + i; } } function col_name(csa, j){ /* construct symbolic name of j-th column (variable) */ var name = glp_get_col_name(csa.P, j); if (name == null) return fake(); adjust_name(name); if (check_name(name)) return fake(); return name; function fake(){ return "x_" + j; } } /* write problem data in CPLEX LP format */ var csa = {}; var row; var col; var aij; var i, j, len, flag, count, ret; var line, term, name; xprintf("Writing problem data"); if (parm == null){ parm = {}; } /* check control parameters */ check_parm("glp_write_lp", parm); /* initialize common storage area */ csa.P = P; csa.parm = parm; count = 0; /* write problem name */ callback("\\* Problem: " + (P.name == null ? "Unknown" : P.name) + " *\\"); count++; callback(""); count++; /* the problem should contain at least one row and one column */ if (!(P.m > 0 && P.n > 0)) { xprintf("Warning: problem has no rows/columns"); callback("\\* WARNING: PROBLEM HAS NO ROWS/COLUMNS *\\"); count++; callback(""); count++; return skip(); } /* write the objective function definition */ if (P.dir == GLP_MIN){ callback("Minimize"); count++; } else if (P.dir == GLP_MAX){ callback("Maximize"); count++; } else xassert(P != P); name = row_name(csa, 0); line = " " + name + ":"; len = 0; for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.coef != 0.0 || col.ptr == null) { len++; name = col_name(csa, j); if (col.coef == 0.0) term = " + 0 " + name; /* empty column */ else if (col.coef == +1.0) term = " + " + name; else if (col.coef == -1.0) term = " - " + name; else if (col.coef > 0.0) term = " + " + col.coef + " " + name; else term = " - " + (-col.coef) + " " + name; if (line.length + term.length > 72){ callback(line); line = ""; count++; } line += term; } } if (len == 0) { /* empty objective */ term = " 0 " + col_name(csa, 1); line += term; } callback(line); count++; if (P.c0 != 0.0){ callback("\\* constant term = " + P.c0 + " *\\"); count++; } callback(""); count++; /* write the constraints section */ callback("Subject To"); count++; for (i = 1; i <= P.m; i++) { row = P.row[i]; if (row.type == GLP_FR) continue; /* skip free row */ name = row_name(csa, i); line = " " + name + ":"; /* linear form */ for (aij = row.ptr; aij != null; aij = aij.r_next) { name = col_name(csa, aij.col.j); if (aij.val == +1.0) term = " + " + name; else if (aij.val == -1.0) term = " - " + name; else if (aij.val > 0.0) term = " + " + aij.val + " " + name; else term = " - " + (-aij.val) + " " + name; if (line.length + term.length > 72){ callback(line); line = ""; count++; } line += term; } if (row.type == GLP_DB) { /* double-bounded (ranged) constraint */ term = " - ~r_" + i; if (line.length + term.length > 72){ callback(line); line = ""; count++; } line += term; } else if (row.ptr == null) { /* empty constraint */ term = " 0 " + col_name(csa, 1); line += term; } /* right hand-side */ if (row.type == GLP_LO) term = " >= " + row.lb; else if (row.type == GLP_UP) term = " <= " + row.ub; else if (row.type == GLP_DB || row.type == GLP_FX) term = " = " + row.lb; else xassert(row != row); if (line.length + term.length > 72){ callback(line); line = ""; count++; } line += term; callback(line); count++; } callback(""); count++; /* write the bounds section */ flag = 0; for (i = 1; i <= P.m; i++) { row = P.row[i]; if (row.type != GLP_DB) continue; if (!flag){ callback("Bounds"); flag = 1; count++; } callback(" 0 <= ~r_" + i + " <= " + (row.ub - row.lb)); count++; } for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.type == GLP_LO && col.lb == 0.0) continue; if (!flag){ callback("Bounds"); flag = 1; count++; } name = col_name(csa, j); if (col.type == GLP_FR){ callback(" " + name + " free"); count++; } else if (col.type == GLP_LO){ callback(" " + name + " >= " + col.lb); count++; } else if (col.type == GLP_UP){ callback(" -Inf <= " + name + " <= " + col.ub); count++; } else if (col.type == GLP_DB){ callback(" " + col.lb + " <= " + name + " <= " + col.ub); count++; } else if (col.type == GLP_FX){ callback(" " + name + " = " + col.lb); count++; } else xassert(col != col); } if (flag) callback(""); count++; /* write the integer section */ flag = 0; for (j = 1; j <= P.n; j++) { col = P.col[j]; if (col.kind == GLP_CV) continue; xassert(col.kind == GLP_IV); if (!flag){ callback("Generals"); flag = 1; count++; } callback(" " + col_name(csa, j)); count++; } if (flag) {callback(""); count++} function skip(){ /* write the end keyword */ callback("End"); count++; /* problem data has been successfully written */ xprintf(count + " lines were written"); return 0; } return skip(); }; var glp_read_lp_from_string = exports["glp_read_lp_from_string"] = function(P, parm, str){ var pos = 0; return glp_read_lp(P, parm, function(){ if (pos < str.length){ return str[pos++]; } else return -1; } ) }; /* return codes: */ var FHV_ESING = 1, /* singular matrix */ FHV_ECOND = 2, /* ill-conditioned matrix */ FHV_ECHECK = 3, /* insufficient accuracy */ FHV_ELIMIT = 4, /* update limit reached */ FHV_EROOM = 5; /* SVA overflow */ function fhv_create_it(){ var fhv; fhv = {}; fhv.m_max = fhv.m = 0; fhv.valid = 0; fhv.luf = luf_create_it(); fhv.hh_max = 50; fhv.hh_nfs = 0; fhv.hh_ind = fhv.hh_ptr = fhv.hh_len = null; fhv.p0_row = fhv.p0_col = null; fhv.cc_ind = null; fhv.cc_val = null; fhv.upd_tol = 1e-6; fhv.nnz_h = 0; return fhv; } function fhv_factorize(fhv, m, col, info){ var ret; if (m < 1) xerror("fhv_factorize: m = " + m + "; invalid parameter"); if (m > M_MAX) xerror("fhv_factorize: m = " + m + "; matrix too big"); fhv.m = m; /* invalidate the factorization */ fhv.valid = 0; /* allocate/reallocate arrays, if necessary */ if (fhv.hh_ind == null) fhv.hh_ind = new Int32Array(1+fhv.hh_max); if (fhv.hh_ptr == null) fhv.hh_ptr = new Int32Array(1+fhv.hh_max); if (fhv.hh_len == null) fhv.hh_len = new Int32Array(1+fhv.hh_max); if (fhv.m_max < m) { fhv.m_max = m + 100; fhv.p0_row = new Int32Array(1+fhv.m_max); fhv.p0_col = new Int32Array(1+fhv.m_max); fhv.cc_ind = new Int32Array(1+fhv.m_max); fhv.cc_val = new Float64Array(1+fhv.m_max); } /* try to factorize the basis matrix */ switch (luf_factorize(fhv.luf, m, col, info)) { case 0: break; case LUF_ESING: ret = FHV_ESING; return ret; case LUF_ECOND: ret = FHV_ECOND; return ret; default: xassert(fhv != fhv); } /* the basis matrix has been successfully factorized */ fhv.valid = 1; /* H := I */ fhv.hh_nfs = 0; /* P0 := P */ xcopyArr(fhv.p0_row, 1, fhv.luf.pp_row, 1, m); xcopyArr(fhv.p0_col, 1, fhv.luf.pp_col, 1, m); /* currently H has no factors */ fhv.nnz_h = 0; ret = 0; /* return to the calling program */ return ret; } function fhv_h_solve(fhv, tr, x){ var nfs = fhv.hh_nfs; var hh_ind = fhv.hh_ind; var hh_ptr = fhv.hh_ptr; var hh_len = fhv.hh_len; var sv_ind = fhv.luf.sv_ind; var sv_val = fhv.luf.sv_val; var i, k, beg, end, ptr; var temp; if (!fhv.valid) xerror("fhv_h_solve: the factorization is not valid"); if (!tr) { /* solve the system H*x = b */ for (k = 1; k <= nfs; k++) { i = hh_ind[k]; temp = x[i]; beg = hh_ptr[k]; end = beg + hh_len[k] - 1; for (ptr = beg; ptr <= end; ptr++) temp -= sv_val[ptr] * x[sv_ind[ptr]]; x[i] = temp; } } else { /* solve the system H'*x = b */ for (k = nfs; k >= 1; k--) { i = hh_ind[k]; temp = x[i]; if (temp == 0.0) continue; beg = hh_ptr[k]; end = beg + hh_len[k] - 1; for (ptr = beg; ptr <= end; ptr++) x[sv_ind[ptr]] -= sv_val[ptr] * temp; } } } function fhv_ftran(fhv, x){ var pp_row = fhv.luf.pp_row; var pp_col = fhv.luf.pp_col; var p0_row = fhv.p0_row; var p0_col = fhv.p0_col; if (!fhv.valid) xerror("fhv_ftran: the factorization is not valid"); /* B = F*H*V, therefore inv(B) = inv(V)*inv(H)*inv(F) */ fhv.luf.pp_row = p0_row; fhv.luf.pp_col = p0_col; luf_f_solve(fhv.luf, 0, x); fhv.luf.pp_row = pp_row; fhv.luf.pp_col = pp_col; fhv_h_solve(fhv, 0, x); luf_v_solve(fhv.luf, 0, x); } function fhv_btran(fhv, x){ var pp_row = fhv.luf.pp_row; var pp_col = fhv.luf.pp_col; var p0_row = fhv.p0_row; var p0_col = fhv.p0_col; if (!fhv.valid) xerror("fhv_btran: the factorization is not valid"); /* B = F*H*V, therefore inv(B') = inv(F')*inv(H')*inv(V') */ luf_v_solve(fhv.luf, 1, x); fhv_h_solve(fhv, 1, x); fhv.luf.pp_row = p0_row; fhv.luf.pp_col = p0_col; luf_f_solve(fhv.luf, 1, x); fhv.luf.pp_row = pp_row; fhv.luf.pp_col = pp_col; } function fhv_update_it(fhv, j, len, ind, idx, val){ var m = fhv.m; var luf = fhv.luf; var vr_ptr = luf.vr_ptr; var vr_len = luf.vr_len; var vr_cap = luf.vr_cap; var vr_piv = luf.vr_piv; var vc_ptr = luf.vc_ptr; var vc_len = luf.vc_len; var vc_cap = luf.vc_cap; var pp_row = luf.pp_row; var pp_col = luf.pp_col; var qq_row = luf.qq_row; var qq_col = luf.qq_col; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var work = luf.work; var eps_tol = luf.eps_tol; var hh_ind = fhv.hh_ind; var hh_ptr = fhv.hh_ptr; var hh_len = fhv.hh_len; var p0_row = fhv.p0_row; var p0_col = fhv.p0_col; var cc_ind = fhv.cc_ind; var cc_val = fhv.cc_val; var upd_tol = fhv.upd_tol; var i, i_beg, i_end, i_ptr, j_beg, j_end, j_ptr, k, k1, k2, p, q, p_beg, p_end, p_ptr, ptr, ret; var f, temp; if (!fhv.valid) xerror("fhv_update_it: the factorization is not valid"); if (!(1 <= j && j <= m)) xerror("fhv_update_it: j = " + j + "; column number out of range"); /* check if the new factor of matrix H can be created */ if (fhv.hh_nfs == fhv.hh_max) { /* maximal number of updates has been reached */ fhv.valid = 0; ret = FHV_ELIMIT; return ret; } /* convert new j-th column of B to dense format */ for (i = 1; i <= m; i++) cc_val[i] = 0.0; for (k = 1; k <= len; k++) { i = ind[idx + k]; if (!(1 <= i && i <= m)) xerror("fhv_update_it: ind[" + k + "] = " + i + "; row number out of range"); if (cc_val[i] != 0.0) xerror("fhv_update_it: ind[" + k + "] = " + i + "; duplicate row index not allowed"); if (val[k] == 0.0) xerror("fhv_update_it: val[" + k + "] = " + val[k] + "; zero element not allowed"); cc_val[i] = val[k]; } /* new j-th column of V := inv(F * H) * (new B[j]) */ fhv.luf.pp_row = p0_row; fhv.luf.pp_col = p0_col; luf_f_solve(fhv.luf, 0, cc_val); fhv.luf.pp_row = pp_row; fhv.luf.pp_col = pp_col; fhv_h_solve(fhv, 0, cc_val); /* convert new j-th column of V to sparse format */ len = 0; for (i = 1; i <= m; i++) { temp = cc_val[i]; if (temp == 0.0 || Math.abs(temp) < eps_tol) continue; len++; cc_ind[len] = i; cc_val[len] = temp; } /* clear old content of j-th column of matrix V */ j_beg = vc_ptr[j]; j_end = j_beg + vc_len[j] - 1; for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++) { /* get row index of v[i,j] */ i = sv_ind[j_ptr]; /* find v[i,j] in the i-th row */ i_beg = vr_ptr[i]; i_end = i_beg + vr_len[i] - 1; for (i_ptr = i_beg; sv_ind[i_ptr] != j; i_ptr++){/* nop */} xassert(i_ptr <= i_end); /* remove v[i,j] from the i-th row */ sv_ind[i_ptr] = sv_ind[i_end]; sv_val[i_ptr] = sv_val[i_end]; vr_len[i]--; } /* now j-th column of matrix V is empty */ luf.nnz_v -= vc_len[j]; vc_len[j] = 0; /* add new elements of j-th column of matrix V to corresponding row lists; determine indices k1 and k2 */ k1 = qq_row[j]; k2 = 0; for (ptr = 1; ptr <= len; ptr++) { /* get row index of v[i,j] */ i = cc_ind[ptr]; /* at least one unused location is needed in i-th row */ if (vr_len[i] + 1 > vr_cap[i]) { if (luf_enlarge_row(luf, i, vr_len[i] + 10)) { /* overflow of the sparse vector area */ fhv.valid = 0; luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); ret = FHV_EROOM; return ret; } } /* add v[i,j] to i-th row */ i_ptr = vr_ptr[i] + vr_len[i]; sv_ind[i_ptr] = j; sv_val[i_ptr] = cc_val[ptr]; vr_len[i]++; /* adjust index k2 */ if (k2 < pp_col[i]) k2 = pp_col[i]; } /* capacity of j-th column (which is currently empty) should be not less than len locations */ if (vc_cap[j] < len) { if (luf_enlarge_col(luf, j, len)) { /* overflow of the sparse vector area */ fhv.valid = 0; luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); ret = FHV_EROOM; return ret; } } /* add new elements of matrix V to j-th column list */ j_ptr = vc_ptr[j]; xcopyArr(sv_ind, j_ptr, cc_ind, 1, len); xcopyArr(sv_val, j_ptr, cc_val, 1, len); vc_len[j] = len; luf.nnz_v += len; /* if k1 > k2, diagonal element u[k2,k2] of matrix U is zero and therefore the adjacent basis matrix is structurally singular */ if (k1 > k2) { fhv.valid = 0; ret = FHV_ESING; return ret; } /* perform implicit symmetric permutations of rows and columns of matrix U */ i = pp_row[k1]; j = qq_col[k1]; for (k = k1; k < k2; k++) { pp_row[k] = pp_row[k+1]; pp_col[pp_row[k]] = k; qq_col[k] = qq_col[k+1]; qq_row[qq_col[k]] = k; } pp_row[k2] = i; pp_col[i] = k2; qq_col[k2] = j; qq_row[j] = k2; /* now i-th row of the matrix V is k2-th row of matrix U; since no pivoting is used, only this row will be transformed */ /* copy elements of i-th row of matrix V to the working array and remove these elements from matrix V */ for (j = 1; j <= m; j++) work[j] = 0.0; i_beg = vr_ptr[i]; i_end = i_beg + vr_len[i] - 1; for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++) { /* get column index of v[i,j] */ j = sv_ind[i_ptr]; /* store v[i,j] to the working array */ work[j] = sv_val[i_ptr]; /* find v[i,j] in the j-th column */ j_beg = vc_ptr[j]; j_end = j_beg + vc_len[j] - 1; for (j_ptr = j_beg; sv_ind[j_ptr] != i; j_ptr++){/* nop */} xassert(j_ptr <= j_end); /* remove v[i,j] from the j-th column */ sv_ind[j_ptr] = sv_ind[j_end]; sv_val[j_ptr] = sv_val[j_end]; vc_len[j]--; } /* now i-th row of matrix V is empty */ luf.nnz_v -= vr_len[i]; vr_len[i] = 0; /* create the next row-like factor of the matrix H; this factor corresponds to i-th (transformed) row */ fhv.hh_nfs++; hh_ind[fhv.hh_nfs] = i; /* hh_ptr[] will be set later */ hh_len[fhv.hh_nfs] = 0; /* up to (k2 - k1) free locations are needed to add new elements to the non-trivial row of the row-like factor */ if (luf.sv_end - luf.sv_beg < k2 - k1) { luf_defrag_sva(luf); if (luf.sv_end - luf.sv_beg < k2 - k1) { /* overflow of the sparse vector area */ fhv.valid = luf.valid = 0; luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); ret = FHV_EROOM; return ret; } } /* eliminate subdiagonal elements of matrix U */ for (k = k1; k < k2; k++) { /* v[p,q] = u[k,k] */ p = pp_row[k]; q = qq_col[k]; /* this is the crucial point, where even tiny non-zeros should not be dropped */ if (work[q] == 0.0) continue; /* compute gaussian multiplier f = v[i,q] / v[p,q] */ f = work[q] / vr_piv[p]; /* perform gaussian transformation: (i-th row) := (i-th row) - f * (p-th row) in order to eliminate v[i,q] = u[k2,k] */ p_beg = vr_ptr[p]; p_end = p_beg + vr_len[p] - 1; for (p_ptr = p_beg; p_ptr <= p_end; p_ptr++) work[sv_ind[p_ptr]] -= f * sv_val[p_ptr]; /* store new element (gaussian multiplier that corresponds to p-th row) in the current row-like factor */ luf.sv_end--; sv_ind[luf.sv_end] = p; sv_val[luf.sv_end] = f; hh_len[fhv.hh_nfs]++; } /* set pointer to the current row-like factor of the matrix H (if no elements were added to this factor, it is unity matrix and therefore can be discarded) */ if (hh_len[fhv.hh_nfs] == 0) fhv.hh_nfs--; else { hh_ptr[fhv.hh_nfs] = luf.sv_end; fhv.nnz_h += hh_len[fhv.hh_nfs]; } /* store new pivot which corresponds to u[k2,k2] */ vr_piv[i] = work[qq_col[k2]]; /* new elements of i-th row of matrix V (which are non-diagonal elements u[k2,k2+1], ..., u[k2,m] of matrix U = P*V*Q) now are contained in the working array; add them to matrix V */ len = 0; for (k = k2+1; k <= m; k++) { /* get column index and value of v[i,j] = u[k2,k] */ j = qq_col[k]; temp = work[j]; /* if v[i,j] is close to zero, skip it */ if (Math.abs(temp) < eps_tol) continue; /* at least one unused location is needed in j-th column */ if (vc_len[j] + 1 > vc_cap[j]) { if (luf_enlarge_col(luf, j, vc_len[j] + 10)) { /* overflow of the sparse vector area */ fhv.valid = 0; luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); ret = FHV_EROOM; return ret; } } /* add v[i,j] to j-th column */ j_ptr = vc_ptr[j] + vc_len[j]; sv_ind[j_ptr] = i; sv_val[j_ptr] = temp; vc_len[j]++; /* also store v[i,j] to the auxiliary array */ len++; cc_ind[len] = j; cc_val[len] = temp; } /* capacity of i-th row (which is currently empty) should be not less than len locations */ if (vr_cap[i] < len) { if (luf_enlarge_row(luf, i, len)) { /* overflow of the sparse vector area */ fhv.valid = 0; luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); ret = FHV_EROOM; return ret; } } /* add new elements to i-th row list */ i_ptr = vr_ptr[i]; xcopyArr(sv_ind, i_ptr, cc_ind, 1, len); xcopyArr(sv_val, i_ptr, cc_val, 1, len); vr_len[i] = len; luf.nnz_v += len; /* updating is finished; check that diagonal element u[k2,k2] is not very small in absolute value among other elements in k2-th row and k2-th column of matrix U = P*V*Q */ /* temp = max(|u[k2,*]|, |u[*,k2]|) */ temp = 0.0; /* walk through k2-th row of U which is i-th row of V */ i = pp_row[k2]; i_beg = vr_ptr[i]; i_end = i_beg + vr_len[i] - 1; for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++) if (temp < Math.abs(sv_val[i_ptr])) temp = Math.abs(sv_val[i_ptr]); /* walk through k2-th column of U which is j-th column of V */ j = qq_col[k2]; j_beg = vc_ptr[j]; j_end = j_beg + vc_len[j] - 1; for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++) if (temp < Math.abs(sv_val[j_ptr])) temp = Math.abs(sv_val[j_ptr]); /* check that u[k2,k2] is not very small */ if (Math.abs(vr_piv[i]) < upd_tol * temp) { /* the factorization seems to be inaccurate and therefore must be recomputed */ fhv.valid = 0; ret = FHV_ECHECK; return ret; } /* the factorization has been successfully updated */ ret = 0; /* return to the calling program */ return ret; } function glp_adv_basis(lp, flags){ function triang(m, n, info, mat, rn, cn){ var ndx; /* int ndx[1+max(m,n)]; */ /* this array is used for querying row and column patterns of the given matrix A (the third parameter to the routine mat) */ var rs_len; /* int rs_len[1+m]; */ /* rs_len[0] is not used; rs_len[i], 1 <= i <= m, is number of non-zeros in the i-th row of the matrix A, which (non-zeros) belong to the current active submatrix */ var rs_head; /* int rs_head[1+n]; */ /* rs_head[len], 0 <= len <= n, is the number i of the first row of the matrix A, for which rs_len[i] = len */ var rs_prev; /* int rs_prev[1+m]; */ /* rs_prev[0] is not used; rs_prev[i], 1 <= i <= m, is a number i' of the previous row of the matrix A, for which rs_len[i] = rs_len[i'] (zero marks the end of this linked list) */ var rs_next; /* int rs_next[1+m]; */ /* rs_next[0] is not used; rs_next[i], 1 <= i <= m, is a number i' of the next row of the matrix A, for which rs_len[i] = rs_len[i'] (zero marks the end this linked list) */ var cs_head; /* is a number j of the first column of the matrix A, which has maximal number of non-zeros among other columns */ var cs_prev; /* cs_prev[1+n]; */ /* cs_prev[0] is not used; cs_prev[j], 1 <= j <= n, is a number of the previous column of the matrix A with the same or greater number of non-zeros than in the j-th column (zero marks the end of this linked list) */ var cs_next; /* cs_next[1+n]; */ /* cs_next[0] is not used; cs_next[j], 1 <= j <= n, is a number of the next column of the matrix A with the same or lesser number of non-zeros than in the j-th column (zero marks the end of this linked list) */ var i, j, ii, jj, k1, k2, len, t, size = 0; var head, rn_inv, cn_inv; if (!(m > 0 && n > 0)) xerror("triang: m = " + m + "; n = " + n + "; invalid dimension"); /* allocate working arrays */ ndx = new Int32Array(1+(m >= n ? m : n)); rs_len = new Int32Array(1+m); rs_head = new Int32Array(1+n); rs_prev = new Int32Array(1+m); rs_next = new Int32Array(1+m); cs_prev = new Int32Array(1+n); cs_next = new Int32Array(1+n); /* build linked lists of columns of the matrix A with the same number of non-zeros */ head = rs_len; /* currently rs_len is used as working array */ for (j = 1; j <= n; j++) { /* obtain length of the j-th column */ len = mat(info, -j, ndx); xassert(0 <= len && len <= m); /* include the j-th column in the corresponding linked list */ cs_prev[j] = head[len]; head[len] = j; } /* merge all linked lists of columns in one linked list, where columns are ordered by descending of their lengths */ cs_head = 0; for (len = 0; len <= m; len++) { for (j = head[len]; j != 0; j = cs_prev[j]) { cs_next[j] = cs_head; cs_head = j; } } jj = 0; for (j = cs_head; j != 0; j = cs_next[j]) { cs_prev[j] = jj; jj = j; } /* build initial doubly linked lists of rows of the matrix A with the same number of non-zeros */ for (i = 1; i <= m; i++) { /* obtain length of the i-th row */ rs_len[i] = len = mat(info, +i, ndx); xassert(0 <= len && len <= n); /* include the i-th row in the correspondng linked list */ rs_prev[i] = 0; rs_next[i] = rs_head[len]; if (rs_next[i] != 0) rs_prev[rs_next[i]] = i; rs_head[len] = i; } /* initially all rows and columns of the matrix A are active */ for (i = 1; i <= m; i++) rn[i] = 0; for (j = 1; j <= n; j++) cn[j] = 0; /* set initial bounds of the active submatrix */ k1 = 1; k2 = n; /* main loop starts here */ while (k1 <= k2) { i = rs_head[1]; if (i != 0) { /* the i-th row of the matrix A is a row singleton, since it has the only non-zero in the active submatrix */ xassert(rs_len[i] == 1); /* determine the number j of an active column of the matrix A, in which this non-zero is placed */ j = 0; t = mat(info, +i, ndx); xassert(0 <= t && t <= n); for (; t >= 1; t--) { jj = ndx[t]; xassert(1 <= jj && jj <= n); if (cn[jj] == 0) { xassert(j == 0); j = jj; } } xassert(j != 0); /* the singleton is a[i,j]; move a[i,j] to the position b[k1,k1] of the matrix B */ rn[i] = cn[j] = k1; /* shift the left bound of the active submatrix */ k1++; /* increase the size of the lower triangular part */ size++; } else { /* the current active submatrix has no row singletons */ /* remove an active column with maximal number of non-zeros from the active submatrix */ j = cs_head; xassert(j != 0); cn[j] = k2; /* shift the right bound of the active submatrix */ k2--; } /* the j-th column of the matrix A has been removed from the active submatrix */ /* remove the j-th column from the linked list */ if (cs_prev[j] == 0) cs_head = cs_next[j]; else cs_next[cs_prev[j]] = cs_next[j]; if (cs_next[j] != 0) cs_prev[cs_next[j]] = cs_prev[j]; /* go through non-zeros of the j-th columns and update active lengths of the corresponding rows */ t = mat(info, -j, ndx); xassert(0 <= t && t <= m); for (; t >= 1; t--) { i = ndx[t]; xassert(1 <= i && i <= m); /* the non-zero a[i,j] has left the active submatrix */ len = rs_len[i]; xassert(len >= 1); /* remove the i-th row from the linked list of rows with active length len */ if (rs_prev[i] == 0) rs_head[len] = rs_next[i]; else rs_next[rs_prev[i]] = rs_next[i]; if (rs_next[i] != 0) rs_prev[rs_next[i]] = rs_prev[i]; /* decrease the active length of the i-th row */ rs_len[i] = --len; /* return the i-th row to the corresponding linked list */ rs_prev[i] = 0; rs_next[i] = rs_head[len]; if (rs_next[i] != 0) rs_prev[rs_next[i]] = i; rs_head[len] = i; } } /* other rows of the matrix A, which are still active, correspond to rows k1, ..., m of the matrix B (in arbitrary order) */ for (i = 1; i <= m; i++) if (rn[i] == 0) rn[i] = k1++; /* but for columns this is not needed, because now the submatrix B2 has no columns */ for (j = 1; j <= n; j++) xassert(cn[j] != 0); /* perform some optional checks */ /* make sure that rn is a permutation of {1, ..., m} and cn is a permutation of {1, ..., n} */ rn_inv = rs_len; /* used as working array */ for (ii = 1; ii <= m; ii++) rn_inv[ii] = 0; for (i = 1; i <= m; i++) { ii = rn[i]; xassert(1 <= ii && ii <= m); xassert(rn_inv[ii] == 0); rn_inv[ii] = i; } cn_inv = rs_head; /* used as working array */ for (jj = 1; jj <= n; jj++) cn_inv[jj] = 0; for (j = 1; j <= n; j++) { jj = cn[j]; xassert(1 <= jj && jj <= n); xassert(cn_inv[jj] == 0); cn_inv[jj] = j; } /* make sure that the matrix B = P*A*Q really has the form, which was declared */ for (ii = 1; ii <= size; ii++) { var diag = 0; i = rn_inv[ii]; t = mat(info, +i, ndx); xassert(0 <= t && t <= n); for (; t >= 1; t--) { j = ndx[t]; xassert(1 <= j && j <= n); jj = cn[j]; if (jj <= size) xassert(jj <= ii); if (jj == ii) { xassert(!diag); diag = 1; } } xassert(diag); } /* return to the calling program */ return size; } function mat(lp, k, ndx){ /* this auxiliary routine returns the pattern of a given row or a given column of the augmented constraint matrix A~ = (I|-A), in which columns of fixed variables are implicitly cleared */ var m = lpx_get_num_rows(lp); var n = lpx_get_num_cols(lp); var i, j, lll, len = 0; if (k > 0) { /* the pattern of the i-th row is required */ i = +k; xassert(1 <= i && i <= m); lll = lpx_get_mat_row(lp, i, ndx, null); for (k = 1; k <= lll; k++) { lpx_get_col_bnds(lp, ndx[k], function(typx){ if (typx != LPX_FX) ndx[++len] = m + ndx[k]; }); } lpx_get_row_bnds(lp, i, function(typx){ if (typx != LPX_FX) ndx[++len] = i; }); } else { /* the pattern of the j-th column is required */ j = -k; xassert(1 <= j && j <= m+n); /* if the (auxiliary or structural) variable x[j] is fixed, the pattern of its column is empty */ function doit(typx){ if (typx != LPX_FX) { if (j <= m) { /* x[j] is non-fixed auxiliary variable */ ndx[++len] = j; } else { /* x[j] is non-fixed structural variables */ len = lpx_get_mat_col(lp, j-m, ndx, null); } } } if (j <= m) lpx_get_row_bnds(lp, j, doit); else lpx_get_col_bnds(lp, j-m, doit); } /* return the length of the row/column pattern */ return len; } function adv_basis(lp){ var m = lpx_get_num_rows(lp); var n = lpx_get_num_cols(lp); var i, j, jj, k, size; var rn, cn, rn_inv, cn_inv; var tagx = new Int32Array(1+m+n); xprintf("Constructing initial basis..."); if (m == 0 || n == 0) { glp_std_basis(lp); return; } /* use the routine triang (see above) to find maximal triangular part of the augmented constraint matrix A~ = (I|-A); in order to prevent columns of fixed variables to be included in the triangular part, such columns are implictly removed from the matrix A~ by the routine adv_mat */ rn = new Int32Array(1+m); cn = new Int32Array(1+m+n); size = triang(m, m+n, lp, mat, rn, cn); if (lpx_get_int_parm(lp, LPX_K_MSGLEV) >= 3) xprintf("Size of triangular part = " + size + ""); /* the first size rows and columns of the matrix P*A~*Q (where P and Q are permutation matrices defined by the arrays rn and cn) form a lower triangular matrix; build the arrays (rn_inv and cn_inv), which define the matrices inv(P) and inv(Q) */ rn_inv = new Int32Array(1+m); cn_inv = new Int32Array(1+m+n); for (i = 1; i <= m; i++) rn_inv[rn[i]] = i; for (j = 1; j <= m+n; j++) cn_inv[cn[j]] = j; /* include the columns of the matrix A~, which correspond to the first size columns of the matrix P*A~*Q, in the basis */ for (k = 1; k <= m+n; k++) tagx[k] = -1; for (jj = 1; jj <= size; jj++) { j = cn_inv[jj]; /* the j-th column of A~ is the jj-th column of P*A~*Q */ tagx[j] = LPX_BS; } /* if size < m, we need to add appropriate columns of auxiliary variables to the basis */ for (jj = size + 1; jj <= m; jj++) { /* the jj-th column of P*A~*Q should be replaced by the column of the auxiliary variable, for which the only unity element is placed in the position [jj,jj] */ i = rn_inv[jj]; /* the jj-th row of P*A~*Q is the i-th row of A~, but in the i-th row of A~ the unity element belongs to the i-th column of A~; therefore the disired column corresponds to the i-th auxiliary variable (note that this column doesn't belong to the triangular part found by the routine triang) */ xassert(1 <= i && i <= m); xassert(cn[i] > size); tagx[i] = LPX_BS; } /* build tags of non-basic variables */ for (k = 1; k <= m+n; k++){ if (tagx[k] != LPX_BS){ function doit(typx, lb, ub){ switch (typx){ case LPX_FR: tagx[k] = LPX_NF; break; case LPX_LO: tagx[k] = LPX_NL; break; case LPX_UP: tagx[k] = LPX_NU; break; case LPX_DB: tagx[k] = (Math.abs(lb) <= Math.abs(ub) ? LPX_NL : LPX_NU); break; case LPX_FX: tagx[k] = LPX_NS; break; default: xassert(typx != typx); } } if (k <= m) lpx_get_row_bnds(lp, k, doit); else lpx_get_col_bnds(lp, k-m, doit); } } for (k = 1; k <= m+n; k++){ if (k <= m) lpx_set_row_stat(lp, k, tagx[k]); else lpx_set_col_stat(lp, k-m, tagx[k]); } } if (flags != 0) xerror("glp_adv_basis: flags = " + flags + "; invalid flags"); if (lp.m == 0 || lp.n == 0) glp_std_basis(lp); else adv_basis(lp); } function cpx_basis(lp){ /* main routine */ var C, C2, C3, C4; var m, n, i, j, jk, k, l, ll, t, n2, n3, n4, type, len, I, r, ind; var alpha, gamma, cmax, temp, v, val; xprintf("Constructing initial basis..."); /* determine the number of rows and columns */ m = glp_get_num_rows(lp); n = glp_get_num_cols(lp); /* allocate working arrays */ C = new Array(1+n); I = new Int32Array(1+m); r = new Int32Array(1+m); v = new Float64Array(1+m); ind = new Int32Array(1+m); val = new Float64Array(1+m); /* make all auxiliary variables non-basic */ for (i = 1; i <= m; i++) { if (glp_get_row_type(lp, i) != GLP_DB) glp_set_row_stat(lp, i, GLP_NS); else if (Math.abs(glp_get_row_lb(lp, i)) <= Math.abs(glp_get_row_ub(lp, i))) glp_set_row_stat(lp, i, GLP_NL); else glp_set_row_stat(lp, i, GLP_NU); } /* make all structural variables non-basic */ for (j = 1; j <= n; j++) { if (glp_get_col_type(lp, j) != GLP_DB) glp_set_col_stat(lp, j, GLP_NS); else if (Math.abs(glp_get_col_lb(lp, j)) <= Math.abs(glp_get_col_ub(lp, j))) glp_set_col_stat(lp, j, GLP_NL); else glp_set_col_stat(lp, j, GLP_NU); } /* C2 is a set of free structural variables */ n2 = 0; C2 = 0; for (j = 1; j <= n; j++) { type = glp_get_col_type(lp, j); if (type == GLP_FR) { n2++; C[C2 + n2].j = j; C[C2 + n2].q = 0.0; } } /* C3 is a set of structural variables having excatly one (lower or upper) bound */ n3 = 0; C3 = C2 + n2; for (j = 1; j <= n; j++) { type = glp_get_col_type(lp, j); if (type == GLP_LO) { n3++; C[C3 + n3].j = j; C[C3 + n3].q = + glp_get_col_lb(lp, j); } else if (type == GLP_UP) { n3++; C[C3 + n3].j = j; C[C3 + n3].q = - glp_get_col_ub(lp, j); } } /* C4 is a set of structural variables having both (lower and upper) bounds */ n4 = 0; C4 = C3 + n3; for (j = 1; j <= n; j++) { type = glp_get_col_type(lp, j); if (type == GLP_DB) { n4++; C[C4 + n4].j = j; C[C4 + n4].q = glp_get_col_lb(lp, j) - glp_get_col_ub(lp, j); } } /* compute gamma = max{|c[j]|: 1 <= j <= n} */ gamma = 0.0; for (j = 1; j <= n; j++) { temp = Math.abs(glp_get_obj_coef(lp, j)); if (gamma < temp) gamma = temp; } /* compute cmax */ cmax = (gamma == 0.0 ? 1.0 : 1000.0 * gamma); /* compute final penalty for all structural variables within sets C2, C3, and C4 */ switch (glp_get_obj_dir(lp)) { case GLP_MIN: temp = +1.0; break; case GLP_MAX: temp = -1.0; break; default: xassert(lp != lp); } for (k = 1; k <= n2+n3+n4; k++) { j = C[k].j; C[k].q += (temp * glp_get_obj_coef(lp, j)) / cmax; } /* sort structural variables within C2, C3, and C4 in ascending order of penalty value */ function fcmp(col1, col2){ /* this routine is passed to the qsort() function */ if (col1.q < col2.q) return -1; if (col1.q > col2.q) return +1; return 0; } xqsort(C, C2+1+n2, fcmp); for (k = 1; k < n2; k++) xassert(C[C2+k].q <= C[C2+k+1].q); xqsort(C, C3+1+n3, fcmp); for (k = 1; k < n3; k++) xassert(C[C3+k].q <= C[C3+k+1].q); xqsort(C, C4+1+n4, fcmp); for (k = 1; k < n4; k++) xassert(C[C4+k].q <= C[C4+k+1].q); /*** STEP 1 ***/ for (i = 1; i <= m; i++) { type = glp_get_row_type(lp, i); if (type != GLP_FX) { /* row i is either free or inequality constraint */ glp_set_row_stat(lp, i, GLP_BS); I[i] = 1; r[i] = 1; } v[i] = +DBL_MAX; } /*** STEP 2 ***/ function get_column(lp, j, ind, val){ /* Bixby's algorithm assumes that the constraint matrix is scaled such that the maximum absolute value in every non-zero row and column is 1 */ var k; var len = glp_get_mat_col(lp, j, ind, val); var big = 0.0; for (k = 1; k <= len; k++) if (big < Math.abs(val[k])) big = Math.abs(val[k]); if (big == 0.0) big = 1.0; for (k = 1; k <= len; k++) val[k] /= big; return len; } for (k = 1; k <= n2+n3+n4; k++) { jk = C[k].j; len = get_column(lp, jk, ind, val); /* let alpha = max{|A[l,jk]|: r[l] = 0} and let l' be such that alpha = |A[l',jk]| */ alpha = 0.0; ll = 0; for (t = 1; t <= len; t++) { l = ind[t]; if (r[l] == 0 && alpha < Math.abs(val[t])){ alpha = Math.abs(val[t]); ll = l; } } if (alpha >= 0.99) { /* B := B union {jk} */ glp_set_col_stat(lp, jk, GLP_BS); I[ll] = 1; v[ll] = alpha; /* r[l] := r[l] + 1 for all l such that |A[l,jk]| != 0 */ for (t = 1; t <= len; t++) { l = ind[t]; if (val[t] != 0.0) r[l]++; } /* continue to the next k */ continue; } /* if |A[l,jk]| > 0.01 * v[l] for some l, continue to the next k */ for (t = 1; t <= len; t++) { l = ind[t]; if (Math.abs(val[t]) > 0.01 * v[l]) break; } if (t <= len) continue; /* otherwise, let alpha = max{|A[l,jk]|: I[l] = 0} and let l' be such that alpha = |A[l',jk]| */ alpha = 0.0; ll = 0; for (t = 1; t <= len; t++) { l = ind[t]; if (I[l] == 0 && alpha < Math.abs(val[t])){ alpha = Math.abs(val[t]); ll = l; } } /* if alpha = 0, continue to the next k */ if (alpha == 0.0) continue; /* B := B union {jk} */ glp_set_col_stat(lp, jk, GLP_BS); I[ll] = 1; v[ll] = alpha; /* r[l] := r[l] + 1 for all l such that |A[l,jk]| != 0 */ for (t = 1; t <= len; t++) { l = ind[t]; if (val[t] != 0.0) r[l]++; } } /*** STEP 3 ***/ /* add an artificial variable (auxiliary variable for equality constraint) to cover each remaining uncovered row */ for (i = 1; i <= m; i++) if (I[i] == 0) glp_set_row_stat(lp, i, GLP_BS); } function glp_cpx_basis(lp){ if (lp.m == 0 || lp.n == 0) glp_std_basis(lp); else cpx_basis(lp); } function new_node(tree, parent){ /* pull a free slot for the new node */ var p = get_slot(tree); /* create descriptor of the new subproblem */ var node = {}; tree.slot[p].node = node; node.p = p; node.up = parent; node.level = (parent == null ? 0 : parent.level + 1); node.count = 0; node.b_ptr = null; node.s_ptr = null; node.r_ptr = null; node.solved = 0; node.lp_obj = (parent == null ? (tree.mip.dir == GLP_MIN ? -DBL_MAX : +DBL_MAX) : parent.lp_obj); node.bound = (parent == null ? (tree.mip.dir == GLP_MIN ? -DBL_MAX : +DBL_MAX) : parent.bound); node.br_var = 0; node.br_val = 0.0; node.ii_cnt = 0; node.ii_sum = 0.0; node.changed = 0; if (tree.parm.cb_size == 0) node.data = null; else { node.data = {}; } node.temp = null; node.prev = tree.tail; node.next = null; /* add the new subproblem to the end of the active list */ if (tree.head == null) tree.head = node; else tree.tail.next = node; tree.tail = node; tree.a_cnt++; tree.n_cnt++; tree.t_cnt++; /* increase the number of child subproblems */ if (parent == null) xassert(p == 1); else parent.count++; return node; } function get_slot(tree){ var p; /* if no free slots are available, increase the room */ if (tree.avail == 0) { var nslots = tree.nslots; var save = tree.slot; if (nslots == 0) tree.nslots = 20; else { tree.nslots = nslots + nslots; xassert(tree.nslots > nslots); } tree.slot = new Array(1+tree.nslots); xfillObjArr(tree.slot, 0, 1+tree.nslots); if (save != null) { xcopyArr(tree.slot, 1, save, 1, nslots); } /* push more free slots into the stack */ for (p = tree.nslots; p > nslots; p--) { tree.slot[p].node = null; tree.slot[p].next = tree.avail; tree.avail = p; } } /* pull a free slot from the stack */ p = tree.avail; tree.avail = tree.slot[p].next; xassert(tree.slot[p].node == null); tree.slot[p].next = 0; return p; } function ios_create_tree(mip, parm){ var m = mip.m; var n = mip.n; var tree; var i, j; xassert(mip.tree == null); mip.tree = tree = {}; tree.n = n; /* save original problem components */ tree.orig_m = m; tree.orig_type = new Int8Array(1+m+n); tree.orig_lb = new Float64Array(1+m+n); tree.orig_ub = new Float64Array(1+m+n); tree.orig_stat = new Int8Array(1+m+n); tree.orig_prim = new Float64Array(1+m+n); tree.orig_dual = new Float64Array(1+m+n); for (i = 1; i <= m; i++) { var row = mip.row[i]; tree.orig_type[i] = row.type; tree.orig_lb[i] = row.lb; tree.orig_ub[i] = row.ub; tree.orig_stat[i] = row.stat; tree.orig_prim[i] = row.prim; tree.orig_dual[i] = row.dual; } for (j = 1; j <= n; j++) { var col = mip.col[j]; tree.orig_type[m+j] = col.type; tree.orig_lb[m+j] = col.lb; tree.orig_ub[m+j] = col.ub; tree.orig_stat[m+j] = col.stat; tree.orig_prim[m+j] = col.prim; tree.orig_dual[m+j] = col.dual; } tree.orig_obj = mip.obj_val; /* initialize the branch-and-bound tree */ tree.nslots = 0; tree.avail = 0; tree.slot = null; tree.head = tree.tail = null; tree.a_cnt = tree.n_cnt = tree.t_cnt = 0; /* the root subproblem is not solved yet, so its final components are unknown so far */ tree.root_m = 0; tree.root_type = null; tree.root_lb = tree.root_ub = null; tree.root_stat = null; /* the current subproblem does not exist yet */ tree.curr = null; tree.mip = mip; /*tree.solved = 0;*/ tree.non_int = new Int8Array(1+n); /* arrays to save parent subproblem components will be allocated later */ tree.pred_m = tree.pred_max = 0; tree.pred_type = null; tree.pred_lb = tree.pred_ub = null; tree.pred_stat = null; /* cut generator */ tree.local = ios_create_pool(tree); /*tree.first_attempt = 1;*/ /*tree.max_added_cuts = 0;*/ /*tree.min_eff = 0.0;*/ /*tree.miss = 0;*/ /*tree.just_selected = 0;*/ tree.mir_gen = null; tree.clq_gen = null; /*tree.round = 0;*/ /* pseudocost branching */ tree.pcost = null; tree.iwrk = new Int32Array(1+n); tree.dwrk = new Float64Array(1+n); /* initialize control parameters */ tree.parm = parm; tree.tm_beg = xtime(); tree.tm_lag = 0; tree.sol_cnt = 0; /* initialize advanced solver interface */ tree.reason = 0; tree.reopt = 0; tree.reinv = 0; tree.br_var = 0; tree.br_sel = 0; tree.child = 0; tree.next_p = 0; /*tree.btrack = null;*/ tree.stop = 0; /* create the root subproblem, which initially is identical to the original MIP */ new_node(tree, null); return tree; } function ios_revive_node(tree, p){ var mip = tree.mip; var node, root; var b, r, s, a; /* obtain pointer to the specified subproblem */ xassert(1 <= p && p <= tree.nslots); node = tree.slot[p].node; xassert(node != null); /* the specified subproblem must be active */ xassert(node.count == 0); /* the current subproblem must not exist */ xassert(tree.curr == null); /* the specified subproblem becomes current */ tree.curr = node; /*tree.solved = 0;*/ /* obtain pointer to the root subproblem */ root = tree.slot[1].node; xassert(root != null); /* at this point problem object components correspond to the root subproblem, so if the root subproblem should be revived, there is nothing more to do */ if (node == root) return; xassert(mip.m == tree.root_m); /* build path from the root to the current node */ node.temp = null; for (; node != null; node = node.up) { if (node.up == null) xassert(node == root); else node.up.temp = node; } /* go down from the root to the current node and make necessary changes to restore components of the current subproblem */ for (node = root; node != null; node = node.temp) { var m = mip.m; var n = mip.n; /* if the current node is reached, the problem object at this point corresponds to its parent, so save attributes of rows and columns for the parent subproblem */ if (node.temp == null) { var i, j; tree.pred_m = m; /* allocate/reallocate arrays, if necessary */ if (tree.pred_max < m + n) { var new_size = m + n + 100; tree.pred_max = new_size; tree.pred_type = new Int8Array(1+new_size); tree.pred_lb = new Float64Array(1+new_size); tree.pred_ub = new Float64Array(1+new_size); tree.pred_stat = new Int8Array(1+new_size); } /* save row attributes */ for (i = 1; i <= m; i++) { var row = mip.row[i]; tree.pred_type[i] = row.type; tree.pred_lb[i] = row.lb; tree.pred_ub[i] = row.ub; tree.pred_stat[i] = row.stat; } /* save column attributes */ for (j = 1; j <= n; j++) { var col = mip.col[j]; tree.pred_type[mip.m+j] = col.type; tree.pred_lb[mip.m+j] = col.lb; tree.pred_ub[mip.m+j] = col.ub; tree.pred_stat[mip.m+j] = col.stat; } } /* change bounds of rows and columns */ { for (b = node.b_ptr; b != null; b = b.next) { if (b.k <= m) glp_set_row_bnds(mip, b.k, b.type, b.lb, b.ub); else glp_set_col_bnds(mip, b.k-m, b.type, b.lb, b.ub); } } /* change statuses of rows and columns */ { for (s = node.s_ptr; s != null; s = s.next) { if (s.k <= m) glp_set_row_stat(mip, s.k, s.stat); else glp_set_col_stat(mip, s.k-m, s.stat); } } /* add new rows */ if (node.r_ptr != null) { var len, ind; var val; ind = new Int32Array(1+n); val = new Float64Array(1+n); for (r = node.r_ptr; r != null; r = r.next) { i = glp_add_rows(mip, 1); glp_set_row_name(mip, i, r.name); xassert(mip.row[i].level == 0); mip.row[i].level = node.level; mip.row[i].origin = r.origin; mip.row[i].klass = r.klass; glp_set_row_bnds(mip, i, r.type, r.lb, r.ub); len = 0; for (a = r.ptr; a != null; a = a.next){ len++; ind[len] = a.j; val[len] = a.val; } glp_set_mat_row(mip, i, len, ind, val); glp_set_rii(mip, i, r.rii); glp_set_row_stat(mip, i, r.stat); } } } /* the specified subproblem has been revived */ node = tree.curr; /* delete its bound change list */ while (node.b_ptr != null) { b = node.b_ptr; node.b_ptr = b.next; } /* delete its status change list */ while (node.s_ptr != null) { s = node.s_ptr; node.s_ptr = s.next; } /* delete its row addition list (additional rows may appear, for example, due to branching on GUB constraints */ while (node.r_ptr != null) { r = node.r_ptr; node.r_ptr = r.next; xassert(r.name == null); while (r.ptr != null) { a = r.ptr; r.ptr = a.next; } } } function ios_freeze_node(tree){ var mip = tree.mip; var m = mip.m; var n = mip.n; /* obtain pointer to the current subproblem */ var node = tree.curr; xassert(node != null); var k, i, row, col; if (node.up == null) { /* freeze the root subproblem */ xassert(node.p == 1); xassert(tree.root_m == 0); xassert(tree.root_type == null); xassert(tree.root_lb == null); xassert(tree.root_ub == null); xassert(tree.root_stat == null); tree.root_m = m; tree.root_type = new Int8Array(1+m+n); tree.root_lb = new Float64Array(1+m+n); tree.root_ub = new Float64Array(1+m+n); tree.root_stat = new Int8Array(1+m+n); for (k = 1; k <= m+n; k++) { if (k <= m) { row = mip.row[k]; tree.root_type[k] = row.type; tree.root_lb[k] = row.lb; tree.root_ub[k] = row.ub; tree.root_stat[k] = row.stat; } else { col = mip.col[k-m]; tree.root_type[k] = col.type; tree.root_lb[k] = col.lb; tree.root_ub[k] = col.ub; tree.root_stat[k] = col.stat; } } } else { /* freeze non-root subproblem */ var root_m = tree.root_m; var pred_m = tree.pred_m; var j; xassert(pred_m <= m); /* build change lists for rows and columns which exist in the parent subproblem */ xassert(node.b_ptr == null); xassert(node.s_ptr == null); for (k = 1; k <= pred_m + n; k++) { var pred_type, pred_stat, type, stat; var pred_lb, pred_ub, lb, ub; /* determine attributes in the parent subproblem */ pred_type = tree.pred_type[k]; pred_lb = tree.pred_lb[k]; pred_ub = tree.pred_ub[k]; pred_stat = tree.pred_stat[k]; /* determine attributes in the current subproblem */ if (k <= pred_m) { row = mip.row[k]; type = row.type; lb = row.lb; ub = row.ub; stat = row.stat; } else { col = mip.col[k - pred_m]; type = col.type; lb = col.lb; ub = col.ub; stat = col.stat; } /* save type and bounds of a row/column, if changed */ if (!(pred_type == type && pred_lb == lb && pred_ub == ub)) { var b = {}; b.k = k; b.type = type; b.lb = lb; b.ub = ub; b.next = node.b_ptr; node.b_ptr = b; } /* save status of a row/column, if changed */ if (pred_stat != stat) { var s = {}; s.k = k; s.stat = stat; s.next = node.s_ptr; node.s_ptr = s; } } /* save new rows added to the current subproblem */ xassert(node.r_ptr == null); if (pred_m < m) { var len, ind; var val; ind = new Int32Array(1+n); val = new Float64Array(1+n); for (i = m; i > pred_m; i--) { row = mip.row[i]; var r = {}; var name = glp_get_row_name(mip, i); if (name == null) r.name = null; else { r.name = name; } r.type = row.type; r.lb = row.lb; r.ub = row.ub; r.ptr = null; len = glp_get_mat_row(mip, i, ind, val); for (k = 1; k <= len; k++) { var a = {}; a.j = ind[k]; a.val = val[k]; a.next = r.ptr; r.ptr = a; } r.rii = row.rii; r.stat = row.stat; r.next = node.r_ptr; node.r_ptr = r; } } /* remove all rows missing in the root subproblem */ if (m != root_m) { var nrs = m - root_m; xassert(nrs > 0); var num = new Int32Array(1+nrs); for (i = 1; i <= nrs; i++) num[i] = root_m + i; glp_del_rows(mip, nrs, num); } m = mip.m; /* and restore attributes of all rows and columns for the root subproblem */ xassert(m == root_m); for (i = 1; i <= m; i++) { glp_set_row_bnds(mip, i, tree.root_type[i], tree.root_lb[i], tree.root_ub[i]); glp_set_row_stat(mip, i, tree.root_stat[i]); } for (j = 1; j <= n; j++) { glp_set_col_bnds(mip, j, tree.root_type[m+j], tree.root_lb[m+j], tree.root_ub[m+j]); glp_set_col_stat(mip, j, tree.root_stat[m+j]); } } /* the current subproblem has been frozen */ tree.curr = null; } function ios_clone_node(tree, p, nnn, ref){ var node, k; /* obtain pointer to the subproblem to be cloned */ xassert(1 <= p && p <= tree.nslots); node = tree.slot[p].node; xassert(node != null); /* the specified subproblem must be active */ xassert(node.count == 0); /* and must be in the frozen state */ xassert(tree.curr != node); /* remove the specified subproblem from the active list, because it becomes inactive */ if (node.prev == null) tree.head = node.next; else node.prev.next = node.next; if (node.next == null) tree.tail = node.prev; else node.next.prev = node.prev; node.prev = node.next = null; tree.a_cnt--; /* create clone subproblems */ xassert(nnn > 0); for (k = 1; k <= nnn; k++) ref[k] = new_node(tree, node).p; } function ios_delete_node(tree, p){ var node, temp; /* obtain pointer to the subproblem to be deleted */ xassert(1 <= p && p <= tree.nslots); node = tree.slot[p].node; xassert(node != null); /* the specified subproblem must be active */ xassert(node.count == 0); /* and must be in the frozen state */ xassert(tree.curr != node); /* remove the specified subproblem from the active list, because it is gone from the tree */ if (node.prev == null) tree.head = node.next; else node.prev.next = node.next; if (node.next == null) tree.tail = node.prev; else node.next.prev = node.prev; node.prev = node.next = null; tree.a_cnt--; while (true){ /* recursive deletion starts here */ /* delete the bound change list */ { var b; while (node.b_ptr != null) { b = node.b_ptr; node.b_ptr = b.next; } } /* delete the status change list */ { var s; while (node.s_ptr != null) { s = node.s_ptr; node.s_ptr = s.next; } } /* delete the row addition list */ while (node.r_ptr != null) { var r; r = node.r_ptr; r.name = null; while (r.ptr != null) { var a; a = r.ptr; r.ptr = a.next; } node.r_ptr = r.next; } /* free application-specific data */ if (tree.parm.cb_size == 0) xassert(node.data == null); /* free the corresponding node slot */ p = node.p; xassert(tree.slot[p].node == node); tree.slot[p].node = null; tree.slot[p].next = tree.avail; tree.avail = p; /* save pointer to the parent subproblem */ temp = node.up; /* delete the subproblem descriptor */ tree.n_cnt--; /* take pointer to the parent subproblem */ node = temp; if (node != null) { /* the parent subproblem exists; decrease the number of its child subproblems */ xassert(node.count > 0); node.count--; /* if now the parent subproblem has no childs, it also must be deleted */ if (node.count == 0) continue; } break; } } function ios_delete_tree(tree){ var mip = tree.mip; var i, j; var m = mip.m; var n = mip.n; xassert(mip.tree == tree); /* remove all additional rows */ if (m != tree.orig_m) { var nrs, num; nrs = m - tree.orig_m; xassert(nrs > 0); num = new Int32Array(1+nrs); for (i = 1; i <= nrs; i++) num[i] = tree.orig_m + i; glp_del_rows(mip, nrs, num); } m = tree.orig_m; /* restore original attributes of rows and columns */ xassert(m == tree.orig_m); xassert(n == tree.n); for (i = 1; i <= m; i++) { glp_set_row_bnds(mip, i, tree.orig_type[i], tree.orig_lb[i], tree.orig_ub[i]); glp_set_row_stat(mip, i, tree.orig_stat[i]); mip.row[i].prim = tree.orig_prim[i]; mip.row[i].dual = tree.orig_dual[i]; } for (j = 1; j <= n; j++) { glp_set_col_bnds(mip, j, tree.orig_type[m+j], tree.orig_lb[m+j], tree.orig_ub[m+j]); glp_set_col_stat(mip, j, tree.orig_stat[m+j]); mip.col[j].prim = tree.orig_prim[m+j]; mip.col[j].dual = tree.orig_dual[m+j]; } mip.pbs_stat = mip.dbs_stat = GLP_FEAS; mip.obj_val = tree.orig_obj; /* delete the branch-and-bound tree */ xassert(tree.local != null); ios_delete_pool(tree.local); xassert(tree.mir_gen == null); xassert(tree.clq_gen == null); mip.tree = null; } function ios_eval_degrad(tree, j, callback){ var mip = tree.mip; var m = mip.m; var n = mip.n; var len, kase, k, t, stat; var alfa, beta, gamma, delta, dz; var ind = tree.iwrk; var val = tree.dwrk; var dn, up; /* current basis must be optimal */ xassert(glp_get_status(mip) == GLP_OPT); /* basis factorization must exist */ xassert(glp_bf_exists(mip)); /* obtain (fractional) value of x[j] in optimal basic solution to LP relaxation of the current subproblem */ xassert(1 <= j && j <= n); beta = mip.col[j].prim; /* since the value of x[j] is fractional, it is basic; compute corresponding row of the simplex table */ len = lpx_eval_tab_row(mip, m+j, ind, val); /* kase < 0 means down-branch; kase > 0 means up-branch */ for (kase = -1; kase <= +1; kase += 2) { /* for down-branch we introduce new upper bound floor(beta) for x[j]; similarly, for up-branch we introduce new lower bound ceil(beta) for x[j]; in the current basis this new upper/lower bound is violated, so in the adjacent basis x[j] will leave the basis and go to its new upper/lower bound; we need to know which non-basic variable x[k] should enter the basis to keep dual feasibility */ k = lpx_dual_ratio_test(mip, len, ind, val, kase, 1e-9); /* if no variable has been chosen, current basis being primal infeasible due to the new upper/lower bound of x[j] is dual unbounded, therefore, LP relaxation to corresponding branch has no primal feasible solution */ if (k == 0) { if (mip.dir == GLP_MIN) { if (kase < 0) dn = +DBL_MAX; else up = +DBL_MAX; } else if (mip.dir == GLP_MAX) { if (kase < 0) dn = -DBL_MAX; else up = -DBL_MAX; } else xassert(mip != mip); continue; } xassert(1 <= k && k <= m+n); /* row of the simplex table corresponding to specified basic variable x[j] is the following: x[j] = ... + alfa * x[k] + ... ; we need to know influence coefficient, alfa, at non-basic variable x[k] chosen with the dual ratio test */ for (t = 1; t <= len; t++) if (ind[t] == k) break; xassert(1 <= t && t <= len); alfa = val[t]; /* determine status and reduced cost of variable x[k] */ if (k <= m) { stat = mip.row[k].stat; gamma = mip.row[k].dual; } else { stat = mip.col[k-m].stat; gamma = mip.col[k-m].dual; } /* x[k] cannot be basic or fixed non-basic */ xassert(stat == GLP_NL || stat == GLP_NU || stat == GLP_NF); /* if the current basis is dual degenerative, some reduced costs, which are close to zero, may have wrong sign due to round-off errors, so correct the sign of gamma */ if (mip.dir == GLP_MIN) { if (stat == GLP_NL && gamma < 0.0 || stat == GLP_NU && gamma > 0.0 || stat == GLP_NF) gamma = 0.0; } else if (mip.dir == GLP_MAX) { if (stat == GLP_NL && gamma > 0.0 || stat == GLP_NU && gamma < 0.0 || stat == GLP_NF) gamma = 0.0; } else xassert(mip != mip); /* determine the change of x[j] in the adjacent basis: delta x[j] = new x[j] - old x[j] */ delta = (kase < 0 ? Math.floor(beta) : Math.ceil(beta)) - beta; /* compute the change of x[k] in the adjacent basis: delta x[k] = new x[k] - old x[k] = delta x[j] / alfa */ delta /= alfa; /* compute the change of the objective in the adjacent basis: delta z = new z - old z = gamma * delta x[k] */ dz = gamma * delta; if (mip.dir == GLP_MIN) xassert(dz >= 0.0); else if (mip.dir == GLP_MAX) xassert(dz <= 0.0); else xassert(mip != mip); /* compute the new objective value in the adjacent basis: new z = old z + delta z */ if (kase < 0) dn = mip.obj_val + dz; else up = mip.obj_val + dz; } callback(dn, up); /*xprintf("obj = %g; dn = %g; up = %g", mip.obj_val, *dn, *up);*/ } function ios_round_bound(tree, bound){ var mip = tree.mip; var n = mip.n; var d, j, nn; var c = tree.iwrk; var s, h; /* determine c[j] and compute s */ nn = 0; s = mip.c0; d = 0; for (j = 1; j <= n; j++) { var col = mip.col[j]; if (col.coef == 0.0) continue; if (col.type == GLP_FX) { /* fixed variable */ s += col.coef * col.prim; } else { /* non-fixed variable */ if (col.kind != GLP_IV) return bound; if (col.coef != Math.floor(col.coef)) return bound; if (Math.abs(col.coef) <= INT_MAX) c[++nn] = Math.abs(col.coef)|0; else d = 1; } } /* compute d = gcd(c[1],...c[nn]) */ if (d == 0) { if (nn == 0) return bound; d = gcdn(nn, c); } xassert(d > 0); /* compute new local bound */ if (mip.dir == GLP_MIN) { if (bound != +DBL_MAX) { h = (bound - s) / d; if (h >= Math.floor(h) + 0.001) { /* round up */ h = Math.ceil(h); /*xprintf("d = %d; old = %g; ", d, bound);*/ bound = d * h + s; /*xprintf("new = %g", bound);*/ } } } else if (mip.dir == GLP_MAX) { if (bound != -DBL_MAX) { h = (bound - s) / d; if (h <= Math.ceil(h) - 0.001) { /* round down */ h = Math.floor(h); bound = d * h + s; } } } else xassert(mip != mip); return bound; } function ios_is_hopeful(tree, bound){ var mip = tree.mip; var ret = 1; var eps; if (mip.mip_stat == GLP_FEAS) { eps = tree.parm.tol_obj * (1.0 + Math.abs(mip.mip_obj)); switch (mip.dir) { case GLP_MIN: if (bound >= mip.mip_obj - eps) ret = 0; break; case GLP_MAX: if (bound <= mip.mip_obj + eps) ret = 0; break; default: xassert(mip != mip); } } else { switch (mip.dir) { case GLP_MIN: if (bound == +DBL_MAX) ret = 0; break; case GLP_MAX: if (bound == -DBL_MAX) ret = 0; break; default: xassert(mip != mip); } } return ret; } function ios_best_node(tree){ var node, best = null; switch (tree.mip.dir) { case GLP_MIN: /* minimization */ for (node = tree.head; node != null; node = node.next) if (best == null || best.bound > node.bound) best = node; break; case GLP_MAX: /* maximization */ for (node = tree.head; node != null; node = node.next) if (best == null || best.bound < node.bound) best = node; break; default: xassert(tree != tree); } return best == null ? 0 : best.p; } var ios_relative_gap = exports['glp_ios_relative_gap'] = function(tree){ var mip = tree.mip; var p; var best_mip, best_bnd, gap; if (mip.mip_stat == GLP_FEAS) { best_mip = mip.mip_obj; p = ios_best_node(tree); if (p == 0) { /* the tree is empty */ gap = 0.0; } else { best_bnd = tree.slot[p].node.bound; gap = Math.abs(best_mip - best_bnd) / (Math.abs(best_mip) + DBL_EPSILON); } } else { /* no integer feasible solution has been found yet */ gap = DBL_MAX; } return gap; }; function ios_solve_node(tree){ var mip = tree.mip; var ret; /* the current subproblem must exist */ xassert(tree.curr != null); /* set some control parameters */ var parm = new SMCP(); // glp_init_smcp(parm); switch (tree.parm.msg_lev) { case GLP_MSG_OFF: parm.msg_lev = GLP_MSG_OFF; break; case GLP_MSG_ERR: parm.msg_lev = GLP_MSG_ERR; break; case GLP_MSG_ON: case GLP_MSG_ALL: parm.msg_lev = GLP_MSG_ON; break; case GLP_MSG_DBG: parm.msg_lev = GLP_MSG_ALL; break; default: xassert(tree != tree); } parm.meth = GLP_DUALP; if (tree.parm.msg_lev < GLP_MSG_DBG) parm.out_dly = tree.parm.out_dly; else parm.out_dly = 0; /* if the incumbent objective value is already known, use it to prematurely terminate the dual simplex search */ if (mip.mip_stat == GLP_FEAS) { switch (tree.mip.dir) { case GLP_MIN: parm.obj_ul = mip.mip_obj; break; case GLP_MAX: parm.obj_ll = mip.mip_obj; break; default: xassert(mip != mip); } } /* try to solve/re-optimize the LP relaxation */ ret = glp_simplex(mip, parm); tree.curr.solved++; return ret; } function ios_create_pool(tree){ /* create cut pool */ xassert(tree == tree); var pool = {}; pool.size = 0; pool.head = pool.tail = null; pool.ord = 0; pool.curr = null; return pool; } function ios_add_row(tree, pool, name, klass, flags, len, ind, val, type, rhs){ /* add row (constraint) to the cut pool */ var cut, aij, k; xassert(pool != null); cut = {}; if (name == null || name[0] == '\0') cut.name = null; else { cut.name = name; } if (!(0 <= klass && klass <= 255)) xerror("glp_ios_add_row: klass = " + klass + "; invalid cut class"); cut.klass = klass; if (flags != 0) xerror("glp_ios_add_row: flags = " + flags + "; invalid cut flags"); cut.ptr = null; if (!(0 <= len && len <= tree.n)) xerror("glp_ios_add_row: len = " + len + "; invalid cut length"); for (k = 1; k <= len; k++) { aij = {}; if (!(1 <= ind[k] && ind[k] <= tree.n)) xerror("glp_ios_add_row: ind[" + k + "] = " + ind[k] + "; column index out of range"); aij.j = ind[k]; aij.val = val[k]; aij.next = cut.ptr; cut.ptr = aij; } if (!(type == GLP_LO || type == GLP_UP || type == GLP_FX)) xerror("glp_ios_add_row: type = " + type + "; invalid cut type"); cut.type = type; cut.rhs = rhs; cut.prev = pool.tail; cut.next = null; if (cut.prev == null) pool.head = cut; else cut.prev.next = cut; pool.tail = cut; pool.size++; return pool.size; } function ios_find_row(pool, i){ /* find row (constraint) in the cut pool */ /* (smart linear search) */ xassert(pool != null); xassert(1 <= i && i <= pool.size); if (pool.ord == 0) { xassert(pool.curr == null); pool.ord = 1; pool.curr = pool.head; } xassert(pool.curr != null); if (i < pool.ord) { if (i < pool.ord - i) { pool.ord = 1; pool.curr = pool.head; while (pool.ord != i) { pool.ord++; xassert(pool.curr != null); pool.curr = pool.curr.next; } } else { while (pool.ord != i) { pool.ord--; xassert(pool.curr != null); pool.curr = pool.curr.prev; } } } else if (i > pool.ord) { if (i - pool.ord < pool.size - i) { while (pool.ord != i) { pool.ord++; xassert(pool.curr != null); pool.curr = pool.curr.next; } } else { pool.ord = pool.size; pool.curr = pool.tail; while (pool.ord != i) { pool.ord--; xassert(pool.curr != null); pool.curr = pool.curr.prev; } } } xassert(pool.ord == i); xassert(pool.curr != null); return pool.curr; } function ios_del_row(pool, i){ /* remove row (constraint) from the cut pool */ var cut, aij; xassert(pool != null); if (!(1 <= i && i <= pool.size)) xerror("glp_ios_del_row: i = " + i + "; cut number out of range"); cut = ios_find_row(pool, i); xassert(pool.curr == cut); if (cut.next != null) pool.curr = cut.next; else if (cut.prev != null){ pool.ord--; pool.curr = cut.prev; } else { pool.ord = 0; pool.curr = null; } if (cut.prev == null) { xassert(pool.head == cut); pool.head = cut.next; } else { xassert(cut.prev.next == cut); cut.prev.next = cut.next; } if (cut.next == null) { xassert(pool.tail == cut); pool.tail = cut.prev; } else { xassert(cut.next.prev == cut); cut.next.prev = cut.prev; } while (cut.ptr != null) { aij = cut.ptr; cut.ptr = aij.next; } pool.size--; } function ios_clear_pool(pool){ /* remove all rows (constraints) from the cut pool */ xassert(pool != null); while (pool.head != null) { var cut = pool.head; pool.head = cut.next; while (cut.ptr != null) { var aij = cut.ptr; cut.ptr = aij.next; } } pool.size = 0; pool.head = pool.tail = null; pool.ord = 0; pool.curr = null; } function ios_delete_pool(pool){ /* delete cut pool */ xassert(pool != null); ios_clear_pool(pool); } function ios_preprocess_node(tree, max_pass){ function prepare_row_info(n, a, l, u, f){ var j, j_min, j_max; var f_min, f_max; xassert(n >= 0); /* determine f_min and j_min */ f_min = 0.0; j_min = 0; for (j = 1; j <= n; j++) { if (a[j] > 0.0) { if (l[j] == -DBL_MAX) { if (j_min == 0) j_min = j; else { f_min = -DBL_MAX; j_min = 0; break; } } else f_min += a[j] * l[j]; } else if (a[j] < 0.0) { if (u[j] == +DBL_MAX) { if (j_min == 0) j_min = j; else { f_min = -DBL_MAX; j_min = 0; break; } } else f_min += a[j] * u[j]; } else xassert(a != a); } f.f_min = f_min; f.j_min = j_min; /* determine f_max and j_max */ f_max = 0.0; j_max = 0; for (j = 1; j <= n; j++) { if (a[j] > 0.0) { if (u[j] == +DBL_MAX) { if (j_max == 0) j_max = j; else { f_max = +DBL_MAX; j_max = 0; break; } } else f_max += a[j] * u[j]; } else if (a[j] < 0.0) { if (l[j] == -DBL_MAX) { if (j_max == 0) j_max = j; else { f_max = +DBL_MAX; j_max = 0; break; } } else f_max += a[j] * l[j]; } else xassert(a != a); } f.f_max = f_max; f.j_max = j_max; } function row_implied_bounds(f, callback){ callback((f.j_min == 0 ? f.f_min : -DBL_MAX), (f.j_max == 0 ? f.f_max : +DBL_MAX)); } function col_implied_bounds(f, n, a, L, U, l, u, k, callback){ var ilb, iub, ll, uu; xassert(n >= 0); xassert(1 <= k && k <= n); /* determine implied lower bound of term a[k] * x[k] (14) */ if (L == -DBL_MAX || f.f_max == +DBL_MAX) ilb = -DBL_MAX; else if (f.j_max == 0) { if (a[k] > 0.0) { xassert(u[k] != +DBL_MAX); ilb = L - (f.f_max - a[k] * u[k]); } else if (a[k] < 0.0) { xassert(l[k] != -DBL_MAX); ilb = L - (f.f_max - a[k] * l[k]); } else xassert(a != a); } else if (f.j_max == k) ilb = L - f.f_max; else ilb = -DBL_MAX; /* determine implied upper bound of term a[k] * x[k] (15) */ if (U == +DBL_MAX || f.f_min == -DBL_MAX) iub = +DBL_MAX; else if (f.j_min == 0) { if (a[k] > 0.0) { xassert(l[k] != -DBL_MAX); iub = U - (f.f_min - a[k] * l[k]); } else if (a[k] < 0.0) { xassert(u[k] != +DBL_MAX); iub = U - (f.f_min - a[k] * u[k]); } else xassert(a != a); } else if (f.j_min == k) iub = U - f.f_min; else iub = +DBL_MAX; /* determine implied bounds of x[k] (16) and (17) */ /* do not use a[k] if it has small magnitude to prevent wrong implied bounds; for example, 1e-15 * x1 >= x2 + x3, where x1 >= -10, x2, x3 >= 0, would lead to wrong conclusion that x1 >= 0 */ if (Math.abs(a[k]) < 1e-6){ ll = -DBL_MAX; uu = +DBL_MAX } else if (a[k] > 0.0) { ll = (ilb == -DBL_MAX ? -DBL_MAX : ilb / a[k]); uu = (iub == +DBL_MAX ? +DBL_MAX : iub / a[k]); } else if (a[k] < 0.0) { ll = (iub == +DBL_MAX ? -DBL_MAX : iub / a[k]); uu = (ilb == -DBL_MAX ? +DBL_MAX : ilb / a[k]); } else xassert(a != a); callback(ll, uu); } function check_row_bounds(f, L_, Lx, U_, Ux){ var eps, ret = 0; var L = L_[Lx], U = U_[Ux], LL = null, UU = null; /* determine implied bounds of the row */ row_implied_bounds(f, function(a, b){LL = a; UU = b}); /* check if the original lower bound is infeasible */ if (L != -DBL_MAX) { eps = 1e-3 * (1.0 + Math.abs(L)); if (UU < L - eps) { ret = 1; return ret; } } /* check if the original upper bound is infeasible */ if (U != +DBL_MAX) { eps = 1e-3 * (1.0 + Math.abs(U)); if (LL > U + eps) { ret = 1; return ret; } } /* check if the original lower bound is redundant */ if (L != -DBL_MAX) { eps = 1e-12 * (1.0 + Math.abs(L)); if (LL > L - eps) { /* it cannot be active, so remove it */ L_[Lx] = -DBL_MAX; } } /* check if the original upper bound is redundant */ if (U != +DBL_MAX) { eps = 1e-12 * (1.0 + Math.abs(U)); if (UU < U + eps) { /* it cannot be active, so remove it */ U_[Ux] = +DBL_MAX; } } return ret } function check_col_bounds(f, n, a, L, U, l, u, flag, j, callback){ var eps, ret = 0; var lj, uj, ll = null, uu = null; xassert(n >= 0); xassert(1 <= j && j <= n); lj = l[j]; uj = u[j]; /* determine implied bounds of the column */ col_implied_bounds(f, n, a, L, U, l, u, j, function(a,b){ll = a; uu = b}); /* if x[j] is integral, round its implied bounds */ if (flag) { if (ll != -DBL_MAX) ll = (ll - Math.floor(ll) < 1e-3 ? Math.floor(ll) : Math.ceil(ll)); if (uu != +DBL_MAX) uu = (Math.ceil(uu) - uu < 1e-3 ? Math.ceil(uu) : Math.floor(uu)); } /* check if the original lower bound is infeasible */ if (lj != -DBL_MAX) { eps = 1e-3 * (1.0 + Math.abs(lj)); if (uu < lj - eps) { ret = 1; return ret; } } /* check if the original upper bound is infeasible */ if (uj != +DBL_MAX) { eps = 1e-3 * (1.0 + Math.abs(uj)); if (ll > uj + eps) { ret = 1; return ret; } } /* check if the original lower bound is redundant */ if (ll != -DBL_MAX) { eps = 1e-3 * (1.0 + Math.abs(ll)); if (lj < ll - eps) { /* it cannot be active, so tighten it */ lj = ll; } } /* check if the original upper bound is redundant */ if (uu != +DBL_MAX) { eps = 1e-3 * (1.0 + Math.abs(uu)); if (uj > uu + eps) { /* it cannot be active, so tighten it */ uj = uu; } } /* due to round-off errors it may happen that lj > uj (although lj < uj + eps, since no primal infeasibility is detected), so adjuct the new actual bounds to provide lj <= uj */ if (!(lj == -DBL_MAX || uj == +DBL_MAX)) { var t1 = Math.abs(lj), t2 = Math.abs(uj); eps = 1e-10 * (1.0 + (t1 <= t2 ? t1 : t2)); if (lj > uj - eps) { if (lj == l[j]) uj = lj; else if (uj == u[j]) lj = uj; else if (t1 <= t2) uj = lj; else lj = uj; } } callback(lj, uj); return ret; } function check_efficiency(flag, l, u, ll, uu){ var r, eff = 0; /* check efficiency for lower bound */ if (l < ll) { if (flag || l == -DBL_MAX) eff++; else { if (u == +DBL_MAX) r = 1.0 + Math.abs(l); else r = 1.0 + (u - l); if (ll - l >= 0.25 * r) eff++; } } /* check efficiency for upper bound */ if (u > uu) { if (flag || u == +DBL_MAX) eff++; else { if (l == -DBL_MAX) r = 1.0 + Math.abs(u); else r = 1.0 + (u - l); if (u - uu >= 0.25 * r) eff++; } } return eff; } function basic_preprocessing(mip, L, U, l, u, nrs, num, max_pass){ var m = mip.m; var n = mip.n; var f = {}; var i, j, k, len, size, ret = 0; var ind, list, mark, pass; var val, lb, ub; var aij, col; xassert(0 <= nrs && nrs <= m+1); xassert(max_pass > 0); /* allocate working arrays */ ind = new Int32Array(1+n); list = new Int32Array(1+m+1); mark = new Int32Array(1+m+1); pass = new Int32Array(1+m+1); val = new Float64Array(1+n); lb = new Float64Array(1+n); ub = new Float64Array(1+n); /* initialize the list of rows to be processed */ size = 0; for (k = 1; k <= nrs; k++) { i = num[k]; xassert(0 <= i && i <= m); /* duplicate row numbers are not allowed */ xassert(!mark[i]); list[++size] = i; mark[i] = 1; } xassert(size == nrs); /* process rows in the list until it becomes empty */ while (size > 0) { /* get a next row from the list */ i = list[size--]; mark[i] = 0; /* increase the row processing count */ pass[i]++; /* if the row is free, skip it */ if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) continue; /* obtain coefficients of the row */ len = 0; if (i == 0) { for (j = 1; j <= n; j++) { col = mip.col[j]; if (col.coef != 0.0){ len++; ind[len] = j; val[len] = col.coef; } } } else { var row = mip.row[i]; for (aij = row.ptr; aij != null; aij = aij.r_next){ len++; ind[len] = aij.col.j; val[len] = aij.val; } } /* determine lower and upper bounds of columns corresponding to non-zero row coefficients */ for (k = 1; k <= len; k++){ j = ind[k]; lb[k] = l[j]; ub[k] = u[j]; } /* prepare the row info to determine implied bounds */ prepare_row_info(len, val, lb, ub, f); /* check and relax bounds of the row */ if (check_row_bounds(f, L, i, U, i)) { /* the feasible region is empty */ ret = 1; return ret; } /* if the row became free, drop it */ if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) continue; /* process columns having non-zero coefficients in the row */ for (k = 1; k <= len; k++){ var flag, eff; var ll = null, uu = null; /* take a next column in the row */ j = ind[k]; col = mip.col[j]; flag = col.kind != GLP_CV; /* check and tighten bounds of the column */ if (check_col_bounds(f, len, val, L[i], U[i], lb, ub, flag, k, function(a, b){ll = a; uu = b})) { /* the feasible region is empty */ ret = 1; return ret; } /* check if change in the column bounds is efficient */ eff = check_efficiency(flag, l[j], u[j], ll, uu); /* set new actual bounds of the column */ l[j] = ll; u[j] = uu; /* if the change is efficient, add all rows affected by the corresponding column, to the list */ if (eff > 0) { for (aij = col.ptr; aij != null; aij = aij.c_next) { var ii = aij.row.i; /* if the row was processed maximal number of times, skip it */ if (pass[ii] >= max_pass) continue; /* if the row is free, skip it */ if (L[ii] == -DBL_MAX && U[ii] == +DBL_MAX) continue; /* put the row into the list */ if (mark[ii] == 0) { xassert(size <= m); list[++size] = ii; mark[ii] = 1; } } } } } return ret; } var mip = tree.mip; var m = mip.m; var n = mip.n; var i, j, nrs, num, ret = 0; var L, U, l, u; /* the current subproblem must exist */ xassert(tree.curr != null); /* determine original row bounds */ L = new Float64Array(1+m); U = new Float64Array(1+m); switch (mip.mip_stat) { case GLP_UNDEF: L[0] = -DBL_MAX; U[0] = +DBL_MAX; break; case GLP_FEAS: switch (mip.dir) { case GLP_MIN: L[0] = -DBL_MAX; U[0] = mip.mip_obj - mip.c0; break; case GLP_MAX: L[0] = mip.mip_obj - mip.c0; U[0] = +DBL_MAX; break; default: xassert(mip != mip); } break; default: xassert(mip != mip); } for (i = 1; i <= m; i++) { L[i] = glp_get_row_lb(mip, i); U[i] = glp_get_row_ub(mip, i); } /* determine original column bounds */ l = new Float64Array(1+n); u = new Float64Array(1+n); for (j = 1; j <= n; j++) { l[j] = glp_get_col_lb(mip, j); u[j] = glp_get_col_ub(mip, j); } /* build the initial list of rows to be analyzed */ nrs = m + 1; num = new Int32Array(1+nrs); for (i = 1; i <= nrs; i++) num[i] = i - 1; /* perform basic preprocessing */ if (basic_preprocessing(mip , L, U, l, u, nrs, num, max_pass)) { ret = 1; return ret; } /* set new actual (relaxed) row bounds */ for (i = 1; i <= m; i++) { /* consider only non-active rows to keep dual feasibility */ if (glp_get_row_stat(mip, i) == GLP_BS) { if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) glp_set_row_bnds(mip, i, GLP_FR, 0.0, 0.0); else if (U[i] == +DBL_MAX) glp_set_row_bnds(mip, i, GLP_LO, L[i], 0.0); else if (L[i] == -DBL_MAX) glp_set_row_bnds(mip, i, GLP_UP, 0.0, U[i]); } } /* set new actual (tightened) column bounds */ for (j = 1; j <= n; j++) { var type; if (l[j] == -DBL_MAX && u[j] == +DBL_MAX) type = GLP_FR; else if (u[j] == +DBL_MAX) type = GLP_LO; else if (l[j] == -DBL_MAX) type = GLP_UP; else if (l[j] != u[j]) type = GLP_DB; else type = GLP_FX; glp_set_col_bnds(mip, j, type, l[j], u[j]); } return ret; } function ios_driver(T){ function show_progress(T, bingo){ var p; var temp; var best_mip, best_bound, rho, rel_gap; /* format the best known integer feasible solution */ if (T.mip.mip_stat == GLP_FEAS) best_mip = String(T.mip.mip_obj); else best_mip = "not found yet"; /* determine reference number of an active subproblem whose local bound is best */ p = ios_best_node(T); /* format the best bound */ if (p == 0) best_bound = "tree is empty"; else { temp = T.slot[p].node.bound; if (temp == -DBL_MAX) best_bound = "-inf"; else if (temp == +DBL_MAX) best_bound = "+inf"; else best_bound = temp; } /* choose the relation sign between global bounds */ if (T.mip.dir == GLP_MIN) rho = ">="; else if (T.mip.dir == GLP_MAX) rho = "<="; else xassert(T != T); /* format the relative mip gap */ temp = ios_relative_gap(T); if (temp == 0.0) rel_gap = " 0.0%"; else if (temp < 0.001) rel_gap = " < 0.1%"; else if (temp <= 9.999){ rel_gap = " " + Number(100.0 * temp).toFixed(1) + "%"; } else rel_gap = ""; /* display progress of the search */ xprintf("+" + T.mip.it_cnt + ": " + (bingo ? ">>>>>" : "mip =") + " " + best_mip + " " + rho + " " + best_bound + " " + rel_gap + " (" + T.a_cnt + "; " + (T.t_cnt - T.n_cnt) + ")"); T.tm_lag = xtime(); } function is_branch_hopeful(T, p){ xassert(1 <= p && p <= T.nslots); xassert(T.slot[p].node != null); return ios_is_hopeful(T, T.slot[p].node.bound); } function check_integrality(T){ var mip = T.mip; var j, type, ii_cnt = 0; var lb, ub, x, temp1, temp2, ii_sum = 0.0; /* walk through the set of columns (structural variables) */ for (j = 1; j <= mip.n; j++) { var col = mip.col[j]; T.non_int[j] = 0; /* if the column is not integer, skip it */ if (col.kind != GLP_IV) continue; /* if the column is non-basic, it is integer feasible */ if (col.stat != GLP_BS) continue; /* obtain the type and bounds of the column */ type = col.type; lb = col.lb; ub = col.ub; /* obtain value of the column in optimal basic solution */ x = col.prim; /* if the column's primal value is close to the lower bound, the column is integer feasible within given tolerance */ if (type == GLP_LO || type == GLP_DB || type == GLP_FX) { temp1 = lb - T.parm.tol_int; temp2 = lb + T.parm.tol_int; if (temp1 <= x && x <= temp2) continue; if (x < lb) continue; } /* if the column's primal value is close to the upper bound, the column is integer feasible within given tolerance */ if (type == GLP_UP || type == GLP_DB || type == GLP_FX) { temp1 = ub - T.parm.tol_int; temp2 = ub + T.parm.tol_int; if (temp1 <= x && x <= temp2) continue; if (x > ub) continue; } /* if the column's primal value is close to nearest integer, the column is integer feasible within given tolerance */ temp1 = Math.floor(x + 0.5) - T.parm.tol_int; temp2 = Math.floor(x + 0.5) + T.parm.tol_int; if (temp1 <= x && x <= temp2) continue; /* otherwise the column is integer infeasible */ T.non_int[j] = 1; /* increase the number of fractional-valued columns */ ii_cnt++; /* compute the sum of integer infeasibilities */ temp1 = x - Math.floor(x); temp2 = Math.ceil(x) - x; xassert(temp1 > 0.0 && temp2 > 0.0); ii_sum += (temp1 <= temp2 ? temp1 : temp2); } /* store ii_cnt and ii_sum to the current problem descriptor */ xassert(T.curr != null); T.curr.ii_cnt = ii_cnt; T.curr.ii_sum = ii_sum; /* and also display these parameters */ if (T.parm.msg_lev >= GLP_MSG_DBG) { if (ii_cnt == 0) xprintf("There are no fractional columns"); else if (ii_cnt == 1) xprintf("There is one fractional column, integer infeasibility is " + ii_sum + ""); else xprintf("There are " + ii_cnt + " fractional columns, integer infeasibility is " + ii_sum + ""); } } function record_solution(T){ var mip = T.mip; var i, j; mip.mip_stat = GLP_FEAS; mip.mip_obj = mip.obj_val; for (i = 1; i <= mip.m; i++) { var row = mip.row[i]; row.mipx = row.prim; } for (j = 1; j <= mip.n; j++) { var col = mip.col[j]; if (col.kind == GLP_CV) col.mipx = col.prim; else if (col.kind == GLP_IV) { /* value of the integer column must be integral */ col.mipx = Math.floor(col.prim + 0.5); } else xassert(col != col); } T.sol_cnt++; } function branch_on(T, j, next){ var mip = T.mip; var node; var m = mip.m; var n = mip.n; var type, dn_type, up_type, dn_bad, up_bad, p, ret, clone = new Array(1+2); var lb, ub, beta, new_ub, new_lb, dn_lp = null, up_lp = null, dn_bnd, up_bnd; /* determine bounds and value of x[j] in optimal solution to LP relaxation of the current subproblem */ xassert(1 <= j && j <= n); type = mip.col[j].type; lb = mip.col[j].lb; ub = mip.col[j].ub; beta = mip.col[j].prim; /* determine new bounds of x[j] for down- and up-branches */ new_ub = Math.floor(beta); new_lb = Math.ceil(beta); switch (type) { case GLP_FR: dn_type = GLP_UP; up_type = GLP_LO; break; case GLP_LO: xassert(lb <= new_ub); dn_type = (lb == new_ub ? GLP_FX : GLP_DB); xassert(lb + 1.0 <= new_lb); up_type = GLP_LO; break; case GLP_UP: xassert(new_ub <= ub - 1.0); dn_type = GLP_UP; xassert(new_lb <= ub); up_type = (new_lb == ub ? GLP_FX : GLP_DB); break; case GLP_DB: xassert(lb <= new_ub && new_ub <= ub - 1.0); dn_type = (lb == new_ub ? GLP_FX : GLP_DB); xassert(lb + 1.0 <= new_lb && new_lb <= ub); up_type = (new_lb == ub ? GLP_FX : GLP_DB); break; default: xassert(type != type); } /* compute local bounds to LP relaxation for both branches */ ios_eval_degrad(T, j, function(a, b){dn_lp = a; up_lp = b}); /* and improve them by rounding */ dn_bnd = ios_round_bound(T, dn_lp); up_bnd = ios_round_bound(T, up_lp); /* check local bounds for down- and up-branches */ dn_bad = !ios_is_hopeful(T, dn_bnd); up_bad = !ios_is_hopeful(T, up_bnd); if (dn_bad && up_bad) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Both down- and up-branches are hopeless"); ret = 2; return ret; } else if (up_bad) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Up-branch is hopeless"); glp_set_col_bnds(mip, j, dn_type, lb, new_ub); T.curr.lp_obj = dn_lp; if (mip.dir == GLP_MIN) { if (T.curr.bound < dn_bnd) T.curr.bound = dn_bnd; } else if (mip.dir == GLP_MAX) { if (T.curr.bound > dn_bnd) T.curr.bound = dn_bnd; } else xassert(mip != mip); ret = 1; return ret; } else if (dn_bad) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Down-branch is hopeless"); glp_set_col_bnds(mip, j, up_type, new_lb, ub); T.curr.lp_obj = up_lp; if (mip.dir == GLP_MIN) { if (T.curr.bound < up_bnd) T.curr.bound = up_bnd; } else if (mip.dir == GLP_MAX) { if (T.curr.bound > up_bnd) T.curr.bound = up_bnd; } else xassert(mip != mip); ret = 1; return ret; } /* both down- and up-branches seem to be hopeful */ if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Branching on column " + j + ", primal value is " + beta + ""); /* determine the reference number of the current subproblem */ xassert(T.curr != null); p = T.curr.p; T.curr.br_var = j; T.curr.br_val = beta; /* freeze the current subproblem */ ios_freeze_node(T); /* create two clones of the current subproblem; the first clone begins the down-branch, the second one begins the up-branch */ ios_clone_node(T, p, 2, clone); if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Node " + clone[1] + " begins down branch, node " + clone[2] + " begins up branch "); /* set new upper bound of j-th column in the down-branch */ node = T.slot[clone[1]].node; xassert(node != null); xassert(node.up != null); xassert(node.b_ptr == null); node.b_ptr = {}; node.b_ptr.k = m + j; node.b_ptr.type = dn_type; node.b_ptr.lb = lb; node.b_ptr.ub = new_ub; node.b_ptr.next = null; node.lp_obj = dn_lp; if (mip.dir == GLP_MIN) { if (node.bound < dn_bnd) node.bound = dn_bnd; } else if (mip.dir == GLP_MAX) { if (node.bound > dn_bnd) node.bound = dn_bnd; } else xassert(mip != mip); /* set new lower bound of j-th column in the up-branch */ node = T.slot[clone[2]].node; xassert(node != null); xassert(node.up != null); xassert(node.b_ptr == null); node.b_ptr = {}; node.b_ptr.k = m + j; node.b_ptr.type = up_type; node.b_ptr.lb = new_lb; node.b_ptr.ub = ub; node.b_ptr.next = null; node.lp_obj = up_lp; if (mip.dir == GLP_MIN) { if (node.bound < up_bnd) node.bound = up_bnd; } else if (mip.dir == GLP_MAX) { if (node.bound > up_bnd) node.bound = up_bnd; } else xassert(mip != mip); /* suggest the subproblem to be solved next */ xassert(T.child == 0); if (next == GLP_NO_BRNCH) T.child = 0; else if (next == GLP_DN_BRNCH) T.child = clone[1]; else if (next == GLP_UP_BRNCH) T.child = clone[2]; else xassert(next != next); ret = 0; return ret; } function fix_by_red_cost(T){ var mip = T.mip; var j, stat, fixed = 0; var obj, lb, ub, dj; /* the global bound must exist */ xassert(T.mip.mip_stat == GLP_FEAS); /* basic solution of LP relaxation must be optimal */ xassert(mip.pbs_stat == GLP_FEAS && mip.dbs_stat == GLP_FEAS); /* determine the objective function value */ obj = mip.obj_val; /* walk through the column list */ for (j = 1; j <= mip.n; j++) { var col = mip.col[j]; /* if the column is not integer, skip it */ if (col.kind != GLP_IV) continue; /* obtain bounds of j-th column */ lb = col.lb; ub = col.ub; /* and determine its status and reduced cost */ stat = col.stat; dj = col.dual; /* analyze the reduced cost */ switch (mip.dir) { case GLP_MIN: /* minimization */ if (stat == GLP_NL) { /* j-th column is non-basic on its lower bound */ if (dj < 0.0) dj = 0.0; if (obj + dj >= mip.mip_obj){ glp_set_col_bnds(mip, j, GLP_FX, lb, lb); fixed++; } } else if (stat == GLP_NU) { /* j-th column is non-basic on its upper bound */ if (dj > 0.0) dj = 0.0; if (obj - dj >= mip.mip_obj){ glp_set_col_bnds(mip, j, GLP_FX, ub, ub); fixed++; } } break; case GLP_MAX: /* maximization */ if (stat == GLP_NL) { /* j-th column is non-basic on its lower bound */ if (dj > 0.0) dj = 0.0; if (obj + dj <= mip.mip_obj){ glp_set_col_bnds(mip, j, GLP_FX, lb, lb); fixed++; } } else if (stat == GLP_NU) { /* j-th column is non-basic on its upper bound */ if (dj < 0.0) dj = 0.0; if (obj - dj <= mip.mip_obj){ glp_set_col_bnds(mip, j, GLP_FX, ub, ub); fixed++; } } break; default: xassert(T != T); } } if (T.parm.msg_lev >= GLP_MSG_DBG) { if (fixed == 0) {/* nothing to say */} else if (fixed == 1) xprintf("One column has been fixed by reduced cost"); else xprintf(fixed + " columns have been fixed by reduced costs"); } /* fixing non-basic columns on their current bounds does not change the basic solution */ xassert(mip.pbs_stat == GLP_FEAS && mip.dbs_stat == GLP_FEAS); } function remove_cuts(T){ /* remove inactive cuts (some valueable globally valid cut might be saved in the global cut pool) */ var i, cnt = 0, num = null; xassert(T.curr != null); for (i = T.orig_m+1; i <= T.mip.m; i++) { if (T.mip.row[i].origin == GLP_RF_CUT && T.mip.row[i].level == T.curr.level && T.mip.row[i].stat == GLP_BS) { if (num == null) num = new Int32Array(1+T.mip.m); num[++cnt] = i; } } if (cnt > 0) { glp_del_rows(T.mip, cnt, num); xassert(glp_factorize(T.mip) == 0); } } function display_cut_info(T){ var mip = T.mip; var i, gmi = 0, mir = 0, cov = 0, clq = 0, app = 0; for (i = mip.m; i > 0; i--) { var row = mip.row[i]; /* if (row.level < T.curr.level) break; */ if (row.origin == GLP_RF_CUT) { if (row.klass == GLP_RF_GMI) gmi++; else if (row.klass == GLP_RF_MIR) mir++; else if (row.klass == GLP_RF_COV) cov++; else if (row.klass == GLP_RF_CLQ) clq++; else app++; } } xassert(T.curr != null); if (gmi + mir + cov + clq + app > 0) { xprintf("Cuts on level " + T.curr.level + ":"); if (gmi > 0) xprintf(" gmi = " + gmi + ";"); if (mir > 0) xprintf(" mir = " + mir + ";"); if (cov > 0) xprintf(" cov = " + cov + ";"); if (clq > 0) xprintf(" clq = " + clq + ";"); if (app > 0) xprintf(" app = " + app + ";"); xprintf(""); } } function generate_cuts(T){ /* generate generic cuts with built-in generators */ if (!(T.parm.mir_cuts == GLP_ON || T.parm.gmi_cuts == GLP_ON || T.parm.cov_cuts == GLP_ON || T.parm.clq_cuts == GLP_ON)) return; { var i, max_cuts, added_cuts; max_cuts = T.n; if (max_cuts < 1000) max_cuts = 1000; added_cuts = 0; for (i = T.orig_m+1; i <= T.mip.m; i++) { if (T.mip.row[i].origin == GLP_RF_CUT) added_cuts++; } /* xprintf("added_cuts = %d", added_cuts); */ if (added_cuts >= max_cuts) return; } /* generate and add to POOL all cuts violated by x* */ if (T.parm.gmi_cuts == GLP_ON) { if (T.curr.changed < 5) ios_gmi_gen(T); } if (T.parm.mir_cuts == GLP_ON) { xassert(T.mir_gen != null); ios_mir_gen(T, T.mir_gen); } if (T.parm.cov_cuts == GLP_ON) { /* cover cuts works well along with mir cuts */ /*if (T.round <= 5)*/ ios_cov_gen(T); } if (T.parm.clq_cuts == GLP_ON) { if (T.clq_gen != null) { if (T.curr.level == 0 && T.curr.changed < 50 || T.curr.level > 0 && T.curr.changed < 5) ios_clq_gen(T, T.clq_gen); } } } function cleanup_the_tree(T){ var node, next_node; var count = 0; /* the global bound must exist */ xassert(T.mip.mip_stat == GLP_FEAS); /* walk through the list of active subproblems */ for (node = T.head; node != null; node = next_node) { /* deleting some active problem node may involve deleting its parents recursively; however, all its parents being created *before* it are always *precede* it in the node list, so the next problem node is never affected by such deletion */ next_node = node.next; /* if the branch is hopeless, prune it */ if (!is_branch_hopeful(T, node.p)){ ios_delete_node(T, node.p); count++; } } if (T.parm.msg_lev >= GLP_MSG_DBG) { if (count == 1) xprintf("One hopeless branch has been pruned"); else if (count > 1) xprintf(count + " hopeless branches have been pruned"); } } var p, curr_p, p_stat, d_stat, ret; var pred_p = 0; /* if the current subproblem has been just created due to branching, pred_p is the reference number of its parent subproblem, otherwise pred_p is zero */ var ttt = T.tm_beg; /* on entry to the B&B driver it is assumed that the active list contains the only active (i.e. root) subproblem, which is the original MIP problem to be solved */ var loop = 0, more = 1, fath = 2, done = 3; var label = loop; while (true){ var go_to = null; switch (label){ case loop: /* main loop starts here */ /* at this point the current subproblem does not exist */ xassert(T.curr == null); /* if the active list is empty, the search is finished */ if (T.head == null) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Active list is empty!"); //xassert(Object.keys(T.pool).length == 0); ret = 0; go_to = done; break; } /* select some active subproblem to continue the search */ xassert(T.next_p == 0); /* let the application program select subproblem */ if (T.parm.cb_func != null) { xassert(T.reason == 0); T.reason = GLP_ISELECT; T.parm.cb_func(T, T.parm.cb_info); T.reason = 0; if (T.stop) { ret = GLP_ESTOP; go_to = done; break; } } if (T.next_p != 0) { /* the application program has selected something */ } else if (T.a_cnt == 1) { /* the only active subproblem exists, so select it */ xassert(T.head.next == null); T.next_p = T.head.p; } else if (T.child != 0) { /* select one of branching childs suggested by the branching heuristic */ T.next_p = T.child; } else { /* select active subproblem as specified by the backtracking technique option */ T.next_p = ios_choose_node(T); } /* the active subproblem just selected becomes current */ ios_revive_node(T, T.next_p); T.next_p = T.child = 0; /* invalidate pred_p, if it is not the reference number of the parent of the current subproblem */ if (T.curr.up != null && T.curr.up.p != pred_p) pred_p = 0; /* determine the reference number of the current subproblem */ p = T.curr.p; if (T.parm.msg_lev >= GLP_MSG_DBG) { xprintf("-----------------------------------------------------" + "-------------------"); xprintf("Processing node " + p + " at level " + T.curr.level + ""); } /* if it is the root subproblem, initialize cut generators */ if (p == 1) { if (T.parm.gmi_cuts == GLP_ON) { if (T.parm.msg_lev >= GLP_MSG_ALL) xprintf("Gomory's cuts enabled"); } if (T.parm.mir_cuts == GLP_ON) { if (T.parm.msg_lev >= GLP_MSG_ALL) xprintf("MIR cuts enabled"); xassert(T.mir_gen == null); T.mir_gen = ios_mir_init(T); } if (T.parm.cov_cuts == GLP_ON) { if (T.parm.msg_lev >= GLP_MSG_ALL) xprintf("Cover cuts enabled"); } if (T.parm.clq_cuts == GLP_ON) { xassert(T.clq_gen == null); if (T.parm.msg_lev >= GLP_MSG_ALL) xprintf("Clique cuts enabled"); T.clq_gen = ios_clq_init(T); } } case more: /* minor loop starts here */ /* at this point the current subproblem needs either to be solved for the first time or re-optimized due to reformulation */ /* display current progress of the search */ if (T.parm.msg_lev >= GLP_MSG_DBG || T.parm.msg_lev >= GLP_MSG_ON && (T.parm.out_frq - 1) <= 1000.0 * xdifftime(xtime(), T.tm_lag)) show_progress(T, 0); if (T.parm.msg_lev >= GLP_MSG_ALL && xdifftime(xtime(), ttt) >= 60.0) { xprintf("Time used: " + xdifftime(xtime(), T.tm_beg) + " secs"); ttt = xtime(); } /* check the mip gap */ if (T.parm.mip_gap > 0.0 && ios_relative_gap(T) <= T.parm.mip_gap) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Relative gap tolerance reached; search terminated "); ret = GLP_EMIPGAP; go_to = done; break; } /* check if the time limit has been exhausted */ if (T.parm.tm_lim < INT_MAX && (T.parm.tm_lim - 1) <= 1000.0 * xdifftime(xtime(), T.tm_beg)) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Time limit exhausted; search terminated"); ret = GLP_ETMLIM; go_to = done; break; } /* let the application program preprocess the subproblem */ if (T.parm.cb_func != null) { xassert(T.reason == 0); T.reason = GLP_IPREPRO; T.parm.cb_func(T, T.parm.cb_info); T.reason = 0; if (T.stop) { ret = GLP_ESTOP; go_to = done; break; } } /* perform basic preprocessing */ if (T.parm.pp_tech == GLP_PP_NONE){ } else if (T.parm.pp_tech == GLP_PP_ROOT) { if (T.curr.level == 0) { if (ios_preprocess_node(T, 100)){ go_to = fath; break; } } } else if (T.parm.pp_tech == GLP_PP_ALL) { if (ios_preprocess_node(T, T.curr.level == 0 ? 100 : 10)){ go_to = fath; break; } } else xassert(T != T); /* preprocessing may improve the global bound */ if (!is_branch_hopeful(T, p)) { xprintf("*** not tested yet ***"); go_to = fath; break; } /* solve LP relaxation of the current subproblem */ if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Solving LP relaxation..."); ret = ios_solve_node(T); if (!(ret == 0 || ret == GLP_EOBJLL || ret == GLP_EOBJUL)) { if (T.parm.msg_lev >= GLP_MSG_ERR) xprintf("ios_driver: unable to solve current LP relaxation; glp_simplex returned " + ret + ""); ret = GLP_EFAIL; go_to = done; break; } /* analyze status of the basic solution to LP relaxation found */ p_stat = T.mip.pbs_stat; d_stat = T.mip.dbs_stat; if (p_stat == GLP_FEAS && d_stat == GLP_FEAS) { /* LP relaxation has optimal solution */ if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Found optimal solution to LP relaxation"); } else if (d_stat == GLP_NOFEAS) { /* LP relaxation has no dual feasible solution */ /* since the current subproblem cannot have a larger feasible region than its parent, there is something wrong */ if (T.parm.msg_lev >= GLP_MSG_ERR) xprintf("ios_driver: current LP relaxation has no dual feasible solution"); ret = GLP_EFAIL; go_to = done; break; } else if (p_stat == GLP_INFEAS && d_stat == GLP_FEAS) { /* LP relaxation has no primal solution which is better than the incumbent objective value */ xassert(T.mip.mip_stat == GLP_FEAS); if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("LP relaxation has no solution better than incumbent objective value"); /* prune the branch */ go_to = fath; break; } else if (p_stat == GLP_NOFEAS) { /* LP relaxation has no primal feasible solution */ if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("LP relaxation has no feasible solution"); /* prune the branch */ go_to = fath; break; } else { /* other cases cannot appear */ xassert(T.mip != T.mip); } /* at this point basic solution to LP relaxation of the current subproblem is optimal */ xassert(p_stat == GLP_FEAS && d_stat == GLP_FEAS); xassert(T.curr != null); T.curr.lp_obj = T.mip.obj_val; /* thus, it defines a local bound to integer optimal solution of the current subproblem */ { var bound = T.mip.obj_val; /* some local bound to the current subproblem could be already set before, so we should only improve it */ bound = ios_round_bound(T, bound); if (T.mip.dir == GLP_MIN) { if (T.curr.bound < bound) T.curr.bound = bound; } else if (T.mip.dir == GLP_MAX) { if (T.curr.bound > bound) T.curr.bound = bound; } else xassert(T.mip != T.mip); if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Local bound is " + bound + ""); } /* if the local bound indicates that integer optimal solution of the current subproblem cannot be better than the global bound, prune the branch */ if (!is_branch_hopeful(T, p)) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Current branch is hopeless and can be pruned"); go_to = fath; break; } /* let the application program generate additional rows ("lazy" constraints) */ xassert(T.reopt == 0); xassert(T.reinv == 0); if (T.parm.cb_func != null) { xassert(T.reason == 0); T.reason = GLP_IROWGEN; T.parm.cb_func(T, T.parm.cb_info); T.reason = 0; if (T.stop) { ret = GLP_ESTOP; go_to = done; break; } if (T.reopt) { /* some rows were added; re-optimization is needed */ T.reopt = T.reinv = 0; go_to = more; break; } if (T.reinv) { /* no rows were added, however, some inactive rows were removed */ T.reinv = 0; xassert(glp_factorize(T.mip) == 0); } } /* check if the basic solution is integer feasible */ check_integrality(T); /* if the basic solution satisfies to all integrality conditions, it is a new, better integer feasible solution */ if (T.curr.ii_cnt == 0) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("New integer feasible solution found"); if (T.parm.msg_lev >= GLP_MSG_ALL) display_cut_info(T); record_solution(T); if (T.parm.msg_lev >= GLP_MSG_ON) show_progress(T, 1); /* make the application program happy */ if (T.parm.cb_func != null) { xassert(T.reason == 0); T.reason = GLP_IBINGO; T.parm.cb_func(T, T.parm.cb_info); T.reason = 0; if (T.stop) { ret = GLP_ESTOP; go_to = done; break; } } /* since the current subproblem has been fathomed, prune its branch */ go_to = fath; break; } /* at this point basic solution to LP relaxation of the current subproblem is optimal, but integer infeasible */ /* try to fix some non-basic structural variables of integer kind on their current bounds due to reduced costs */ if (T.mip.mip_stat == GLP_FEAS) fix_by_red_cost(T); /* let the application program try to find some solution to the original MIP with a primal heuristic */ if (T.parm.cb_func != null) { xassert(T.reason == 0); T.reason = GLP_IHEUR; T.parm.cb_func(T, T.parm.cb_info); T.reason = 0; if (T.stop) { ret = GLP_ESTOP; go_to = done; break; } /* check if the current branch became hopeless */ if (!is_branch_hopeful(T, p)) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Current branch became hopeless and can be pruned"); go_to = fath; break; } } /* try to find solution with the feasibility pump heuristic */ if (T.parm.fp_heur) { xassert(T.reason == 0); T.reason = GLP_IHEUR; ios_feas_pump(T); T.reason = 0; /* check if the current branch became hopeless */ if (!is_branch_hopeful(T, p)) { if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Current branch became hopeless and can be pruned"); go_to = fath; break; } } /* it's time to generate cutting planes */ xassert(T.local != null); xassert(T.local.size == 0); /* let the application program generate some cuts; note that it can add cuts either to the local cut pool or directly to the current subproblem */ if (T.parm.cb_func != null) { xassert(T.reason == 0); T.reason = GLP_ICUTGEN; T.parm.cb_func(T, T.parm.cb_info); T.reason = 0; if (T.stop) { ret = GLP_ESTOP; go_to = done; break; } } /* try to generate generic cuts with built-in generators (as suggested by Matteo Fischetti et al. the built-in cuts are not generated at each branching node; an intense attempt of generating new cuts is only made at the root node, and then a moderate effort is spent after each backtracking step) */ if (T.curr.level == 0 || pred_p == 0) { xassert(T.reason == 0); T.reason = GLP_ICUTGEN; generate_cuts(T); T.reason = 0; } /* if the local cut pool is not empty, select useful cuts and add them to the current subproblem */ if (T.local.size > 0) { xassert(T.reason == 0); T.reason = GLP_ICUTGEN; ios_process_cuts(T); T.reason = 0; } /* clear the local cut pool */ ios_clear_pool(T.local); /* perform re-optimization, if necessary */ if (T.reopt) { T.reopt = 0; T.curr.changed++; go_to = more; break; } /* no cuts were generated; remove inactive cuts */ remove_cuts(T); if (T.parm.msg_lev >= GLP_MSG_ALL && T.curr.level == 0) display_cut_info(T); /* update history information used on pseudocost branching */ if (T.pcost != null) ios_pcost_update(T); /* it's time to perform branching */ xassert(T.br_var == 0); xassert(T.br_sel == 0); /* let the application program choose variable to branch on */ if (T.parm.cb_func != null) { xassert(T.reason == 0); xassert(T.br_var == 0); xassert(T.br_sel == 0); T.reason = GLP_IBRANCH; T.parm.cb_func(T, T.parm.cb_info); T.reason = 0; if (T.stop) { ret = GLP_ESTOP; go_to = done; break; } } /* if nothing has been chosen, choose some variable as specified by the branching technique option */ if (T.br_var == 0) T.br_var = ios_choose_var(T, function(next){T.br_sel = next}); /* perform actual branching */ curr_p = T.curr.p; ret = branch_on(T, T.br_var, T.br_sel); T.br_var = T.br_sel = 0; if (ret == 0) { /* both branches have been created */ pred_p = curr_p; go_to = loop; break; } else if (ret == 1) { /* one branch is hopeless and has been pruned, so now the current subproblem is other branch */ /* the current subproblem should be considered as a new one, since one bound of the branching variable was changed */ T.curr.solved = T.curr.changed = 0; go_to = more; break; } else if (ret == 2) { /* both branches are hopeless and have been pruned; new subproblem selection is needed to continue the search */ go_to = fath; break; } else xassert(ret != ret); case fath: /* the current subproblem has been fathomed */ if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("Node " + p + " fathomed"); /* freeze the current subproblem */ ios_freeze_node(T); /* and prune the corresponding branch of the tree */ ios_delete_node(T, p); /* if a new integer feasible solution has just been found, other branches may become hopeless and therefore must be pruned */ if (T.mip.mip_stat == GLP_FEAS) cleanup_the_tree(T); /* new subproblem selection is needed due to backtracking */ pred_p = 0; go_to = loop; break; case done: /* display progress of the search on exit from the solver */ if (T.parm.msg_lev >= GLP_MSG_ON) show_progress(T, 0); T.mir_gen = null; T.clq_gen = null; /* return to the calling program */ return ret; } if (go_to == null) break; label = go_to; } } function ios_create_vec(n){ var v; xassert(n >= 0); v = {}; v.n = n; v.nnz = 0; v.pos = new Int32Array(1+n); v.ind = new Int32Array(1+n); v.val = new Float64Array(1+n); return v; } function ios_check_vec(v){ var j, k, nnz; xassert(v.n >= 0); nnz = 0; for (j = v.n; j >= 1; j--) { k = v.pos[j]; xassert(0 <= k && k <= v.nnz); if (k != 0) { xassert(v.ind[k] == j); nnz++; } } xassert(v.nnz == nnz); } function ios_get_vj(v, j){ var k; xassert(1 <= j && j <= v.n); k = v.pos[j]; xassert(0 <= k && k <= v.nnz); return (k == 0 ? 0.0 : v.val[k]); } function ios_set_vj(v, j, val){ xassert(1 <= j && j <= v.n); var k = v.pos[j]; if (val == 0.0) { if (k != 0) { /* remove j-th component */ v.pos[j] = 0; if (k < v.nnz) { v.pos[v.ind[v.nnz]] = k; v.ind[k] = v.ind[v.nnz]; v.val[k] = v.val[v.nnz]; } v.nnz--; } } else { if (k == 0) { /* create j-th component */ k = ++(v.nnz); v.pos[j] = k; v.ind[k] = j; } v.val[k] = val; } } function ios_clear_vec(v){ for (var k = 1; k <= v.nnz; k++) v.pos[v.ind[k]] = 0; v.nnz = 0; } function ios_clean_vec(v, eps){ var nnz = 0; for (var k = 1; k <= v.nnz; k++) { if (Math.abs(v.val[k]) == 0.0 || Math.abs(v.val[k]) < eps) { /* remove component */ v.pos[v.ind[k]] = 0; } else { /* keep component */ nnz++; v.pos[v.ind[k]] = nnz; v.ind[nnz] = v.ind[k]; v.val[nnz] = v.val[k]; } } v.nnz = nnz; } function ios_copy_vec(x, y){ xassert(x != y); xassert(x.n == y.n); ios_clear_vec(x); x.nnz = y.nnz; xcopyArr(x.ind, 1, y.ind, 1, x.nnz); xcopyArr(x.val, 1, y.val, 1, x.nnz); for (var j = 1; j <= x.nnz; j++) x.pos[x.ind[j]] = j; } function ios_linear_comb(x, a, y){ var j, xj, yj; xassert(x != y); xassert(x.n == y.n); for (var k = 1; k <= y.nnz; k++) { j = y.ind[k]; xj = ios_get_vj(x, j); yj = y.val[k]; ios_set_vj(x, j, xj + a * yj); } } function ios_gmi_gen(tree){ var MAXCUTS = 50; /* maximal number of cuts to be generated for one round */ function f(x) {return x - Math.floor(x)} /* compute fractional part of x */ function gen_cut(tree, worka, j){ /* this routine tries to generate Gomory's mixed integer cut for specified structural variable x[m+j] of integer kind, which is basic and has fractional value in optimal solution to current LP relaxation */ var mip = tree.mip; var m = mip.m; var n = mip.n; var ind = worka.ind; var val = worka.val; var phi = worka.phi; var i, k, len, kind, stat; var lb, ub, alfa, beta, ksi, phi1, rhs; var row, col; /* compute row of the simplex tableau, which (row) corresponds to specified basic variable xB[i] = x[m+j]; see (23) */ len = glp_eval_tab_row(mip, m+j, ind, val); /* determine beta[i], which a value of xB[i] in optimal solution to current LP relaxation; note that this value is the same as if it would be computed with formula (27); it is assumed that beta[i] is fractional enough */ beta = mip.col[j].prim; /* compute cut coefficients phi and right-hand side rho, which correspond to formula (30); dense format is used, because rows of the simplex tableau is usually dense */ for (k = 1; k <= m+n; k++) phi[k] = 0.0; rhs = f(beta); /* initial value of rho; see (28), (32) */ for (j = 1; j <= len; j++) { /* determine original number of non-basic variable xN[j] */ k = ind[j]; xassert(1 <= k && k <= m+n); /* determine the kind, bounds and current status of xN[j] in optimal solution to LP relaxation */ if (k <= m) { /* auxiliary variable */ row = mip.row[k]; kind = GLP_CV; lb = row.lb; ub = row.ub; stat = row.stat; } else { /* structural variable */ col = mip.col[k-m]; kind = col.kind; lb = col.lb; ub = col.ub; stat = col.stat; } /* xN[j] cannot be basic */ xassert(stat != GLP_BS); /* determine row coefficient ksi[i,j] at xN[j]; see (23) */ ksi = val[j]; /* if ksi[i,j] is too large in the magnitude, do not generate the cut */ if (Math.abs(ksi) > 1e+05) return; /* if ksi[i,j] is too small in the magnitude, skip it */ if (Math.abs(ksi) < 1e-10) continue; /* compute row coefficient alfa[i,j] at y[j]; see (26) */ switch (stat) { case GLP_NF: /* xN[j] is free (unbounded) having non-zero ksi[i,j]; do not generate the cut */ return; case GLP_NL: /* xN[j] has active lower bound */ alfa = - ksi; break; case GLP_NU: /* xN[j] has active upper bound */ alfa = + ksi; break; case GLP_NS: /* xN[j] is fixed; skip it */ continue; default: xassert(stat != stat); } /* compute cut coefficient phi'[j] at y[j]; see (21), (28) */ switch (kind) { case GLP_IV: /* y[j] is integer */ if (Math.abs(alfa - Math.floor(alfa + 0.5)) < 1e-10) { /* alfa[i,j] is close to nearest integer; skip it */ continue; } else if (f(alfa) <= f(beta)) phi1 = f(alfa); else phi1 = (f(beta) / (1.0 - f(beta))) * (1.0 - f(alfa)); break; case GLP_CV: /* y[j] is continuous */ if (alfa >= 0.0) phi1 = + alfa; else phi1 = (f(beta) / (1.0 - f(beta))) * (- alfa); break; default: xassert(kind != kind); } /* compute cut coefficient phi[j] at xN[j] and update right- hand side rho; see (31), (32) */ switch (stat) { case GLP_NL: /* xN[j] has active lower bound */ phi[k] = + phi1; rhs += phi1 * lb; break; case GLP_NU: /* xN[j] has active upper bound */ phi[k] = - phi1; rhs -= phi1 * ub; break; default: xassert(stat != stat); } } /* now the cut has the form sum_k phi[k] * x[k] >= rho, where cut coefficients are stored in the array phi in dense format; x[1,...,m] are auxiliary variables, x[m+1,...,m+n] are struc- tural variables; see (30) */ /* eliminate auxiliary variables in order to express the cut only through structural variables; see (33) */ for (i = 1; i <= m; i++) { var aij; if (Math.abs(phi[i]) < 1e-10) continue; /* auxiliary variable x[i] has non-zero cut coefficient */ row = mip.row[i]; /* x[i] cannot be fixed */ xassert(row.type != GLP_FX); /* substitute x[i] = sum_j a[i,j] * x[m+j] */ for (aij = row.ptr; aij != null; aij = aij.r_next) phi[m+aij.col.j] += phi[i] * aij.val; } /* convert the final cut to sparse format and substitute fixed (structural) variables */ len = 0; for (j = 1; j <= n; j++) { if (Math.abs(phi[m+j]) < 1e-10) continue; /* structural variable x[m+j] has non-zero cut coefficient */ col = mip.col[j]; if (col.type == GLP_FX) { /* eliminate x[m+j] */ rhs -= phi[m+j] * col.lb; } else { len++; ind[len] = j; val[len] = phi[m+j]; } } if (Math.abs(rhs) < 1e-12) rhs = 0.0; /* if the cut inequality seems to be badly scaled, reject it to avoid numeric difficulties */ for (k = 1; k <= len; k++) { if (Math.abs(val[k]) < 1e-03) return; if (Math.abs(val[k]) > 1e+03) return; } /* add the cut to the cut pool for further consideration */ glp_ios_add_row(tree, null, GLP_RF_GMI, 0, len, ind, val, GLP_LO, rhs); } /* main routine to generate Gomory's cuts */ var mip = tree.mip; var m = mip.m; var n = mip.n; var var_; var k, nv, j, size; var worka = {}; /* allocate working arrays */ var_ = new Array(1+n); worka.ind = new Int32Array(1+n); worka.val = new Float64Array(1+n); worka.phi = new Float64Array(1+m+n); /* build the list of integer structural variables, which are basic and have fractional value in optimal solution to current LP relaxation */ nv = 0; for (j = 1; j <= n; j++) { var col = mip.col[j]; var frac; if (col.kind != GLP_IV) continue; if (col.type == GLP_FX) continue; if (col.stat != GLP_BS) continue; frac = f(col.prim); if (!(0.05 <= frac && frac <= 0.95)) continue; /* add variable to the list */ nv++; var_[nv].j = j; var_[nv].f = frac; } /* order the list by descending fractionality */ xqsort(var_, 1, nv, function(v1, v2){ if (v1.f > v2.f) return -1; if (v1.f < v2.f) return +1; return 0; } ); /* try to generate cuts by one for each variable in the list, but not more than MAXCUTS cuts */ size = glp_ios_pool_size(tree); for (k = 1; k <= nv; k++) { if (glp_ios_pool_size(tree) - size >= MAXCUTS) break; gen_cut(tree, worka, var_[k].j); } } var _MIR_DEBUG = 0; var MAXAGGR = 5; /* maximal number of rows which can be aggregated */ var MIR_N = 0, MIR_L = 1, MIR_U = 2; function ios_mir_init(tree){ function set_row_attrib(tree, mir){ /* set global row attributes */ var mip = tree.mip; var m = mir.m; var k; for (k = 1; k <= m; k++) { var row = mip.row[k]; mir.skip[k] = 0; mir.isint[k] = 0; switch (row.type) { case GLP_FR: mir.lb[k] = -DBL_MAX; mir.ub[k] = +DBL_MAX; break; case GLP_LO: mir.lb[k] = row.lb; mir.ub[k] = +DBL_MAX; break; case GLP_UP: mir.lb[k] = -DBL_MAX; mir.ub[k] = row.ub; break; case GLP_DB: mir.lb[k] = row.lb; mir.ub[k] = row.ub; break; case GLP_FX: mir.lb[k] = mir.ub[k] = row.lb; break; default: xassert(row != row); } mir.vlb[k] = mir.vub[k] = 0; } } function set_col_attrib(tree, mir){ /* set global column attributes */ var mip = tree.mip; var m = mir.m; var n = mir.n; var k; for (k = m+1; k <= m+n; k++) { var col = mip.col[k-m]; switch (col.kind) { case GLP_CV: mir.isint[k] = 0; break; case GLP_IV: mir.isint[k] = 1; break; default: xassert(col != col); } switch (col.type) { case GLP_FR: mir.lb[k] = -DBL_MAX; mir.ub[k] = +DBL_MAX; break; case GLP_LO: mir.lb[k] = col.lb; mir.ub[k] = +DBL_MAX; break; case GLP_UP: mir.lb[k] = -DBL_MAX; mir.ub[k] = col.ub; break; case GLP_DB: mir.lb[k] = col.lb; mir.ub[k] = col.ub; break; case GLP_FX: mir.lb[k] = mir.ub[k] = col.lb; break; default: xassert(col != col); } mir.vlb[k] = mir.vub[k] = 0; } } function set_var_bounds(tree, mir){ /* set variable bounds */ var mip = tree.mip; var m = mir.m; var aij; var i, k1, k2; var a1, a2; for (i = 1; i <= m; i++) { /* we need the row to be '>= 0' or '<= 0' */ if (!(mir.lb[i] == 0.0 && mir.ub[i] == +DBL_MAX || mir.lb[i] == -DBL_MAX && mir.ub[i] == 0.0)) continue; /* take first term */ aij = mip.row[i].ptr; if (aij == null) continue; k1 = m + aij.col.j; a1 = aij.val; /* take second term */ aij = aij.r_next; if (aij == null) continue; k2 = m + aij.col.j; a2 = aij.val; /* there must be only two terms */ if (aij.r_next != null) continue; /* interchange terms, if needed */ if (!mir.isint[k1] && mir.isint[k2]){ } else if (mir.isint[k1] && !mir.isint[k2]) { k2 = k1; a2 = a1; k1 = m + aij.col.j; a1 = aij.val; } else { /* both terms are either continuous or integer */ continue; } /* x[k2] should be double-bounded */ if (mir.lb[k2] == -DBL_MAX || mir.ub[k2] == +DBL_MAX || mir.lb[k2] == mir.ub[k2]) continue; /* change signs, if necessary */ if (mir.ub[i] == 0.0){a1 = - a1; a2 = - a2} /* now the row has the form a1 * x1 + a2 * x2 >= 0, where x1 is continuous, x2 is integer */ if (a1 > 0.0) { /* x1 >= - (a2 / a1) * x2 */ if (mir.vlb[k1] == 0) { /* set variable lower bound for x1 */ mir.lb[k1] = - a2 / a1; mir.vlb[k1] = k2; /* the row should not be used */ mir.skip[i] = 1; } } else /* a1 < 0.0 */ { /* x1 <= - (a2 / a1) * x2 */ if (mir.vub[k1] == 0) { /* set variable upper bound for x1 */ mir.ub[k1] = - a2 / a1; mir.vub[k1] = k2; /* the row should not be used */ mir.skip[i] = 1; } } } } function mark_useless_rows(tree, mir){ /* mark rows which should not be used */ var mip = tree.mip; var m = mir.m; var aij; var i, k, nv; for (i = 1; i <= m; i++) { /* free rows should not be used */ if (mir.lb[i] == -DBL_MAX && mir.ub[i] == +DBL_MAX) { mir.skip[i] = 1; continue; } nv = 0; for (aij = mip.row[i].ptr; aij != null; aij = aij.r_next) { k = m + aij.col.j; /* rows with free variables should not be used */ if (mir.lb[k] == -DBL_MAX && mir.ub[k] == +DBL_MAX) { mir.skip[i] = 1; break; } /* rows with integer variables having infinite (lower or upper) bound should not be used */ if (mir.isint[k] && mir.lb[k] == -DBL_MAX || mir.isint[k] && mir.ub[k] == +DBL_MAX) { mir.skip[i] = 1; break; } /* count non-fixed variables */ if (!(mir.vlb[k] == 0 && mir.vub[k] == 0 && mir.lb[k] == mir.ub[k])) nv++; } /* rows with all variables fixed should not be used */ if (nv == 0) { mir.skip[i] = 1; //continue; } } } /* initialize MIR cut generator */ var mip = tree.mip; var m = mip.m; var n = mip.n; var mir; if (_MIR_DEBUG){ xprintf("ios_mir_init: warning: debug mode enabled"); } /* allocate working area */ mir = {}; mir.m = m; mir.n = n; mir.skip = new Int8Array(1+m); mir.isint = new Int8Array(1+m+n); mir.lb = new Float64Array(1+m+n); mir.vlb = new Int32Array(1+m+n); mir.ub = new Float64Array(1+m+n); mir.vub = new Int32Array(1+m+n); mir.x = new Float64Array(1+m+n); mir.agg_row = new Int32Array(1+MAXAGGR); mir.agg_vec = ios_create_vec(m+n); mir.subst = new Int8Array(1+m+n); mir.mod_vec = ios_create_vec(m+n); mir.cut_vec = ios_create_vec(m+n); /* set global row attributes */ set_row_attrib(tree, mir); /* set global column attributes */ set_col_attrib(tree, mir); /* set variable bounds */ set_var_bounds(tree, mir); /* mark rows which should not be used */ mark_useless_rows(tree, mir); return mir; } function ios_mir_gen(tree, mir){ var beta, gamma; function cmir_sep(n, a, b, u, x, s, alpha){ function cmir_cmp(v1, v2){ if (v1.v < v2.v) return -1; if (v1.v > v2.v) return +1; return 0; } function cmir_ineq(n, a, b, u, cset, delta, alpha){ function mir_ineq(n, a, b, alpha){ var j; var f, t; if (Math.abs(b - Math.floor(b + .5)) < 0.01) return 1; f = b - Math.floor(b); for (j = 1; j <= n; j++) { t = (a[j] - Math.floor(a[j])) - f; if (t <= 0.0) alpha[j] = Math.floor(a[j]); else alpha[j] = Math.floor(a[j]) + t / (1.0 - f); } beta = Math.floor(b); gamma = 1.0 / (1.0 - f); return 0; } var j; var aa, bb; aa = alpha; bb = b; for (j = 1; j <= n; j++) { aa[j] = a[j] / delta; if (cset[j]) aa[j] = - aa[j]; bb -= a[j] * u[j]; } bb /= delta; if (mir_ineq(n, aa, bb, alpha)) return 1; for (j = 1; j <= n; j++) { if (cset[j]){ alpha[j] = - alpha[j]; beta += alpha[j] * u[j]; } } gamma /= delta; return 0; } var fail, j, k, nv, v; var delta, eps, d_try = new Array(1+3), r, r_best; var cset; var vset; /* allocate working arrays */ cset = new Int8Array(1+n); vset = new Array(1+n); /* choose initial C */ for (j = 1; j <= n; j++) cset[j] = (x[j] >= 0.5 * u[j]); /* choose initial delta */ r_best = delta = 0.0; for (j = 1; j <= n; j++) { xassert(a[j] != 0.0); /* if x[j] is close to its bounds, skip it */ eps = 1e-9 * (1.0 + Math.abs(u[j])); if (x[j] < eps || x[j] > u[j] - eps) continue; /* try delta = |a[j]| to construct c-MIR inequality */ fail = cmir_ineq(n, a, b, u, cset, Math.abs(a[j]), alpha); if (fail) continue; /* compute violation */ r = - beta - gamma * s; for (k = 1; k <= n; k++) r += alpha[k] * x[k]; if (r_best < r){r_best = r; delta = Math.abs(a[j])} } if (r_best < 0.001) r_best = 0.0; if (r_best == 0.0) return r_best; xassert(delta > 0.0); /* try to increase violation by dividing delta by 2, 4, and 8, respectively */ d_try[1] = delta / 2.0; d_try[2] = delta / 4.0; d_try[3] = delta / 8.0; for (j = 1; j <= 3; j++) { /* construct c-MIR inequality */ fail = cmir_ineq(n, a, b, u, cset, d_try[j], alpha); if (fail) continue; /* compute violation */ r = - beta - gamma * s; for (k = 1; k <= n; k++) r += alpha[k] * x[k]; if (r_best < r){r_best = r; delta = d_try[j]} } /* build subset of variables lying strictly between their bounds and order it by nondecreasing values of |x[j] - u[j]/2| */ nv = 0; for (j = 1; j <= n; j++) { /* if x[j] is close to its bounds, skip it */ eps = 1e-9 * (1.0 + Math.abs(u[j])); if (x[j] < eps || x[j] > u[j] - eps) continue; /* add x[j] to the subset */ nv++; vset[nv].j = j; vset[nv].v = Math.abs(x[j] - 0.5 * u[j]); } xqsort(vset, 1, nv, cmir_cmp); /* try to increase violation by successively complementing each variable in the subset */ for (v = 1; v <= nv; v++) { j = vset[v].j; /* replace x[j] by its complement or vice versa */ cset[j] = !cset[j]; /* construct c-MIR inequality */ fail = cmir_ineq(n, a, b, u, cset, delta, alpha); /* restore the variable */ cset[j] = !cset[j]; /* do not replace the variable in case of failure */ if (fail) continue; /* compute violation */ r = - beta - gamma * s; for (k = 1; k <= n; k++) r += alpha[k] * x[k]; if (r_best < r){r_best = r; cset[j] = !cset[j]} } /* construct the best c-MIR inequality chosen */ fail = cmir_ineq(n, a, b, u, cset, delta, alpha); xassert(!fail); /* return to the calling routine */ return r_best; } function get_current_point(tree, mir){ /* obtain current point */ var mip = tree.mip; var m = mir.m; var n = mir.n; var k; for (k = 1; k <= m; k++) mir.x[k] = mip.row[k].prim; for (k = m+1; k <= m+n; k++) mir.x[k] = mip.col[k-m].prim; } //if (_MIR_DEBUG){ function check_current_point(mir){ /* check current point */ var m = mir.m; var n = mir.n; var k, kk; var lb, ub, eps; for (k = 1; k <= m+n; k++) { /* determine lower bound */ lb = mir.lb[k]; kk = mir.vlb[k]; if (kk != 0) { xassert(lb != -DBL_MAX); xassert(!mir.isint[k]); xassert(mir.isint[kk]); lb *= mir.x[kk]; } /* check lower bound */ if (lb != -DBL_MAX) { eps = 1e-6 * (1.0 + Math.abs(lb)); xassert(mir.x[k] >= lb - eps); } /* determine upper bound */ ub = mir.ub[k]; kk = mir.vub[k]; if (kk != 0) { xassert(ub != +DBL_MAX); xassert(!mir.isint[k]); xassert(mir.isint[kk]); ub *= mir.x[kk]; } /* check upper bound */ if (ub != +DBL_MAX) { eps = 1e-6 * (1.0 + Math.abs(ub)); xassert(mir.x[k] <= ub + eps); } } } //} function initial_agg_row(tree, mir, i){ /* use original i-th row as initial aggregated constraint */ var mip = tree.mip; var m = mir.m; var aij; xassert(1 <= i && i <= m); xassert(!mir.skip[i]); /* mark i-th row in order not to use it in the same aggregated constraint */ mir.skip[i] = 2; mir.agg_cnt = 1; mir.agg_row[1] = i; /* use x[i] - sum a[i,j] * x[m+j] = 0, where x[i] is auxiliary variable of row i, x[m+j] are structural variables */ ios_clear_vec(mir.agg_vec); ios_set_vj(mir.agg_vec, i, 1.0); for (aij = mip.row[i].ptr; aij != null; aij = aij.r_next) ios_set_vj(mir.agg_vec, m + aij.col.j, - aij.val); mir.agg_rhs = 0.0; if (_MIR_DEBUG){ ios_check_vec(mir.agg_vec); } } //if (_MIR_DEBUG){ function check_agg_row(mir) { /* check aggregated constraint */ var m = mir.m; var n = mir.n; var j, k; var r, big; /* compute the residual r = sum a[k] * x[k] - b and determine big = max(1, |a[k]|, |b|) */ r = 0.0; big = 1.0; for (j = 1; j <= mir.agg_vec.nnz; j++) { k = mir.agg_vec.ind[j]; xassert(1 <= k && k <= m+n); r += mir.agg_vec.val[j] * mir.x[k]; if (big < Math.abs(mir.agg_vec.val[j])) big = Math.abs(mir.agg_vec.val[j]); } r -= mir.agg_rhs; if (big < Math.abs(mir.agg_rhs)) big = Math.abs(mir.agg_rhs); /* the residual must be close to zero */ xassert(Math.abs(r) <= 1e-6 * big); } //} function subst_fixed_vars(mir){ /* substitute fixed variables into aggregated constraint */ var m = mir.m; var n = mir.n; var j, k; for (j = 1; j <= mir.agg_vec.nnz; j++) { k = mir.agg_vec.ind[j]; xassert(1 <= k && k <= m+n); if (mir.vlb[k] == 0 && mir.vub[k] == 0 && mir.lb[k] == mir.ub[k]) { /* x[k] is fixed */ mir.agg_rhs -= mir.agg_vec.val[j] * mir.lb[k]; mir.agg_vec.val[j] = 0.0; } } /* remove terms corresponding to fixed variables */ ios_clean_vec(mir.agg_vec, DBL_EPSILON); if (_MIR_DEBUG){ ios_check_vec(mir.agg_vec); } } function bound_subst_heur(mir){ /* bound substitution heuristic */ var m = mir.m; var n = mir.n; var j, k, kk; var d1, d2; for (j = 1; j <= mir.agg_vec.nnz; j++) { k = mir.agg_vec.ind[j]; xassert(1 <= k && k <= m+n); if (mir.isint[k]) continue; /* skip integer variable */ /* compute distance from x[k] to its lower bound */ kk = mir.vlb[k]; if (kk == 0) { if (mir.lb[k] == -DBL_MAX) d1 = DBL_MAX; else d1 = mir.x[k] - mir.lb[k]; } else { xassert(1 <= kk && kk <= m+n); xassert(mir.isint[kk]); xassert(mir.lb[k] != -DBL_MAX); d1 = mir.x[k] - mir.lb[k] * mir.x[kk]; } /* compute distance from x[k] to its upper bound */ kk = mir.vub[k]; if (kk == 0) { if (mir.vub[k] == +DBL_MAX) d2 = DBL_MAX; else d2 = mir.ub[k] - mir.x[k]; } else { xassert(1 <= kk && kk <= m+n); xassert(mir.isint[kk]); xassert(mir.ub[k] != +DBL_MAX); d2 = mir.ub[k] * mir.x[kk] - mir.x[k]; } /* x[k] cannot be free */ xassert(d1 != DBL_MAX || d2 != DBL_MAX); /* choose the bound which is closer to x[k] */ xassert(mir.subst[k] == MIR_N); if (d1 <= d2) mir.subst[k] = MIR_L; else mir.subst[k] = MIR_U; } } function build_mod_row(mir){ /* substitute bounds and build modified constraint */ var m = mir.m; var n = mir.n; var j, jj, k, kk; /* initially modified constraint is aggregated constraint */ ios_copy_vec(mir.mod_vec, mir.agg_vec); mir.mod_rhs = mir.agg_rhs; if (_MIR_DEBUG){ ios_check_vec(mir.mod_vec); } /* substitute bounds for continuous variables; note that due to substitution of variable bounds additional terms may appear in modified constraint */ for (j = mir.mod_vec.nnz; j >= 1; j--) { k = mir.mod_vec.ind[j]; xassert(1 <= k && k <= m+n); if (mir.isint[k]) continue; /* skip integer variable */ if (mir.subst[k] == MIR_L) { /* x[k] = (lower bound) + x'[k] */ xassert(mir.lb[k] != -DBL_MAX); kk = mir.vlb[k]; if (kk == 0) { /* x[k] = lb[k] + x'[k] */ mir.mod_rhs -= mir.mod_vec.val[j] * mir.lb[k]; } else { /* x[k] = lb[k] * x[kk] + x'[k] */ xassert(mir.isint[kk]); jj = mir.mod_vec.pos[kk]; if (jj == 0) { ios_set_vj(mir.mod_vec, kk, 1.0); jj = mir.mod_vec.pos[kk]; mir.mod_vec.val[jj] = 0.0; } mir.mod_vec.val[jj] += mir.mod_vec.val[j] * mir.lb[k]; } } else if (mir.subst[k] == MIR_U) { /* x[k] = (upper bound) - x'[k] */ xassert(mir.ub[k] != +DBL_MAX); kk = mir.vub[k]; if (kk == 0) { /* x[k] = ub[k] - x'[k] */ mir.mod_rhs -= mir.mod_vec.val[j] * mir.ub[k]; } else { /* x[k] = ub[k] * x[kk] - x'[k] */ xassert(mir.isint[kk]); jj = mir.mod_vec.pos[kk]; if (jj == 0) { ios_set_vj(mir.mod_vec, kk, 1.0); jj = mir.mod_vec.pos[kk]; mir.mod_vec.val[jj] = 0.0; } mir.mod_vec.val[jj] += mir.mod_vec.val[j] * mir.ub[k]; } mir.mod_vec.val[j] = - mir.mod_vec.val[j]; } else xassert(k != k); } if (_MIR_DEBUG){ ios_check_vec(mir.mod_vec); } /* substitute bounds for integer variables */ for (j = 1; j <= mir.mod_vec.nnz; j++) { k = mir.mod_vec.ind[j]; xassert(1 <= k && k <= m+n); if (!mir.isint[k]) continue; /* skip continuous variable */ xassert(mir.subst[k] == MIR_N); xassert(mir.vlb[k] == 0 && mir.vub[k] == 0); xassert(mir.lb[k] != -DBL_MAX && mir.ub[k] != +DBL_MAX); if (Math.abs(mir.lb[k]) <= Math.abs(mir.ub[k])) { /* x[k] = lb[k] + x'[k] */ mir.subst[k] = MIR_L; mir.mod_rhs -= mir.mod_vec.val[j] * mir.lb[k]; } else { /* x[k] = ub[k] - x'[k] */ mir.subst[k] = MIR_U; mir.mod_rhs -= mir.mod_vec.val[j] * mir.ub[k]; mir.mod_vec.val[j] = - mir.mod_vec.val[j]; } } if (_MIR_DEBUG){ ios_check_vec(mir.mod_vec); } } //if (_MIR_DEBUG){ function check_mod_row(mir){ /* check modified constraint */ var m = mir.m; var n = mir.n; var j, k, kk; var r, big, x; /* compute the residual r = sum a'[k] * x'[k] - b' and determine big = max(1, |a[k]|, |b|) */ r = 0.0; big = 1.0; for (j = 1; j <= mir.mod_vec.nnz; j++) { k = mir.mod_vec.ind[j]; xassert(1 <= k && k <= m+n); if (mir.subst[k] == MIR_L) { /* x'[k] = x[k] - (lower bound) */ xassert(mir.lb[k] != -DBL_MAX); kk = mir.vlb[k]; if (kk == 0) x = mir.x[k] - mir.lb[k]; else x = mir.x[k] - mir.lb[k] * mir.x[kk]; } else if (mir.subst[k] == MIR_U) { /* x'[k] = (upper bound) - x[k] */ xassert(mir.ub[k] != +DBL_MAX); kk = mir.vub[k]; if (kk == 0) x = mir.ub[k] - mir.x[k]; else x = mir.ub[k] * mir.x[kk] - mir.x[k]; } else xassert(k != k); r += mir.mod_vec.val[j] * x; if (big < Math.abs(mir.mod_vec.val[j])) big = Math.abs(mir.mod_vec.val[j]); } r -= mir.mod_rhs; if (big < Math.abs(mir.mod_rhs)) big = Math.abs(mir.mod_rhs); /* the residual must be close to zero */ xassert(Math.abs(r) <= 1e-6 * big); } //} function generate(mir){ /* try to generate violated c-MIR cut for modified constraint */ var m = mir.m; var n = mir.n; var j, k, kk, nint; var s, u, x, alpha, r_best = 0.0, b, beta = null, gamma = null; ios_copy_vec(mir.cut_vec, mir.mod_vec); mir.cut_rhs = mir.mod_rhs; /* remove small terms, which can appear due to substitution of variable bounds */ ios_clean_vec(mir.cut_vec, DBL_EPSILON); if (_MIR_DEBUG){ ios_check_vec(mir.cut_vec); } /* remove positive continuous terms to obtain MK relaxation */ for (j = 1; j <= mir.cut_vec.nnz; j++) { k = mir.cut_vec.ind[j]; xassert(1 <= k && k <= m+n); if (!mir.isint[k] && mir.cut_vec.val[j] > 0.0) mir.cut_vec.val[j] = 0.0; } ios_clean_vec(mir.cut_vec, 0.0); if (_MIR_DEBUG){ ios_check_vec(mir.cut_vec); } /* move integer terms to the beginning of the sparse vector and determine the number of integer variables */ nint = 0; for (j = 1; j <= mir.cut_vec.nnz; j++) { k = mir.cut_vec.ind[j]; xassert(1 <= k && k <= m+n); if (mir.isint[k]) { var temp; nint++; /* interchange elements [nint] and [j] */ kk = mir.cut_vec.ind[nint]; mir.cut_vec.pos[k] = nint; mir.cut_vec.pos[kk] = j; mir.cut_vec.ind[nint] = k; mir.cut_vec.ind[j] = kk; temp = mir.cut_vec.val[nint]; mir.cut_vec.val[nint] = mir.cut_vec.val[j]; mir.cut_vec.val[j] = temp; } } if (_MIR_DEBUG){ ios_check_vec(mir.cut_vec); } /* if there is no integer variable, nothing to generate */ if (nint == 0) return r_best; /* allocate working arrays */ u = new Float64Array(1+nint); x = new Float64Array(1+nint); alpha = new Float64Array(1+nint); /* determine u and x */ for (j = 1; j <= nint; j++) { k = mir.cut_vec.ind[j]; xassert(m+1 <= k && k <= m+n); xassert(mir.isint[k]); u[j] = mir.ub[k] - mir.lb[k]; xassert(u[j] >= 1.0); if (mir.subst[k] == MIR_L) x[j] = mir.x[k] - mir.lb[k]; else if (mir.subst[k] == MIR_U) x[j] = mir.ub[k] - mir.x[k]; else xassert(k != k); xassert(x[j] >= -0.001); if (x[j] < 0.0) x[j] = 0.0; } /* compute s = - sum of continuous terms */ s = 0.0; for (j = nint+1; j <= mir.cut_vec.nnz; j++) { k = mir.cut_vec.ind[j]; xassert(1 <= k && k <= m+n); /* must be continuous */ xassert(!mir.isint[k]); if (mir.subst[k] == MIR_L) { xassert(mir.lb[k] != -DBL_MAX); kk = mir.vlb[k]; if (kk == 0) x = mir.x[k] - mir.lb[k]; else x = mir.x[k] - mir.lb[k] * mir.x[kk]; } else if (mir.subst[k] == MIR_U) { xassert(mir.ub[k] != +DBL_MAX); kk = mir.vub[k]; if (kk == 0) x = mir.ub[k] - mir.x[k]; else x = mir.ub[k] * mir.x[kk] - mir.x[k]; } else xassert(k != k); xassert(x >= -0.001); if (x < 0.0) x = 0.0; s -= mir.cut_vec.val[j] * x; } xassert(s >= 0.0); /* apply heuristic to obtain most violated c-MIR inequality */ b = mir.cut_rhs; r_best = cmir_sep(nint, mir.cut_vec.val, b, u, x, s, alpha); if (r_best == 0.0) return r_best; xassert(r_best > 0.0); /* convert to raw cut */ /* sum alpha[j] * x[j] <= beta + gamma * s */ for (j = 1; j <= nint; j++) mir.cut_vec.val[j] = alpha[j]; for (j = nint+1; j <= mir.cut_vec.nnz; j++) { k = mir.cut_vec.ind[j]; if (k <= m+n) mir.cut_vec.val[j] *= gamma; } mir.cut_rhs = beta; if (_MIR_DEBUG){ ios_check_vec(mir.cut_vec); } return r_best; } //if (_MIR_DEBUG){ function check_raw_cut(mir, r_best){ /* check raw cut before back bound substitution */ var m = mir.m; var n = mir.n; var j, k, kk; var r, big, x; /* compute the residual r = sum a[k] * x[k] - b and determine big = max(1, |a[k]|, |b|) */ r = 0.0; big = 1.0; for (j = 1; j <= mir.cut_vec.nnz; j++) { k = mir.cut_vec.ind[j]; xassert(1 <= k && k <= m+n); if (mir.subst[k] == MIR_L) { xassert(mir.lb[k] != -DBL_MAX); kk = mir.vlb[k]; if (kk == 0) x = mir.x[k] - mir.lb[k]; else x = mir.x[k] - mir.lb[k] * mir.x[kk]; } else if (mir.subst[k] == MIR_U) { xassert(mir.ub[k] != +DBL_MAX); kk = mir.vub[k]; if (kk == 0) x = mir.ub[k] - mir.x[k]; else x = mir.ub[k] * mir.x[kk] - mir.x[k]; } else xassert(k != k); r += mir.cut_vec.val[j] * x; if (big < Math.abs(mir.cut_vec.val[j])) big = Math.abs(mir.cut_vec.val[j]); } r -= mir.cut_rhs; if (big < Math.abs(mir.cut_rhs)) big = Math.abs(mir.cut_rhs); /* the residual must be close to r_best */ xassert(Math.abs(r - r_best) <= 1e-6 * big); } //} function back_subst(mir){ /* back substitution of original bounds */ var m = mir.m; var n = mir.n; var j, jj, k, kk; /* at first, restore bounds of integer variables (because on restoring variable bounds of continuous variables we need original, not shifted, bounds of integer variables) */ for (j = 1; j <= mir.cut_vec.nnz; j++) { k = mir.cut_vec.ind[j]; xassert(1 <= k && k <= m+n); if (!mir.isint[k]) continue; /* skip continuous */ if (mir.subst[k] == MIR_L) { /* x'[k] = x[k] - lb[k] */ xassert(mir.lb[k] != -DBL_MAX); xassert(mir.vlb[k] == 0); mir.cut_rhs += mir.cut_vec.val[j] * mir.lb[k]; } else if (mir.subst[k] == MIR_U) { /* x'[k] = ub[k] - x[k] */ xassert(mir.ub[k] != +DBL_MAX); xassert(mir.vub[k] == 0); mir.cut_rhs -= mir.cut_vec.val[j] * mir.ub[k]; mir.cut_vec.val[j] = - mir.cut_vec.val[j]; } else xassert(k != k); } /* now restore bounds of continuous variables */ for (j = 1; j <= mir.cut_vec.nnz; j++) { k = mir.cut_vec.ind[j]; xassert(1 <= k && k <= m+n); if (mir.isint[k]) continue; /* skip integer */ if (mir.subst[k] == MIR_L) { /* x'[k] = x[k] - (lower bound) */ xassert(mir.lb[k] != -DBL_MAX); kk = mir.vlb[k]; if (kk == 0) { /* x'[k] = x[k] - lb[k] */ mir.cut_rhs += mir.cut_vec.val[j] * mir.lb[k]; } else { /* x'[k] = x[k] - lb[k] * x[kk] */ jj = mir.cut_vec.pos[kk]; if (jj == 0) { ios_set_vj(mir.cut_vec, kk, 1.0); jj = mir.cut_vec.pos[kk]; xassert(jj != 0); mir.cut_vec.val[jj] = 0.0; } mir.cut_vec.val[jj] -= mir.cut_vec.val[j] * mir.lb[k]; } } else if (mir.subst[k] == MIR_U) { /* x'[k] = (upper bound) - x[k] */ xassert(mir.ub[k] != +DBL_MAX); kk = mir.vub[k]; if (kk == 0) { /* x'[k] = ub[k] - x[k] */ mir.cut_rhs -= mir.cut_vec.val[j] * mir.ub[k]; } else { /* x'[k] = ub[k] * x[kk] - x[k] */ jj = mir.cut_vec.pos[kk]; if (jj == 0) { ios_set_vj(mir.cut_vec, kk, 1.0); jj = mir.cut_vec.pos[kk]; xassert(jj != 0); mir.cut_vec.val[jj] = 0.0; } mir.cut_vec.val[jj] += mir.cut_vec.val[j] * mir.ub[k]; } mir.cut_vec.val[j] = - mir.cut_vec.val[j]; } else xassert(k != k); } if (_MIR_DEBUG){ ios_check_vec(mir.cut_vec); } } //if (_MIR_DEBUG){ function check_cut_row(mir, r_best){ /* check the cut after back bound substitution or elimination of auxiliary variables */ var m = mir.m; var n = mir.n; var j, k; var r, big; /* compute the residual r = sum a[k] * x[k] - b and determine big = max(1, |a[k]|, |b|) */ r = 0.0; big = 1.0; for (j = 1; j <= mir.cut_vec.nnz; j++) { k = mir.cut_vec.ind[j]; xassert(1 <= k && k <= m+n); r += mir.cut_vec.val[j] * mir.x[k]; if (big < Math.abs(mir.cut_vec.val[j])) big = Math.abs(mir.cut_vec.val[j]); } r -= mir.cut_rhs; if (big < Math.abs(mir.cut_rhs)) big = Math.abs(mir.cut_rhs); /* the residual must be close to r_best */ xassert(Math.abs(r - r_best) <= 1e-6 * big); } //} function subst_aux_vars(tree, mir){ /* final substitution to eliminate auxiliary variables */ var mip = tree.mip; var m = mir.m; var n = mir.n; var aij; var j, k, kk, jj; for (j = mir.cut_vec.nnz; j >= 1; j--) { k = mir.cut_vec.ind[j]; xassert(1 <= k && k <= m+n); if (k > m) continue; /* skip structurals */ for (aij = mip.row[k].ptr; aij != null; aij = aij.r_next) { kk = m + aij.col.j; /* structural */ jj = mir.cut_vec.pos[kk]; if (jj == 0) { ios_set_vj(mir.cut_vec, kk, 1.0); jj = mir.cut_vec.pos[kk]; mir.cut_vec.val[jj] = 0.0; } mir.cut_vec.val[jj] += mir.cut_vec.val[j] * aij.val; } mir.cut_vec.val[j] = 0.0; } ios_clean_vec(mir.cut_vec, 0.0); } function add_cut(tree, mir){ /* add constructed cut inequality to the cut pool */ var m = mir.m; var n = mir.n; var j, k, len; var ind = new Int32Array(1+n); var val = new Float64Array(1+n); len = 0; for (j = mir.cut_vec.nnz; j >= 1; j--) { k = mir.cut_vec.ind[j]; xassert(m+1 <= k && k <= m+n); len++; ind[len] = k - m; val[len] = mir.cut_vec.val[j]; } glp_ios_add_row(tree, null, GLP_RF_MIR, 0, len, ind, val, GLP_UP, mir.cut_rhs); } function aggregate_row(tree, mir){ /* try to aggregate another row */ var mip = tree.mip; var m = mir.m; var n = mir.n; var aij; var v; var ii, j, jj, k, kk, kappa = 0, ret = 0; var d1, d2, d, d_max = 0.0; /* choose appropriate structural variable in the aggregated row to be substituted */ for (j = 1; j <= mir.agg_vec.nnz; j++) { k = mir.agg_vec.ind[j]; xassert(1 <= k && k <= m+n); if (k <= m) continue; /* skip auxiliary var */ if (mir.isint[k]) continue; /* skip integer var */ if (Math.abs(mir.agg_vec.val[j]) < 0.001) continue; /* compute distance from x[k] to its lower bound */ kk = mir.vlb[k]; if (kk == 0) { if (mir.lb[k] == -DBL_MAX) d1 = DBL_MAX; else d1 = mir.x[k] - mir.lb[k]; } else { xassert(1 <= kk && kk <= m+n); xassert(mir.isint[kk]); xassert(mir.lb[k] != -DBL_MAX); d1 = mir.x[k] - mir.lb[k] * mir.x[kk]; } /* compute distance from x[k] to its upper bound */ kk = mir.vub[k]; if (kk == 0) { if (mir.vub[k] == +DBL_MAX) d2 = DBL_MAX; else d2 = mir.ub[k] - mir.x[k]; } else { xassert(1 <= kk && kk <= m+n); xassert(mir.isint[kk]); xassert(mir.ub[k] != +DBL_MAX); d2 = mir.ub[k] * mir.x[kk] - mir.x[k]; } /* x[k] cannot be free */ xassert(d1 != DBL_MAX || d2 != DBL_MAX); /* d = min(d1, d2) */ d = (d1 <= d2 ? d1 : d2); xassert(d != DBL_MAX); /* should not be close to corresponding bound */ if (d < 0.001) continue; if (d_max < d) {d_max = d; kappa = k} } if (kappa == 0) { /* nothing chosen */ ret = 1; return ret; } /* x[kappa] has been chosen */ xassert(m+1 <= kappa && kappa <= m+n); xassert(!mir.isint[kappa]); /* find another row, which have not been used yet, to eliminate x[kappa] from the aggregated row */ for (ii = 1; ii <= m; ii++) { if (mir.skip[ii]) continue; for (aij = mip.row[ii].ptr; aij != null; aij = aij.r_next) if (aij.col.j == kappa - m) break; if (aij != null && Math.abs(aij.val) >= 0.001) break; } if (ii > m) { /* nothing found */ ret = 2; return ret; } /* row ii has been found; include it in the aggregated list */ mir.agg_cnt++; xassert(mir.agg_cnt <= MAXAGGR); mir.agg_row[mir.agg_cnt] = ii; mir.skip[ii] = 2; /* v := new row */ v = ios_create_vec(m+n); ios_set_vj(v, ii, 1.0); for (aij = mip.row[ii].ptr; aij != null; aij = aij.r_next) ios_set_vj(v, m + aij.col.j, - aij.val); if (_MIR_DEBUG){ ios_check_vec(v); } /* perform gaussian elimination to remove x[kappa] */ j = mir.agg_vec.pos[kappa]; xassert(j != 0); jj = v.pos[kappa]; xassert(jj != 0); ios_linear_comb(mir.agg_vec, - mir.agg_vec.val[j] / v.val[jj], v); ios_set_vj(mir.agg_vec, kappa, 0.0); if (_MIR_DEBUG){ ios_check_vec(mir.agg_vec); } return ret; } /* main routine to generate MIR cuts */ var mip = tree.mip; var m = mir.m; var n = mir.n; var i, k; var r_best; xassert(mip.m >= m); xassert(mip.n == n); /* obtain current point */ get_current_point(tree, mir); if (_MIR_DEBUG){ /* check current point */ check_current_point(mir); } /* reset bound substitution flags */ xfillArr(mir.subst, 1, MIR_N, m+n); /* try to generate a set of violated MIR cuts */ for (i = 1; i <= m; i++) { if (mir.skip[i]) continue; /* use original i-th row as initial aggregated constraint */ initial_agg_row(tree, mir, i); while (true){ if (_MIR_DEBUG){ /* check aggregated row */ check_agg_row(mir); } /* substitute fixed variables into aggregated constraint */ subst_fixed_vars(mir); if (_MIR_DEBUG){ /* check aggregated row */ check_agg_row(mir); /* check bound substitution flags */ { for (k = 1; k <= m+n; k++) xassert(mir.subst[k] == MIR_N); } } /* apply bound substitution heuristic */ bound_subst_heur(mir); /* substitute bounds and build modified constraint */ build_mod_row(mir); if (_MIR_DEBUG){ /* check modified row */ check_mod_row(mir); } /* try to generate violated c-MIR cut for modified row */ r_best = generate(mir); if (r_best > 0.0){ /* success */ if (_MIR_DEBUG){ /* check raw cut before back bound substitution */ check_raw_cut(mir, r_best); } /* back substitution of original bounds */ back_subst(mir); if (_MIR_DEBUG){ /* check the cut after back bound substitution */ check_cut_row(mir, r_best); } /* final substitution to eliminate auxiliary variables */ subst_aux_vars(tree, mir); if (_MIR_DEBUG){ /* check the cut after elimination of auxiliaries */ check_cut_row(mir, r_best); } /* add constructed cut inequality to the cut pool */ add_cut(tree, mir); } /* reset bound substitution flags */ { for (var j = 1; j <= mir.mod_vec.nnz; j++) { k = mir.mod_vec.ind[j]; xassert(1 <= k && k <= m+n); xassert(mir.subst[k] != MIR_N); mir.subst[k] = MIR_N; } } if (r_best == 0.0) { /* failure */ if (mir.agg_cnt < MAXAGGR) { /* try to aggregate another row */ if (aggregate_row(tree, mir) == 0) continue; } } break; } /* unmark rows used in the aggregated constraint */ { var ii; for (k = 1; k <= mir.agg_cnt; k++) { ii = mir.agg_row[k]; xassert(1 <= ii && ii <= m); xassert(mir.skip[ii] == 2); mir.skip[ii] = 0; } } } } function lpx_cover_cut(lp, len, ind, val, x){ var alfa = null, beta = null; var MAXTRY = 1000; function cover2(n, a, b, u, x, y, cov){ /* try to generate mixed cover cut using two-element cover */ var i, j, try_ = 0, ret = 0; var eps, temp, rmax = 0.001; eps = 0.001 * (1.0 + Math.abs(b)); for (i = 1; i <= n; i++) for (j = i+1; j <= n; j++) { /* C = {i, j} */ try_++; if (try_ > MAXTRY) return ret; /* check if condition (8) is satisfied */ if (a[i] + a[j] + y > b + eps) { /* compute parameters for inequality (15) */ temp = a[i] + a[j] - b; alfa = 1.0 / (temp + u); beta = 2.0 - alfa * temp; /* compute violation of inequality (15) */ temp = x[i] + x[j] + alfa * y - beta; /* choose C providing maximum violation */ if (rmax < temp) { rmax = temp; cov[1] = i; cov[2] = j; ret = 1; } } } return ret; } function cover3(n, a, b, u, x, y, cov){ /* try to generate mixed cover cut using three-element cover */ var i, j, k, try_ = 0, ret = 0; var eps, temp, rmax = 0.001; eps = 0.001 * (1.0 + Math.abs(b)); for (i = 1; i <= n; i++) for (j = i+1; j <= n; j++) for (k = j+1; k <= n; k++) { /* C = {i, j, k} */ try_++; if (try_ > MAXTRY) return ret; /* check if condition (8) is satisfied */ if (a[i] + a[j] + a[k] + y > b + eps) { /* compute parameters for inequality (15) */ temp = a[i] + a[j] + a[k] - b; alfa = 1.0 / (temp + u); beta = 3.0 - alfa * temp; /* compute violation of inequality (15) */ temp = x[i] + x[j] + x[k] + alfa * y - beta; /* choose C providing maximum violation */ if (rmax < temp) { rmax = temp; cov[1] = i; cov[2] = j; cov[3] = k; ret = 1; } } } return ret; } function cover4(n, a, b, u, x, y, cov){ /* try_ to generate mixed cover cut using four-element cover */ var i, j, k, l, try_ = 0, ret = 0; var eps, temp, rmax = 0.001; eps = 0.001 * (1.0 + Math.abs(b)); for (i = 1; i <= n; i++) for (j = i+1; j <= n; j++) for (k = j+1; k <= n; k++) for (l = k+1; l <= n; l++) { /* C = {i, j, k, l} */ try_++; if (try_ > MAXTRY) return ret; /* check if condition (8) is satisfied */ if (a[i] + a[j] + a[k] + a[l] + y > b + eps) { /* compute parameters for inequality (15) */ temp = a[i] + a[j] + a[k] + a[l] - b; alfa = 1.0 / (temp + u); beta = 4.0 - alfa * temp; /* compute violation of inequality (15) */ temp = x[i] + x[j] + x[k] + x[l] + alfa * y - beta; /* choose C providing maximum violation */ if (rmax < temp) { rmax = temp; cov[1] = i; cov[2] = j; cov[3] = k; cov[4] = l; ret = 1; } } } return ret; } function cover(n, a, b, u, x, y, cov){ /* try to generate mixed cover cut; input (see (5)): n is the number of binary variables; a[1:n] are coefficients at binary variables; b is the right-hand side; u is upper bound of continuous variable; x[1:n] are values of binary variables at current point; y is value of continuous variable at current point; output (see (15), (16), (17)): cov[1:r] are indices of binary variables included in cover C, where r is the set cardinality returned on exit; alfa coefficient at continuous variable; beta is the right-hand side; */ var j; /* perform some sanity checks */ xassert(n >= 2); for (j = 1; j <= n; j++) xassert(a[j] > 0.0); xassert(b > -1e-5); xassert(u >= 0.0); for (j = 1; j <= n; j++) xassert(0.0 <= x[j] && x[j] <= 1.0); xassert(0.0 <= y && y <= u); /* try to generate mixed cover cut */ if (cover2(n, a, b, u, x, y, cov)) return 2; if (cover3(n, a, b, u, x, y, cov)) return 3; if (cover4(n, a, b, u, x, y, cov)) return 4; return 0; } var cov = new Array(1+4), j, k, nb, newlen, r; var f_min, f_max, u, y; /* substitute and remove fixed variables */ newlen = 0; for (k = 1; k <= len; k++) { j = ind[k]; if (lpx_get_col_type(lp, j) == LPX_FX) val[0] -= val[k] * lpx_get_col_lb(lp, j); else { newlen++; ind[newlen] = ind[k]; val[newlen] = val[k]; } } len = newlen; /* move binary variables to the beginning of the list so that elements 1, 2, ..., nb correspond to binary variables, and elements nb+1, nb+2, ..., len correspond to rest variables */ nb = 0; for (k = 1; k <= len; k++) { j = ind[k]; if (lpx_get_col_kind(lp, j) == LPX_IV && lpx_get_col_type(lp, j) == LPX_DB && lpx_get_col_lb(lp, j) == 0.0 && lpx_get_col_ub(lp, j) == 1.0) { /* binary variable */ var ind_k; var val_k; nb++; ind_k = ind[nb]; val_k = val[nb]; ind[nb] = ind[k]; val[nb] = val[k]; ind[k] = ind_k; val[k] = val_k; } } /* now the specified row has the form: sum a[j]*x[j] + sum a[j]*y[j] <= b, where x[j] are binary variables, y[j] are rest variables */ /* at least two binary variables are needed */ if (nb < 2) return 0; /* compute implied lower and upper bounds for sum a[j]*y[j] */ f_min = f_max = 0.0; for (k = nb+1; k <= len; k++) { j = ind[k]; /* both bounds must be finite */ if (lpx_get_col_type(lp, j) != LPX_DB) return 0; if (val[k] > 0.0) { f_min += val[k] * lpx_get_col_lb(lp, j); f_max += val[k] * lpx_get_col_ub(lp, j); } else { f_min += val[k] * lpx_get_col_ub(lp, j); f_max += val[k] * lpx_get_col_lb(lp, j); } } /* sum a[j]*x[j] + sum a[j]*y[j] <= b ===> sum a[j]*x[j] + (sum a[j]*y[j] - f_min) <= b - f_min ===> sum a[j]*x[j] + y <= b - f_min, where y = sum a[j]*y[j] - f_min; note that 0 <= y <= u, u = f_max - f_min */ /* determine upper bound of y */ u = f_max - f_min; /* determine value of y at the current point */ y = 0.0; for (k = nb+1; k <= len; k++) { j = ind[k]; y += val[k] * lpx_get_col_prim(lp, j); } y -= f_min; if (y < 0.0) y = 0.0; if (y > u) y = u; /* modify the right-hand side b */ val[0] -= f_min; /* now the transformed row has the form: sum a[j]*x[j] + y <= b, where 0 <= y <= u */ /* determine values of x[j] at the current point */ for (k = 1; k <= nb; k++) { j = ind[k]; x[k] = lpx_get_col_prim(lp, j); if (x[k] < 0.0) x[k] = 0.0; if (x[k] > 1.0) x[k] = 1.0; } /* if a[j] < 0, replace x[j] by its complement 1 - x'[j] */ for (k = 1; k <= nb; k++) { if (val[k] < 0.0) { ind[k] = - ind[k]; val[k] = - val[k]; val[0] += val[k]; x[k] = 1.0 - x[k]; } } /* try to generate a mixed cover cut for the transformed row */ r = cover(nb, val, val[0], u, x, y, cov); if (r == 0) return 0; xassert(2 <= r && r <= 4); /* now the cut is in the form: sum{j in C} x[j] + alfa * y <= beta */ /* store the right-hand side beta */ ind[0] = 0; val[0] = beta; /* restore the original ordinal numbers of x[j] */ for (j = 1; j <= r; j++) cov[j] = ind[cov[j]]; /* store cut coefficients at binary variables complementing back the variables having negative row coefficients */ xassert(r <= nb); for (k = 1; k <= r; k++) { if (cov[k] > 0) { ind[k] = +cov[k]; val[k] = +1.0; } else { ind[k] = -cov[k]; val[k] = -1.0; val[0] -= 1.0; } } /* substitute y = sum a[j]*y[j] - f_min */ for (k = nb+1; k <= len; k++) { r++; ind[r] = ind[k]; val[r] = alfa * val[k]; } val[0] += alfa * f_min; xassert(r <= len); len = r; return len; } function lpx_eval_row(lp, len, ind, val){ var n = lpx_get_num_cols(lp); var j, k; var sum = 0.0; if (len < 0) xerror("lpx_eval_row: len = " + len + "; invalid row length"); for (k = 1; k <= len; k++) { j = ind[k]; if (!(1 <= j && j <= n)) xerror("lpx_eval_row: j = " + j + "; column number out of range"); sum += val[k] * lpx_get_col_prim(lp, j); } return sum; } function ios_cov_gen(tree){ var prob = tree.mip; var m = lpx_get_num_rows(prob); var n = lpx_get_num_cols(prob); var i, k, type, kase, len, ind; var r, val, work; xassert(lpx_get_status(prob) == LPX_OPT); /* allocate working arrays */ ind = new Int32Array(1+n); val = new Float64Array(1+n); work = new Float64Array(1+n); /* look through all rows */ for (i = 1; i <= m; i++) for (kase = 1; kase <= 2; kase++) { type = lpx_get_row_type(prob, i); if (kase == 1) { /* consider rows of '<=' type */ if (!(type == LPX_UP || type == LPX_DB)) continue; len = lpx_get_mat_row(prob, i, ind, val); val[0] = lpx_get_row_ub(prob, i); } else { /* consider rows of '>=' type */ if (!(type == LPX_LO || type == LPX_DB)) continue; len = lpx_get_mat_row(prob, i, ind, val); for (k = 1; k <= len; k++) val[k] = - val[k]; val[0] = - lpx_get_row_lb(prob, i); } /* generate mixed cover cut: sum{j in J} a[j] * x[j] <= b */ len = lpx_cover_cut(prob, len, ind, val, work); if (len == 0) continue; /* at the current point the cut inequality is violated, i.e. sum{j in J} a[j] * x[j] - b > 0 */ r = lpx_eval_row(prob, len, ind, val) - val[0]; if (r < 1e-3) continue; /* add the cut to the cut pool */ glp_ios_add_row(tree, null, GLP_RF_COV, 0, len, ind, val, GLP_UP, val[0]); } } function lpx_create_cog(lp){ var MAX_NB = 4000; var MAX_ROW_LEN = 500; function get_row_lb(lp, i){ /* this routine returns lower bound of row i or -DBL_MAX if the row has no lower bound */ var lb; switch (lpx_get_row_type(lp, i)) { case LPX_FR: case LPX_UP: lb = -DBL_MAX; break; case LPX_LO: case LPX_DB: case LPX_FX: lb = lpx_get_row_lb(lp, i); break; default: xassert(lp != lp); } return lb; } function get_row_ub(lp, i){ /* this routine returns upper bound of row i or +DBL_MAX if the row has no upper bound */ var ub; switch (lpx_get_row_type(lp, i)) { case LPX_FR: case LPX_LO: ub = +DBL_MAX; break; case LPX_UP: case LPX_DB: case LPX_FX: ub = lpx_get_row_ub(lp, i); break; default: xassert(lp != lp); } return ub; } function get_col_lb(lp, j){ /* this routine returns lower bound of column j or -DBL_MAX if the column has no lower bound */ var lb; switch (lpx_get_col_type(lp, j)) { case LPX_FR: case LPX_UP: lb = -DBL_MAX; break; case LPX_LO: case LPX_DB: case LPX_FX: lb = lpx_get_col_lb(lp, j); break; default: xassert(lp != lp); } return lb; } function get_col_ub(lp, j){ /* this routine returns upper bound of column j or +DBL_MAX if the column has no upper bound */ var ub; switch (lpx_get_col_type(lp, j)) { case LPX_FR: case LPX_LO: ub = +DBL_MAX; break; case LPX_UP: case LPX_DB: case LPX_FX: ub = lpx_get_col_ub(lp, j); break; default: xassert(lp != lp); } return ub; } function is_binary(lp, j){ /* this routine checks if variable x[j] is binary */ return lpx_get_col_kind(lp, j) == LPX_IV && lpx_get_col_type(lp, j) == LPX_DB && lpx_get_col_lb(lp, j) == 0.0 && lpx_get_col_ub(lp, j) == 1.0; } function eval_lf_min(lp, len, ind, val){ /* this routine computes the minimum of a specified linear form sum a[j]*x[j] j using the formula: min = sum a[j]*lb[j] + sum a[j]*ub[j], j in J+ j in J- where J+ = {j: a[j] > 0}, J- = {j: a[j] < 0}, lb[j] and ub[j] are lower and upper bound of variable x[j], resp. */ var j, t; var lb, ub, sum; sum = 0.0; for (t = 1; t <= len; t++) { j = ind[t]; if (val[t] > 0.0) { lb = get_col_lb(lp, j); if (lb == -DBL_MAX) { sum = -DBL_MAX; break; } sum += val[t] * lb; } else if (val[t] < 0.0) { ub = get_col_ub(lp, j); if (ub == +DBL_MAX) { sum = -DBL_MAX; break; } sum += val[t] * ub; } else xassert(val != val); } return sum; } function eval_lf_max(lp, len, ind, val){ /* this routine computes the maximum of a specified linear form sum a[j]*x[j] j using the formula: max = sum a[j]*ub[j] + sum a[j]*lb[j], j in J+ j in J- where J+ = {j: a[j] > 0}, J- = {j: a[j] < 0}, lb[j] and ub[j] are lower and upper bound of variable x[j], resp. */ var j, t; var lb, ub, sum; sum = 0.0; for (t = 1; t <= len; t++) { j = ind[t]; if (val[t] > 0.0) { ub = get_col_ub(lp, j); if (ub == +DBL_MAX) { sum = +DBL_MAX; break; } sum += val[t] * ub; } else if (val[t] < 0.0) { lb = get_col_lb(lp, j); if (lb == -DBL_MAX) { sum = +DBL_MAX; break; } sum += val[t] * lb; } else xassert(val != val); } return sum; } function probing(len, val, L, U, lf_min, lf_max, p, set, q){ var temp; xassert(1 <= p && p < q && q <= len); /* compute L' (3) */ if (L != -DBL_MAX && set) L -= val[p]; /* compute U' (4) */ if (U != +DBL_MAX && set) U -= val[p]; /* compute MIN (9) */ if (lf_min != -DBL_MAX) { if (val[p] < 0.0) lf_min -= val[p]; if (val[q] < 0.0) lf_min -= val[q]; } /* compute MAX (10) */ if (lf_max != +DBL_MAX) { if (val[p] > 0.0) lf_max -= val[p]; if (val[q] > 0.0) lf_max -= val[q]; } /* compute implied lower bound of x[q]; see (7), (8) */ if (val[q] > 0.0) { if (L == -DBL_MAX || lf_max == +DBL_MAX) temp = -DBL_MAX; else temp = (L - lf_max) / val[q]; } else { if (U == +DBL_MAX || lf_min == -DBL_MAX) temp = -DBL_MAX; else temp = (U - lf_min) / val[q]; } if (temp > 0.001) return 2; /* compute implied upper bound of x[q]; see (7), (8) */ if (val[q] > 0.0) { if (U == +DBL_MAX || lf_min == -DBL_MAX) temp = +DBL_MAX; else temp = (U - lf_min) / val[q]; } else { if (L == -DBL_MAX || lf_max == +DBL_MAX) temp = +DBL_MAX; else temp = (L - lf_max) / val[q]; } if (temp < 0.999) return 1; /* there is no logical relation between x[p] and x[q] */ return 0; } var cog = null; var m, n, nb, i, j, p, q, len, ind, vert, orig; var L, U, lf_min, lf_max, val; xprintf("Creating the conflict graph..."); m = lpx_get_num_rows(lp); n = lpx_get_num_cols(lp); /* determine which binary variables should be included in the conflict graph */ nb = 0; vert = new Int32Array(1+n); orig = new Int32Array(1+n); ind = new Int32Array(1+n); val = new Float64Array(1+n); for (i = 1; i <= m; i++) { L = get_row_lb(lp, i); U = get_row_ub(lp, i); if (L == -DBL_MAX && U == +DBL_MAX) continue; len = lpx_get_mat_row(lp, i, ind, val); if (len > MAX_ROW_LEN) continue; lf_min = eval_lf_min(lp, len, ind, val); lf_max = eval_lf_max(lp, len, ind, val); for (p = 1; p <= len; p++) { if (!is_binary(lp, ind[p])) continue; for (q = p+1; q <= len; q++) { if (!is_binary(lp, ind[q])) continue; if (probing(len, val, L, U, lf_min, lf_max, p, 0, q) || probing(len, val, L, U, lf_min, lf_max, p, 1, q)) { /* there is a logical relation */ /* include the first variable in the graph */ j = ind[p]; if (vert[j] == 0) {nb++; vert[j] = nb; orig[nb] = j} /* incude the second variable in the graph */ j = ind[q]; if (vert[j] == 0) {nb++; vert[j] = nb; orig[nb] = j} } } } } /* if the graph is either empty or has too many vertices, do not create it */ if (nb == 0 || nb > MAX_NB) { xprintf("The conflict graph is either empty or too big"); return cog; } /* create the conflict graph */ cog = {}; cog.n = n; cog.nb = nb; cog.ne = 0; cog.vert = vert; cog.orig = orig; len = nb + nb; /* number of vertices */ len = (len * (len - 1)) / 2; /* number of entries in triangle */ len = (len + (CHAR_BIT - 1)) / CHAR_BIT; /* bytes needed */ cog.a = new Array(len); for (j = 1; j <= nb; j++) { /* add edge between variable and its complement */ lpx_add_cog_edge(cog, +orig[j], -orig[j]); } for (i = 1; i <= m; i++) { L = get_row_lb(lp, i); U = get_row_ub(lp, i); if (L == -DBL_MAX && U == +DBL_MAX) continue; len = lpx_get_mat_row(lp, i, ind, val); if (len > MAX_ROW_LEN) continue; lf_min = eval_lf_min(lp, len, ind, val); lf_max = eval_lf_max(lp, len, ind, val); for (p = 1; p <= len; p++) { if (!is_binary(lp, ind[p])) continue; for (q = p+1; q <= len; q++) { if (!is_binary(lp, ind[q])) continue; /* set x[p] to 0 and examine x[q] */ switch (probing(len, val, L, U, lf_min, lf_max, p, 0, q)) { case 0: /* no logical relation */ break; case 1: /* x[p] = 0 implies x[q] = 0 */ lpx_add_cog_edge(cog, -ind[p], +ind[q]); break; case 2: /* x[p] = 0 implies x[q] = 1 */ lpx_add_cog_edge(cog, -ind[p], -ind[q]); break; default: xassert(lp != lp); } /* set x[p] to 1 and examine x[q] */ switch (probing(len, val, L, U, lf_min, lf_max, p, 1, q)) { case 0: /* no logical relation */ break; case 1: /* x[p] = 1 implies x[q] = 0 */ lpx_add_cog_edge(cog, +ind[p], +ind[q]); break; case 2: /* x[p] = 1 implies x[q] = 1 */ lpx_add_cog_edge(cog, +ind[p], -ind[q]); break; default: xassert(lp != lp); } } } } xprintf("The conflict graph has 2*" + cog.nb + " vertices and " + cog.ne + " edges"); return cog; } function lpx_add_cog_edge(cog, i, j){ var k; xassert(i != j); /* determine indices of corresponding vertices */ if (i > 0) { xassert(1 <= i && i <= cog.n); i = cog.vert[i]; xassert(i != 0); } else { i = -i; xassert(1 <= i && i <= cog.n); i = cog.vert[i]; xassert(i != 0); i += cog.nb; } if (j > 0) { xassert(1 <= j && j <= cog.n); j = cog.vert[j]; xassert(j != 0); } else { j = -j; xassert(1 <= j && j <= cog.n); j = cog.vert[j]; xassert(j != 0); j += cog.nb; } /* only lower triangle is stored, so we need i > j */ if (i < j){k = i; i = j; j = k} k = ((i - 1) * (i - 2)) / 2 + (j - 1); cog.a[k / CHAR_BIT] |= (1 << ((CHAR_BIT - 1) - k % CHAR_BIT)); cog.ne++; } function lpx_clique_cut(lp, cog, ind, val){ function is_edge(dsa, i, j) { return i == j ? 0 : i > j ? is_edge1(dsa, i, j) : is_edge1(dsa, j, i)} function is_edge1(dsa, i, j) {return is_edge2(dsa, (i * (i - 1)) / 2 + j)} function is_edge2(dsa, k){return (dsa.a[k / CHAR_BIT] & (1 << ((CHAR_BIT - 1) - k % CHAR_BIT)))} function sub(dsa, ct, table, level, weight, l_weight){ var i, j, k, curr_weight, left_weight, p1, p2, newtable; newtable = new Int32Array(dsa.n); if (ct <= 0) { /* 0 or 1 elements left; include these */ if (ct == 0) { dsa.set[level++] = table[0]; weight += l_weight; } if (weight > dsa.record) { dsa.record = weight; dsa.rec_level = level; for (i = 0; i < level; i++) dsa.rec[i+1] = dsa.set[i]; } return; } for (i = ct; i >= 0; i--) { if ((level == 0) && (i < ct)) return; k = table[i]; if ((level > 0) && (dsa.clique[k] <= (dsa.record - weight))) return; /* prune */ dsa.set[level] = k; curr_weight = weight + dsa.wt[k+1]; l_weight -= dsa.wt[k+1]; if (l_weight <= (dsa.record - curr_weight)) return; /* prune */ p1 = 0; p2 = 0; left_weight = 0; while (p2 < table + i) { j = table[p2]; p2++; if (is_edge(dsa, j, k)) { newtable[p1] = j; p1++; left_weight += dsa.wt[j+1]; } } if (left_weight <= (dsa.record - curr_weight)) continue; sub(dsa, p1 - 1, newtable, level + 1, curr_weight, left_weight); } } function wclique(_n, w, _a, sol){ var dsa = {}; var i, j, p, max_wt, max_nwt, wth, used, nwt, pos; var timer; dsa.n = _n; dsa.wt = w; dsa.a = _a; dsa.record = 0; dsa.rec_level = 0; dsa.rec = sol; dsa.clique = new Int32Array(dsa.n); dsa.set = new Int32Array(dsa.n); used = new Int32Array(dsa.n); nwt = new Int32Array(dsa.n); pos = new Int32Array(dsa.n); /* start timer */ timer = xtime(); /* order vertices */ for (i = 0; i < dsa.n; i++) { nwt[i] = 0; for (j = 0; j < dsa.n; j++) if (is_edge(dsa, i, j)) nwt[i] += dsa.wt[j+1]; } for (i = 0; i < dsa.n; i++) used[i] = 0; for (i = dsa.n-1; i >= 0; i--) { max_wt = -1; max_nwt = -1; for (j = 0; j < dsa.n; j++) { if ((!used[j]) && ((dsa.wt[j+1] > max_wt) || (dsa.wt[j+1] == max_wt && nwt[j] > max_nwt))) { max_wt = dsa.wt[j+1]; max_nwt = nwt[j]; p = j; } } pos[i] = p; used[p] = 1; for (j = 0; j < dsa.n; j++) if ((!used[j]) && (j != p) && (is_edge(dsa, p, j))) nwt[j] -= dsa.wt[p+1]; } /* main routine */ wth = 0; for (i = 0; i < dsa.n; i++) { wth += dsa.wt[pos[i]+1]; sub(dsa, i, pos, 0, 0, wth); dsa.clique[pos[i]] = dsa.record; if (xdifftime(xtime(), timer) >= 5.0 - 0.001) { /* print current record and reset timer */ xprintf("level = " + i+1 + " (" + dsa.n + "); best = " + dsa.record + ""); timer = xtime(); } } /* return the solution found */ for (i = 1; i <= dsa.rec_level; i++) sol[i]++; return dsa.rec_level; } var n = lpx_get_num_cols(lp); var j, t, v, card, temp, len = 0, w, sol; var x, sum, b, vec; /* allocate working arrays */ w = new Int32Array(1 + 2 * cog.nb); sol = new Int32Array(1 + 2 * cog.nb); vec = new Float64Array(1+n); /* assign weights to vertices of the conflict graph */ for (t = 1; t <= cog.nb; t++) { j = cog.orig[t]; x = lpx_get_col_prim(lp, j); temp = (100.0 * x + 0.5)|0; if (temp < 0) temp = 0; if (temp > 100) temp = 100; w[t] = temp; w[cog.nb + t] = 100 - temp; } /* find a clique of maximum weight */ card = wclique(2 * cog.nb, w, cog.a, sol); /* compute the clique weight for unscaled values */ sum = 0.0; for ( t = 1; t <= card; t++) { v = sol[t]; xassert(1 <= v && v <= 2 * cog.nb); if (v <= cog.nb) { /* vertex v corresponds to binary variable x[j] */ j = cog.orig[v]; x = lpx_get_col_prim(lp, j); sum += x; } else { /* vertex v corresponds to the complement of x[j] */ j = cog.orig[v - cog.nb]; x = lpx_get_col_prim(lp, j); sum += 1.0 - x; } } /* if the sum of binary variables and their complements in the clique greater than 1, the clique cut is violated */ if (sum >= 1.01) { /* construct the inquality */ b = 1.0; for (t = 1; t <= card; t++) { v = sol[t]; if (v <= cog.nb) { /* vertex v corresponds to binary variable x[j] */ j = cog.orig[v]; xassert(1 <= j && j <= n); vec[j] += 1.0; } else { /* vertex v corresponds to the complement of x[j] */ j = cog.orig[v - cog.nb]; xassert(1 <= j && j <= n); vec[j] -= 1.0; b -= 1.0; } } xassert(len == 0); for (j = 1; j <= n; j++) { if (vec[j] != 0.0) { len++; ind[len] = j; val[len] = vec[j]; } } ind[0] = 0; val[0] = b; } /* return to the calling program */ return len; } function ios_clq_init(tree){ /* initialize clique cut generator */ var mip = tree.mip; xassert(mip != null); return lpx_create_cog(mip); } function ios_clq_gen(tree, gen){ var n = lpx_get_num_cols(tree.mip); var len, ind; var val; xassert(gen != null); ind = new Int32Array(1+n); val = new Float64Array(1+n); len = lpx_clique_cut(tree.mip, gen, ind, val); if (len > 0) { /* xprintf("len = %d", len); */ glp_ios_add_row(tree, null, GLP_RF_CLQ, 0, len, ind, val, GLP_UP, val[0]); } } function ios_choose_var(T, callback){ var j; if (T.parm.br_tech == GLP_BR_FFV) { /* branch on first fractional variable */ j = branch_first(T, callback); } else if (T.parm.br_tech == GLP_BR_LFV) { /* branch on last fractional variable */ j = branch_last(T, callback); } else if (T.parm.br_tech == GLP_BR_MFV) { /* branch on most fractional variable */ j = branch_mostf(T, callback); } else if (T.parm.br_tech == GLP_BR_DTH) { /* branch using the heuristic by Dreebeck and Tomlin */ j = branch_drtom(T, callback); } else if (T.parm.br_tech == GLP_BR_PCH) { /* hybrid pseudocost heuristic */ j = ios_pcost_branch(T, callback); } else xassert(T != T); return j; } function branch_first(T, callback){ var j, next; var beta; /* choose the column to branch on */ for (j = 1; j <= T.n; j++) if (T.non_int[j]) break; xassert(1 <= j && j <= T.n); /* select the branch to be solved next */ beta = glp_get_col_prim(T.mip, j); if (beta - Math.floor(beta) < Math.ceil(beta) - beta) next = GLP_DN_BRNCH; else next = GLP_UP_BRNCH; callback(next); return j; } function branch_last(T, callback){ var j, next; var beta; /* choose the column to branch on */ for (j = T.n; j >= 1; j--) if (T.non_int[j]) break; xassert(1 <= j && j <= T.n); /* select the branch to be solved next */ beta = glp_get_col_prim(T.mip, j); if (beta - Math.floor(beta) < Math.ceil(beta) - beta) next = GLP_DN_BRNCH; else next = GLP_UP_BRNCH; callback(next); return j; } function branch_mostf(T, callback){ var j, jj, next; var beta, most, temp; /* choose the column to branch on */ jj = 0; most = DBL_MAX; for (j = 1; j <= T.n; j++) { if (T.non_int[j]) { beta = glp_get_col_prim(T.mip, j); temp = Math.floor(beta) + 0.5; if (most > Math.abs(beta - temp)) { jj = j; most = Math.abs(beta - temp); if (beta < temp) next = GLP_DN_BRNCH; else next = GLP_UP_BRNCH; } } } callback(next); return jj; } function branch_drtom(T, callback){ var mip = T.mip; var m = mip.m; var n = mip.n; var non_int = T.non_int; var j, jj, k, t, next, kase, len, stat, ind; var x, dk, alfa, delta_j, delta_k, delta_z, dz_dn, dz_up, dd_dn, dd_up, degrad, val; /* basic solution of LP relaxation must be optimal */ xassert(glp_get_status(mip) == GLP_OPT); /* allocate working arrays */ ind = new Int32Array(1+n); val = new Float64Array(1+n); /* nothing has been chosen so far */ jj = 0; degrad = -1.0; /* walk through the list of columns (structural variables) */ for (j = 1; j <= n; j++) { /* if j-th column is not marked as fractional, skip it */ if (!non_int[j]) continue; /* obtain (fractional) value of j-th column in basic solution of LP relaxation */ x = glp_get_col_prim(mip, j); /* since the value of j-th column is fractional, the column is basic; compute corresponding row of the simplex table */ len = glp_eval_tab_row(mip, m+j, ind, val); /* the following fragment computes a change in the objective function: delta Z = new Z - old Z, where old Z is the objective value in the current optimal basis, and new Z is the objective value in the adjacent basis, for two cases: 1) if new upper bound ub' = Math.floor(x[j]) is introduced for j-th column (down branch); 2) if new lower bound lb' = Math.ceil(x[j]) is introduced for j-th column (up branch); since in both cases the solution remaining dual feasible becomes primal infeasible, one implicit simplex iteration is performed to determine the change delta Z; it is obvious that new Z, which is never better than old Z, is a lower (minimization) or upper (maximization) bound of the objective function for down- and up-branches. */ for (kase = -1; kase <= +1; kase += 2) { /* if kase < 0, the new upper bound of x[j] is introduced; in this case x[j] should decrease in order to leave the basis and go to its new upper bound */ /* if kase > 0, the new lower bound of x[j] is introduced; in this case x[j] should increase in order to leave the basis and go to its new lower bound */ /* apply the dual ratio test in order to determine which auxiliary or structural variable should enter the basis to keep dual feasibility */ k = glp_dual_rtest(mip, len, ind, val, kase, 1e-9); if (k != 0) k = ind[k]; /* if no non-basic variable has been chosen, LP relaxation of corresponding branch being primal infeasible and dual unbounded has no primal feasible solution; in this case the change delta Z is formally set to infinity */ if (k == 0) { delta_z = (T.mip.dir == GLP_MIN ? +DBL_MAX : -DBL_MAX); } else { /* row of the simplex table that corresponds to non-basic variable x[k] choosen by the dual ratio test is: x[j] = ... + alfa * x[k] + ... where alfa is the influence coefficient (an element of the simplex table row) */ /* determine the coefficient alfa */ for (t = 1; t <= len; t++) if (ind[t] == k) break; xassert(1 <= t && t <= len); alfa = val[t]; /* since in the adjacent basis the variable x[j] becomes non-basic, knowing its value in the current basis we can determine its change delta x[j] = new x[j] - old x[j] */ delta_j = (kase < 0 ? Math.floor(x) : Math.ceil(x)) - x; /* and knowing the coefficient alfa we can determine the corresponding change delta x[k] = new x[k] - old x[k], where old x[k] is a value of x[k] in the current basis, and new x[k] is a value of x[k] in the adjacent basis */ delta_k = delta_j / alfa; /* Tomlin noticed that if the variable x[k] is of integer kind, its change cannot be less (eventually) than one in the magnitude */ if (k > m && glp_get_col_kind(mip, k-m) != GLP_CV) { /* x[k] is structural integer variable */ if (Math.abs(delta_k - Math.floor(delta_k + 0.5)) > 1e-3) { if (delta_k > 0.0) delta_k = Math.ceil(delta_k); /* +3.14 . +4 */ else delta_k = Math.floor(delta_k); /* -3.14 . -4 */ } } /* now determine the status and reduced cost of x[k] in the current basis */ if (k <= m) { stat = glp_get_row_stat(mip, k); dk = glp_get_row_dual(mip, k); } else { stat = glp_get_col_stat(mip, k-m); dk = glp_get_col_dual(mip, k-m); } /* if the current basis is dual degenerate, some reduced costs which are close to zero may have wrong sign due to round-off errors, so correct the sign of d[k] */ switch (T.mip.dir) { case GLP_MIN: if (stat == GLP_NL && dk < 0.0 || stat == GLP_NU && dk > 0.0 || stat == GLP_NF) dk = 0.0; break; case GLP_MAX: if (stat == GLP_NL && dk > 0.0 || stat == GLP_NU && dk < 0.0 || stat == GLP_NF) dk = 0.0; break; default: xassert(T != T); } /* now knowing the change of x[k] and its reduced cost d[k] we can compute the corresponding change in the objective function delta Z = new Z - old Z = d[k] * delta x[k]; note that due to Tomlin's modification new Z can be even worse than in the adjacent basis */ delta_z = dk * delta_k; } /* new Z is never better than old Z, therefore the change delta Z is always non-negative (in case of minimization) or non-positive (in case of maximization) */ switch (T.mip.dir) { case GLP_MIN: xassert(delta_z >= 0.0); break; case GLP_MAX: xassert(delta_z <= 0.0); break; default: xassert(T != T); } /* save the change in the objective fnction for down- and up-branches, respectively */ if (kase < 0) dz_dn = delta_z; else dz_up = delta_z; } /* thus, in down-branch no integer feasible solution can be better than Z + dz_dn, and in up-branch no integer feasible solution can be better than Z + dz_up, where Z is value of the objective function in the current basis */ /* following the heuristic by Driebeck and Tomlin we choose a column (i.e. structural variable) which provides largest degradation of the objective function in some of branches; besides, we select the branch with smaller degradation to be solved next and keep other branch with larger degradation in the active list hoping to minimize the number of further backtrackings */ if (degrad < Math.abs(dz_dn) || degrad < Math.abs(dz_up)) { jj = j; if (Math.abs(dz_dn) < Math.abs(dz_up)) { /* select down branch to be solved next */ next = GLP_DN_BRNCH; degrad = Math.abs(dz_up); } else { /* select up branch to be solved next */ next = GLP_UP_BRNCH; degrad = Math.abs(dz_dn); } /* save the objective changes for printing */ dd_dn = dz_dn; dd_up = dz_up; /* if down- or up-branch has no feasible solution, we does not need to consider other candidates (in principle, the corresponding branch could be pruned right now) */ if (degrad == DBL_MAX) break; } } /* something must be chosen */ xassert(1 <= jj && jj <= n); if (degrad < 1e-6 * (1.0 + 0.001 * Math.abs(mip.obj_val))) { jj = branch_mostf(T, callback); return jj; } if (T.parm.msg_lev >= GLP_MSG_DBG) { xprintf("branch_drtom: column " + jj + " chosen to branch on"); if (Math.abs(dd_dn) == DBL_MAX) xprintf("branch_drtom: down-branch is infeasible"); else xprintf("branch_drtom: down-branch bound is " + (lpx_get_obj_val(mip) + dd_dn) + ""); if (Math.abs(dd_up) == DBL_MAX) xprintf("branch_drtom: up-branch is infeasible"); else xprintf("branch_drtom: up-branch bound is " + (lpx_get_obj_val(mip) + dd_up) + ""); } callback(next); return jj; } function ios_pcost_init(tree){ /* initialize working data used on pseudocost branching */ var n = tree.n, j; var csa = {}; csa.dn_cnt = new Int32Array(1+n); csa.dn_sum = new Float64Array(1+n); csa.up_cnt = new Int32Array(1+n); csa.up_sum = new Float64Array(1+n); for (j = 1; j <= n; j++) { csa.dn_cnt[j] = csa.up_cnt[j] = 0; csa.dn_sum[j] = csa.up_sum[j] = 0.0; } return csa; } function ios_pcost_update(tree){ /* update history information for pseudocost branching */ /* this routine is called every time when LP relaxation of the current subproblem has been solved to optimality with all lazy and cutting plane constraints included */ var j; var dx, dz, psi; var csa = tree.pcost; xassert(csa != null); xassert(tree.curr != null); /* if the current subproblem is the root, skip updating */ if (tree.curr.up == null) return; /* determine branching variable x[j], which was used in the parent subproblem to create the current subproblem */ j = tree.curr.up.br_var; xassert(1 <= j && j <= tree.n); /* determine the change dx[j] = new x[j] - old x[j], where new x[j] is a value of x[j] in optimal solution to LP relaxation of the current subproblem, old x[j] is a value of x[j] in optimal solution to LP relaxation of the parent subproblem */ dx = tree.mip.col[j].prim - tree.curr.up.br_val; xassert(dx != 0.0); /* determine corresponding change dz = new dz - old dz in the objective function value */ dz = tree.mip.obj_val - tree.curr.up.lp_obj; /* determine per unit degradation of the objective function */ psi = Math.abs(dz / dx); /* update history information */ if (dx < 0.0) { /* the current subproblem is down-branch */ csa.dn_cnt[j]++; csa.dn_sum[j] += psi; } else /* dx > 0.0 */ { /* the current subproblem is up-branch */ csa.up_cnt[j]++; csa.up_sum[j] += psi; } } function ios_pcost_free(tree){ /* free working area used on pseudocost branching */ var csa = tree.pcost; xassert(csa != null); tree.pcost = null; } function ios_pcost_branch(T, callback){ function eval_degrad(P, j, bnd){ /* compute degradation of the objective on fixing x[j] at given value with a limited number of dual simplex iterations */ /* this routine fixes column x[j] at specified value bnd, solves resulting LP, and returns a lower bound to degradation of the objective, degrad >= 0 */ var lp; var ret; var degrad; /* the current basis must be optimal */ xassert(glp_get_status(P) == GLP_OPT); /* create a copy of P */ lp = glp_create_prob(); glp_copy_prob(lp, P, 0); /* fix column x[j] at specified value */ glp_set_col_bnds(lp, j, GLP_FX, bnd, bnd); /* try to solve resulting LP */ var parm = new SMCP(); //glp_init_smcp(parm); parm.msg_lev = GLP_MSG_OFF; parm.meth = GLP_DUAL; parm.it_lim = 30; parm.out_dly = 1000; parm.meth = GLP_DUAL; ret = glp_simplex(lp, parm); if (ret == 0 || ret == GLP_EITLIM) { if (glp_get_prim_stat(lp) == GLP_NOFEAS) { /* resulting LP has no primal feasible solution */ degrad = DBL_MAX; } else if (glp_get_dual_stat(lp) == GLP_FEAS) { /* resulting basis is optimal or at least dual feasible, so we have the correct lower bound to degradation */ if (P.dir == GLP_MIN) degrad = lp.obj_val - P.obj_val; else if (P.dir == GLP_MAX) degrad = P.obj_val - lp.obj_val; else xassert(P != P); /* degradation cannot be negative by definition */ /* note that the lower bound to degradation may be close to zero even if its exact value is zero due to round-off errors on computing the objective value */ if (degrad < 1e-6 * (1.0 + 0.001 * Math.abs(P.obj_val))) degrad = 0.0; } else { /* the final basis reported by the simplex solver is dual infeasible, so we cannot determine a non-trivial lower bound to degradation */ degrad = 0.0; } } else { /* the simplex solver failed */ degrad = 0.0; } return degrad; } function eval_psi(T, j, brnch){ /* compute estimation of pseudocost of variable x[j] for down- or up-branch */ var csa = T.pcost; var beta, degrad, psi; xassert(csa != null); xassert(1 <= j && j <= T.n); if (brnch == GLP_DN_BRNCH) { /* down-branch */ if (csa.dn_cnt[j] == 0) { /* initialize down pseudocost */ beta = T.mip.col[j].prim; degrad = eval_degrad(T.mip, j, Math.floor(beta)); if (degrad == DBL_MAX) { psi = DBL_MAX; return psi; } csa.dn_cnt[j] = 1; csa.dn_sum[j] = degrad / (beta - Math.floor(beta)); } psi = csa.dn_sum[j] / csa.dn_cnt[j]; } else if (brnch == GLP_UP_BRNCH) { /* up-branch */ if (csa.up_cnt[j] == 0) { /* initialize up pseudocost */ beta = T.mip.col[j].prim; degrad = eval_degrad(T.mip, j, Math.ceil(beta)); if (degrad == DBL_MAX) { psi = DBL_MAX; return psi; } csa.up_cnt[j] = 1; csa.up_sum[j] = degrad / (Math.ceil(beta) - beta); } psi = csa.up_sum[j] / csa.up_cnt[j]; } else xassert(brnch != brnch); return psi; } function progress(T){ /* display progress of pseudocost initialization */ var csa = T.pcost; var j, nv = 0, ni = 0; for (j = 1; j <= T.n; j++) { if (glp_ios_can_branch(T, j)) { nv++; if (csa.dn_cnt[j] > 0 && csa.up_cnt[j] > 0) ni++; } } xprintf("Pseudocosts initialized for " + ni + " of " + nv + " variables"); } /* choose branching variable with pseudocost branching */ var t = xtime(); var j, jjj, sel; var beta, psi, d1, d2, d, dmax; /* initialize the working arrays */ if (T.pcost == null) T.pcost = ios_pcost_init(T); /* nothing has been chosen so far */ jjj = 0; dmax = -1.0; /* go through the list of branching candidates */ for (j = 1; j <= T.n; j++) { if (!glp_ios_can_branch(T, j)) continue; /* determine primal value of x[j] in optimal solution to LP relaxation of the current subproblem */ beta = T.mip.col[j].prim; /* estimate pseudocost of x[j] for down-branch */ psi = eval_psi(T, j, GLP_DN_BRNCH); if (psi == DBL_MAX) { /* down-branch has no primal feasible solution */ jjj = j; sel = GLP_DN_BRNCH; callback(sel); return jjj; } /* estimate degradation of the objective for down-branch */ d1 = psi * (beta - Math.floor(beta)); /* estimate pseudocost of x[j] for up-branch */ psi = eval_psi(T, j, GLP_UP_BRNCH); if (psi == DBL_MAX) { /* up-branch has no primal feasible solution */ jjj = j; sel = GLP_UP_BRNCH; callback(sel); return jjj; } /* estimate degradation of the objective for up-branch */ d2 = psi * (Math.ceil(beta) - beta); /* determine d = max(d1, d2) */ d = (d1 > d2 ? d1 : d2); /* choose x[j] which provides maximal estimated degradation of the objective either in down- or up-branch */ if (dmax < d) { dmax = d; jjj = j; /* continue the search from a subproblem, where degradation is less than in other one */ sel = (d1 <= d2 ? GLP_DN_BRNCH : GLP_UP_BRNCH); } /* display progress of pseudocost initialization */ if (T.parm.msg_lev >= GLP_ON) { if (xdifftime(xtime(), t) >= 10.0) { progress(T); t = xtime(); } } } if (dmax == 0.0) { /* no degradation is indicated; choose a variable having most fractional value */ jjj = branch_mostf(T, callback); return jjj; } callback(sel); return jjj; } function ios_feas_pump(T){ var P = T.mip; var n = P.n; var lp = null; var var_ = null; var rand = null; var col; var parm; var j, k, new_x, nfail, npass, nv, ret, stalling; var dist, tol; var start = 0, more = 1, pass = 2, loop = 3, skip = 4, done = 5; var label = start; while (true){ var go_to = null; switch (label){ case start: xassert(glp_get_status(P) == GLP_OPT); /* this heuristic is applied only once on the root level */ if (!(T.curr.level == 0 && T.curr.solved == 1)){go_to = done; break} /* determine number of binary variables */ nv = 0; for (j = 1; j <= n; j++) { col = P.col[j]; /* if x[j] is continuous, skip it */ if (col.kind == GLP_CV) continue; /* if x[j] is fixed, skip it */ if (col.type == GLP_FX) continue; /* x[j] is non-fixed integer */ xassert(col.kind == GLP_IV); if (col.type == GLP_DB && col.lb == 0.0 && col.ub == 1.0) { /* x[j] is binary */ nv++; } else { /* x[j] is general integer */ if (T.parm.msg_lev >= GLP_MSG_ALL) xprintf("FPUMP heuristic cannot be applied due to genera"+ "l integer variables"); go_to = done; break; } } if (go_to != null) break; /* there must be at least one binary variable */ if (nv == 0) {go_to = done; break} if (T.parm.msg_lev >= GLP_MSG_ALL) xprintf("Applying FPUMP heuristic..."); /* build the list of binary variables */ var_ = new Array(1+nv); xfillObjArr(var_, 1, nv); k = 0; for (j = 1; j <= n; j++) { col = P.col[j]; if (col.kind == GLP_IV && col.type == GLP_DB) var_[++k].j = j; } xassert(k == nv); /* create working problem object */ lp = glp_create_prob(); case more: /* copy the original problem object to keep it intact */ glp_copy_prob(lp, P, GLP_OFF); /* we are interested to find an integer feasible solution, which is better than the best known one */ if (P.mip_stat == GLP_FEAS) { var ind; var val, bnd; /* add a row and make it identical to the objective row */ glp_add_rows(lp, 1); ind = new Int32Array(1+n); val = new Float64Array(1+n); for (j = 1; j <= n; j++) { ind[j] = j; val[j] = P.col[j].coef; } glp_set_mat_row(lp, lp.m, n, ind, val); /* introduce upper (minimization) or lower (maximization) bound to the original objective function; note that this additional constraint is not violated at the optimal point to LP relaxation */ bnd = 0.1 * P.obj_val + 0.9 * P.mip_obj; /* xprintf("bnd = %f", bnd); */ if (P.dir == GLP_MIN) glp_set_row_bnds(lp, lp.m, GLP_UP, 0.0, bnd - P.c0); else if (P.dir == GLP_MAX) glp_set_row_bnds(lp, lp.m, GLP_LO, bnd - P.c0, 0.0); else xassert(P != P); } /* reset pass count */ npass = 0; /* invalidate the rounded point */ for (k = 1; k <= nv; k++) var_[k].x = -1; case pass: /* next pass starts here */ npass++; if (T.parm.msg_lev >= GLP_MSG_ALL) xprintf("Pass " + npass + ""); /* initialize minimal distance between the basic point and the rounded one obtained during this pass */ dist = DBL_MAX; /* reset failure count (the number of succeeded iterations failed to improve the distance) */ nfail = 0; /* if it is not the first pass, perturb the last rounded point rather than construct it from the basic solution */ if (npass > 1) { var rho, temp; if (rand == null) rand = rng_create_rand(); for (k = 1; k <= nv; k++) { j = var_[k].j; col = lp.col[j]; rho = rng_uniform(rand, -0.3, 0.7); if (rho < 0.0) rho = 0.0; temp = Math.abs(var_[k].x - col.prim); if (temp + rho > 0.5) var_[k].x = 1 - var_[k].x; } go_to = skip; break; } case loop: /* innermost loop begins here */ /* round basic solution (which is assumed primal feasible) */ stalling = 1; for (k = 1; k <= nv; k++) { col = lp.col[var_[k].j]; if (col.prim < 0.5) { /* rounded value is 0 */ new_x = 0; } else { /* rounded value is 1 */ new_x = 1; } if (var_[k].x != new_x) { stalling = 0; var_[k].x = new_x; } } /* if the rounded point has not changed (stalling), choose and flip some its entries heuristically */ if (stalling) { /* compute d[j] = |x[j] - round(x[j])| */ for (k = 1; k <= nv; k++) { col = lp.col[var_[k].j]; var_[k].d = Math.abs(col.prim - var_[k].x); } /* sort the list of binary variables by descending d[j] */ xqsort(var_, 1, nv, function(vx, vy){ /* comparison routine */ if (vx.d > vy.d) return -1; else if (vx.d < vy.d) return +1; else return 0; } ); /* choose and flip some rounded components */ for (k = 1; k <= nv; k++) { if (k >= 5 && var_[k].d < 0.35 || k >= 10) break; var_[k].x = 1 - var_[k].x; } } case skip: /* check if the time limit has been exhausted */ if (T.parm.tm_lim < INT_MAX && (T.parm.tm_lim - 1) <= 1000.0 * xdifftime(xtime(), T.tm_beg)) {go_to = done; break} /* build the objective, which is the distance between the current (basic) point and the rounded one */ lp.dir = GLP_MIN; lp.c0 = 0.0; for (j = 1; j <= n; j++) lp.col[j].coef = 0.0; for (k = 1; k <= nv; k++) { j = var_[k].j; if (var_[k].x == 0) lp.col[j].coef = +1.0; else { lp.col[j].coef = -1.0; lp.c0 += 1.0; } } /* minimize the distance with the simplex method */ parm = new SMCP(); //glp_init_smcp(parm); if (T.parm.msg_lev <= GLP_MSG_ERR) parm.msg_lev = T.parm.msg_lev; else if (T.parm.msg_lev <= GLP_MSG_ALL) { parm.msg_lev = GLP_MSG_ON; parm.out_dly = 10000; } ret = glp_simplex(lp, parm); if (ret != 0) { if (T.parm.msg_lev >= GLP_MSG_ERR) xprintf("Warning: glp_simplex returned " + ret + ""); go_to = done; break; } ret = glp_get_status(lp); if (ret != GLP_OPT) { if (T.parm.msg_lev >= GLP_MSG_ERR) xprintf("Warning: glp_get_status returned " + ret + ""); go_to = done; break; } if (T.parm.msg_lev >= GLP_MSG_DBG) xprintf("delta = " + lp.obj_val + ""); /* check if the basic solution is integer feasible; note that it may be so even if the minimial distance is positive */ tol = 0.3 * T.parm.tol_int; for (k = 1; k <= nv; k++) { col = lp.col[var_[k].j]; if (tol < col.prim && col.prim < 1.0 - tol) break; } if (k > nv) { /* okay; the basic solution seems to be integer feasible */ var x = new Float64Array(1+n); for (j = 1; j <= n; j++) { x[j] = lp.col[j].prim; if (P.col[j].kind == GLP_IV) x[j] = Math.floor(x[j] + 0.5); } /* reset direction and right-hand side of objective */ lp.c0 = P.c0; lp.dir = P.dir; /* fix integer variables */ for (k = 1; k <= nv; k++) { lp.col[var_[k].j].lb = x[var_[k].j]; lp.col[var_[k].j].ub = x[var_[k].j]; lp.col[var_[k].j].type = GLP_FX; } /* copy original objective function */ for (j = 1; j <= n; j++) lp.col[j].coef = P.col[j].coef; /* solve original LP and copy result */ ret = glp_simplex(lp, parm); if (ret != 0) { if (T.parm.msg_lev >= GLP_MSG_ERR) xprintf("Warning: glp_simplex returned " + ret + ""); go_to = done; break; } ret = glp_get_status(lp); if (ret != GLP_OPT) { if (T.parm.msg_lev >= GLP_MSG_ERR) xprintf("Warning: glp_get_status returned " + ret + ""); go_to = done; break; } for (j = 1; j <= n; j++) if (P.col[j].kind != GLP_IV) x[j] = lp.col[j].prim; ret = glp_ios_heur_sol(T, x); if (ret == 0) { /* the integer solution is accepted */ if (ios_is_hopeful(T, T.curr.bound)) { /* it is reasonable to apply the heuristic once again */ go_to = more; break; } else { /* the best known integer feasible solution just found is close to optimal solution to LP relaxation */ go_to = done; break; } } } /* the basic solution is fractional */ if (dist == DBL_MAX || lp.obj_val <= dist - 1e-6 * (1.0 + dist)) { /* the distance is reducing */ nfail = 0; dist = lp.obj_val; } else { /* improving the distance failed */ nfail++; } if (nfail < 3) {go_to = loop; break} if (npass < 5) {go_to = pass; break} case done: } if (go_to == null) break; label = go_to; } } function ios_process_cuts(T){ function parallel(a, b, work){ var aij; var s = 0.0, sa = 0.0, sb = 0.0, temp; for (aij = a.ptr; aij != null; aij = aij.next) { work[aij.j] = aij.val; sa += aij.val * aij.val; } for (aij = b.ptr; aij != null; aij = aij.next) { s += work[aij.j] * aij.val; sb += aij.val * aij.val; } for (aij = a.ptr; aij != null; aij = aij.next) work[aij.j] = 0.0; temp = Math.sqrt(sa) * Math.sqrt(sb); if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; return s / temp; } var pool; var cut; var aij; var info; var k, kk, max_cuts, len, ret, ind; var val, work; /* the current subproblem must exist */ xassert(T.curr != null); /* the pool must exist and be non-empty */ pool = T.local; xassert(pool != null); xassert(pool.size > 0); /* allocate working arrays */ info = new Array(1+pool.size); ind = new Int32Array(1+T.n); val = new Float64Array(1+T.n); work = new Float64Array(1+T.n); /* build the list of cuts stored in the cut pool */ for (k = 0, cut = pool.head; cut != null; cut = cut.next){ k++; info[k].cut = cut; info[k].flag = 0; } xassert(k == pool.size); /* estimate efficiency of all cuts in the cut pool */ for (k = 1; k <= pool.size; k++) { var temp, dy = null, dz = null; cut = info[k].cut; /* build the vector of cut coefficients and compute its Euclidean norm */ len = 0; temp = 0.0; for (aij = cut.ptr; aij != null; aij = aij.next) { xassert(1 <= aij.j && aij.j <= T.n); len++; ind[len] = aij.j; val[len] = aij.val; temp += aij.val * aij.val; } if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; /* transform the cut to express it only through non-basic (auxiliary and structural) variables */ len = glp_transform_row(T.mip, len, ind, val); /* determine change in the cut value and in the objective value for the adjacent basis by simulating one step of the dual simplex */ ret = _glp_analyze_row(T.mip, len, ind, val, cut.type, cut.rhs, 1e-9, function(piv, x, dx, y, dy_, dz_){dy = dy_; dz = dz_}); /* determine normalized residual and lower bound to objective degradation */ if (ret == 0) { info[k].eff = Math.abs(dy) / Math.sqrt(temp); /* if some reduced costs violates (slightly) their zero bounds (i.e. have wrong signs) due to round-off errors, dz also may have wrong sign being close to zero */ if (T.mip.dir == GLP_MIN) { if (dz < 0.0) dz = 0.0; info[k].deg = + dz; } else /* GLP_MAX */ { if (dz > 0.0) dz = 0.0; info[k].deg = - dz; } } else if (ret == 1) { /* the constraint is not violated at the current point */ info[k].eff = info[k].deg = 0.0; } else if (ret == 2) { /* no dual feasible adjacent basis exists */ info[k].eff = 1.0; info[k].deg = DBL_MAX; } else xassert(ret != ret); /* if the degradation is too small, just ignore it */ if (info[k].deg < 0.01) info[k].deg = 0.0; } /* sort the list of cuts by decreasing objective degradation and then by decreasing efficacy */ xqsort(info, 1, pool.size, function(info1, info2){ if (info1.deg == 0.0 && info2.deg == 0.0) { if (info1.eff > info2.eff) return -1; if (info1.eff < info2.eff) return +1; } else { if (info1.deg > info2.deg) return -1; if (info1.deg < info2.deg) return +1; } return 0; } ); /* only first (most efficient) max_cuts in the list are qualified as candidates to be added to the current subproblem */ max_cuts = (T.curr.level == 0 ? 90 : 10); if (max_cuts > pool.size) max_cuts = pool.size; /* add cuts to the current subproblem */ for (k = 1; k <= max_cuts; k++) { var i; /* if this cut seems to be inefficient, skip it */ if (info[k].deg < 0.01 && info[k].eff < 0.01) continue; /* if the angle between this cut and every other cut included in the current subproblem is small, skip this cut */ for (kk = 1; kk < k; kk++) { if (info[kk].flag) { if (parallel(info[k].cut, info[kk].cut, work) > 0.90) break; } } if (kk < k) continue; /* add this cut to the current subproblem */ cut = info[k].cut; info[k].flag = 1; i = glp_add_rows(T.mip, 1); if (cut.name != null) glp_set_row_name(T.mip, i, cut.name); xassert(T.mip.row[i].origin == GLP_RF_CUT); T.mip.row[i].klass = cut.klass; len = 0; for (aij = cut.ptr; aij != null; aij = aij.next){ len++; ind[len] = aij.j; val[len] = aij.val; } glp_set_mat_row(T.mip, i, len, ind, val); xassert(cut.type == GLP_LO || cut.type == GLP_UP); glp_set_row_bnds(T.mip, i, cut.type, cut.rhs, cut.rhs); } } function ios_choose_node(T){ function most_feas(T){ /* select subproblem whose parent has minimal sum of integer infeasibilities */ var node; var p; var best; p = 0; best = DBL_MAX; for (node = T.head; node != null; node = node.next) { xassert(node.up != null); if (best > node.up.ii_sum){ p = node.p; best = node.up.ii_sum; } } return p; } function best_proj(T){ /* select subproblem using the best projection heuristic */ var root, node; var p; var best, deg, obj; /* the global bound must exist */ xassert(T.mip.mip_stat == GLP_FEAS); /* obtain pointer to the root node, which must exist */ root = T.slot[1].node; xassert(root != null); /* deg estimates degradation of the objective function per unit of the sum of integer infeasibilities */ xassert(root.ii_sum > 0.0); deg = (T.mip.mip_obj - root.bound) / root.ii_sum; /* nothing has been selected so far */ p = 0; best = DBL_MAX; /* walk through the list of active subproblems */ for (node = T.head; node != null; node = node.next) { xassert(node.up != null); /* obj estimates optimal objective value if the sum of integer infeasibilities were zero */ obj = node.up.bound + deg * node.up.ii_sum; if (T.mip.dir == GLP_MAX) obj = - obj; /* select the subproblem which has the best estimated optimal objective value */ if (best > obj){p = node.p; best = obj} } return p; } function best_node(T){ /* select subproblem with best local bound */ var node, best = null; var bound, eps; switch (T.mip.dir) { case GLP_MIN: bound = +DBL_MAX; for (node = T.head; node != null; node = node.next) if (bound > node.bound) bound = node.bound; xassert(bound != +DBL_MAX); eps = 0.001 * (1.0 + Math.abs(bound)); for (node = T.head; node != null; node = node.next) { if (node.bound <= bound + eps) { xassert(node.up != null); if (best == null || best.up.ii_sum > node.up.ii_sum) best = node; } } break; case GLP_MAX: bound = -DBL_MAX; for (node = T.head; node != null; node = node.next) if (bound < node.bound) bound = node.bound; xassert(bound != -DBL_MAX); eps = 0.001 * (1.0 + Math.abs(bound)); for (node = T.head; node != null; node = node.next) { if (node.bound >= bound - eps) { xassert(node.up != null); if (best == null || best.lp_obj < node.lp_obj) best = node; } } break; default: xassert(T != T); } xassert(best != null); return best.p; } var p; if (T.parm.bt_tech == GLP_BT_DFS) { /* depth first search */ xassert(T.tail != null); p = T.tail.p; } else if (T.parm.bt_tech == GLP_BT_BFS) { /* breadth first search */ xassert(T.head != null); p = T.head.p; } else if (T.parm.bt_tech == GLP_BT_BLB) { /* select node with best local bound */ p = best_node(T); } else if (T.parm.bt_tech == GLP_BT_BPH) { if (T.mip.mip_stat == GLP_UNDEF) { /* "most integer feasible" subproblem */ p = most_feas(T); } else { /* best projection heuristic */ p = best_proj(T); } } else xassert(T != T); return p; } /* library version numbers: */ var GLP_MAJOR_VERSION = exports["GLP_MAJOR_VERSION"] = 4, GLP_MINOR_VERSION = exports["GLP_MINOR_VERSION"] = 49, /* optimization direction flag: */ /** @const */GLP_MIN = exports["GLP_MIN"] = 1, /* minimization */ /** @const */GLP_MAX = exports["GLP_MAX"] = 2, /* maximization */ /* kind of structural variable: */ /** @const */GLP_CV = exports["GLP_CV"] = 1, /* continuous variable */ /** @const */GLP_IV = exports["GLP_IV"] = 2, /* integer variable */ /** @const */GLP_BV = exports["GLP_BV"] = 3, /* binary variable */ /* type of auxiliary/structural variable: */ /** @const */GLP_FR = exports["GLP_FR"] = 1, /* free variable */ /** @const */GLP_LO = exports["GLP_LO"] = 2, /* variable with lower bound */ /** @const */GLP_UP = exports["GLP_UP"] = 3, /* variable with upper bound */ /** @const */GLP_DB = exports["GLP_DB"] = 4, /* double-bounded variable */ /** @const */GLP_FX = exports["GLP_FX"] = 5, /* fixed variable */ /* status of auxiliary/structural variable: */ /** @const */GLP_BS = exports["GLP_BS"] = 1, /* basic variable */ /** @const */GLP_NL = exports["GLP_NL"] = 2, /* non-basic variable on lower bound */ /** @const */GLP_NU = exports["GLP_NU"] = 3, /* non-basic variable on upper bound */ /** @const */GLP_NF = exports["GLP_NF"] = 4, /* non-basic free variable */ /** @const */GLP_NS = exports["GLP_NS"] = 5, /* non-basic fixed variable */ /* scaling options: */ /** @const */GLP_SF_GM = exports["GLP_SF_GM"] = 0x01, /* perform geometric mean scaling */ /** @const */GLP_SF_EQ = exports["GLP_SF_EQ"] = 0x10, /* perform equilibration scaling */ /** @const */GLP_SF_2N = exports["GLP_SF_2N"] = 0x20, /* round scale factors to power of two */ /** @const */GLP_SF_SKIP = exports["GLP_SF_SKIP"] = 0x40, /* skip if problem is well scaled */ /** @const */GLP_SF_AUTO = exports["GLP_SF_AUTO"] = 0x80, /* choose scaling options automatically */ /* solution indicator: */ /** @const */GLP_SOL = exports["GLP_SOL"] = 1, /* basic solution */ /** @const */GLP_IPT = exports["GLP_IPT"] = 2, /* interior-point solution */ /** @const */GLP_MIP = exports["GLP_MIP"] = 3, /* mixed integer solution */ /* solution status: */ /** @const */GLP_UNDEF = exports["GLP_UNDEF"] = 1, /* solution is undefined */ /** @const */GLP_FEAS = exports["GLP_FEAS"] = 2, /* solution is feasible */ /** @const */GLP_INFEAS = exports["GLP_INFEAS"] = 3, /* solution is infeasible */ /** @const */GLP_NOFEAS = exports["GLP_NOFEAS"] = 4, /* no feasible solution exists */ /** @const */GLP_OPT = exports["GLP_OPT"] = 5, /* solution is optimal */ /** @const */GLP_UNBND = exports["GLP_UNBND"] = 6, /* solution is unbounded */ /* basis factorization control parameters */ /** @const */GLP_BF_FT = exports["GLP_BF_FT"] = 1, /* LUF + Forrest-Tomlin */ /** @const */GLP_BF_BG = exports["GLP_BF_BG"] = 2, /* LUF + Schur compl. + Bartels-Golub */ /** @const */GLP_BF_GR = exports["GLP_BF_GR"] = 3, /* LUF + Schur compl. + Givens rotation */ /* simplex method control parameters */ /** @const */GLP_MSG_OFF = exports["GLP_MSG_OFF"] = 0, /* no output */ /** @const */GLP_MSG_ERR = exports["GLP_MSG_ERR"] = 1, /* warning and error messages only */ /** @const */GLP_MSG_ON = exports["GLP_MSG_ON"] = 2, /* normal output */ /** @const */GLP_MSG_ALL = exports["GLP_MSG_ALL"] = 3, /* full output */ /** @const */GLP_MSG_DBG = exports["GLP_MSG_DBG"] = 4, /* debug output */ /** @const */GLP_PRIMAL = exports["GLP_PRIMAL"] = 1, /* use primal simplex */ /** @const */GLP_DUALP = exports["GLP_DUALP"] = 2, /* use dual; if it fails, use primal */ /** @const */GLP_DUAL = exports["GLP_DUAL"] = 3, /* use dual simplex */ /** @const */GLP_PT_STD = exports["GLP_PT_STD"] = 0x11, /* standard (Dantzig rule) */ /** @const */GLP_PT_PSE = exports["GLP_PT_PSE"] = 0x22, /* projected steepest edge */ /** @const */GLP_RT_STD = exports["GLP_RT_STD"] = 0x11, /* standard (textbook) */ /** @const */GLP_RT_HAR = exports["GLP_RT_HAR"] = 0x22, /* two-pass Harris' ratio test */ /* interior-point solver control parameters */ /** @const */GLP_ORD_NONE = exports["GLP_ORD_NONE"] = 0, /* natural (original) ordering */ /** @const */GLP_ORD_QMD = exports["GLP_ORD_QMD"] = 1, /* quotient minimum degree (QMD) */ /** @const */GLP_ORD_AMD = exports["GLP_ORD_AMD"] = 2, /* approx. minimum degree (AMD) */ /** @const */GLP_ORD_SYMAMD = exports["GLP_ORD_SYMAMD"] = 3, /* approx. minimum degree (SYMAMD) */ /* integer optimizer control parameters */ /** @const */GLP_BR_FFV = exports["GLP_BR_FFV"] = 1, /* first fractional variable */ /** @const */GLP_BR_LFV = exports["GLP_BR_LFV"] = 2, /* last fractional variable */ /** @const */GLP_BR_MFV = exports["GLP_BR_MFV"] = 3, /* most fractional variable */ /** @const */GLP_BR_DTH = exports["GLP_BR_DTH"] = 4, /* heuristic by Driebeck and Tomlin */ /** @const */GLP_BR_PCH = exports["GLP_BR_PCH"] = 5, /* hybrid pseudocost heuristic */ /** @const */GLP_BT_DFS = exports["GLP_BT_DFS"] = 1, /* depth first search */ /** @const */GLP_BT_BFS = exports["GLP_BT_BFS"] = 2, /* breadth first search */ /** @const */GLP_BT_BLB = exports["GLP_BT_BLB"] = 3, /* best local bound */ /** @const */GLP_BT_BPH = exports["GLP_BT_BPH"] = 4, /* best projection heuristic */ /** @const */GLP_PP_NONE = exports["GLP_PP_NONE"] = 0, /* disable preprocessing */ /** @const */GLP_PP_ROOT = exports["GLP_PP_ROOT"] = 1, /* preprocessing only on root level */ /** @const */GLP_PP_ALL = exports["GLP_PP_ALL"] = 2, /* preprocessing on all levels */ /* additional row attributes */ /** @const */GLP_RF_REG = exports["GLP_RF_REG"] = 0, /* regular constraint */ /** @const */GLP_RF_LAZY = exports["GLP_RF_LAZY"] = 1, /* "lazy" constraint */ /** @const */GLP_RF_CUT = exports["GLP_RF_CUT"] = 2, /* cutting plane constraint */ /* row class descriptor: */ /** @const */GLP_RF_GMI = exports["GLP_RF_GMI"] = 1, /* Gomory's mixed integer cut */ /** @const */GLP_RF_MIR = exports["GLP_RF_MIR"] = 2, /* mixed integer rounding cut */ /** @const */GLP_RF_COV = exports["GLP_RF_COV"] = 3, /* mixed cover cut */ /** @const */GLP_RF_CLQ = exports["GLP_RF_CLQ"] = 4, /* clique cut */ /* enable/disable flag: */ /** @const */GLP_ON = exports["GLP_ON"] = 1, /* enable something */ /** @const */GLP_OFF = exports["GLP_OFF"] = 0, /* disable something */ /* reason codes: */ /** @const */GLP_IROWGEN = exports["GLP_IROWGEN"] = 0x01, /* request for row generation */ /** @const */GLP_IBINGO = exports["GLP_IBINGO"] = 0x02, /* better integer solution found */ /** @const */GLP_IHEUR = exports["GLP_IHEUR"] = 0x03, /* request for heuristic solution */ /** @const */GLP_ICUTGEN = exports["GLP_ICUTGEN"] = 0x04, /* request for cut generation */ /** @const */GLP_IBRANCH = exports["GLP_IBRANCH"] = 0x05, /* request for branching */ /** @const */GLP_ISELECT = exports["GLP_ISELECT"] = 0x06, /* request for subproblem selection */ /** @const */GLP_IPREPRO = exports["GLP_IPREPRO"] = 0x07, /* request for preprocessing */ /* branch selection indicator: */ /** @const */GLP_NO_BRNCH = exports["GLP_NO_BRNCH"] = 0, /* select no branch */ /** @const */GLP_DN_BRNCH = exports["GLP_DN_BRNCH"] = 1, /* select down-branch */ /** @const */GLP_UP_BRNCH = exports["GLP_UP_BRNCH"] = 2, /* select up-branch */ /* return codes: */ /** @const */GLP_EBADB = exports["GLP_EBADB"] = 0x01, /* invalid basis */ /** @const */GLP_ESING = exports["GLP_ESING"] = 0x02, /* singular matrix */ /** @const */GLP_ECOND = exports["GLP_ECOND"] = 0x03, /* ill-conditioned matrix */ /** @const */GLP_EBOUND = exports["GLP_EBOUND"] = 0x04, /* invalid bounds */ /** @const */GLP_EFAIL = exports["GLP_EFAIL"] = 0x05, /* solver failed */ /** @const */GLP_EOBJLL = exports["GLP_EOBJLL"] = 0x06, /* objective lower limit reached */ /** @const */GLP_EOBJUL = exports["GLP_EOBJUL"] = 0x07, /* objective upper limit reached */ /** @const */GLP_EITLIM = exports["GLP_EITLIM"] = 0x08, /* iteration limit exceeded */ /** @const */GLP_ETMLIM = exports["GLP_ETMLIM"] = 0x09, /* time limit exceeded */ /** @const */GLP_ENOPFS = exports["GLP_ENOPFS"] = 0x0A, /* no primal feasible solution */ /** @const */GLP_ENODFS = exports["GLP_ENODFS"] = 0x0B, /* no dual feasible solution */ /** @const */GLP_EROOT = exports["GLP_EROOT"] = 0x0C, /* root LP optimum not provided */ /** @const */GLP_ESTOP = exports["GLP_ESTOP"] = 0x0D, /* search terminated by application */ /** @const */GLP_EMIPGAP = exports["GLP_EMIPGAP"] = 0x0E, /* relative mip gap tolerance reached */ /** @const */GLP_ENOFEAS = exports["GLP_ENOFEAS"] = 0x0F, /* no primal/dual feasible solution */ /** @const */GLP_ENOCVG = exports["GLP_ENOCVG"] = 0x10, /* no convergence */ /** @const */GLP_EINSTAB = exports["GLP_EINSTAB"] = 0x11, /* numerical instability */ /** @const */GLP_EDATA = exports["GLP_EDATA"] = 0x12, /* invalid data */ /** @const */GLP_ERANGE = exports["GLP_ERANGE"] = 0x13, /* result out of range */ /* condition indicator: */ /** @const */GLP_KKT_PE = exports["GLP_KKT_PE"] = 1, /* primal equalities */ /** @const */GLP_KKT_PB = exports["GLP_KKT_PB"] = 2, /* primal bounds */ /** @const */GLP_KKT_DE = exports["GLP_KKT_DE"] = 3, /* dual equalities */ /** @const */GLP_KKT_DB = exports["GLP_KKT_DB"] = 4, /* dual bounds */ /** @const */GLP_KKT_CS = exports["GLP_KKT_CS"] = 5, /* complementary slackness */ /* MPS file format: */ /** @const */GLP_MPS_DECK = exports["GLP_MPS_DECK"] = 1, /* fixed (ancient) */ /** @const */GLP_MPS_FILE = exports["GLP_MPS_FILE"] = 2, /* free (modern) */ /* assignment problem formulation: */ /** @const */GLP_ASN_MIN = exports["GLP_ASN_MIN"] = 1, /* perfect matching (minimization) */ /** @const */GLP_ASN_MAX = exports["GLP_ASN_MAX"] = 2, /* perfect matching (maximization) */ /** @const */GLP_ASN_MMP = exports["GLP_ASN_MMP"] = 3; /* maximum matching */ function gcd(x, y){ var r; xassert(x > 0 && y > 0); while (y > 0){ r = x % y; x = y; y = r; } return x; } function gcdn(n, x){ var d = 0, j; xassert(n > 0); for (j = 1; j <= n; j++) { xassert(x[j] > 0); if (j == 1) d = x[1]; else d = gcd(d, x[j]); if (d == 1) break; } return d; } function round2n(x){ xassert(x > 0.0); var e = Math.floor(Math.log(x) / Math.log(2)) + 1; var f = x / Math.pow(2, e); return Math.pow(2, f <= 0.75 ? e-1 : e); } /* 0 - no error; * 1 - value out of range; * 2 - character string is syntactically incorrect. */ function str2num(str, callback){ var ret = Number(str); if (isNaN(ret)) return 2; switch (ret){ case Number.POSITIVE_INFINITY: case Number.NEGATIVE_INFINITY: return 1; default: callback(ret); return 0; } } function str2int(str, callback){ var ret = Number(str); if (isNaN(ret)) return 2; switch (ret){ case Number.POSITIVE_INFINITY: case Number.NEGATIVE_INFINITY: return 1; default: if (ret % 1 == 0){ callback(ret); return 0; } else { return 2 } } } function jday(d, m, y){ var c, ya, j, dd; if (!(1 <= d && d <= 31 && 1 <= m && m <= 12 && 1 <= y && y <= 4000)) return -1; if (m >= 3)m -= 3;else{m += 9;y--;} c = (y / 100)|0; ya = y - 100 * c; j = ((146097 * c) / 4)|0; j += ((1461 * ya) / 4)|0; j += ((153 * m + 2) / 5)|0; j += d + 1721119; jdate(j, function(d){dd = d}); if (d != dd) j = -1; return j; } function jdate(j, callback) { var d, m, y, ret = 0; if (!(1721426 <= j && j <= 3182395)) return 1; j -= 1721119; y = ((4 * j - 1) / 146097)|0; j = (4 * j - 1) % 146097; d = (j / 4)|0; j = ((4 * d + 3) / 1461)|0; d = (4 * d + 3) % 1461; d = ((d + 4) / 4)|0; m = ((5 * d - 3) / 153)|0; d = (5 * d - 3) % 153; d = ((d + 5) / 5)|0; y = 100 * y + j; if (m <= 9) m += 3; else{ m -= 9; y++; } callback(d, m, y); return ret; } /* return codes: */ var LPF_ESING = 1; /* singular matrix */ LPF_ECOND = 2; /* ill-conditioned matrix */ LPF_ELIMIT = 3; /* update limit reached */ var _GLPLPF_DEBUG = 0; function lpf_create_it(){ var lpf; if (_GLPLPF_DEBUG){ xprintf("lpf_create_it: warning: debug mode enabled"); } lpf = {}; lpf.valid = 0; lpf.m0_max = lpf.m0 = 0; lpf.luf = luf_create_it(); lpf.m = 0; lpf.B = null; lpf.n_max = 50; lpf.n = 0; lpf.R_ptr = lpf.R_len = null; lpf.S_ptr = lpf.S_len = null; lpf.scf = null; lpf.P_row = lpf.P_col = null; lpf.Q_row = lpf.Q_col = null; lpf.v_size = 1000; lpf.v_ptr = 0; lpf.v_ind = null; lpf.v_val = null; lpf.work1 = lpf.work2 = null; return lpf; } function lpf_factorize(lpf, m, bh, col, info){ var k, ret; if (_GLPLPF_DEBUG){ var i, j, len, ind; var B, val; } xassert(bh == bh); if (m < 1) xerror("lpf_factorize: m = " + m + "; invalid parameter"); if (m > M_MAX) xerror("lpf_factorize: m = " + m + "; matrix too big"); lpf.m0 = lpf.m = m; /* invalidate the factorization */ lpf.valid = 0; /* allocate/reallocate arrays, if necessary */ if (lpf.R_ptr == null) lpf.R_ptr = new Int32Array(1+lpf.n_max); if (lpf.R_len == null) lpf.R_len = new Int32Array(1+lpf.n_max); if (lpf.S_ptr == null) lpf.S_ptr = new Int32Array(1+lpf.n_max); if (lpf.S_len == null) lpf.S_len = new Int32Array(1+lpf.n_max); if (lpf.scf == null) lpf.scf = scf_create_it(lpf.n_max); if (lpf.v_ind == null) lpf.v_ind = new Int32Array(1+lpf.v_size); if (lpf.v_val == null) lpf.v_val = new Float64Array(1+lpf.v_size); if (lpf.m0_max < m) { lpf.m0_max = m + 100; lpf.P_row = new Int32Array(1+lpf.m0_max+lpf.n_max); lpf.P_col = new Int32Array(1+lpf.m0_max+lpf.n_max); lpf.Q_row = new Int32Array(1+lpf.m0_max+lpf.n_max); lpf.Q_col = new Int32Array(1+lpf.m0_max+lpf.n_max); lpf.work1 = new Float64Array(1+lpf.m0_max+lpf.n_max); lpf.work2 = new Float64Array(1+lpf.m0_max+lpf.n_max); } /* try to factorize the basis matrix */ switch (luf_factorize(lpf.luf, m, col, info)) { case 0: break; case LUF_ESING: ret = LPF_ESING; return ret; case LUF_ECOND: ret = LPF_ECOND; return ret; default: xassert(lpf != lpf); } /* the basis matrix has been successfully factorized */ lpf.valid = 1; if (_GLPLPF_DEBUG){ /* store the basis matrix for debugging */ xassert(m <= 32767); lpf.B = B = new Float64Array(1+m*m); ind = new Int32Array(1+m); val = new Float64Array(1+m); for (k = 1; k <= m * m; k++) B[k] = 0.0; for (j = 1; j <= m; j++) { len = col(info, j, ind, val); xassert(0 <= len && len <= m); for (k = 1; k <= len; k++) { i = ind[k]; xassert(1 <= i && i <= m); xassert(B[(i - 1) * m + j] == 0.0); xassert(val[k] != 0.0); B[(i - 1) * m + j] = val[k]; } } } /* B = B0, so there are no additional rows/columns */ lpf.n = 0; /* reset the Schur complement factorization */ scf_reset_it(lpf.scf); /* P := Q := I */ for (k = 1; k <= m; k++) { lpf.P_row[k] = lpf.P_col[k] = k; lpf.Q_row[k] = lpf.Q_col[k] = k; } /* make all SVA locations free */ lpf.v_ptr = 1; ret = 0; /* return to the calling program */ return ret; } function r_prod(lpf, y, a, x, idx){ var n = lpf.n; var R_ptr = lpf.R_ptr; var R_len = lpf.R_len; var v_ind = lpf.v_ind; var v_val = lpf.v_val; var j, beg, end, ptr; var t; for (j = 1; j <= n; j++) { if (x[j+idx] == 0.0) continue; /* y := y + alpha * R[j] * x[j] */ t = a * x[j+idx]; beg = R_ptr[j]; end = beg + R_len[j]; for (ptr = beg; ptr < end; ptr++) y[v_ind[ptr]] += t * v_val[ptr]; } } function rt_prod(lpf, y, idx, a, x){ var n = lpf.n; var R_ptr = lpf.R_ptr; var R_len = lpf.R_len; var v_ind = lpf.v_ind; var v_val = lpf.v_val; var j, beg, end, ptr; var t; for (j = 1; j <= n; j++) { /* t := (j-th column of R) * x */ t = 0.0; beg = R_ptr[j]; end = beg + R_len[j]; for (ptr = beg; ptr < end; ptr++) t += v_val[ptr] * x[v_ind[ptr]]; /* y[j] := y[j] + alpha * t */ y[j+idx] += a * t; } } function s_prod(lpf, y, idx, a, x){ var n = lpf.n; var S_ptr = lpf.S_ptr; var S_len = lpf.S_len; var v_ind = lpf.v_ind; var v_val = lpf.v_val; var i, beg, end, ptr; var t; for (i = 1; i <= n; i++) { /* t := (i-th row of S) * x */ t = 0.0; beg = S_ptr[i]; end = beg + S_len[i]; for (ptr = beg; ptr < end; ptr++) t += v_val[ptr] * x[v_ind[ptr]]; /* y[i] := y[i] + alpha * t */ y[i+idx] += a * t; } } function st_prod(lpf, y, a, x, idx){ var n = lpf.n; var S_ptr = lpf.S_ptr; var S_len = lpf.S_len; var v_ind = lpf.v_ind; var v_val = lpf.v_val; var i, beg, end, ptr; var t; for (i = 1; i <= n; i++) { if (x[i+idx] == 0.0) continue; /* y := y + alpha * S'[i] * x[i] */ t = a * x[i+idx]; beg = S_ptr[i]; end = beg + S_len[i]; for (ptr = beg; ptr < end; ptr++) y[v_ind[ptr]] += t * v_val[ptr]; } } if (_GLPLPF_DEBUG){ /*********************************************************************** * The routine check_error computes the maximal relative error between * left- and right-hand sides for the system B * x = b (if tr is zero) * or B' * x = b (if tr is non-zero), where B' is a matrix transposed * to B. (This routine is intended for debugging only.) */ function check_error(lpf, tr, x, b){ var m = lpf.m; var B = lpf.B; var i, j; var d, dmax = 0.0, s, t, tmax; for (i = 1; i <= m; i++) { s = 0.0; tmax = 1.0; for (j = 1; j <= m; j++) { if (!tr) t = B[m * (i - 1) + j] * x[j]; else t = B[m * (j - 1) + i] * x[j]; if (tmax < Math.abs(t)) tmax = Math.abs(t); s += t; } d = Math.abs(s - b[i]) / tmax; if (dmax < d) dmax = d; } if (dmax > 1e-8) xprintf((!tr ? "lpf_ftran" : "lpf_btran") + ": dmax = " + dmax + "; relative error too large"); } } function lpf_ftran(lpf, x){ var m0 = lpf.m0; var m = lpf.m; var n = lpf.n; var P_col = lpf.P_col; var Q_col = lpf.Q_col; var fg = lpf.work1; var f = fg; var g = fg; var i, ii; if (_GLPLPF_DEBUG){var b} if (!lpf.valid) xerror("lpf_ftran: the factorization is not valid"); xassert(0 <= m && m <= m0 + n); if (_GLPLPF_DEBUG){ /* save the right-hand side vector */ b = new Float64Array(1+m); for (i = 1; i <= m; i++) b[i] = x[i]; } /* (f g) := inv(P) * (b 0) */ for (i = 1; i <= m0 + n; i++) fg[i] = ((ii = P_col[i]) <= m ? x[ii] : 0.0); /* f1 := inv(L0) * f */ luf_f_solve(lpf.luf, 0, f); /* g1 := g - S * f1 */ s_prod(lpf, g, m0, -1.0, f); /* g2 := inv(C) * g1 */ scf_solve_it(lpf.scf, 0, g, m0); /* f2 := inv(U0) * (f1 - R * g2) */ r_prod(lpf, f, -1.0, g, m0); luf_v_solve(lpf.luf, 0, f); /* (x y) := inv(Q) * (f2 g2) */ for (i = 1; i <= m; i++) x[i] = fg[Q_col[i]]; if (_GLPLPF_DEBUG){ /* check relative error in solution */ check_error(lpf, 0, x, b); } } function lpf_btran(lpf, x){ var m0 = lpf.m0; var m = lpf.m; var n = lpf.n; var P_row = lpf.P_row; var Q_row = lpf.Q_row; var fg = lpf.work1; var f = fg; var g = fg; var i, ii; if (_GLPLPF_DEBUG){var b} if (!lpf.valid) xerror("lpf_btran: the factorization is not valid"); xassert(0 <= m && m <= m0 + n); if (_GLPLPF_DEBUG){ /* save the right-hand side vector */ b = new Float64Array(1+m); for (i = 1; i <= m; i++) b[i] = x[i]; } /* (f g) := Q * (b 0) */ for (i = 1; i <= m0 + n; i++) fg[i] = ((ii = Q_row[i]) <= m ? x[ii] : 0.0); /* f1 := inv(U'0) * f */ luf_v_solve(lpf.luf, 1, f); /* g1 := inv(C') * (g - R' * f1) */ rt_prod(lpf, g, m0, -1.0, f); scf_solve_it(lpf.scf, 1, g, m0); /* g2 := g1 */ //g = g; /* f2 := inv(L'0) * (f1 - S' * g2) */ st_prod(lpf, f, -1.0, g, m0); luf_f_solve(lpf.luf, 1, f); /* (x y) := P * (f2 g2) */ for (i = 1; i <= m; i++) x[i] = fg[P_row[i]]; if (_GLPLPF_DEBUG){ /* check relative error in solution */ check_error(lpf, 1, x, b); } } function enlarge_sva(lpf, new_size){ var v_size = lpf.v_size; var used = lpf.v_ptr - 1; var v_ind = lpf.v_ind; var v_val = lpf.v_val; xassert(v_size < new_size); while (v_size < new_size) v_size += v_size; lpf.v_size = v_size; lpf.v_ind = new Int32Array(1+v_size); lpf.v_val = new Float64Array(1+v_size); xassert(used >= 0); xcopyArr(lpf.v_ind, 1, v_ind, 1, used); xcopyArr(lpf.v_val, 1, v_val, 1, used); } function lpf_update_it(lpf, j, bh, len, ind, idx, val){ var m0 = lpf.m0; var m = lpf.m; if (_GLPLPF_DEBUG){var B = lpf.B} var n = lpf.n; var R_ptr = lpf.R_ptr; var R_len = lpf.R_len; var S_ptr = lpf.S_ptr; var S_len = lpf.S_len; var P_row = lpf.P_row; var P_col = lpf.P_col; var Q_row = lpf.Q_row; var Q_col = lpf.Q_col; var v_ptr = lpf.v_ptr; var v_ind = lpf.v_ind; var v_val = lpf.v_val; var a = lpf.work2; /* new column */ var fg = lpf.work1, f = fg, g = fg; var vw = lpf.work2, v = vw, w = vw; var x = g, y = w, z; var i, ii, k, ret; xassert(bh == bh); if (!lpf.valid) xerror("lpf_update_it: the factorization is not valid"); if (!(1 <= j && j <= m)) xerror("lpf_update_it: j = " + j + "; column number out of range"); xassert(0 <= m && m <= m0 + n); /* check if the basis factorization can be expanded */ if (n == lpf.n_max) { lpf.valid = 0; ret = LPF_ELIMIT; return ret; } /* convert new j-th column of B to dense format */ for (i = 1; i <= m; i++) a[i] = 0.0; for (k = 1; k <= len; k++) { i = ind[idx + k]; if (!(1 <= i && i <= m)) xerror("lpf_update_it: ind[" + k + "] = " + i + "; row number out of range"); if (a[i] != 0.0) xerror("lpf_update_it: ind[" + k + "] = " + i + "; duplicate row index not allowed"); if (val[k] == 0.0) xerror("lpf_update_it: val[" + k + "] = " + val[k] + "; zero element not allowed"); a[i] = val[k]; } if (_GLPLPF_DEBUG){ /* change column in the basis matrix for debugging */ for (i = 1; i <= m; i++) B[(i - 1) * m + j] = a[i]; } /* (f g) := inv(P) * (a 0) */ for (i = 1; i <= m0+n; i++) fg[i] = ((ii = P_col[i]) <= m ? a[ii] : 0.0); /* (v w) := Q * (ej 0) */ for (i = 1; i <= m0+n; i++) vw[i] = 0.0; vw[Q_col[j]] = 1.0; /* f1 := inv(L0) * f (new column of R) */ luf_f_solve(lpf.luf, 0, f); /* v1 := inv(U'0) * v (new row of S) */ luf_v_solve(lpf.luf, 1, v); /* we need at most 2 * m0 available locations in the SVA to store new column of matrix R and new row of matrix S */ if (lpf.v_size < v_ptr + m0 + m0) { enlarge_sva(lpf, v_ptr + m0 + m0); v_ind = lpf.v_ind; v_val = lpf.v_val; } /* store new column of R */ R_ptr[n+1] = v_ptr; for (i = 1; i <= m0; i++) { if (f[i] != 0.0){ v_ind[v_ptr] = i; v_val[v_ptr] = f[i]; v_ptr++; } } R_len[n+1] = v_ptr - lpf.v_ptr; lpf.v_ptr = v_ptr; /* store new row of S */ S_ptr[n+1] = v_ptr; for (i = 1; i <= m0; i++) { if (v[i] != 0.0){ v_ind[v_ptr] = i; v_val[v_ptr] = v[i]; v_ptr++; } } S_len[n+1] = v_ptr - lpf.v_ptr; lpf.v_ptr = v_ptr; /* x := g - S * f1 (new column of C) */ s_prod(lpf, x, 0, -1.0, f); /* y := w - R' * v1 (new row of C) */ rt_prod(lpf, y, 0, -1.0, v); /* z := - v1 * f1 (new diagonal element of C) */ z = 0.0; for (i = 1; i <= m0; i++) z -= v[i] * f[i]; /* update factorization of new matrix C */ switch (scf_update_exp(lpf.scf, x, m0, y, m0, z)) { case 0: break; case SCF_ESING: lpf.valid = 0; ret = LPF_ESING; return ret; case SCF_ELIMIT: xassert(lpf != lpf); default: xassert(lpf != lpf); } /* expand matrix P */ P_row[m0+n+1] = P_col[m0+n+1] = m0+n+1; /* expand matrix Q */ Q_row[m0+n+1] = Q_col[m0+n+1] = m0+n+1; /* permute j-th and last (just added) column of matrix Q */ i = Q_col[j]; ii = Q_col[m0+n+1]; Q_row[i] = m0+n+1; Q_col[m0+n+1] = i; Q_row[ii] = j; Q_col[j] = ii; /* increase the number of additional rows and columns */ lpf.n++; xassert(lpf.n <= lpf.n_max); /* the factorization has been successfully updated */ ret = 0; /* return to the calling program */ return ret; } var /* problem class: */ /** @const */LPX_LP = exports["LPX_LP"] = 100, /* linear programming (LP) */ /** @const */LPX_MIP = exports["LPX_MIP"] = 101, /* mixed integer programming (MIP) */ /* type of auxiliary/structural variable: */ /** @const */LPX_FR = exports["LPX_FR"] = 110, /* free variable */ /** @const */LPX_LO = exports["LPX_LO"] = 111, /* variable with lower bound */ /** @const */LPX_UP = exports["LPX_UP"] = 112, /* variable with upper bound */ /** @const */LPX_DB = exports["LPX_DB"] = 113, /* double-bounded variable */ /** @const */LPX_FX = exports["LPX_FX"] = 114, /* fixed variable */ /* optimization direction flag: */ /** @const */LPX_MIN = exports["LPX_MIN"] = 120, /* minimization */ /** @const */LPX_MAX = exports["LPX_MAX"] = 121, /* maximization */ /* status of primal basic solution: */ /** @const */LPX_P_UNDEF = exports["LPX_P_UNDEF"] = 132, /* primal solution is undefined */ /** @const */LPX_P_FEAS = exports["LPX_P_FEAS"] = 133, /* solution is primal feasible */ /** @const */LPX_P_INFEAS = exports["LPX_P_INFEAS"] = 134, /* solution is primal infeasible */ /** @const */LPX_P_NOFEAS = exports["LPX_P_NOFEAS"] = 135, /* no primal feasible solution exists */ /* status of dual basic solution: */ /** @const */LPX_D_UNDEF = exports["LPX_D_UNDEF"] = 136, /* dual solution is undefined */ /** @const */LPX_D_FEAS = exports["LPX_D_FEAS"] = 137, /* solution is dual feasible */ /** @const */LPX_D_INFEAS = exports["LPX_D_INFEAS"] = 138, /* solution is dual infeasible */ /** @const */LPX_D_NOFEAS = exports["LPX_D_NOFEAS"] = 139, /* no dual feasible solution exists */ /* status of auxiliary/structural variable: */ /** @const */LPX_BS = exports["LPX_BS"] = 140, /* basic variable */ /** @const */LPX_NL = exports["LPX_NL"] = 141, /* non-basic variable on lower bound */ /** @const */LPX_NU = exports["LPX_NU"] = 142, /* non-basic variable on upper bound */ /** @const */LPX_NF = exports["LPX_NF"] = 143, /* non-basic free variable */ /** @const */LPX_NS = exports["LPX_NS"] = 144, /* non-basic fixed variable */ /* status of interior-point solution: */ /** @const */LPX_T_UNDEF = exports["LPX_T_UNDEF"] = 150, /* interior solution is undefined */ /** @const */LPX_T_OPT = exports["LPX_T_OPT"] = 151, /* interior solution is optimal */ /* kind of structural variable: */ /** @const */LPX_CV = exports["LPX_CV"] = 160, /* continuous variable */ /** @const */LPX_IV = exports["LPX_IV"] = 161, /* integer variable */ /* status of integer solution: */ /** @const */LPX_I_UNDEF = exports["LPX_I_UNDEF"] = 170, /* integer solution is undefined */ /** @const */LPX_I_OPT = exports["LPX_I_OPT"] = 171, /* integer solution is optimal */ /** @const */LPX_I_FEAS = exports["LPX_I_FEAS"] = 172, /* integer solution is feasible */ /** @const */LPX_I_NOFEAS = exports["LPX_I_NOFEAS"] = 173, /* no integer solution exists */ /* status codes reported by the routine lpx_get_status: */ /** @const */LPX_OPT = exports["LPX_OPT"] = 180, /* optimal */ /** @const */LPX_FEAS = exports["LPX_FEAS"] = 181, /* feasible */ /** @const */LPX_INFEAS = exports["LPX_INFEAS"] = 182, /* infeasible */ /** @const */LPX_NOFEAS = exports["LPX_NOFEAS"] = 183, /* no feasible */ /** @const */LPX_UNBND = exports["LPX_UNBND"] = 184, /* unbounded */ /** @const */LPX_UNDEF = exports["LPX_UNDEF"] = 185, /* undefined */ /* exit codes returned by solver routines: */ /** @const */LPX_E_OK = exports["LPX_E_OK"] = 200, /* success */ /** @const */LPX_E_EMPTY = exports["LPX_E_EMPTY"] = 201, /* empty problem */ /** @const */LPX_E_BADB = exports["LPX_E_BADB"] = 202, /* invalid initial basis */ /** @const */LPX_E_INFEAS = exports["LPX_E_INFEAS"] = 203, /* infeasible initial solution */ /** @const */LPX_E_FAULT = exports["LPX_E_FAULT"] = 204, /* unable to start the search */ /** @const */LPX_E_OBJLL = exports["LPX_E_OBJLL"] = 205, /* objective lower limit reached */ /** @const */LPX_E_OBJUL = exports["LPX_E_OBJUL"] = 206, /* objective upper limit reached */ /** @const */LPX_E_ITLIM = exports["LPX_E_ITLIM"] = 207, /* iterations limit exhausted */ /** @const */LPX_E_TMLIM = exports["LPX_E_TMLIM"] = 208, /* time limit exhausted */ /** @const */LPX_E_NOFEAS = exports["LPX_E_NOFEAS"] = 209, /* no feasible solution */ /** @const */LPX_E_INSTAB = exports["LPX_E_INSTAB"] = 210, /* numerical instability */ /** @const */LPX_E_SING = exports["LPX_E_SING"] = 211, /* problems with basis matrix */ /** @const */LPX_E_NOCONV = exports["LPX_E_NOCONV"] = 212, /* no convergence (interior) */ /** @const */LPX_E_NOPFS = exports["LPX_E_NOPFS"] = 213, /* no primal feas. sol. (LP presolver) */ /** @const */LPX_E_NODFS = exports["LPX_E_NODFS"] = 214, /* no dual feas. sol. (LP presolver) */ /** @const */LPX_E_MIPGAP = exports["LPX_E_MIPGAP"] = 215, /* relative mip gap tolerance reached */ /* control parameter identifiers: */ /** @const */LPX_K_MSGLEV = exports["LPX_K_MSGLEV"] = 300, /* lp.msg_lev */ /** @const */LPX_K_SCALE = exports["LPX_K_SCALE"] = 301, /* lp.scale */ /** @const */LPX_K_DUAL = exports["LPX_K_DUAL"] = 302, /* lp.dual */ /** @const */LPX_K_PRICE = exports["LPX_K_PRICE"] = 303, /* lp.price */ /** @const */LPX_K_RELAX = exports["LPX_K_RELAX"] = 304, /* lp.relax */ /** @const */LPX_K_TOLBND = exports["LPX_K_TOLBND"] = 305, /* lp.tol_bnd */ /** @const */LPX_K_TOLDJ = exports["LPX_K_TOLDJ"] = 306, /* lp.tol_dj */ /** @const */LPX_K_TOLPIV = exports["LPX_K_TOLPIV"] = 307, /* lp.tol_piv */ /** @const */LPX_K_ROUND = exports["LPX_K_ROUND"] = 308, /* lp.round */ /** @const */LPX_K_OBJLL = exports["LPX_K_OBJLL"] = 309, /* lp.obj_ll */ /** @const */LPX_K_OBJUL = exports["LPX_K_OBJUL"] = 310, /* lp.obj_ul */ /** @const */LPX_K_ITLIM = exports["LPX_K_ITLIM"] = 311, /* lp.it_lim */ /** @const */LPX_K_ITCNT = exports["LPX_K_ITCNT"] = 312, /* lp.it_cnt */ /** @const */LPX_K_TMLIM = exports["LPX_K_TMLIM"] = 313, /* lp.tm_lim */ /** @const */LPX_K_OUTFRQ = exports["LPX_K_OUTFRQ"] = 314, /* lp.out_frq */ /** @const */LPX_K_OUTDLY = exports["LPX_K_OUTDLY"] = 315, /* lp.out_dly */ /** @const */LPX_K_BRANCH = exports["LPX_K_BRANCH"] = 316, /* lp.branch */ /** @const */LPX_K_BTRACK = exports["LPX_K_BTRACK"] = 317, /* lp.btrack */ /** @const */LPX_K_TOLINT = exports["LPX_K_TOLINT"] = 318, /* lp.tol_int */ /** @const */LPX_K_TOLOBJ = exports["LPX_K_TOLOBJ"] = 319, /* lp.tol_obj */ /** @const */LPX_K_MPSINFO = exports["LPX_K_MPSINFO"] = 320, /* lp.mps_info */ /** @const */LPX_K_MPSOBJ = exports["LPX_K_MPSOBJ"] = 321, /* lp.mps_obj */ /** @const */LPX_K_MPSORIG = exports["LPX_K_MPSORIG"] = 322, /* lp.mps_orig */ /** @const */LPX_K_MPSWIDE = exports["LPX_K_MPSWIDE"] = 323, /* lp.mps_wide */ /** @const */LPX_K_MPSFREE = exports["LPX_K_MPSFREE"] = 324, /* lp.mps_free */ /** @const */LPX_K_MPSSKIP = exports["LPX_K_MPSSKIP"] = 325, /* lp.mps_skip */ /** @const */LPX_K_LPTORIG = exports["LPX_K_LPTORIG"] = 326, /* lp.lpt_orig */ /** @const */LPX_K_PRESOL = exports["LPX_K_PRESOL"] = 327, /* lp.presol */ /** @const */LPX_K_BINARIZE = exports["LPX_K_BINARIZE"] = 328, /* lp.binarize */ /** @const */LPX_K_USECUTS = exports["LPX_K_USECUTS"] = 329, /* lp.use_cuts */ /** @const */LPX_K_BFTYPE = exports["LPX_K_BFTYPE"] = 330, /* lp.bfcp.type */ /** @const */LPX_K_MIPGAP = exports["LPX_K_MIPGAP"] = 331, /* lp.mip_gap */ /** @const */LPX_C_COVER = exports["LPX_C_COVER"] = 0x01, /* mixed cover cuts */ /** @const */LPX_C_CLIQUE = exports["LPX_C_CLIQUE"] = 0x02, /* clique cuts */ /** @const */LPX_C_GOMORY = exports["LPX_C_GOMORY"] = 0x04, /* Gomory's mixed integer cuts */ /** @const */LPX_C_MIR = exports["LPX_C_MIR"] = 0x08, /* mixed integer rounding cuts */ /** @const */LPX_C_ALL = exports["LPX_C_ALL"] = 0xFF; function lpx_create_prob(){ /* create problem object */ return glp_create_prob(); } function lpx_set_prob_name(lp, name) { /* assign (change) problem name */ glp_set_prob_name(lp, name); } function lpx_set_obj_name(lp, name){ /* assign (change) objective function name */ glp_set_obj_name(lp, name); } function lpx_set_obj_dir(lp, dir){ /* set (change) optimization direction flag */ glp_set_obj_dir(lp, dir - LPX_MIN + GLP_MIN); } function lpx_add_rows(lp, nrs){ /* add new rows to problem object */ return glp_add_rows(lp, nrs); } function lpx_add_cols(lp, ncs){ /* add new columns to problem object */ return glp_add_cols(lp, ncs); } function lpx_set_row_name(lp, i, name) { /* assign (change) row name */ glp_set_row_name(lp, i, name); } function lpx_set_col_name(lp, j, name){ /* assign (change) column name */ glp_set_col_name(lp, j, name); } function lpx_set_row_bnds(lp, i, type, lb, ub){ /* set (change) row bounds */ glp_set_row_bnds(lp, i, type - LPX_FR + GLP_FR, lb, ub); } function lpx_set_col_bnds(lp, j, type, lb, ub){ /* set (change) column bounds */ glp_set_col_bnds(lp, j, type - LPX_FR + GLP_FR, lb, ub); } function lpx_set_obj_coef(lp, j, coef){ /* set (change) obj. coefficient or constant term */ glp_set_obj_coef(lp, j, coef); } function lpx_set_mat_row(lp, i, len, ind, val){ /* set (replace) row of the constraint matrix */ glp_set_mat_row(lp, i, len, ind, val); } function lpx_set_mat_col(lp, j, len, ind, val){ /* set (replace) column of the constraint matrix */ glp_set_mat_col(lp, j, len, ind, val); } function lpx_load_matrix(lp, ne, ia, ja, ar){ /* load (replace) the whole constraint matrix */ glp_load_matrix(lp, ne, ia, ja, ar); } function lpx_del_rows(lp, nrs, num){ /* delete specified rows from problem object */ glp_del_rows(lp, nrs, num); } function lpx_del_cols(lp, ncs, num){ /* delete specified columns from problem object */ glp_del_cols(lp, ncs, num); } function lpx_get_prob_name(lp){ /* retrieve problem name */ return glp_get_prob_name(lp); } function lpx_get_obj_name(lp){ /* retrieve objective function name */ return glp_get_obj_name(lp); } function lpx_get_obj_dir(lp){ /* retrieve optimization direction flag */ return glp_get_obj_dir(lp) - GLP_MIN + LPX_MIN; } function lpx_get_num_rows(lp){ /* retrieve number of rows */ return glp_get_num_rows(lp); } function lpx_get_num_cols(lp){ /* retrieve number of columns */ return glp_get_num_cols(lp); } function lpx_get_row_name(lp, i){ /* retrieve row name */ return glp_get_row_name(lp, i); } function lpx_get_col_name(lp, j){ /* retrieve column name */ return glp_get_col_name(lp, j); } function lpx_get_row_type(lp, i){ /* retrieve row type */ return glp_get_row_type(lp, i) - GLP_FR + LPX_FR; } function lpx_get_row_lb(lp, i){ /* retrieve row lower bound */ var lb = glp_get_row_lb(lp, i); if (lb == -DBL_MAX) lb = 0.0; return lb; } function lpx_get_row_ub(lp, i){ /* retrieve row upper bound */ var ub = glp_get_row_ub(lp, i); if (ub == +DBL_MAX) ub = 0.0; return ub; } function lpx_get_row_bnds(lp, i, callback){ /* retrieve row bounds */ callback(lpx_get_row_type(lp, i), lpx_get_row_lb(lp, i), lpx_get_row_ub(lp, i)); } function lpx_get_col_type(lp, j){ /* retrieve column type */ return glp_get_col_type(lp, j) - GLP_FR + LPX_FR; } function lpx_get_col_lb(lp, j){ /* retrieve column lower bound */ var lb = glp_get_col_lb(lp, j); if (lb == -DBL_MAX) lb = 0.0; return lb; } function lpx_get_col_ub(lp, j){ /* retrieve column upper bound */ var ub = glp_get_col_ub(lp, j); if (ub == +DBL_MAX) ub = 0.0; return ub; } function lpx_get_col_bnds(lp, j, callback) { /* retrieve column bounds */ callback(lpx_get_col_type(lp, j), lpx_get_col_lb(lp, j), lpx_get_col_ub(lp, j)); } function lpx_get_obj_coef(lp, j){ /* retrieve obj. coefficient or constant term */ return glp_get_obj_coef(lp, j); } function lpx_get_num_nz(lp){ /* retrieve number of constraint coefficients */ return glp_get_num_nz(lp); } function lpx_get_mat_row(lp, i, ind, val){ /* retrieve row of the constraint matrix */ return glp_get_mat_row(lp, i, ind, val); } function lpx_get_mat_col(lp, j, ind, val){ /* retrieve column of the constraint matrix */ return glp_get_mat_col(lp, j, ind, val); } function lpx_create_index(lp){ /* create the name index */ glp_create_index(lp); } function lpx_find_row(lp, name){ /* find row by its name */ return glp_find_row(lp, name); } function lpx_find_col(lp, name){ /* find column by its name */ return glp_find_col(lp, name); } function lpx_delete_index(lp){ /* delete the name index */ glp_delete_index(lp); } function lpx_scale_prob(lp){ /* scale problem data */ switch (lpx_get_int_parm(lp, LPX_K_SCALE)) { case 0: /* no scaling */ glp_unscale_prob(lp); break; case 1: /* equilibration scaling */ glp_scale_prob(lp, GLP_SF_EQ); break; case 2: /* geometric mean scaling */ glp_scale_prob(lp, GLP_SF_GM); break; case 3: /* geometric mean scaling, then equilibration scaling */ glp_scale_prob(lp, GLP_SF_GM | GLP_SF_EQ); break; default: xassert(lp != lp); } } function lpx_unscale_prob(lp){ /* unscale problem data */ glp_unscale_prob(lp); } function lpx_set_row_stat(lp, i, stat){ /* set (change) row status */ glp_set_row_stat(lp, i, stat - LPX_BS + GLP_BS); } function lpx_set_col_stat(lp, j, stat){ /* set (change) column status */ glp_set_col_stat(lp, j, stat - LPX_BS + GLP_BS); } function lpx_std_basis(lp){ /* construct standard initial LP basis */ glp_std_basis(lp); } function lpx_adv_basis(lp){ /* construct advanced initial LP basis */ glp_adv_basis(lp, 0); } function lpx_cpx_basis(lp){ /* construct Bixby's initial LP basis */ glp_cpx_basis(lp); } function fill_smcp(lp, parm){ //glp_init_smcp(parm); switch (lpx_get_int_parm(lp, LPX_K_MSGLEV)) { case 0: parm.msg_lev = GLP_MSG_OFF; break; case 1: parm.msg_lev = GLP_MSG_ERR; break; case 2: parm.msg_lev = GLP_MSG_ON; break; case 3: parm.msg_lev = GLP_MSG_ALL; break; default: xassert(lp != lp); } switch (lpx_get_int_parm(lp, LPX_K_DUAL)) { case 0: parm.meth = GLP_PRIMAL; break; case 1: parm.meth = GLP_DUAL; break; default: xassert(lp != lp); } switch (lpx_get_int_parm(lp, LPX_K_PRICE)) { case 0: parm.pricing = GLP_PT_STD; break; case 1: parm.pricing = GLP_PT_PSE; break; default: xassert(lp != lp); } if (lpx_get_real_parm(lp, LPX_K_RELAX) == 0.0) parm.r_test = GLP_RT_STD; else parm.r_test = GLP_RT_HAR; parm.tol_bnd = lpx_get_real_parm(lp, LPX_K_TOLBND); parm.tol_dj = lpx_get_real_parm(lp, LPX_K_TOLDJ); parm.tol_piv = lpx_get_real_parm(lp, LPX_K_TOLPIV); parm.obj_ll = lpx_get_real_parm(lp, LPX_K_OBJLL); parm.obj_ul = lpx_get_real_parm(lp, LPX_K_OBJUL); if (lpx_get_int_parm(lp, LPX_K_ITLIM) < 0) parm.it_lim = INT_MAX; else parm.it_lim = lpx_get_int_parm(lp, LPX_K_ITLIM); if (lpx_get_real_parm(lp, LPX_K_TMLIM) < 0.0) parm.tm_lim = INT_MAX; else parm.tm_lim = (1000.0 * lpx_get_real_parm(lp, LPX_K_TMLIM))|0; parm.out_frq = lpx_get_int_parm(lp, LPX_K_OUTFRQ); parm.out_dly = (1000.0 * lpx_get_real_parm(lp, LPX_K_OUTDLY))|0; switch (lpx_get_int_parm(lp, LPX_K_PRESOL)) { case 0: parm.presolve = GLP_OFF; break; case 1: parm.presolve = GLP_ON; break; default: xassert(lp != lp); } } function lpx_simplex(lp){ /* easy-to-use driver to the simplex method */ var parm = new SMCP(); var ret; fill_smcp(lp, parm); ret = glp_simplex(lp, parm); switch (ret) { case 0: ret = LPX_E_OK; break; case GLP_EBADB: case GLP_ESING: case GLP_ECOND: case GLP_EBOUND: ret = LPX_E_FAULT; break; case GLP_EFAIL: ret = LPX_E_SING; break; case GLP_EOBJLL: ret = LPX_E_OBJLL; break; case GLP_EOBJUL: ret = LPX_E_OBJUL; break; case GLP_EITLIM: ret = LPX_E_ITLIM; break; case GLP_ETMLIM: ret = LPX_E_TMLIM; break; case GLP_ENOPFS: ret = LPX_E_NOPFS; break; case GLP_ENODFS: ret = LPX_E_NODFS; break; default: xassert(ret != ret); } return ret; } function lpx_exact(lp){ /* easy-to-use driver to the exact simplex method */ var parm = new SMCP(); var ret; fill_smcp(lp, parm); ret = glp_exact(lp, parm); switch (ret) { case 0: ret = LPX_E_OK; break; case GLP_EBADB: case GLP_ESING: case GLP_EBOUND: case GLP_EFAIL: ret = LPX_E_FAULT; break; case GLP_EITLIM: ret = LPX_E_ITLIM; break; case GLP_ETMLIM: ret = LPX_E_TMLIM; break; default: xassert(ret != ret); } return ret; } function lpx_get_status(lp){ /* retrieve generic status of basic solution */ var status; switch (glp_get_status(lp)) { case GLP_OPT: status = LPX_OPT; break; case GLP_FEAS: status = LPX_FEAS; break; case GLP_INFEAS: status = LPX_INFEAS; break; case GLP_NOFEAS: status = LPX_NOFEAS; break; case GLP_UNBND: status = LPX_UNBND; break; case GLP_UNDEF: status = LPX_UNDEF; break; default: xassert(lp != lp); } return status; } function lpx_get_prim_stat(lp){ /* retrieve status of primal basic solution */ return glp_get_prim_stat(lp) - GLP_UNDEF + LPX_P_UNDEF; } function lpx_get_dual_stat(lp){ /* retrieve status of dual basic solution */ return glp_get_dual_stat(lp) - GLP_UNDEF + LPX_D_UNDEF; } function lpx_get_obj_val(lp){ /* retrieve objective value (basic solution) */ return glp_get_obj_val(lp); } function lpx_get_row_stat(lp, i){ /* retrieve row status (basic solution) */ return glp_get_row_stat(lp, i) - GLP_BS + LPX_BS; } function lpx_get_row_prim(lp, i){ /* retrieve row primal value (basic solution) */ return glp_get_row_prim(lp, i); } function lpx_get_row_dual(lp, i){ /* retrieve row dual value (basic solution) */ return glp_get_row_dual(lp, i); } function lpx_get_row_info(lp, i, callback){ /* obtain row solution information */ callback(lpx_get_row_stat(lp, i), lpx_get_row_prim(lp, i), lpx_get_row_dual(lp, i)) } function lpx_get_col_stat(lp, j){ /* retrieve column status (basic solution) */ return glp_get_col_stat(lp, j) - GLP_BS + LPX_BS; } function lpx_get_col_prim(lp, j){ /* retrieve column primal value (basic solution) */ return glp_get_col_prim(lp, j); } function lpx_get_col_dual(lp, j){ /* retrieve column dual value (basic solution) */ return glp_get_col_dual(lp, j); } function lpx_get_col_info(lp, j, callback){ /* obtain column solution information */ callback(lpx_get_col_stat(lp, j), lpx_get_col_prim(lp, j), lpx_get_col_dual(lp, j)); } function lpx_get_ray_info(lp){ /* determine what causes primal unboundness */ return glp_get_unbnd_ray(lp); } function lpx_check_kkt(lp, scaled, kkt){ /* check Karush-Kuhn-Tucker conditions */ xassert(scaled == scaled); glp_check_kkt(lp, GLP_SOL, GLP_KKT_PE, function(ae_max, ae_ind, re_max, re_ind){ kkt.pe_ae_max = ae_max; kkt.pe_ae_row = ae_ind; kkt.pe_re_max = re_max; kkt.pe_re_row = re_ind; if (re_max <= 1e-9) kkt.pe_quality = 'H'; else if (re_max <= 1e-6) kkt.pe_quality = 'M'; else if (re_max <= 1e-3) kkt.pe_quality = 'L'; else kkt.pe_quality = '?'; } ); glp_check_kkt(lp, GLP_SOL, GLP_KKT_PB, function(ae_max, ae_ind, re_max, re_ind){ kkt.pb_ae_max = ae_max; kkt.pb_ae_ind = ae_ind; kkt.pb_re_max = re_max; kkt.pb_re_ind = re_ind; if (re_max <= 1e-9) kkt.pb_quality = 'H'; else if (re_max <= 1e-6) kkt.pb_quality = 'M'; else if (re_max <= 1e-3) kkt.pb_quality = 'L'; else kkt.pb_quality = '?'; } ); glp_check_kkt(lp, GLP_SOL, GLP_KKT_DE, function(ae_max, ae_ind, re_max, re_ind){ kkt.de_ae_max = ae_max; if (ae_ind == 0) kkt.de_ae_col = 0; else kkt.de_ae_col = ae_ind - lp.m; kkt.de_re_max = re_max; if (re_ind == 0) kkt.de_re_col = 0; else kkt.de_re_col = ae_ind - lp.m; if (re_max <= 1e-9) kkt.de_quality = 'H'; else if (re_max <= 1e-6) kkt.de_quality = 'M'; else if (re_max <= 1e-3) kkt.de_quality = 'L'; else kkt.de_quality = '?'; } ); glp_check_kkt(lp, GLP_SOL, GLP_KKT_DB, function(ae_max, ae_ind, re_max, re_ind){ kkt.db_ae_max = ae_max; kkt.db_ae_ind = ae_ind; kkt.db_re_max = re_max; kkt.db_re_ind = re_ind; if (re_max <= 1e-9) kkt.db_quality = 'H'; else if (re_max <= 1e-6) kkt.db_quality = 'M'; else if (re_max <= 1e-3) kkt.db_quality = 'L'; else kkt.db_quality = '?'; kkt.cs_ae_max = 0.0; kkt.cs_ae_ind = 0; kkt.cs_re_max = 0.0; kkt.cs_re_ind = 0; kkt.cs_quality = 'H'; } ); } function lpx_warm_up(lp){ /* "warm up" LP basis */ var ret = glp_warm_up(lp); if (ret == 0) ret = LPX_E_OK; else if (ret == GLP_EBADB) ret = LPX_E_BADB; else if (ret == GLP_ESING) ret = LPX_E_SING; else if (ret == GLP_ECOND) ret = LPX_E_SING; else xassert(ret != ret); return ret; } function lpx_eval_tab_row(lp, k, ind, val){ /* compute row of the simplex tableau */ return glp_eval_tab_row(lp, k, ind, val); } function lpx_eval_tab_col(lp, k, ind, val){ /* compute column of the simplex tableau */ return glp_eval_tab_col(lp, k, ind, val); } function lpx_transform_row(lp, len, ind, val){ /* transform explicitly specified row */ return glp_transform_row(lp, len, ind, val); } function lpx_transform_col(lp, len, ind, val){ /* transform explicitly specified column */ return glp_transform_col(lp, len, ind, val); } function lpx_prim_ratio_test(lp, len, ind, val, how, tol){ /* perform primal ratio test */ var piv = glp_prim_rtest(lp, len, ind, val, how, tol); xassert(0 <= piv && piv <= len); return piv == 0 ? 0 : ind[piv]; } function lpx_dual_ratio_test(lp, len, ind, val, how, tol){ /* perform dual ratio test */ var piv = glp_dual_rtest(lp, len, ind, val, how, tol); xassert(0 <= piv && piv <= len); return piv == 0 ? 0 : ind[piv]; } function lpx_interior(lp){ /* easy-to-use driver to the interior-point method */ var ret = glp_interior(lp, null); switch (ret) { case 0: ret = LPX_E_OK; break; case GLP_EFAIL: ret = LPX_E_FAULT; break; case GLP_ENOFEAS: ret = LPX_E_NOFEAS; break; case GLP_ENOCVG: ret = LPX_E_NOCONV; break; case GLP_EITLIM: ret = LPX_E_ITLIM; break; case GLP_EINSTAB: ret = LPX_E_INSTAB; break; default: xassert(ret != ret); } return ret; } function lpx_ipt_status(lp){ /* retrieve status of interior-point solution */ var status; switch (glp_ipt_status(lp)) { case GLP_UNDEF: status = LPX_T_UNDEF; break; case GLP_OPT: status = LPX_T_OPT; break; default: xassert(lp != lp); } return status; } function lpx_ipt_obj_val(lp){ /* retrieve objective value (interior point) */ return glp_ipt_obj_val(lp); } function lpx_ipt_row_prim(lp, i){ /* retrieve row primal value (interior point) */ return glp_ipt_row_prim(lp, i); } function lpx_ipt_row_dual(lp, i){ /* retrieve row dual value (interior point) */ return glp_ipt_row_dual(lp, i); } function lpx_ipt_col_prim(lp, j){ /* retrieve column primal value (interior point) */ return glp_ipt_col_prim(lp, j); } function lpx_ipt_col_dual(lp, j){ /* retrieve column dual value (interior point) */ return glp_ipt_col_dual(lp, j); } function lpx_set_class(lp, klass){ /* set problem class */ xassert(lp == lp); if (!(klass == LPX_LP || klass == LPX_MIP)) xerror("lpx_set_class: invalid problem class"); } function lpx_get_class(lp){ /* determine problem klass */ return glp_get_num_int(lp) == 0 ? LPX_LP : LPX_MIP; } function lpx_set_col_kind(lp, j, kind){ /* set (change) column kind */ glp_set_col_kind(lp, j, kind - LPX_CV + GLP_CV); } function lpx_get_col_kind(lp, j){ /* retrieve column kind */ return glp_get_col_kind(lp, j) == GLP_CV ? LPX_CV : LPX_IV; } function lpx_get_num_int(lp){ /* retrieve number of integer columns */ return glp_get_num_int(lp); } function lpx_get_num_bin(lp){ /* retrieve number of binary columns */ return glp_get_num_bin(lp); } function solve_mip(lp, presolve){ var parm = new IOCP(); var ret; //glp_init_iocp(parm); switch (lpx_get_int_parm(lp, LPX_K_MSGLEV)) { case 0: parm.msg_lev = GLP_MSG_OFF; break; case 1: parm.msg_lev = GLP_MSG_ERR; break; case 2: parm.msg_lev = GLP_MSG_ON; break; case 3: parm.msg_lev = GLP_MSG_ALL; break; default: xassert(lp != lp); } switch (lpx_get_int_parm(lp, LPX_K_BRANCH)) { case 0: parm.br_tech = GLP_BR_FFV; break; case 1: parm.br_tech = GLP_BR_LFV; break; case 2: parm.br_tech = GLP_BR_DTH; break; case 3: parm.br_tech = GLP_BR_MFV; break; default: xassert(lp != lp); } switch (lpx_get_int_parm(lp, LPX_K_BTRACK)) { case 0: parm.bt_tech = GLP_BT_DFS; break; case 1: parm.bt_tech = GLP_BT_BFS; break; case 2: parm.bt_tech = GLP_BT_BPH; break; case 3: parm.bt_tech = GLP_BT_BLB; break; default: xassert(lp != lp); } parm.tol_int = lpx_get_real_parm(lp, LPX_K_TOLINT); parm.tol_obj = lpx_get_real_parm(lp, LPX_K_TOLOBJ); if (lpx_get_real_parm(lp, LPX_K_TMLIM) < 0.0 || lpx_get_real_parm(lp, LPX_K_TMLIM) > 1e6) parm.tm_lim = INT_MAX; else parm.tm_lim = (1000.0 * lpx_get_real_parm(lp, LPX_K_TMLIM))|0; parm.mip_gap = lpx_get_real_parm(lp, LPX_K_MIPGAP); if (lpx_get_int_parm(lp, LPX_K_USECUTS) & LPX_C_GOMORY) parm.gmi_cuts = GLP_ON; else parm.gmi_cuts = GLP_OFF; if (lpx_get_int_parm(lp, LPX_K_USECUTS) & LPX_C_MIR) parm.mir_cuts = GLP_ON; else parm.mir_cuts = GLP_OFF; if (lpx_get_int_parm(lp, LPX_K_USECUTS) & LPX_C_COVER) parm.cov_cuts = GLP_ON; else parm.cov_cuts = GLP_OFF; if (lpx_get_int_parm(lp, LPX_K_USECUTS) & LPX_C_CLIQUE) parm.clq_cuts = GLP_ON; else parm.clq_cuts = GLP_OFF; parm.presolve = presolve; if (lpx_get_int_parm(lp, LPX_K_BINARIZE)) parm.binarize = GLP_ON; ret = glp_intopt(lp, parm); switch (ret) { case 0: ret = LPX_E_OK; break; case GLP_ENOPFS: ret = LPX_E_NOPFS; break; case GLP_ENODFS: ret = LPX_E_NODFS; break; case GLP_EBOUND: case GLP_EROOT: ret = LPX_E_FAULT; break; case GLP_EFAIL: ret = LPX_E_SING; break; case GLP_EMIPGAP: ret = LPX_E_MIPGAP; break; case GLP_ETMLIM: ret = LPX_E_TMLIM; break; default: xassert(ret != ret); } return ret; } function lpx_integer(lp){ /* easy-to-use driver to the branch-and-bound method */ return solve_mip(lp, GLP_OFF); } function lpx_intopt(lp){ /* easy-to-use driver to the branch-and-bound method */ return solve_mip(lp, GLP_ON); } function lpx_mip_status(lp){ /* retrieve status of MIP solution */ var status; switch (glp_mip_status(lp)) { case GLP_UNDEF: status = LPX_I_UNDEF; break; case GLP_OPT: status = LPX_I_OPT; break; case GLP_FEAS: status = LPX_I_FEAS; break; case GLP_NOFEAS: status = LPX_I_NOFEAS; break; default: xassert(lp != lp); } return status; } function lpx_mip_obj_val(lp){ /* retrieve objective value (MIP solution) */ return glp_mip_obj_val(lp); } function lpx_mip_row_val(lp, i){ /* retrieve row value (MIP solution) */ return glp_mip_row_val(lp, i); } function lpx_mip_col_val(lp, j){ /* retrieve column value (MIP solution) */ return glp_mip_col_val(lp, j); } function lpx_check_int(lp, kkt){ /* check integer feasibility conditions */ glp_check_kkt(lp, GLP_MIP, GLP_KKT_PE, function(ae_max, ae_ind, re_max, re_ind){ kkt.pe_ae_max = ae_max; kkt.pe_ae_row = ae_ind; kkt.pe_re_max = re_max; kkt.pe_re_row = re_ind; if (re_max <= 1e-9) kkt.pe_quality = 'H'; else if (re_max <= 1e-6) kkt.pe_quality = 'M'; else if (re_max <= 1e-3) kkt.pe_quality = 'L'; else kkt.pe_quality = '?'; } ); glp_check_kkt(lp, GLP_MIP, GLP_KKT_PB, function(ae_max, ae_ind, re_max, re_ind){ kkt.pb_ae_max = ae_max; kkt.pb_ae_ind = ae_ind; kkt.pb_re_max = re_max; kkt.pb_re_ind = re_ind; if (re_max <= 1e-9) kkt.pb_quality = 'H'; else if (re_max <= 1e-6) kkt.pb_quality = 'M'; else if (re_max <= 1e-3) kkt.pb_quality = 'L'; else kkt.pb_quality = '?'; } ); } function reset_parms(lp){ /* reset control parameters to default values */ var cps = lp.parms; xassert(cps != null); cps.msg_lev = 3; cps.scale = 1; cps.dual = 0; cps.price = 1; cps.relax = 0.07; cps.tol_bnd = 1e-7; cps.tol_dj = 1e-7; cps.tol_piv = 1e-9; cps.round = 0; cps.obj_ll = -DBL_MAX; cps.obj_ul = +DBL_MAX; cps.it_lim = -1; cps.tm_lim = -1.0; cps.out_frq = 200; cps.out_dly = 0.0; cps.branch = 2; cps.btrack = 3; cps.tol_int = 1e-5; cps.tol_obj = 1e-7; cps.mps_info = 1; cps.mps_obj = 2; cps.mps_orig = 0; cps.mps_wide = 1; cps.mps_free = 0; cps.mps_skip = 0; cps.lpt_orig = 0; cps.presol = 0; cps.binarize = 0; cps.use_cuts = 0; cps.mip_gap = 0.0; } function access_parms(lp){ /* allocate and initialize control parameters, if necessary */ if (lp.parms == null) { lp.parms = {}; reset_parms(lp); } return lp.parms; } function lpx_reset_parms(lp){ /* reset control parameters to default values */ access_parms(lp); reset_parms(lp); } function lpx_set_int_parm(lp, parm, val){ /* set (change) integer control parameter */ var cps = access_parms(lp); switch (parm) { case LPX_K_MSGLEV: if (!(0 <= val && val <= 3)) xerror("lpx_set_int_parm: MSGLEV = " + val + "; invalid value"); cps.msg_lev = val; break; case LPX_K_SCALE: if (!(0 <= val && val <= 3)) xerror("lpx_set_int_parm: SCALE = " + val + "; invalid value"); cps.scale = val; break; case LPX_K_DUAL: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: DUAL = " + val + "; invalid value"); cps.dual = val; break; case LPX_K_PRICE: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: PRICE = " + val + "; invalid value"); cps.price = val; break; case LPX_K_ROUND: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: ROUND = " + val + "; invalid value"); cps.round = val; break; case LPX_K_ITLIM: cps.it_lim = val; break; case LPX_K_ITCNT: lp.it_cnt = val; break; case LPX_K_OUTFRQ: if (!(val > 0)) xerror("lpx_set_int_parm: OUTFRQ = " + val + "; invalid value"); cps.out_frq = val; break; case LPX_K_BRANCH: if (!(val == 0 || val == 1 || val == 2 || val == 3)) xerror("lpx_set_int_parm: BRANCH = " + val + "; invalid value"); cps.branch = val; break; case LPX_K_BTRACK: if (!(val == 0 || val == 1 || val == 2 || val == 3)) xerror("lpx_set_int_parm: BTRACK = " + val + "; invalid value"); cps.btrack = val; break; case LPX_K_MPSINFO: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: MPSINFO = " + val + "; invalid value"); cps.mps_info = val; break; case LPX_K_MPSOBJ: if (!(val == 0 || val == 1 || val == 2)) xerror("lpx_set_int_parm: MPSOBJ = " + val + "; invalid value"); cps.mps_obj = val; break; case LPX_K_MPSORIG: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: MPSORIG = " + val + "; invalid value"); cps.mps_orig = val; break; case LPX_K_MPSWIDE: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: MPSWIDE = " + val + "; invalid value"); cps.mps_wide = val; break; case LPX_K_MPSFREE: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: MPSFREE = " + val + "; invalid value"); cps.mps_free = val; break; case LPX_K_MPSSKIP: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: MPSSKIP = " + val + "; invalid value"); cps.mps_skip = val; break; case LPX_K_LPTORIG: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: LPTORIG = " + val + "; invalid value"); cps.lpt_orig = val; break; case LPX_K_PRESOL: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: PRESOL = " + val + "; invalid value"); cps.presol = val; break; case LPX_K_BINARIZE: if (!(val == 0 || val == 1)) xerror("lpx_set_int_parm: BINARIZE = " + val + "; invalid value"); cps.binarize = val; break; case LPX_K_USECUTS: if (val & ~LPX_C_ALL) xerror("lpx_set_int_parm: USECUTS = " + val + "; invalid value"); cps.use_cuts = val; break; case LPX_K_BFTYPE: { parm = {}; glp_get_bfcp(lp, parm); switch (val) { case 1: parm.type = GLP_BF_FT; break; case 2: parm.type = GLP_BF_BG; break; case 3: parm.type = GLP_BF_GR; break; default: xerror("lpx_set_int_parm: BFTYPE = " + val + "; invalid value"); } glp_set_bfcp(lp, parm); } break; default: xerror("lpx_set_int_parm: parm = " + parm + "; invalid parameter"); } } function lpx_get_int_parm(lp, parm){ /* query integer control parameter */ var cps = access_parms(lp); var val = 0; switch (parm) { case LPX_K_MSGLEV: val = cps.msg_lev; break; case LPX_K_SCALE: val = cps.scale; break; case LPX_K_DUAL: val = cps.dual; break; case LPX_K_PRICE: val = cps.price; break; case LPX_K_ROUND: val = cps.round; break; case LPX_K_ITLIM: val = cps.it_lim; break; case LPX_K_ITCNT: val = lp.it_cnt; break; case LPX_K_OUTFRQ: val = cps.out_frq; break; case LPX_K_BRANCH: val = cps.branch; break; case LPX_K_BTRACK: val = cps.btrack; break; case LPX_K_MPSINFO: val = cps.mps_info; break; case LPX_K_MPSOBJ: val = cps.mps_obj; break; case LPX_K_MPSORIG: val = cps.mps_orig; break; case LPX_K_MPSWIDE: val = cps.mps_wide; break; case LPX_K_MPSFREE: val = cps.mps_free; break; case LPX_K_MPSSKIP: val = cps.mps_skip; break; case LPX_K_LPTORIG: val = cps.lpt_orig; break; case LPX_K_PRESOL: val = cps.presol; break; case LPX_K_BINARIZE: val = cps.binarize; break; case LPX_K_USECUTS: val = cps.use_cuts; break; case LPX_K_BFTYPE: { parm = {}; glp_get_bfcp(lp, parm); switch (parm.type) { case GLP_BF_FT: val = 1; break; case GLP_BF_BG: val = 2; break; case GLP_BF_GR: val = 3; break; default: xassert(lp != lp); } } break; default: xerror("lpx_get_int_parm: parm = " + parm + "; invalid parameter"); } return val; } function lpx_set_real_parm(lp, parm, val){ /* set (change) real control parameter */ var cps = access_parms(lp); switch (parm) { case LPX_K_RELAX: if (!(0.0 <= val && val <= 1.0)) xerror("lpx_set_real_parm: RELAX = " + val + "; invalid value"); cps.relax = val; break; case LPX_K_TOLBND: if (!(DBL_EPSILON <= val && val <= 0.001)) xerror("lpx_set_real_parm: TOLBND = " + val + "; invalid value"); cps.tol_bnd = val; break; case LPX_K_TOLDJ: if (!(DBL_EPSILON <= val && val <= 0.001)) xerror("lpx_set_real_parm: TOLDJ = " + val + "; invalid value"); cps.tol_dj = val; break; case LPX_K_TOLPIV: if (!(DBL_EPSILON <= val && val <= 0.001)) xerror("lpx_set_real_parm: TOLPIV = " + val + "; invalid value"); cps.tol_piv = val; break; case LPX_K_OBJLL: cps.obj_ll = val; break; case LPX_K_OBJUL: cps.obj_ul = val; break; case LPX_K_TMLIM: cps.tm_lim = val; break; case LPX_K_OUTDLY: cps.out_dly = val; break; case LPX_K_TOLINT: if (!(DBL_EPSILON <= val && val <= 0.001)) xerror("lpx_set_real_parm: TOLINT = " + val + "; invalid value"); cps.tol_int = val; break; case LPX_K_TOLOBJ: if (!(DBL_EPSILON <= val && val <= 0.001)) xerror("lpx_set_real_parm: TOLOBJ = " + val + "; invalid value"); cps.tol_obj = val; break; case LPX_K_MIPGAP: if (val < 0.0) xerror("lpx_set_real_parm: MIPGAP = " + val + "; invalid value"); cps.mip_gap = val; break; default: xerror("lpx_set_real_parm: parm = " + parm + "; invalid parameter"); } } function lpx_get_real_parm(lp, parm){ /* query real control parameter */ var cps = access_parms(lp); var val = 0.0; switch (parm) { case LPX_K_RELAX: val = cps.relax; break; case LPX_K_TOLBND: val = cps.tol_bnd; break; case LPX_K_TOLDJ: val = cps.tol_dj; break; case LPX_K_TOLPIV: val = cps.tol_piv; break; case LPX_K_OBJLL: val = cps.obj_ll; break; case LPX_K_OBJUL: val = cps.obj_ul; break; case LPX_K_TMLIM: val = cps.tm_lim; break; case LPX_K_OUTDLY: val = cps.out_dly; break; case LPX_K_TOLINT: val = cps.tol_int; break; case LPX_K_TOLOBJ: val = cps.tol_obj; break; case LPX_K_MIPGAP: val = cps.mip_gap; break; default: xerror("lpx_get_real_parm: parm = " + parm + "; invalid parameter"); } return val; } function lpx_read_mps(fname){ /* read problem data in fixed MPS format */ var lp = lpx_create_prob(); if (glp_read_mps(lp, GLP_MPS_DECK, null, fname)){ lp = null; } return lp; } function lpx_write_mps(lp, fname){ /* write problem data in fixed MPS format */ return glp_write_mps(lp, GLP_MPS_DECK, null, fname); } function lpx_read_bas(lp, fname){ /* read LP basis in fixed MPS format */ xassert(lp == lp); xassert(fname == fname); xerror("lpx_read_bas: operation not supported"); return 0; } function lpx_write_bas(lp, fname){ /* write LP basis in fixed MPS format */ xassert(lp == lp); xassert(fname == fname); xerror("lpx_write_bas: operation not supported"); return 0; } function lpx_read_freemps(fname){ /* read problem data in free MPS format */ var lp = lpx_create_prob(); if (glp_read_mps(lp, GLP_MPS_FILE, null, fname)){ lp = null; } return lp; } function lpx_write_freemps(lp, fname){ /* write problem data in free MPS format */ return glp_write_mps(lp, GLP_MPS_FILE, null, fname); } function lpx_read_cpxlp(fname){ /* read problem data in CPLEX LP format */ var lp = lpx_create_prob(); if (glp_read_lp(lp, null, fname)){ lp = null; } return lp; } function lpx_write_cpxlp(lp, fname){ /* write problem data in CPLEX LP format */ return glp_write_lp(lp, null, fname); } function lpx_read_model(model, data, output, tablecb){ /* read LP/MIP model written in GNU MathProg language */ var lp = null; /* allocate the translator workspace */ var tran = glp_mpl_alloc_wksp(); /* read model section and optional data section */ if (glp_mpl_read_model(tran, model, data != null)) return done(); /* read separate data section, if required */ if (data != null) if (glp_mpl_read_data(tran, data)) return done(); /* generate the model */ if (glp_mpl_generate(tran, output, tablecb)) return done(); /* build the problem instance from the model */ lp = glp_create_prob(); glp_mpl_build_prob(tran, lp); function done(){ /* bring the problem object to the calling program */ return lp; } return done(); } function lpx_print_prob(lp, fname){ /* write problem data in plain text format */ return glp_write_lp(lp, null, fname); } function lpx_print_sol(lp, fname){ /* write LP problem solution in printable format */ return glp_print_sol(lp, fname); } function lpx_print_sens_bnds(lp, fname){ /* write bounds sensitivity information */ if (glp_get_status(lp) == GLP_OPT && !glp_bf_exists(lp)) glp_factorize(lp); return glp_print_ranges(lp, 0, null, 0, fname); } function lpx_print_ips(lp, fname){ /* write interior point solution in printable format */ return glp_print_ipt(lp, fname); } function lpx_print_mip(lp, fname){ /* write MIP problem solution in printable format */ return glp_print_mip(lp, fname); } function lpx_is_b_avail(lp){ /* check if LP basis is available */ return glp_bf_exists(lp); } function lpx_main(argc, argv) { /* stand-alone LP/MIP solver */ return glp_main(argc, argv); } /* return codes: */ var LUF_ESING = 1, /* singular matrix */ LUF_ECOND = 2; /* ill-conditioned matrix */ function luf_create_it(){ var luf = {}; luf.n_max = luf.n = 0; luf.valid = 0; luf.fr_ptr = luf.fr_len = null; luf.fc_ptr = luf.fc_len = null; luf.vr_ptr = luf.vr_len = luf.vr_cap = null; luf.vr_piv = null; luf.vc_ptr = luf.vc_len = luf.vc_cap = null; luf.pp_row = luf.pp_col = null; luf.qq_row = luf.qq_col = null; luf.sv_size = 0; luf.sv_beg = luf.sv_end = 0; luf.sv_ind = null; luf.sv_val = null; luf.sv_head = luf.sv_tail = 0; luf.sv_prev = luf.sv_next = null; luf.vr_max = null; luf.rs_head = luf.rs_prev = luf.rs_next = null; luf.cs_head = luf.cs_prev = luf.cs_next = null; luf.flag = null; luf.work = null; luf.new_sva = 0; luf.piv_tol = 0.10; luf.piv_lim = 4; luf.suhl = 1; luf.eps_tol = 1e-15; luf.max_gro = 1e+10; luf.nnz_a = luf.nnz_f = luf.nnz_v = 0; luf.max_a = luf.big_v = 0.0; luf.rank = 0; return luf; } function luf_defrag_sva(luf){ var n = luf.n; var vr_ptr = luf.vr_ptr; var vr_len = luf.vr_len; var vr_cap = luf.vr_cap; var vc_ptr = luf.vc_ptr; var vc_len = luf.vc_len; var vc_cap = luf.vc_cap; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var sv_next = luf.sv_next; var sv_beg = 1; var i, j, k; /* skip rows and columns, which do not need to be relocated */ for (k = luf.sv_head; k != 0; k = sv_next[k]) { if (k <= n) { /* i-th row of the matrix V */ i = k; if (vr_ptr[i] != sv_beg) break; vr_cap[i] = vr_len[i]; sv_beg += vr_cap[i]; } else { /* j-th column of the matrix V */ j = k - n; if (vc_ptr[j] != sv_beg) break; vc_cap[j] = vc_len[j]; sv_beg += vc_cap[j]; } } /* relocate other rows and columns in order to gather all unused locations in one continuous extent */ for (; k != 0; k = sv_next[k]) { if (k <= n) { /* i-th row of the matrix V */ i = k; xcopyArr(sv_ind, sv_beg, sv_ind, vr_ptr[i], vr_len[i]); xcopyArr(sv_val, sv_beg, sv_val, vr_ptr[i], vr_len[i]); vr_ptr[i] = sv_beg; vr_cap[i] = vr_len[i]; sv_beg += vr_cap[i]; } else { /* j-th column of the matrix V */ j = k - n; xcopyArr(sv_ind, sv_beg, sv_ind, vc_ptr[j], vc_len[j]); xcopyArr(sv_val, sv_beg, sv_val ,vc_ptr[j], vc_len[j]); vc_ptr[j] = sv_beg; vc_cap[j] = vc_len[j]; sv_beg += vc_cap[j]; } } /* set new pointer to the beginning of the free part */ luf.sv_beg = sv_beg; } function luf_enlarge_row(luf, i, cap){ var n = luf.n; var vr_ptr = luf.vr_ptr; var vr_len = luf.vr_len; var vr_cap = luf.vr_cap; var vc_cap = luf.vc_cap; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var sv_prev = luf.sv_prev; var sv_next = luf.sv_next; var ret = 0; var cur, k, kk; xassert(1 <= i && i <= n); xassert(vr_cap[i] < cap); /* if there are less than cap free locations, defragment SVA */ if (luf.sv_end - luf.sv_beg < cap) { luf_defrag_sva(luf); if (luf.sv_end - luf.sv_beg < cap) { ret = 1; return ret; } } /* save current capacity of the i-th row */ cur = vr_cap[i]; /* copy existing elements to the beginning of the free part */ xcopyArr(sv_ind, luf.sv_beg, sv_ind, vr_ptr[i], vr_len[i]); xcopyArr(sv_val, luf.sv_beg, sv_val, vr_ptr[i], vr_len[i]); /* set new pointer and new capacity of the i-th row */ vr_ptr[i] = luf.sv_beg; vr_cap[i] = cap; /* set new pointer to the beginning of the free part */ luf.sv_beg += cap; /* now the i-th row starts in the rightmost location among other rows and columns of the matrix V, so its node should be moved to the end of the row/column linked list */ k = i; /* remove the i-th row node from the linked list */ if (sv_prev[k] == 0) luf.sv_head = sv_next[k]; else { /* capacity of the previous row/column can be increased at the expense of old locations of the i-th row */ kk = sv_prev[k]; if (kk <= n) vr_cap[kk] += cur; else vc_cap[kk-n] += cur; sv_next[sv_prev[k]] = sv_next[k]; } if (sv_next[k] == 0) luf.sv_tail = sv_prev[k]; else sv_prev[sv_next[k]] = sv_prev[k]; /* insert the i-th row node to the end of the linked list */ sv_prev[k] = luf.sv_tail; sv_next[k] = 0; if (sv_prev[k] == 0) luf.sv_head = k; else sv_next[sv_prev[k]] = k; luf.sv_tail = k; return ret; } function luf_enlarge_col(luf, j, cap){ var n = luf.n; var vr_cap = luf.vr_cap; var vc_ptr = luf.vc_ptr; var vc_len = luf.vc_len; var vc_cap = luf.vc_cap; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var sv_prev = luf.sv_prev; var sv_next = luf.sv_next; var ret = 0; var cur, k, kk; xassert(1 <= j && j <= n); xassert(vc_cap[j] < cap); /* if there are less than cap free locations, defragment SVA */ if (luf.sv_end - luf.sv_beg < cap) { luf_defrag_sva(luf); if (luf.sv_end - luf.sv_beg < cap) { ret = 1; return ret; } } /* save current capacity of the j-th column */ cur = vc_cap[j]; /* copy existing elements to the beginning of the free part */ xcopyArr(sv_ind, luf.sv_beg, sv_ind, vc_ptr[j], vc_len[j]); xcopyArr(sv_val, luf.sv_beg, sv_val, vc_ptr[j], vc_len[j]); /* set new pointer and new capacity of the j-th column */ vc_ptr[j] = luf.sv_beg; vc_cap[j] = cap; /* set new pointer to the beginning of the free part */ luf.sv_beg += cap; /* now the j-th column starts in the rightmost location among other rows and columns of the matrix V, so its node should be moved to the end of the row/column linked list */ k = n + j; /* remove the j-th column node from the linked list */ if (sv_prev[k] == 0) luf.sv_head = sv_next[k]; else { /* capacity of the previous row/column can be increased at the expense of old locations of the j-th column */ kk = sv_prev[k]; if (kk <= n) vr_cap[kk] += cur; else vc_cap[kk-n] += cur; sv_next[sv_prev[k]] = sv_next[k]; } if (sv_next[k] == 0) luf.sv_tail = sv_prev[k]; else sv_prev[sv_next[k]] = sv_prev[k]; /* insert the j-th column node to the end of the linked list */ sv_prev[k] = luf.sv_tail; sv_next[k] = 0; if (sv_prev[k] == 0) luf.sv_head = k; else sv_next[sv_prev[k]] = k; luf.sv_tail = k; return ret; } function reallocate(luf, n){ var n_max = luf.n_max; luf.n = n; if (n <= n_max) return; luf.n_max = n_max = n + 100; luf.fr_ptr = new Int32Array(1+n_max); luf.fr_len = new Int32Array(1+n_max); luf.fc_ptr = new Int32Array(1+n_max); luf.fc_len = new Int32Array(1+n_max); luf.vr_ptr = new Int32Array(1+n_max); luf.vr_len = new Int32Array(1+n_max); luf.vr_cap = new Int32Array(1+n_max); luf.vr_piv = new Float64Array(1+n_max); luf.vc_ptr = new Int32Array(1+n_max); luf.vc_len = new Int32Array(1+n_max); luf.vc_cap = new Int32Array(1+n_max); luf.pp_row = new Int32Array(1+n_max); luf.pp_col = new Int32Array(1+n_max); luf.qq_row = new Int32Array(1+n_max); luf.qq_col = new Int32Array(1+n_max); luf.sv_prev = new Int32Array(1+n_max+n_max); luf.sv_next = new Int32Array(1+n_max+n_max); luf.vr_max = new Float64Array(1+n_max); luf.rs_head = new Int32Array(1+n_max); luf.rs_prev = new Int32Array(1+n_max); luf.rs_next = new Int32Array(1+n_max); luf.cs_head = new Int32Array(1+n_max); luf.cs_prev = new Int32Array(1+n_max); luf.cs_next = new Int32Array(1+n_max); luf.flag = new Int32Array(1+n_max); luf.work = new Float64Array(1+n_max); } function initialize(luf, col, info){ var n = luf.n; var fc_ptr = luf.fc_ptr; var fc_len = luf.fc_len; var vr_ptr = luf.vr_ptr; var vr_len = luf.vr_len; var vr_cap = luf.vr_cap; var vc_ptr = luf.vc_ptr; var vc_len = luf.vc_len; var vc_cap = luf.vc_cap; var pp_row = luf.pp_row; var pp_col = luf.pp_col; var qq_row = luf.qq_row; var qq_col = luf.qq_col; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var sv_prev = luf.sv_prev; var sv_next = luf.sv_next; var vr_max = luf.vr_max; var rs_head = luf.rs_head; var rs_prev = luf.rs_prev; var rs_next = luf.rs_next; var cs_head = luf.cs_head; var cs_prev = luf.cs_prev; var cs_next = luf.cs_next; var flag = luf.flag; var work = luf.work; var ret = 0; var i, i_ptr, j, j_beg, j_end, k, len, nnz, sv_beg, sv_end, ptr; var big, val; /* free all locations of the sparse vector area */ sv_beg = 1; sv_end = luf.sv_size + 1; /* (row-wise representation of the matrix F is not initialized, because it is not used at the factorization stage) */ /* build the matrix F in column-wise format (initially F = I) */ for (j = 1; j <= n; j++) { fc_ptr[j] = sv_end; fc_len[j] = 0; } /* clear rows of the matrix V; clear the flag array */ for (i = 1; i <= n; i++) vr_len[i] = vr_cap[i] = 0, flag[i] = 0; /* build the matrix V in column-wise format (initially V = A); count non-zeros in rows of this matrix; count total number of non-zeros; compute largest of absolute values of elements */ nnz = 0; big = 0.0; for (j = 1; j <= n; j++) { var rn = pp_row; var aj = work; /* obtain j-th column of the matrix A */ len = col(info, j, rn, aj); if (!(0 <= len && len <= n)) xerror("luf_factorize: j = " + j + "; len = " + len + "; invalid column length"); /* check for free locations */ if (sv_end - sv_beg < len) { /* overflow of the sparse vector area */ ret = 1; return ret; } /* set pointer to the j-th column */ vc_ptr[j] = sv_beg; /* set length of the j-th column */ vc_len[j] = vc_cap[j] = len; /* count total number of non-zeros */ nnz += len; /* walk through elements of the j-th column */ for (ptr = 1; ptr <= len; ptr++) { /* get row index and numerical value of a[i,j] */ i = rn[ptr]; val = aj[ptr]; if (!(1 <= i && i <= n)) xerror("luf_factorize: i = " + i + "; j = " + j + "; invalid row index"); if (flag[i]) xerror("luf_factorize: i = " + i + "; j = " + j + "; duplicate element not allowed"); if (val == 0.0) xerror("luf_factorize: i = " + i + "; j = " + j + "; zero element not allowed"); /* add new element v[i,j] = a[i,j] to j-th column */ sv_ind[sv_beg] = i; sv_val[sv_beg] = val; sv_beg++; /* big := max(big, |a[i,j]|) */ if (val < 0.0) val = - val; if (big < val) big = val; /* mark non-zero in the i-th position of the j-th column */ flag[i] = 1; /* increase length of the i-th row */ vr_cap[i]++; } /* reset all non-zero marks */ for (ptr = 1; ptr <= len; ptr++) flag[rn[ptr]] = 0; } /* allocate rows of the matrix V */ for (i = 1; i <= n; i++) { /* get length of the i-th row */ len = vr_cap[i]; /* check for free locations */ if (sv_end - sv_beg < len) { /* overflow of the sparse vector area */ ret = 1; return ret; } /* set pointer to the i-th row */ vr_ptr[i] = sv_beg; /* reserve locations for the i-th row */ sv_beg += len; } /* build the matrix V in row-wise format using representation of this matrix in column-wise format */ for (j = 1; j <= n; j++) { /* walk through elements of the j-th column */ j_beg = vc_ptr[j]; j_end = j_beg + vc_len[j] - 1; for (k = j_beg; k <= j_end; k++) { /* get row index and numerical value of v[i,j] */ i = sv_ind[k]; val = sv_val[k]; /* store element in the i-th row */ i_ptr = vr_ptr[i] + vr_len[i]; sv_ind[i_ptr] = j; sv_val[i_ptr] = val; /* increase count of the i-th row */ vr_len[i]++; } } /* initialize the matrices P and Q (initially P = Q = I) */ for (k = 1; k <= n; k++) pp_row[k] = pp_col[k] = qq_row[k] = qq_col[k] = k; /* set sva partitioning pointers */ luf.sv_beg = sv_beg; luf.sv_end = sv_end; /* the initial physical order of rows and columns of the matrix V is n+1, ..., n+n, 1, ..., n (firstly columns, then rows) */ luf.sv_head = n+1; luf.sv_tail = n; for (i = 1; i <= n; i++) { sv_prev[i] = i-1; sv_next[i] = i+1; } sv_prev[1] = n+n; sv_next[n] = 0; for (j = 1; j <= n; j++) { sv_prev[n+j] = n+j-1; sv_next[n+j] = n+j+1; } sv_prev[n+1] = 0; sv_next[n+n] = 1; /* clear working arrays */ for (k = 1; k <= n; k++) { flag[k] = 0; work[k] = 0.0; } /* initialize some statistics */ luf.nnz_a = nnz; luf.nnz_f = 0; luf.nnz_v = nnz; luf.max_a = big; luf.big_v = big; luf.rank = -1; /* initially the active submatrix is the entire matrix V */ /* largest of absolute values of elements in each active row is unknown yet */ for (i = 1; i <= n; i++) vr_max[i] = -1.0; /* build linked lists of active rows */ for (len = 0; len <= n; len++) rs_head[len] = 0; for (i = 1; i <= n; i++) { len = vr_len[i]; rs_prev[i] = 0; rs_next[i] = rs_head[len]; if (rs_next[i] != 0) rs_prev[rs_next[i]] = i; rs_head[len] = i; } /* build linked lists of active columns */ for (len = 0; len <= n; len++) cs_head[len] = 0; for (j = 1; j <= n; j++) { len = vc_len[j]; cs_prev[j] = 0; cs_next[j] = cs_head[len]; if (cs_next[j] != 0) cs_prev[cs_next[j]] = j; cs_head[len] = j; } /* return to the factorizing routine */ return ret; } function find_pivot(luf, callback){ var n = luf.n; var vr_ptr = luf.vr_ptr; var vr_len = luf.vr_len; var vc_ptr = luf.vc_ptr; var vc_len = luf.vc_len; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var vr_max = luf.vr_max; var rs_head = luf.rs_head; var rs_next = luf.rs_next; var cs_head = luf.cs_head; var cs_prev = luf.cs_prev; var cs_next = luf.cs_next; var piv_tol = luf.piv_tol; var piv_lim = luf.piv_lim; var suhl = luf.suhl; var p, q, len, i, i_beg, i_end, i_ptr, j, j_beg, j_end, j_ptr, ncand, next_j, min_p, min_q, min_len; var best, cost, big, temp; /* initially no pivot candidates have been found so far */ p = q = 0; best = DBL_MAX; ncand = 0; /* if in the active submatrix there is a column that has the only non-zero (column singleton), choose it as pivot */ j = cs_head[1]; if (j != 0) { xassert(vc_len[j] == 1); p = sv_ind[vc_ptr[j]]; q = j; return done(); } /* if in the active submatrix there is a row that has the only non-zero (row singleton), choose it as pivot */ i = rs_head[1]; if (i != 0) { xassert(vr_len[i] == 1); p = i; q = sv_ind[vr_ptr[i]]; return done(); } /* there are no singletons in the active submatrix; walk through other non-empty rows and columns */ for (len = 2; len <= n; len++) { /* consider active columns that have len non-zeros */ for (j = cs_head[len]; j != 0; j = next_j) { /* the j-th column has len non-zeros */ j_beg = vc_ptr[j]; j_end = j_beg + vc_len[j] - 1; /* save pointer to the next column with the same length */ next_j = cs_next[j]; /* find an element in the j-th column, which is placed in a row with minimal number of non-zeros and satisfies to the stability condition (such element may not exist) */ min_p = min_q = 0; min_len = INT_MAX; for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++) { /* get row index of v[i,j] */ i = sv_ind[j_ptr]; i_beg = vr_ptr[i]; i_end = i_beg + vr_len[i] - 1; /* if the i-th row is not shorter than that one, where minimal element is currently placed, skip v[i,j] */ if (vr_len[i] >= min_len) continue; /* determine the largest of absolute values of elements in the i-th row */ big = vr_max[i]; if (big < 0.0) { /* the largest value is unknown yet; compute it */ for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++) { temp = sv_val[i_ptr]; if (temp < 0.0) temp = - temp; if (big < temp) big = temp; } vr_max[i] = big; } /* find v[i,j] in the i-th row */ for (i_ptr = vr_ptr[i]; sv_ind[i_ptr] != j; i_ptr++){} xassert(i_ptr <= i_end); /* if v[i,j] doesn't satisfy to the stability condition, skip it */ temp = sv_val[i_ptr]; if (temp < 0.0) temp = - temp; if (temp < piv_tol * big) continue; /* v[i,j] is better than the current minimal element */ min_p = i; min_q = j; min_len = vr_len[i]; /* if Markowitz cost of the current minimal element is not greater than (len-1)**2, it can be chosen right now; this heuristic reduces the search and works well in many cases */ if (min_len <= len) { p = min_p; q = min_q; return done(); } } /* the j-th column has been scanned */ if (min_p != 0) { /* the minimal element is a next pivot candidate */ ncand++; /* compute its Markowitz cost */ cost = (min_len - 1) * (len - 1); /* choose between the minimal element and the current candidate */ if (cost < best) {p = min_p; q = min_q; best = cost} /* if piv_lim candidates have been considered, there are doubts that a much better candidate exists; therefore it's time to terminate the search */ if (ncand == piv_lim) return done(); } else { /* the j-th column has no elements, which satisfy to the stability condition; Uwe Suhl suggests to exclude such column from the further consideration until it becomes a column singleton; in hard cases this significantly reduces a time needed for pivot searching */ if (suhl) { /* remove the j-th column from the active set */ if (cs_prev[j] == 0) cs_head[len] = cs_next[j]; else cs_next[cs_prev[j]] = cs_next[j]; if (cs_next[j] == 0){ /* nop */ } else cs_prev[cs_next[j]] = cs_prev[j]; /* the following assignment is used to avoid an error when the routine eliminate (see below) will try to remove the j-th column from the active set */ cs_prev[j] = cs_next[j] = j; } } } /* consider active rows that have len non-zeros */ for (i = rs_head[len]; i != 0; i = rs_next[i]) { /* the i-th row has len non-zeros */ i_beg = vr_ptr[i]; i_end = i_beg + vr_len[i] - 1; /* determine the largest of absolute values of elements in the i-th row */ big = vr_max[i]; if (big < 0.0) { /* the largest value is unknown yet; compute it */ for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++) { temp = sv_val[i_ptr]; if (temp < 0.0) temp = - temp; if (big < temp) big = temp; } vr_max[i] = big; } /* find an element in the i-th row, which is placed in a column with minimal number of non-zeros and satisfies to the stability condition (such element always exists) */ min_p = min_q = 0; min_len = INT_MAX; for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++) { /* get column index of v[i,j] */ j = sv_ind[i_ptr]; /* if the j-th column is not shorter than that one, where minimal element is currently placed, skip v[i,j] */ if (vc_len[j] >= min_len) continue; /* if v[i,j] doesn't satisfy to the stability condition, skip it */ temp = sv_val[i_ptr]; if (temp < 0.0) temp = - temp; if (temp < piv_tol * big) continue; /* v[i,j] is better than the current minimal element */ min_p = i; min_q = j; min_len = vc_len[j]; /* if Markowitz cost of the current minimal element is not greater than (len-1)**2, it can be chosen right now; this heuristic reduces the search and works well in many cases */ if (min_len <= len) { p = min_p; q = min_q; return done(); } } /* the i-th row has been scanned */ if (min_p != 0) { /* the minimal element is a next pivot candidate */ ncand++; /* compute its Markowitz cost */ cost = (len - 1) * (min_len - 1); /* choose between the minimal element and the current candidate */ if (cost < best) {p = min_p; q = min_q; best = cost} /* if piv_lim candidates have been considered, there are doubts that a much better candidate exists; therefore it's time to terminate the search */ if (ncand == piv_lim) return done(); } else { /* this can't be because this can never be */ xassert(min_p != min_p); } } } function done(){ /* bring the pivot to the factorizing routine */ callback(p, q); return (p == 0); } return done(); } function eliminate(luf, p, q){ var n = luf.n; var fc_ptr = luf.fc_ptr; var fc_len = luf.fc_len; var vr_ptr = luf.vr_ptr; var vr_len = luf.vr_len; var vr_cap = luf.vr_cap; var vr_piv = luf.vr_piv; var vc_ptr = luf.vc_ptr; var vc_len = luf.vc_len; var vc_cap = luf.vc_cap; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var sv_prev = luf.sv_prev; var sv_next = luf.sv_next; var vr_max = luf.vr_max; var rs_head = luf.rs_head; var rs_prev = luf.rs_prev; var rs_next = luf.rs_next; var cs_head = luf.cs_head; var cs_prev = luf.cs_prev; var cs_next = luf.cs_next; var flag = luf.flag; var work = luf.work; var eps_tol = luf.eps_tol; /* at this stage the row-wise representation of the matrix F is not used, so fr_len can be used as a working array */ var ndx = luf.fr_len; var ret = 0; var len, fill, i, i_beg, i_end, i_ptr, j, j_beg, j_end, j_ptr, k, p_beg, p_end, p_ptr, q_beg, q_end, q_ptr; var fip, val, vpq, temp; xassert(1 <= p && p <= n); xassert(1 <= q && q <= n); /* remove the p-th (pivot) row from the active set; this row will never return there */ if (rs_prev[p] == 0) rs_head[vr_len[p]] = rs_next[p]; else rs_next[rs_prev[p]] = rs_next[p]; if (rs_next[p] == 0){ } else rs_prev[rs_next[p]] = rs_prev[p]; /* remove the q-th (pivot) column from the active set; this column will never return there */ if (cs_prev[q] == 0) cs_head[vc_len[q]] = cs_next[q]; else cs_next[cs_prev[q]] = cs_next[q]; if (cs_next[q] == 0){ } else cs_prev[cs_next[q]] = cs_prev[q]; /* find the pivot v[p,q] = u[k,k] in the p-th row */ p_beg = vr_ptr[p]; p_end = p_beg + vr_len[p] - 1; for (p_ptr = p_beg; sv_ind[p_ptr] != q; p_ptr++){/* nop */} xassert(p_ptr <= p_end); /* store value of the pivot */ vpq = (vr_piv[p] = sv_val[p_ptr]); /* remove the pivot from the p-th row */ sv_ind[p_ptr] = sv_ind[p_end]; sv_val[p_ptr] = sv_val[p_end]; vr_len[p]--; p_end--; /* find the pivot v[p,q] = u[k,k] in the q-th column */ q_beg = vc_ptr[q]; q_end = q_beg + vc_len[q] - 1; for (q_ptr = q_beg; sv_ind[q_ptr] != p; q_ptr++){/* nop */} xassert(q_ptr <= q_end); /* remove the pivot from the q-th column */ sv_ind[q_ptr] = sv_ind[q_end]; vc_len[q]--; q_end--; /* walk through the p-th (pivot) row, which doesn't contain the pivot v[p,q] already, and do the following... */ for (p_ptr = p_beg; p_ptr <= p_end; p_ptr++) { /* get column index of v[p,j] */ j = sv_ind[p_ptr]; /* store v[p,j] to the working array */ flag[j] = 1; work[j] = sv_val[p_ptr]; /* remove the j-th column from the active set; this column will return there later with new length */ if (cs_prev[j] == 0) cs_head[vc_len[j]] = cs_next[j]; else cs_next[cs_prev[j]] = cs_next[j]; if (cs_next[j] == 0){ } else cs_prev[cs_next[j]] = cs_prev[j]; /* find v[p,j] in the j-th column */ j_beg = vc_ptr[j]; j_end = j_beg + vc_len[j] - 1; for (j_ptr = j_beg; sv_ind[j_ptr] != p; j_ptr++){/* nop */} xassert(j_ptr <= j_end); /* since v[p,j] leaves the active submatrix, remove it from the j-th column; however, v[p,j] is kept in the p-th row */ sv_ind[j_ptr] = sv_ind[j_end]; vc_len[j]--; } /* walk through the q-th (pivot) column, which doesn't contain the pivot v[p,q] already, and perform gaussian elimination */ while (q_beg <= q_end) { /* element v[i,q] should be eliminated */ /* get row index of v[i,q] */ i = sv_ind[q_beg]; /* remove the i-th row from the active set; later this row will return there with new length */ if (rs_prev[i] == 0) rs_head[vr_len[i]] = rs_next[i]; else rs_next[rs_prev[i]] = rs_next[i]; if (rs_next[i] == 0){ } else rs_prev[rs_next[i]] = rs_prev[i]; /* find v[i,q] in the i-th row */ i_beg = vr_ptr[i]; i_end = i_beg + vr_len[i] - 1; for (i_ptr = i_beg; sv_ind[i_ptr] != q; i_ptr++){/* nop */} xassert(i_ptr <= i_end); /* compute gaussian multiplier f[i,p] = v[i,q] / v[p,q] */ fip = sv_val[i_ptr] / vpq; /* since v[i,q] should be eliminated, remove it from the i-th row */ sv_ind[i_ptr] = sv_ind[i_end]; sv_val[i_ptr] = sv_val[i_end]; vr_len[i]--; i_end--; /* and from the q-th column */ sv_ind[q_beg] = sv_ind[q_end]; vc_len[q]--; q_end--; /* perform gaussian transformation: (i-th row) := (i-th row) - f[i,p] * (p-th row) note that now the p-th row, which is in the working array, doesn't contain the pivot v[p,q], and the i-th row doesn't contain the eliminated element v[i,q] */ /* walk through the i-th row and transform existing non-zero elements */ fill = vr_len[p]; for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++) { /* get column index of v[i,j] */ j = sv_ind[i_ptr]; /* v[i,j] := v[i,j] - f[i,p] * v[p,j] */ if (flag[j]) { /* v[p,j] != 0 */ temp = (sv_val[i_ptr] -= fip * work[j]); if (temp < 0.0) temp = - temp; flag[j] = 0; fill--; /* since both v[i,j] and v[p,j] exist */ if (temp == 0.0 || temp < eps_tol) { /* new v[i,j] is closer to zero; replace it by exact zero, i.e. remove it from the active submatrix */ /* remove v[i,j] from the i-th row */ sv_ind[i_ptr] = sv_ind[i_end]; sv_val[i_ptr] = sv_val[i_end]; vr_len[i]--; i_ptr--; i_end--; /* find v[i,j] in the j-th column */ j_beg = vc_ptr[j]; j_end = j_beg + vc_len[j] - 1; for (j_ptr = j_beg; sv_ind[j_ptr] != i; j_ptr++){} xassert(j_ptr <= j_end); /* remove v[i,j] from the j-th column */ sv_ind[j_ptr] = sv_ind[j_end]; vc_len[j]--; } else { /* v_big := max(v_big, |v[i,j]|) */ if (luf.big_v < temp) luf.big_v = temp; } } } /* now flag is the pattern of the set v[p,*] \ v[i,*], and fill is number of non-zeros in this set; therefore up to fill new non-zeros may appear in the i-th row */ if (vr_len[i] + fill > vr_cap[i]) { /* enlarge the i-th row */ if (luf_enlarge_row(luf, i, vr_len[i] + fill)) { /* overflow of the sparse vector area */ ret = 1; return ret; } /* defragmentation may change row and column pointers of the matrix V */ p_beg = vr_ptr[p]; p_end = p_beg + vr_len[p] - 1; q_beg = vc_ptr[q]; q_end = q_beg + vc_len[q] - 1; } /* walk through the p-th (pivot) row and create new elements of the i-th row that appear due to fill-in; column indices of these new elements are accumulated in the array ndx */ len = 0; for (p_ptr = p_beg; p_ptr <= p_end; p_ptr++) { /* get column index of v[p,j], which may cause fill-in */ j = sv_ind[p_ptr]; if (flag[j]) { /* compute new non-zero v[i,j] = 0 - f[i,p] * v[p,j] */ temp = (val = - fip * work[j]); if (temp < 0.0) temp = - temp; if (temp == 0.0 || temp < eps_tol){ /* if v[i,j] is closer to zero; just ignore it */ } else { /* add v[i,j] to the i-th row */ i_ptr = vr_ptr[i] + vr_len[i]; sv_ind[i_ptr] = j; sv_val[i_ptr] = val; vr_len[i]++; /* remember column index of v[i,j] */ ndx[++len] = j; /* big_v := max(big_v, |v[i,j]|) */ if (luf.big_v < temp) luf.big_v = temp; } } else { /* there is no fill-in, because v[i,j] already exists in the i-th row; restore the flag of the element v[p,j], which was reset before */ flag[j] = 1; } } /* add new non-zeros v[i,j] to the corresponding columns */ for (k = 1; k <= len; k++) { /* get column index of new non-zero v[i,j] */ j = ndx[k]; /* one free location is needed in the j-th column */ if (vc_len[j] + 1 > vc_cap[j]) { /* enlarge the j-th column */ if (luf_enlarge_col(luf, j, vc_len[j] + 10)) { /* overflow of the sparse vector area */ ret = 1; return ret; } /* defragmentation may change row and column pointers of the matrix V */ p_beg = vr_ptr[p]; p_end = p_beg + vr_len[p] - 1; q_beg = vc_ptr[q]; q_end = q_beg + vc_len[q] - 1; } /* add new non-zero v[i,j] to the j-th column */ j_ptr = vc_ptr[j] + vc_len[j]; sv_ind[j_ptr] = i; vc_len[j]++; } /* now the i-th row has been completely transformed, therefore it can return to the active set with new length */ rs_prev[i] = 0; rs_next[i] = rs_head[vr_len[i]]; if (rs_next[i] != 0) rs_prev[rs_next[i]] = i; rs_head[vr_len[i]] = i; /* the largest of absolute values of elements in the i-th row is currently unknown */ vr_max[i] = -1.0; /* at least one free location is needed to store the gaussian multiplier */ if (luf.sv_end - luf.sv_beg < 1) { /* there are no free locations at all; defragment SVA */ luf_defrag_sva(luf); if (luf.sv_end - luf.sv_beg < 1) { /* overflow of the sparse vector area */ ret = 1; return ret; } /* defragmentation may change row and column pointers of the matrix V */ p_beg = vr_ptr[p]; p_end = p_beg + vr_len[p] - 1; q_beg = vc_ptr[q]; q_end = q_beg + vc_len[q] - 1; } /* add the element f[i,p], which is the gaussian multiplier, to the matrix F */ luf.sv_end--; sv_ind[luf.sv_end] = i; sv_val[luf.sv_end] = fip; fc_len[p]++; /* end of elimination loop */ } /* at this point the q-th (pivot) column should be empty */ xassert(vc_len[q] == 0); /* reset capacity of the q-th column */ vc_cap[q] = 0; /* remove node of the q-th column from the addressing list */ k = n + q; if (sv_prev[k] == 0) luf.sv_head = sv_next[k]; else sv_next[sv_prev[k]] = sv_next[k]; if (sv_next[k] == 0) luf.sv_tail = sv_prev[k]; else sv_prev[sv_next[k]] = sv_prev[k]; /* the p-th column of the matrix F has been completely built; set its pointer */ fc_ptr[p] = luf.sv_end; /* walk through the p-th (pivot) row and do the following... */ for (p_ptr = p_beg; p_ptr <= p_end; p_ptr++) { /* get column index of v[p,j] */ j = sv_ind[p_ptr]; /* erase v[p,j] from the working array */ flag[j] = 0; work[j] = 0.0; /* the j-th column has been completely transformed, therefore it can return to the active set with new length; however the special case c_prev[j] = c_next[j] = j means that the routine find_pivot excluded the j-th column from the active set due to Uwe Suhl's rule, and therefore in this case the column can return to the active set only if it is a column singleton */ if (!(vc_len[j] != 1 && cs_prev[j] == j && cs_next[j] == j)) { cs_prev[j] = 0; cs_next[j] = cs_head[vc_len[j]]; if (cs_next[j] != 0) cs_prev[cs_next[j]] = j; cs_head[vc_len[j]] = j; } } /* return to the factorizing routine */ return ret; } function build_v_cols(luf){ var n = luf.n; var vr_ptr = luf.vr_ptr; var vr_len = luf.vr_len; var vc_ptr = luf.vc_ptr; var vc_len = luf.vc_len; var vc_cap = luf.vc_cap; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var sv_prev = luf.sv_prev; var sv_next = luf.sv_next; var ret = 0; var i, i_beg, i_end, i_ptr, j, j_ptr, k, nnz; /* it is assumed that on entry all columns of the matrix V are empty, i.e. vc_len[j] = vc_cap[j] = 0 for all j = 1, ..., n, and have been removed from the addressing list */ /* count non-zeros in columns of the matrix V; count total number of non-zeros in this matrix */ nnz = 0; for (i = 1; i <= n; i++) { /* walk through elements of the i-th row and count non-zeros in the corresponding columns */ i_beg = vr_ptr[i]; i_end = i_beg + vr_len[i] - 1; for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++) vc_cap[sv_ind[i_ptr]]++; /* count total number of non-zeros */ nnz += vr_len[i]; } /* store total number of non-zeros */ luf.nnz_v = nnz; /* check for free locations */ if (luf.sv_end - luf.sv_beg < nnz) { /* overflow of the sparse vector area */ ret = 1; return ret; } /* allocate columns of the matrix V */ for (j = 1; j <= n; j++) { /* set pointer to the j-th column */ vc_ptr[j] = luf.sv_beg; /* reserve locations for the j-th column */ luf.sv_beg += vc_cap[j]; } /* build the matrix V in column-wise format using this matrix in row-wise format */ for (i = 1; i <= n; i++) { /* walk through elements of the i-th row */ i_beg = vr_ptr[i]; i_end = i_beg + vr_len[i] - 1; for (i_ptr = i_beg; i_ptr <= i_end; i_ptr++) { /* get column index */ j = sv_ind[i_ptr]; /* store element in the j-th column */ j_ptr = vc_ptr[j] + vc_len[j]; sv_ind[j_ptr] = i; sv_val[j_ptr] = sv_val[i_ptr]; /* increase length of the j-th column */ vc_len[j]++; } } /* now columns are placed in the sparse vector area behind rows in the order n+1, n+2, ..., n+n; so insert column nodes in the addressing list using this order */ for (k = n+1; k <= n+n; k++) { sv_prev[k] = k-1; sv_next[k] = k+1; } sv_prev[n+1] = luf.sv_tail; sv_next[luf.sv_tail] = n+1; sv_next[n+n] = 0; luf.sv_tail = n+n; /* return to the factorizing routine */ return ret; } function build_f_rows(luf){ var n = luf.n; var fr_ptr = luf.fr_ptr; var fr_len = luf.fr_len; var fc_ptr = luf.fc_ptr; var fc_len = luf.fc_len; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var ret = 0; var i, j, j_beg, j_end, j_ptr, ptr, nnz; /* clear rows of the matrix F */ for (i = 1; i <= n; i++) fr_len[i] = 0; /* count non-zeros in rows of the matrix F; count total number of non-zeros in this matrix */ nnz = 0; for (j = 1; j <= n; j++) { /* walk through elements of the j-th column and count non-zeros in the corresponding rows */ j_beg = fc_ptr[j]; j_end = j_beg + fc_len[j] - 1; for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++) fr_len[sv_ind[j_ptr]]++; /* increase total number of non-zeros */ nnz += fc_len[j]; } /* store total number of non-zeros */ luf.nnz_f = nnz; /* check for free locations */ if (luf.sv_end - luf.sv_beg < nnz) { /* overflow of the sparse vector area */ ret = 1; return ret; } /* allocate rows of the matrix F */ for (i = 1; i <= n; i++) { /* set pointer to the end of the i-th row; later this pointer will be set to the beginning of the i-th row */ fr_ptr[i] = luf.sv_end; /* reserve locations for the i-th row */ luf.sv_end -= fr_len[i]; } /* build the matrix F in row-wise format using this matrix in column-wise format */ for (j = 1; j <= n; j++) { /* walk through elements of the j-th column */ j_beg = fc_ptr[j]; j_end = j_beg + fc_len[j] - 1; for (j_ptr = j_beg; j_ptr <= j_end; j_ptr++) { /* get row index */ i = sv_ind[j_ptr]; /* store element in the i-th row */ ptr = --fr_ptr[i]; sv_ind[ptr] = j; sv_val[ptr] = sv_val[j_ptr]; } } /* return to the factorizing routine */ return ret; } function luf_factorize(luf, n, col, info){ var pp_row, pp_col, qq_row, qq_col; var max_gro = luf.max_gro; var i, j, k, p, q, t, ret = null; if (n < 1) xerror("luf_factorize: n = " + n + "; invalid parameter"); if (n > N_MAX) xerror("luf_factorize: n = " + n + "; matrix too big"); /* invalidate the factorization */ luf.valid = 0; /* reallocate arrays, if necessary */ reallocate(luf, n); pp_row = luf.pp_row; pp_col = luf.pp_col; qq_row = luf.qq_row; qq_col = luf.qq_col; /* estimate initial size of the SVA, if not specified */ if (luf.sv_size == 0 && luf.new_sva == 0) luf.new_sva = 5 * (n + 10); function more(){ /* reallocate the sparse vector area, if required */ if (luf.new_sva > 0) { luf.sv_size = luf.new_sva; luf.sv_ind = new Int32Array(1+luf.sv_size); luf.sv_val = new Float64Array(1+luf.sv_size); luf.new_sva = 0; } /* initialize LU-factorization data structures */ if (initialize(luf, col, info)) { /* overflow of the sparse vector area */ luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); return true; } /* main elimination loop */ for (k = 1; k <= n; k++) { /* choose a pivot element v[p,q] */ if (find_pivot(luf, function(_p, _q){p = _p; q = _q})) { /* no pivot can be chosen, because the active submatrix is exactly zero */ luf.rank = k - 1; ret = LUF_ESING; return false; } /* let v[p,q] correspond to u[i',j']; permute k-th and i'-th rows and k-th and j'-th columns of the matrix U = P*V*Q to move the element u[i',j'] to the position u[k,k] */ i = pp_col[p]; j = qq_row[q]; xassert(k <= i && i <= n && k <= j && j <= n); /* permute k-th and i-th rows of the matrix U */ t = pp_row[k]; pp_row[i] = t; pp_col[t] = i; pp_row[k] = p; pp_col[p] = k; /* permute k-th and j-th columns of the matrix U */ t = qq_col[k]; qq_col[j] = t; qq_row[t] = j; qq_col[k] = q; qq_row[q] = k; /* eliminate subdiagonal elements of k-th column of the matrix U = P*V*Q using the pivot element u[k,k] = v[p,q] */ if (eliminate(luf, p, q)) { /* overflow of the sparse vector area */ luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); return true; } /* check relative growth of elements of the matrix V */ if (luf.big_v > max_gro * luf.max_a) { /* the growth is too intensive, therefore most probably the matrix A is ill-conditioned */ luf.rank = k - 1; ret = LUF_ECOND; return false; } } /* now the matrix U = P*V*Q is upper triangular, the matrix V has been built in row-wise format, and the matrix F has been built in column-wise format */ /* defragment the sparse vector area in order to merge all free locations in one continuous extent */ luf_defrag_sva(luf); /* build the matrix V in column-wise format */ if (build_v_cols(luf)) { /* overflow of the sparse vector area */ luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); return true; } /* build the matrix F in row-wise format */ if (build_f_rows(luf)) { /* overflow of the sparse vector area */ luf.new_sva = luf.sv_size + luf.sv_size; xassert(luf.new_sva > luf.sv_size); return true; } return false; } while (more()){} if (ret != null) return ret; /* the LU-factorization has been successfully computed */ luf.valid = 1; luf.rank = n; ret = 0; /* if there are few free locations in the sparse vector area, try increasing its size in the future */ t = 3 * (n + luf.nnz_v) + 2 * luf.nnz_f; if (luf.sv_size < t) { luf.new_sva = luf.sv_size; while (luf.new_sva < t) { k = luf.new_sva; luf.new_sva = k + k; xassert(luf.new_sva > k); } } /* return to the calling program */ return ret; } function luf_f_solve(luf, tr, x){ var n = luf.n; var fr_ptr = luf.fr_ptr; var fr_len = luf.fr_len; var fc_ptr = luf.fc_ptr; var fc_len = luf.fc_len; var pp_row = luf.pp_row; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var i, j, k, beg, end, ptr; var xk; if (!luf.valid) xerror("luf_f_solve: LU-factorization is not valid"); if (!tr) { /* solve the system F*x = b */ for (j = 1; j <= n; j++) { k = pp_row[j]; xk = x[k]; if (xk != 0.0) { beg = fc_ptr[k]; end = beg + fc_len[k] - 1; for (ptr = beg; ptr <= end; ptr++) x[sv_ind[ptr]] -= sv_val[ptr] * xk; } } } else { /* solve the system F'*x = b */ for (i = n; i >= 1; i--) { k = pp_row[i]; xk = x[k]; if (xk != 0.0) { beg = fr_ptr[k]; end = beg + fr_len[k] - 1; for (ptr = beg; ptr <= end; ptr++) x[sv_ind[ptr]] -= sv_val[ptr] * xk; } } } } function luf_v_solve(luf, tr, x){ var n = luf.n; var vr_ptr = luf.vr_ptr; var vr_len = luf.vr_len; var vr_piv = luf.vr_piv; var vc_ptr = luf.vc_ptr; var vc_len = luf.vc_len; var pp_row = luf.pp_row; var qq_col = luf.qq_col; var sv_ind = luf.sv_ind; var sv_val = luf.sv_val; var b = luf.work; var i, j, k, beg, end, ptr; var temp; if (!luf.valid) xerror("luf_v_solve: LU-factorization is not valid"); for (k = 1; k <= n; k++){b[k] = x[k]; x[k] = 0.0} if (!tr) { /* solve the system V*x = b */ for (k = n; k >= 1; k--) { i = pp_row[k]; j = qq_col[k]; temp = b[i]; if (temp != 0.0) { x[j] = (temp /= vr_piv[i]); beg = vc_ptr[j]; end = beg + vc_len[j] - 1; for (ptr = beg; ptr <= end; ptr++) b[sv_ind[ptr]] -= sv_val[ptr] * temp; } } } else { /* solve the system V'*x = b */ for (k = 1; k <= n; k++) { i = pp_row[k]; j = qq_col[k]; temp = b[j]; if (temp != 0.0) { x[i] = (temp /= vr_piv[i]); beg = vr_ptr[i]; end = beg + vr_len[i] - 1; for (ptr = beg; ptr <= end; ptr++) b[sv_ind[ptr]] -= sv_val[ptr] * temp; } } } } function luf_a_solve(luf, tr, x){ if (!luf.valid) xerror("luf_a_solve: LU-factorization is not valid"); if (!tr) { /* A = F*V, therefore inv(A) = inv(V)*inv(F) */ luf_f_solve(luf, 0, x); luf_v_solve(luf, 0, x); } else { /* A' = V'*F', therefore inv(A') = inv(F')*inv(V') */ luf_v_solve(luf, 1, x); luf_f_solve(luf, 1, x); } } var MPL_EOF = -1; var A_BINARY = 101, /* something binary */ A_CHECK = 102, /* check statement */ A_CONSTRAINT = 103, /* model constraint */ A_DISPLAY = 104, /* display statement */ A_ELEMCON = 105, /* elemental constraint/objective */ A_ELEMSET = 106, /* elemental set */ A_ELEMVAR = 107, /* elemental variable */ A_EXPRESSION = 108, /* expression */ A_FOR = 109, /* for statement */ A_FORMULA = 110, /* formula */ A_INDEX = 111, /* dummy index */ A_INPUT = 112, /* input table */ A_INTEGER = 113, /* something integer */ A_LOGICAL = 114, /* something logical */ A_MAXIMIZE = 115, /* objective has to be maximized */ A_MINIMIZE = 116, /* objective has to be minimized */ A_NONE = 117, /* nothing */ A_NUMERIC = 118, /* something numeric */ A_OUTPUT = 119, /* output table */ A_PARAMETER = 120, /* model parameter */ A_PRINTF = 121, /* printf statement */ A_SET = 122, /* model set */ A_SOLVE = 123, /* solve statement */ A_SYMBOLIC = 124, /* something symbolic */ A_TABLE = 125, /* data table */ A_TUPLE = 126, /* n-tuple */ A_VARIABLE = 127; /* model variable */ /* size limit is not necessary var MAX_LENGTH = 100; maximal length of any symbolic value (this includes symbolic names, numeric and string literals, and all symbolic values that may appear during the evaluation phase) */ var CONTEXT_SIZE = 60; /* size of the context queue, in characters */ var OUTBUF_SIZE = 1024; /* size of the output buffer, in characters */ var T_EOF = 201, /* end of file */ T_NAME = 202, /* symbolic name (model section only) */ T_SYMBOL = 203, /* symbol (data section only) */ T_NUMBER = 204, /* numeric literal */ T_STRING = 205, /* string literal */ T_AND = 206, /* and && */ T_BY = 207, /* by */ T_CROSS = 208, /* cross */ T_DIFF = 209, /* diff */ T_DIV = 210, /* div */ T_ELSE = 211, /* else */ T_IF = 212, /* if */ T_IN = 213, /* in */ T_INFINITY = 214, /* Infinity */ T_INTER = 215, /* inter */ T_LESS = 216, /* less */ T_MOD = 217, /* mod */ T_NOT = 218, /* not ! */ T_OR = 219, /* or || */ T_SPTP = 220, /* s.t. */ T_SYMDIFF = 221, /* symdiff */ T_THEN = 222, /* then */ T_UNION = 223, /* union */ T_WITHIN = 224, /* within */ T_PLUS = 225, /* + */ T_MINUS = 226, /* - */ T_ASTERISK = 227, /* * */ T_SLASH = 228, /* / */ T_POWER = 229, /* ^ ** */ T_LT = 230, /* < */ T_LE = 231, /* <= */ T_EQ = 232, /* = == */ T_GE = 233, /* >= */ T_GT = 234, /* > */ T_NE = 235, /* <> != */ T_CONCAT = 236, /* & */ T_BAR = 237, /* | */ T_POINT = 238, /* . */ T_COMMA = 239, /* , */ T_COLON = 240, /* : */ T_SEMICOLON = 241, /* ; */ T_ASSIGN = 242, /* := */ T_DOTS = 243, /* .. */ T_LEFT = 244, /* ( */ T_RIGHT = 245, /* ) */ T_LBRACKET = 246, /* [ */ T_RBRACKET = 247, /* ] */ T_LBRACE = 248, /* { */ T_RBRACE = 249, /* } */ T_APPEND = 250, /* >> */ T_TILDE = 251, /* ~ */ T_INPUT = 252; /* <- */ /* suffix specified: */ var DOT_NONE = 0x00, /* none (means variable itself) */ DOT_LB = 0x01, /* .lb (lower bound) */ DOT_UB = 0x02, /* .ub (upper bound) */ DOT_STATUS = 0x03, /* .status (status) */ DOT_VAL = 0x04, /* .val (primal value) */ DOT_DUAL = 0x05; /* .dual (dual value) */ /* operation code: */ var O_NUMBER = 301, /* take floating-point number */ O_STRING = 302, /* take character string */ O_INDEX = 303, /* take dummy index */ O_MEMNUM = 304, /* take member of numeric parameter */ O_MEMSYM = 305, /* take member of symbolic parameter */ O_MEMSET = 306, /* take member of set */ O_MEMVAR = 307, /* take member of variable */ O_MEMCON = 308, /* take member of constraint */ O_TUPLE = 309, /* make n-tuple */ O_MAKE = 310, /* make elemental set of n-tuples */ O_SLICE = 311, /* define domain block (dummy op) */ /* 0-ary operations --------------------*/ O_IRAND224 = 312, /* pseudo-random in [0, 2^24-1] */ O_UNIFORM01 = 313, /* pseudo-random in [0, 1) */ O_NORMAL01 = 314, /* gaussian random, mu = 0, sigma = 1 */ O_GMTIME = 315, /* current calendar time (UTC) */ /* unary operations --------------------*/ O_CVTNUM = 316, /* conversion to numeric */ O_CVTSYM = 317, /* conversion to symbolic */ O_CVTLOG = 318, /* conversion to logical */ O_CVTTUP = 319, /* conversion to 1-tuple */ O_CVTLFM = 320, /* conversion to linear form */ O_PLUS = 321, /* unary plus */ O_MINUS = 322, /* unary minus */ O_NOT = 323, /* negation (logical "not") */ O_ABS = 324, /* absolute value */ O_CEIL = 325, /* round upward ("ceiling of x") */ O_FLOOR = 326, /* round downward ("floor of x") */ O_EXP = 327, /* base-e exponential */ O_LOG = 328, /* natural logarithm */ O_LOG10 = 329, /* common (decimal) logarithm */ O_SQRT = 330, /* square root */ O_SIN = 331, /* trigonometric sine */ O_COS = 332, /* trigonometric cosine */ O_ATAN = 333, /* trigonometric arctangent */ O_ROUND = 334, /* round to nearest integer */ O_TRUNC = 335, /* truncate to nearest integer */ O_CARD = 336, /* cardinality of set */ O_LENGTH = 337, /* length of symbolic value */ /* binary operations -------------------*/ O_ADD = 338, /* addition */ O_SUB = 339, /* subtraction */ O_LESS = 340, /* non-negative subtraction */ O_MUL = 341, /* multiplication */ O_DIV = 342, /* division */ O_IDIV = 343, /* quotient of exact division */ O_MOD = 344, /* remainder of exact division */ O_POWER = 345, /* exponentiation (raise to power) */ O_ATAN2 = 346, /* trigonometric arctangent */ O_ROUND2 = 347, /* round to n fractional digits */ O_TRUNC2 = 348, /* truncate to n fractional digits */ O_UNIFORM = 349, /* pseudo-random in [a, b) */ O_NORMAL = 350, /* gaussian random, given mu and sigma */ O_CONCAT = 351, /* concatenation */ O_LT = 352, /* comparison on 'less than' */ O_LE = 353, /* comparison on 'not greater than' */ O_EQ = 354, /* comparison on 'equal to' */ O_GE = 355, /* comparison on 'not less than' */ O_GT = 356, /* comparison on 'greater than' */ O_NE = 357, /* comparison on 'not equal to' */ O_AND = 358, /* conjunction (logical "and") */ O_OR = 359, /* disjunction (logical "or") */ O_UNION = 360, /* union */ O_DIFF = 361, /* difference */ O_SYMDIFF = 362, /* symmetric difference */ O_INTER = 363, /* intersection */ O_CROSS = 364, /* cross (Cartesian) product */ O_IN = 365, /* test on 'x in Y' */ O_NOTIN = 366, /* test on 'x not in Y' */ O_WITHIN = 367, /* test on 'X within Y' */ O_NOTWITHIN = 368, /* test on 'X not within Y' */ O_SUBSTR = 369, /* substring */ O_STR2TIME = 370, /* convert string to time */ O_TIME2STR = 371, /* convert time to string */ /* ternary operations ------------------*/ O_DOTS = 372, /* build "arithmetic" set */ O_FORK = 373, /* if-then-else */ O_SUBSTR3 = 374, /* substring */ /* n-ary operations --------------------*/ O_MIN = 375, /* minimal value (n-ary) */ O_MAX = 376, /* maximal value (n-ary) */ /* iterated operations -----------------*/ O_SUM = 377, /* summation */ O_PROD = 378, /* multiplication */ O_MINIMUM = 379, /* minimum */ O_MAXIMUM = 380, /* maximum */ O_FORALL = 381, /* conjunction (A-quantification) */ O_EXISTS = 382, /* disjunction (E-quantification) */ O_SETOF = 383, /* compute elemental set */ O_BUILD = 384; /* build elemental set */ /**********************************************************************/ /* * * SOLVER INTERFACE * * */ /**********************************************************************/ var MPL_FR = 401, /* free (unbounded) */ MPL_LO = 402, /* lower bound */ MPL_UP = 403, /* upper bound */ MPL_DB = 404, /* both lower and upper bounds */ MPL_FX = 405, /* fixed */ MPL_ST = 411, /* constraint */ MPL_MIN = 412, /* objective (minimization) */ MPL_MAX = 413, /* objective (maximization) */ MPL_NUM = 421, /* continuous */ MPL_INT = 422, /* integer */ MPL_BIN = 423; /* binary */ function mpl_internal_create_operands(){ return {index: {},par: {},set: {},var_: {},con: {},arg: {},loop: {}}; } /* glpmpl01.c */ /**********************************************************************/ /* * * PROCESSING MODEL SECTION * * */ /**********************************************************************/ function mpl_internal_enter_context(mpl){ var image; if (mpl.token == T_EOF) image = "_|_"; else if (mpl.token == T_STRING) image = "'...'"; else image = mpl.image; xassert(0 <= mpl.c_ptr && mpl.c_ptr < CONTEXT_SIZE); mpl.context[mpl.c_ptr++] = ' '; if (mpl.c_ptr == CONTEXT_SIZE) mpl.c_ptr = 0; for (var s = 0; s < image.length; s++) { mpl.context[mpl.c_ptr++] = image[s]; if (mpl.c_ptr == CONTEXT_SIZE) mpl.c_ptr = 0; } } function mpl_internal_print_context(mpl){ var c; while (mpl.c_ptr > 0) { mpl.c_ptr--; c = mpl.context[0]; xcopyArr(mpl.context, 0, mpl.context, 1, CONTEXT_SIZE-1); mpl.context[CONTEXT_SIZE-1] = c; } xprintf("Context: " + mpl.line + " > " + (mpl.context[0] == ' ' ? "" : "...") + mpl.context.join('').trim()); } function mpl_internal_get_char(mpl){ var c; if (mpl.c == MPL_EOF) return; if (mpl.c == '\n'){ mpl.line++; mpl.column = 0; } c = mpl_internal_read_char(mpl); mpl.column++; if (c == MPL_EOF) { if (mpl.c == '\n') mpl.line--; else mpl_internal_warning(mpl, "final NL missing before end of file"); } else if (c == '\n'){ } else if (isspace(c)) c = ' '; else if (iscntrl(c)) { mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "control character " + c + " not allowed"); } mpl.c = c; } function mpl_internal_append_char(mpl){ xassert(0 <= mpl.imlen /*&& mpl.imlen <= MAX_LENGTH*/); /* if (mpl.imlen >= MAX_LENGTH) { switch (mpl.token) { case T_NAME: mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "symbolic name " + mpl.image + "... too long"); break; case T_SYMBOL: mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "symbol " + mpl.image + "... too long"); break; case T_NUMBER: mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "numeric literal " + mpl.image + "... too long"); break; case T_STRING: mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "string literal too long"); break; default: xassert(mpl != mpl); } } */ mpl.image += mpl.c ; mpl.imlen++; mpl_internal_get_char(mpl); } function mpl_internal_get_token(mpl){ function sptp(){ mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "keyword s.t. incomplete"); } function err(){ mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "cannot convert numeric literal " + mpl.image + " to floating-point number"); } function scanDecimal(){ /* scan optional decimal exponent */ if (mpl.c == 'e' || mpl.c == 'E') { mpl_internal_append_char(mpl); if (mpl.c == '+' || mpl.c == '-') mpl_internal_append_char(mpl); if (!isdigit(mpl.c)) { mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "numeric literal " + mpl.image + " incomplete"); } while (isdigit(mpl.c)) mpl_internal_append_char(mpl); } /* there must be no letter following the numeric literal */ if (isalpha(mpl.c) || mpl.c == '_') { mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "symbol " + mpl.image + mpl.c + "... should be enclosed in quotes"); } } /* save the current token */ mpl.b_token = mpl.token; mpl.b_imlen = mpl.imlen; mpl.b_image = mpl.image; mpl.b_value = mpl.value; /* if the next token is already scanned, make it current */ if (mpl.f_scan) { mpl.f_scan = 0; mpl.token = mpl.f_token; mpl.imlen = mpl.f_imlen; mpl.image = mpl.f_image; mpl.value = mpl.f_value; return; } /* nothing has been scanned so far */ while (true){ mpl.token = 0; mpl.imlen = 0; mpl.image = ''; mpl.value = 0.0; /* skip any uninteresting characters */ while (mpl.c == ' ' || mpl.c == '\n') mpl_internal_get_char(mpl); /* recognize and construct the token */ if (mpl.c == MPL_EOF) { /* end-of-file reached */ mpl.token = T_EOF; } else if (mpl.c == '#') { /* comment; skip anything until end-of-line */ while (mpl.c != '\n' && mpl.c != MPL_EOF) mpl_internal_get_char(mpl); continue; } else if (!mpl.flag_d && (isalpha(mpl.c) || mpl.c == '_')) { /* symbolic name or reserved keyword */ mpl.token = T_NAME; while (isalnum(mpl.c) || mpl.c == '_') mpl_internal_append_char(mpl); if (mpl.image == "and") mpl.token = T_AND; else if (mpl.image == "by") mpl.token = T_BY; else if (mpl.image == "cross") mpl.token = T_CROSS; else if (mpl.image == "diff") mpl.token = T_DIFF; else if (mpl.image == "div") mpl.token = T_DIV; else if (mpl.image == "else") mpl.token = T_ELSE; else if (mpl.image == "if") mpl.token = T_IF; else if (mpl.image == "in") mpl.token = T_IN; else if (mpl.image == "Infinity") mpl.token = T_INFINITY; else if (mpl.image == "inter") mpl.token = T_INTER; else if (mpl.image == "less") mpl.token = T_LESS; else if (mpl.image == "mod") mpl.token = T_MOD; else if (mpl.image == "not") mpl.token = T_NOT; else if (mpl.image == "or") mpl.token = T_OR; else if (mpl.image == "s" && mpl.c == '.') { mpl.token = T_SPTP; mpl_internal_append_char(mpl); if (mpl.c != 't') sptp(); mpl_internal_append_char(mpl); if (mpl.c != '.') sptp(); mpl_internal_append_char(mpl); } else if (mpl.image == "symdiff") mpl.token = T_SYMDIFF; else if (mpl.image == "then") mpl.token = T_THEN; else if (mpl.image == "union") mpl.token = T_UNION; else if (mpl.image == "within") mpl.token = T_WITHIN; } else if (!mpl.flag_d && isdigit(mpl.c)) { /* numeric literal */ mpl.token = T_NUMBER; /* scan integer part */ while (isdigit(mpl.c)) mpl_internal_append_char(mpl); /* scan optional fractional part */ var skip = false; if (mpl.c == '.') { mpl_internal_append_char(mpl); if (mpl.c == '.') { /* hmm, it is not the fractional part, it is dots that follow the integer part */ mpl.imlen--; mpl.image = mpl.image.substr(0,mpl.image.length-1); mpl.f_dots = 1; skip = true; } else{ while (isdigit(mpl.c)) mpl_internal_append_char(mpl); } } if (!skip) scanDecimal(); /* convert numeric literal to floating-point */ if (str2num(mpl.image, function(v){mpl.value = v})) err(); } else if (mpl.c == '\'' || mpl.c == '"') { /* character string */ var quote = mpl.c; var triple = false; mpl.token = T_STRING; mpl_internal_get_char(mpl); function eat(){ for (;;) { if ((mpl.c == '\n' && !triple) || mpl.c == MPL_EOF) { mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "unexpected end of line; string literal incomplete"); } if (mpl.c == quote) { mpl_internal_get_char(mpl); if (mpl.c == quote) { if (triple) { mpl_internal_get_char(mpl); if (mpl.c == quote) { mpl_internal_get_char(mpl); break; } else { mpl.image += '""' ; mpl.imlen += 2; } } } else { if (triple) { mpl.image += '"' ; mpl.imlen++; } else break; } } mpl_internal_append_char(mpl); } } if (mpl.c == quote){ mpl_internal_get_char(mpl); if (mpl.c == quote){ triple = true; mpl_internal_get_char(mpl); eat(); } else { // empty string } } else { eat() } } else if (!mpl.flag_d && mpl.c == '+'){ mpl.token = T_PLUS; mpl_internal_append_char(mpl); } else if (!mpl.flag_d && mpl.c == '-'){ mpl.token = T_MINUS; mpl_internal_append_char(mpl); } else if (mpl.c == '*') { mpl.token = T_ASTERISK; mpl_internal_append_char(mpl); if (mpl.c == '*'){ mpl.token = T_POWER; mpl_internal_append_char(mpl); } } else if (mpl.c == '/') { mpl.token = T_SLASH; mpl_internal_append_char(mpl); if (mpl.c == '*') { /* comment sequence */ mpl_internal_get_char(mpl); for (;;) { if (mpl.c == MPL_EOF) { /* do not call enter_context at this point */ mpl_internal_error(mpl, "unexpected end of file; comment sequence incomplete"); } else if (mpl.c == '*') { mpl_internal_get_char(mpl); if (mpl.c == '/') break; } else mpl_internal_get_char(mpl); } mpl_internal_get_char(mpl); continue; } } else if (mpl.c == '^'){ mpl.token = T_POWER; mpl_internal_append_char(mpl); } else if (mpl.c == '<') { mpl.token = T_LT; mpl_internal_append_char(mpl); if (mpl.c == '='){ mpl.token = T_LE; mpl_internal_append_char(mpl); } else if (mpl.c == '>'){ mpl.token = T_NE; mpl_internal_append_char(mpl); } else if (mpl.c == '-'){ mpl.token = T_INPUT; mpl_internal_append_char(mpl); } } else if (mpl.c == '=') { mpl.token = T_EQ; mpl_internal_append_char(mpl); if (mpl.c == '=') mpl_internal_append_char(mpl); } else if (mpl.c == '>') { mpl.token = T_GT; mpl_internal_append_char(mpl); if (mpl.c == '='){ mpl.token = T_GE; mpl_internal_append_char(mpl); } else if (mpl.c == '>'){ mpl.token = T_APPEND; mpl_internal_append_char(mpl); } } else if (mpl.c == '!') { mpl.token = T_NOT; mpl_internal_append_char(mpl); if (mpl.c == '='){ mpl.token = T_NE; mpl_internal_append_char(mpl); } } else if (mpl.c == '&') { mpl.token = T_CONCAT; mpl_internal_append_char(mpl); if (mpl.c == '&'){ mpl.token = T_AND; mpl_internal_append_char(mpl); } } else if (mpl.c == '|') { mpl.token = T_BAR; mpl_internal_append_char(mpl); if (mpl.c == '|'){ mpl.token = T_OR; mpl_internal_append_char(mpl); } } else if (!mpl.flag_d && mpl.c == '.') { mpl.token = T_POINT; mpl_internal_append_char(mpl); if (mpl.f_dots) { /* dots; the first dot was read on the previous call to the scanner, so the current character is the second dot */ mpl.token = T_DOTS; mpl.imlen = 2; mpl.image = ".."; mpl.f_dots = 0; } else if (mpl.c == '.'){ mpl.token = T_DOTS; mpl_internal_append_char(mpl); } else if (isdigit(mpl.c)) { /* numeric literal that begins with the decimal point */ mpl.token = T_NUMBER; mpl_internal_append_char(mpl); while (isdigit(mpl.c)) mpl_internal_append_char(mpl); scanDecimal(); /* convert numeric literal to floating-point */ if (str2num(mpl.image, function(v){mpl.value = v})) err(); } } else if (mpl.c == ','){ mpl.token = T_COMMA; mpl_internal_append_char(mpl); } else if (mpl.c == ':') { mpl.token = T_COLON; mpl_internal_append_char(mpl); if (mpl.c == '='){ mpl.token = T_ASSIGN; mpl_internal_append_char(mpl); } } else if (mpl.c == ';'){ mpl.token = T_SEMICOLON; mpl_internal_append_char(mpl); } else if (mpl.c == '('){ mpl.token = T_LEFT; mpl_internal_append_char(mpl); } else if (mpl.c == ')'){ mpl.token = T_RIGHT; mpl_internal_append_char(mpl); } else if (mpl.c == '['){ mpl.token = T_LBRACKET; mpl_internal_append_char(mpl); } else if (mpl.c == ']'){ mpl.token = T_RBRACKET; mpl_internal_append_char(mpl); } else if (mpl.c == '{'){ mpl.token = T_LBRACE; mpl_internal_append_char(mpl); } else if (mpl.c == '}'){ mpl.token = T_RBRACE; mpl_internal_append_char(mpl); } else if (mpl.c == '~'){ mpl.token = T_TILDE; mpl_internal_append_char(mpl); } else if (isalnum(mpl.c) || strchr("+-._", mpl.c) >= 0) { /* symbol */ xassert(mpl.flag_d); mpl.token = T_SYMBOL; while (isalnum(mpl.c) || strchr("+-._", mpl.c) >= 0) mpl_internal_append_char(mpl); switch (str2num(mpl.image, function(v){mpl.value = v})){ case 0: mpl.token = T_NUMBER; break; case 1: err(); break; case 2: break; default: xassert(mpl != mpl); } } else { mpl_internal_enter_context(mpl); mpl_internal_error(mpl, "character " + mpl.c + " not allowed"); } break; } /* enter the current token into the context queue */ mpl_internal_enter_context(mpl); /* reset the flag, which may be set by indexing_expression() and is used by expression_list() */ mpl.flag_x = 0; } function mpl_internal_unget_token(mpl){ /* save the current token, which becomes the next one */ xassert(!mpl.f_scan); mpl.f_scan = 1; mpl.f_token = mpl.token; mpl.f_imlen = mpl.imlen; mpl.f_image = mpl.image; mpl.f_value = mpl.value; /* restore the previous token, which becomes the current one */ mpl.token = mpl.b_token; mpl.imlen = mpl.b_imlen; mpl.image = mpl.b_image; mpl.value = mpl.b_value; } function mpl_internal_is_keyword(mpl, keyword){ return mpl.token == T_NAME && mpl.image == keyword; } function mpl_internal_is_reserved(mpl){ return mpl.token == T_AND && mpl.image[0] == 'a' || mpl.token == T_BY || mpl.token == T_CROSS || mpl.token == T_DIFF || mpl.token == T_DIV || mpl.token == T_ELSE || mpl.token == T_IF || mpl.token == T_IN || mpl.token == T_INTER || mpl.token == T_LESS || mpl.token == T_MOD || mpl.token == T_NOT && mpl.image[0] == 'n' || mpl.token == T_OR && mpl.image[0] == 'o' || mpl.token == T_SYMDIFF || mpl.token == T_THEN || mpl.token == T_UNION || mpl.token == T_WITHIN; } function mpl_internal_make_code(mpl, op, arg, type, dim){ var code = {}; var domain; var block; var e; /* generate pseudo-code */ code.op = op; code.vflag = 0; /* is inherited from operand(s) */ /* copy operands and also make them referring to the pseudo-code being generated, because the latter becomes the parent for all its operands */ code.arg = mpl_internal_create_operands(); code.value = {}; switch (op) { case O_NUMBER: code.arg.num = arg.num; break; case O_STRING: code.arg.str = arg.str; break; case O_INDEX: code.arg.index.slot = arg.index.slot; code.arg.index.next = arg.index.next; break; case O_MEMNUM: case O_MEMSYM: for (e = arg.par.list; e != null; e = e.next) { xassert(e.x != null); xassert(e.x.up == null); e.x.up = code; code.vflag |= e.x.vflag; } code.arg.par.par = arg.par.par; code.arg.par.list = arg.par.list; break; case O_MEMSET: for (e = arg.set.list; e != null; e = e.next) { xassert(e.x != null); xassert(e.x.up == null); e.x.up = code; code.vflag |= e.x.vflag; } code.arg.set.set = arg.set.set; code.arg.set.list = arg.set.list; break; case O_MEMVAR: for (e = arg.var_.list; e != null; e = e.next) { xassert(e.x != null); xassert(e.x.up == null); e.x.up = code; code.vflag |= e.x.vflag; } code.arg.var_.var_ = arg.var_.var_; code.arg.var_.list = arg.var_.list; code.arg.var_.suff = arg.var_.suff; break; case O_MEMCON: for (e = arg.con.list; e != null; e = e.next) { xassert(e.x != null); xassert(e.x.up == null); e.x.up = code; code.vflag |= e.x.vflag; } code.arg.con.con = arg.con.con; code.arg.con.list = arg.con.list; code.arg.con.suff = arg.con.suff; break; case O_TUPLE: case O_MAKE: for (e = arg.list; e != null; e = e.next) { xassert(e.x != null); xassert(e.x.up == null); e.x.up = code; code.vflag |= e.x.vflag; } code.arg.list = arg.list; break; case O_SLICE: xassert(arg.slice != null); code.arg.slice = arg.slice; break; case O_IRAND224: case O_UNIFORM01: case O_NORMAL01: case O_GMTIME: code.vflag = 1; break; case O_CVTNUM: case O_CVTSYM: case O_CVTLOG: case O_CVTTUP: case O_CVTLFM: case O_PLUS: case O_MINUS: case O_NOT: case O_ABS: case O_CEIL: case O_FLOOR: case O_EXP: case O_LOG: case O_LOG10: case O_SQRT: case O_SIN: case O_COS: case O_ATAN: case O_ROUND: case O_TRUNC: case O_CARD: case O_LENGTH: /* unary operation */ xassert(arg.arg.x != null); xassert(arg.arg.x.up == null); arg.arg.x.up = code; code.vflag |= arg.arg.x.vflag; code.arg.arg.x = arg.arg.x; break; case O_ADD: case O_SUB: case O_LESS: case O_MUL: case O_DIV: case O_IDIV: case O_MOD: case O_POWER: case O_ATAN2: case O_ROUND2: case O_TRUNC2: case O_UNIFORM: if (op == O_UNIFORM) code.vflag = 1; case O_NORMAL: if (op == O_NORMAL) code.vflag = 1; case O_CONCAT: case O_LT: case O_LE: case O_EQ: case O_GE: case O_GT: case O_NE: case O_AND: case O_OR: case O_UNION: case O_DIFF: case O_SYMDIFF: case O_INTER: case O_CROSS: case O_IN: case O_NOTIN: case O_WITHIN: case O_NOTWITHIN: case O_SUBSTR: case O_STR2TIME: case O_TIME2STR: /* binary operation */ xassert(arg.arg.x != null); xassert(arg.arg.x.up == null); arg.arg.x.up = code; code.vflag |= arg.arg.x.vflag; xassert(arg.arg.y != null); xassert(arg.arg.y.up == null); arg.arg.y.up = code; code.vflag |= arg.arg.y.vflag; code.arg.arg.x = arg.arg.x; code.arg.arg.y = arg.arg.y; break; case O_DOTS: case O_FORK: case O_SUBSTR3: /* ternary operation */ xassert(arg.arg.x != null); xassert(arg.arg.x.up == null); arg.arg.x.up = code; code.vflag |= arg.arg.x.vflag; xassert(arg.arg.y != null); xassert(arg.arg.y.up == null); arg.arg.y.up = code; code.vflag |= arg.arg.y.vflag; if (arg.arg.z != null) { xassert(arg.arg.z.up == null); arg.arg.z.up = code; code.vflag |= arg.arg.z.vflag; } code.arg.arg.x = arg.arg.x; code.arg.arg.y = arg.arg.y; code.arg.arg.z = arg.arg.z; break; case O_MIN: case O_MAX: /* n-ary operation */ for (e = arg.list; e != null; e = e.next) { xassert(e.x != null); xassert(e.x.up == null); e.x.up = code; code.vflag |= e.x.vflag; } code.arg.list = arg.list; break; case O_SUM: case O_PROD: case O_MINIMUM: case O_MAXIMUM: case O_FORALL: case O_EXISTS: case O_SETOF: case O_BUILD: /* iterated operation */ domain = arg.loop.domain; xassert(domain != null); if (domain.code != null) { xassert(domain.code.up == null); domain.code.up = code; code.vflag |= domain.code.vflag; } for (block = domain.list; block != null; block = block.next) { xassert(block.code != null); xassert(block.code.up == null); block.code.up = code; code.vflag |= block.code.vflag; } if (arg.loop.x != null) { xassert(arg.loop.x.up == null); arg.loop.x.up = code; code.vflag |= arg.loop.x.vflag; } code.arg.loop.domain = arg.loop.domain; code.arg.loop.x = arg.loop.x; break; default: xassert(op != op); } /* set other attributes of the pseudo-code */ code.type = type; code.dim = dim; code.up = null; code.valid = 0; code.value = {}; return code; } function mpl_internal_make_unary(mpl, op, x, type, dim){ var code; var arg = mpl_internal_create_operands(); xassert(x != null); arg.arg.x = x; code = mpl_internal_make_code(mpl, op, arg, type, dim); return code; } function mpl_internal_make_binary(mpl, op, x, y, type, dim){ var code; var arg = mpl_internal_create_operands(); xassert(x != null); xassert(y != null); arg.arg.x = x; arg.arg.y = y; code = mpl_internal_make_code(mpl, op, arg, type, dim); return code; } function mpl_internal_make_ternary(mpl, op, x, y, z, type, dim){ var code; var arg = mpl_internal_create_operands(); xassert(x != null); xassert(y != null); /* third operand can be null */ arg.arg.x = x; arg.arg.y = y; arg.arg.z = z; code = mpl_internal_make_code(mpl, op, arg, type, dim); return code; } function mpl_internal_numeric_literal(mpl){ var code; var arg = mpl_internal_create_operands(); xassert(mpl.token == T_NUMBER); arg.num = mpl.value; code = mpl_internal_make_code(mpl, O_NUMBER, arg, A_NUMERIC, 0); mpl_internal_get_token(mpl /* */); return code; } function mpl_internal_string_literal(mpl){ var code; var arg = mpl_internal_create_operands(); xassert(mpl.token == T_STRING); arg.str = mpl.image; code = mpl_internal_make_code(mpl, O_STRING, arg, A_SYMBOLIC, 0); mpl_internal_get_token(mpl /* */); return code; } function mpl_internal_expand_arg_list(mpl, list, x){ var tail = {}, temp; xassert(x != null); /* create new operands list entry */ tail.x = x; tail.next = null; /* and append it to the operands list */ if (list == null) list = tail; else { for (temp = list; temp.next != null; temp = temp.next){} temp.next = tail; } return list; } function mpl_internal_arg_list_len(mpl, list){ var temp; var len; len = 0; for (temp = list; temp != null; temp = temp.next) len++; return len; } function mpl_internal_subscript_list(mpl){ var x; var list = null; for (;;) { /* parse subscript expression */ x = mpl_internal_expression_5(mpl); /* convert it to symbolic type, if necessary */ if (x.type == A_NUMERIC) x = mpl_internal_make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); /* check that now the expression is of symbolic type */ if (x.type != A_SYMBOLIC) mpl_internal_error(mpl, "subscript expression has invalid type"); xassert(x.dim == 0); /* and append it to the subscript list */ list = mpl_internal_expand_arg_list(mpl, list, x); /* check a token that follows the subscript expression */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_RBRACKET) break; else mpl_internal_error(mpl, "syntax error in subscript list"); } return list; } function mpl_internal_object_reference(mpl){ var slot, set, par, var_, con, list, code, name, dim, suff; var arg = mpl_internal_create_operands(); /* find the object in the symbolic name table */ xassert(mpl.token == T_NAME); var node = mpl.tree[mpl.image]; if (node == null) mpl_internal_error(mpl, mpl.image + " not defined"); /* check the object type and obtain its dimension */ switch (node.type) { case A_INDEX: /* dummy index */ slot = node.link; name = slot.name; dim = 0; break; case A_SET: /* model set */ set = node.link; name = set.name; dim = set.dim; /* if a set object is referenced in its own declaration and the dimen attribute is not specified yet, use dimen 1 by default */ if (set.dimen == 0) set.dimen = 1; break; case A_PARAMETER: /* model parameter */ par = node.link; name = par.name; dim = par.dim; break; case A_VARIABLE: /* model variable */ var_ = node.link; name = var_.name; dim = var_.dim; break; case A_CONSTRAINT: /* model constraint or objective */ con = node.link; name = con.name; dim = con.dim; break; default: xassert(node != node); } mpl_internal_get_token(mpl /* */); /* parse optional subscript list */ if (mpl.token == T_LBRACKET) { /* subscript list is specified */ if (dim == 0) mpl_internal_error(mpl, name + " cannot be subscripted"); mpl_internal_get_token(mpl /* [ */); list = mpl_internal_subscript_list(mpl); if (dim != mpl_internal_arg_list_len(mpl, list)) mpl_internal_error(mpl, name + " must have " + dim + " subscript" + (dim == 1 ? "" : "s") + " rather than " + mpl_internal_arg_list_len(mpl, list)); xassert(mpl.token == T_RBRACKET); mpl_internal_get_token(mpl /* ] */); } else { /* subscript list is not specified */ if (dim != 0) mpl_internal_error(mpl, name + " must be subscripted"); list = null; } /* parse optional suffix */ if (!mpl.flag_s && node.type == A_VARIABLE) suff = DOT_NONE; else suff = DOT_VAL; if (mpl.token == T_POINT) { mpl_internal_get_token(mpl /* . */); if (mpl.token != T_NAME) mpl_internal_error(mpl, "invalid use of period"); if (!(node.type == A_VARIABLE || node.type == A_CONSTRAINT)) mpl_internal_error(mpl, name + " cannot have a suffix"); if (mpl.image == "lb") suff = DOT_LB; else if (mpl.image == "ub") suff = DOT_UB; else if (mpl.image == "status") suff = DOT_STATUS; else if (mpl.image == "val") suff = DOT_VAL; else if (mpl.image == "dual") suff = DOT_DUAL; else mpl_internal_error(mpl, "suffix ." + mpl.image + " invalid"); mpl_internal_get_token(mpl /* suffix */); } /* generate pseudo-code to take value of the object */ switch (node.type) { case A_INDEX: arg.index.slot = slot; arg.index.next = slot.list; code = mpl_internal_make_code(mpl, O_INDEX, arg, A_SYMBOLIC, 0); slot.list = code; break; case A_SET: arg.set.set = set; arg.set.list = list; code = mpl_internal_make_code(mpl, O_MEMSET, arg, A_ELEMSET, set.dimen); break; case A_PARAMETER: arg.par.par = par; arg.par.list = list; if (par.type == A_SYMBOLIC) code = mpl_internal_make_code(mpl, O_MEMSYM, arg, A_SYMBOLIC, 0); else code = mpl_internal_make_code(mpl, O_MEMNUM, arg, A_NUMERIC, 0); break; case A_VARIABLE: if (!mpl.flag_s && (suff == DOT_STATUS || suff == DOT_VAL || suff == DOT_DUAL)) mpl_internal_error(mpl, "invalid reference to status, primal value, or dual value of variable " + var_.name + " above solve statement"); arg.var_.var_ = var_; arg.var_.list = list; arg.var_.suff = suff; code = mpl_internal_make_code(mpl, O_MEMVAR, arg, suff == DOT_NONE ? A_FORMULA : A_NUMERIC, 0); break; case A_CONSTRAINT: if (!mpl.flag_s && (suff == DOT_STATUS || suff == DOT_VAL || suff == DOT_DUAL)) mpl_internal_error(mpl, "invalid reference to status, primal value, o"+ "r dual value of " + (con.type == A_CONSTRAINT ? "constraint" : "objective") + " " + con.name + " above solve statement"); arg.con.con = con; arg.con.list = list; arg.con.suff = suff; code = mpl_internal_make_code(mpl, O_MEMCON, arg, A_NUMERIC, 0); break; default: xassert(node != node); } return code; } function mpl_internal_numeric_argument(mpl, func){ var x = mpl_internal_expression_5(mpl); /* convert the argument to numeric type, if necessary */ if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); /* check that now the argument is of numeric type */ if (x.type != A_NUMERIC) mpl_internal_error(mpl, "argument for " + func + " has invalid type"); xassert(x.dim == 0); return x; } function mpl_internal_symbolic_argument(mpl, func){ var x = mpl_internal_expression_5(mpl); /* convert the argument to symbolic type, if necessary */ if (x.type == A_NUMERIC) x = mpl_internal_make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); /* check that now the argument is of symbolic type */ if (x.type != A_SYMBOLIC) mpl_internal_error(mpl, "argument for " + func + " has invalid type"); xassert(x.dim == 0); return x; } function mpl_internal_elemset_argument(mpl, func){ var x = mpl_internal_expression_9(mpl); if (x.type != A_ELEMSET) mpl_internal_error(mpl, "argument for " + func + " has invalid type"); xassert(x.dim > 0); return x; } function mpl_internal_function_reference(mpl){ var code; var arg = mpl_internal_create_operands(); var op; var func; /* determine operation code */ xassert(mpl.token == T_NAME); if (mpl.image == "abs") op = O_ABS; else if (mpl.image == "ceil") op = O_CEIL; else if (mpl.image == "floor") op = O_FLOOR; else if (mpl.image == "exp") op = O_EXP; else if (mpl.image == "log") op = O_LOG; else if (mpl.image == "log10") op = O_LOG10; else if (mpl.image == "sqrt") op = O_SQRT; else if (mpl.image == "sin") op = O_SIN; else if (mpl.image == "cos") op = O_COS; else if (mpl.image == "atan") op = O_ATAN; else if (mpl.image == "min") op = O_MIN; else if (mpl.image == "max") op = O_MAX; else if (mpl.image == "round") op = O_ROUND; else if (mpl.image == "trunc") op = O_TRUNC; else if (mpl.image == "Irand224") op = O_IRAND224; else if (mpl.image == "Uniform01") op = O_UNIFORM01; else if (mpl.image == "Uniform") op = O_UNIFORM; else if (mpl.image == "Normal01") op = O_NORMAL01; else if (mpl.image == "Normal") op = O_NORMAL; else if (mpl.image == "card") op = O_CARD; else if (mpl.image == "length") op = O_LENGTH; else if (mpl.image == "substr") op = O_SUBSTR; else if (mpl.image == "str2time") op = O_STR2TIME; else if (mpl.image == "time2str") op = O_TIME2STR; else if (mpl.image == "gmtime") op = O_GMTIME; else mpl_internal_error(mpl, "function " + mpl.image + " unknown"); /* save symbolic name of the function */ func = mpl.image; xassert(func.length < 16); mpl_internal_get_token(mpl /* */); /* check the left parenthesis that follows the function name */ xassert(mpl.token == T_LEFT); mpl_internal_get_token(mpl /* ( */); /* parse argument list */ if (op == O_MIN || op == O_MAX) { /* min and max allow arbitrary number of arguments */ arg.list = null; /* parse argument list */ for (;;) { /* parse argument and append it to the operands list */ arg.list = mpl_internal_expand_arg_list(mpl, arg.list, mpl_internal_numeric_argument(mpl, func)); /* check a token that follows the argument */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_RIGHT) break; else mpl_internal_error(mpl, "syntax error in argument list for " + func); } } else if (op == O_IRAND224 || op == O_UNIFORM01 || op == O_NORMAL01 || op == O_GMTIME) { /* Irand224, Uniform01, Normal01, gmtime need no arguments */ if (mpl.token != T_RIGHT) mpl_internal_error(mpl, func + " needs no arguments"); } else if (op == O_UNIFORM || op == O_NORMAL) { /* Uniform and Normal need two arguments */ /* parse the first argument */ arg.arg.x = mpl_internal_numeric_argument(mpl, func); /* check a token that follows the first argument */ if (mpl.token == T_COMMA){ } else if (mpl.token == T_RIGHT) mpl_internal_error(mpl, func + " needs two arguments"); else mpl_internal_error(mpl, "syntax error in argument for " + func); mpl_internal_get_token(mpl /* , */); /* parse the second argument */ arg.arg.y = mpl_internal_numeric_argument(mpl, func); /* check a token that follows the second argument */ if (mpl.token == T_COMMA) mpl_internal_error(mpl, func + " needs two argument"); else if (mpl.token == T_RIGHT){ } else mpl_internal_error(mpl, "syntax error in argument for " + func); } else if (op == O_ATAN || op == O_ROUND || op == O_TRUNC) { /* atan, round, and trunc need one or two arguments */ /* parse the first argument */ arg.arg.x = mpl_internal_numeric_argument(mpl, func); /* parse the second argument, if specified */ if (mpl.token == T_COMMA) { switch (op) { case O_ATAN: op = O_ATAN2; break; case O_ROUND: op = O_ROUND2; break; case O_TRUNC: op = O_TRUNC2; break; default: xassert(op != op); } mpl_internal_get_token(mpl /* , */); arg.arg.y = mpl_internal_numeric_argument(mpl, func); } /* check a token that follows the last argument */ if (mpl.token == T_COMMA) mpl_internal_error(mpl, func + " needs one or two arguments"); else if (mpl.token == T_RIGHT){ } else mpl_internal_error(mpl, "syntax error in argument for " + func); } else if (op == O_SUBSTR) { /* substr needs two or three arguments */ /* parse the first argument */ arg.arg.x = mpl_internal_symbolic_argument(mpl, func); /* check a token that follows the first argument */ if (mpl.token == T_COMMA){ } else if (mpl.token == T_RIGHT) mpl_internal_error(mpl, func + " needs two or three arguments"); else mpl_internal_error(mpl, "syntax error in argument for " + func); mpl_internal_get_token(mpl /* , */); /* parse the second argument */ arg.arg.y = mpl_internal_numeric_argument(mpl, func); /* parse the third argument, if specified */ if (mpl.token == T_COMMA) { op = O_SUBSTR3; mpl_internal_get_token(mpl /* , */); arg.arg.z = mpl_internal_numeric_argument(mpl, func); } /* check a token that follows the last argument */ if (mpl.token == T_COMMA) mpl_internal_error(mpl, func + " needs two or three arguments"); else if (mpl.token == T_RIGHT){ } else mpl_internal_error(mpl, "syntax error in argument for " + func); } else if (op == O_STR2TIME) { /* str2time needs two arguments, both symbolic */ /* parse the first argument */ arg.arg.x = mpl_internal_symbolic_argument(mpl, func); /* check a token that follows the first argument */ if (mpl.token == T_COMMA){ } else if (mpl.token == T_RIGHT) mpl_internal_error(mpl, func + " needs two arguments"); else mpl_internal_error(mpl, "syntax error in argument for " + func); mpl_internal_get_token(mpl /* , */); /* parse the second argument */ arg.arg.y = mpl_internal_symbolic_argument(mpl, func); /* check a token that follows the second argument */ if (mpl.token == T_COMMA) mpl_internal_error(mpl, func + " needs two argument"); else if (mpl.token == T_RIGHT){ } else mpl_internal_error(mpl, "syntax error in argument for " + func); } else if (op == O_TIME2STR) { /* time2str needs two arguments, numeric and symbolic */ /* parse the first argument */ arg.arg.x = mpl_internal_numeric_argument(mpl, func); /* check a token that follows the first argument */ if (mpl.token == T_COMMA){ } else if (mpl.token == T_RIGHT) mpl_internal_error(mpl, func + " needs two arguments"); else mpl_internal_error(mpl, "syntax error in argument for " + func); mpl_internal_get_token(mpl /* , */); /* parse the second argument */ arg.arg.y = mpl_internal_symbolic_argument(mpl, func); /* check a token that follows the second argument */ if (mpl.token == T_COMMA) mpl_internal_error(mpl, func + " needs two argument"); else if (mpl.token == T_RIGHT){ } else mpl_internal_error(mpl, "syntax error in argument for " + func); } else { /* other functions need one argument */ if (op == O_CARD) arg.arg.x = mpl_internal_elemset_argument(mpl, func); else if (op == O_LENGTH) arg.arg.x = mpl_internal_symbolic_argument(mpl, func); else arg.arg.x = mpl_internal_numeric_argument(mpl, func); /* check a token that follows the argument */ if (mpl.token == T_COMMA) mpl_internal_error(mpl, func + " needs one argument"); else if (mpl.token == T_RIGHT){ } else mpl_internal_error(mpl, "syntax error in argument for " + func); } /* make pseudo-code to call the built-in function */ if (op == O_SUBSTR || op == O_SUBSTR3 || op == O_TIME2STR) code = mpl_internal_make_code(mpl, op, arg, A_SYMBOLIC, 0); else code = mpl_internal_make_code(mpl, op, arg, A_NUMERIC, 0); /* the reference ends with the right parenthesis */ xassert(mpl.token == T_RIGHT); mpl_internal_get_token(mpl /* ) */); return code; } function mpl_internal_append_block(mpl, domain, block){ var temp; xassert(domain != null); xassert(block != null); xassert(block.next == null); if (domain.list == null) domain.list = block; else { for (temp = domain.list; temp.next != null; temp = temp.next){} temp.next = block; } } function mpl_internal_append_slot(mpl, block, name, code){ var slot = {}, temp; xassert(block != null); slot.name = name; slot.code = code; slot.value = null; slot.list = null; slot.next = null; if (block.list == null) block.list = slot; else { for (temp = block.list; temp.next != null; temp = temp.next){} temp.next = slot; } return slot; } function mpl_internal_expression_list(mpl){ var code; var arg = mpl_internal_create_operands(); var max_dim = 20; /* maximal number of components allowed within parentheses */ var list = new Array(max_dim + 1); xfillObjArr(list, 0, max_dim + 1); var flag_x, next_token, dim, j, slice = 0; xassert(mpl.token == T_LEFT); /* the flag, which allows recognizing undeclared symbolic names as dummy indices, will be automatically reset by get_token(), so save it before scanning the next token */ flag_x = mpl.flag_x; mpl_internal_get_token(mpl /* ( */); /* parse */ for (dim = 1; ; dim++) { if (dim > max_dim) mpl_internal_error(mpl, "too many components within parentheses"); function expr(){ /* current component of is expression */ code = mpl_internal_expression_13(mpl); /* if the current expression is followed by comma or it is not the very first expression, entire is n-tuple or slice, in which case the current expression should be converted to symbolic type, if necessary */ if (mpl.token == T_COMMA || dim > 1) { if (code.type == A_NUMERIC) code = mpl_internal_make_unary(mpl, O_CVTSYM, code, A_SYMBOLIC, 0); /* now the expression must be of symbolic type */ if (code.type != A_SYMBOLIC) mpl_internal_error(mpl, "component expression has invalid type"); xassert(code.dim == 0); } list[dim].name = null; list[dim].code = code; } /* current component of can be either dummy index or expression */ if (mpl.token == T_NAME) { /* symbolic name is recognized as dummy index only if: the flag, which allows that, is set, and the name is followed by comma or right parenthesis, and the name is undeclared */ mpl_internal_get_token(mpl /* */); next_token = mpl.token; mpl_internal_unget_token(mpl); if (!(flag_x && (next_token == T_COMMA || next_token == T_RIGHT) && mpl.tree[mpl.image] == null)) { /* this is not dummy index */ expr(); } else { /* all dummy indices within the same slice must have unique symbolic names */ for (j = 1; j < dim; j++) { if (list[j].name != null && list[j].name == mpl.image) mpl_internal_error(mpl, "duplicate dummy index " + mpl.image + " not allowed"); } /* current component of is dummy index */ list[dim].name = mpl.image; list[dim].code = null; mpl_internal_get_token(mpl /* */); /* is a slice, because at least one dummy index has appeared */ slice = 1; /* note that the context ( ) is not allowed, i.e. in this case is considered as a parenthesized expression */ if (dim == 1 && mpl.token == T_RIGHT) mpl_internal_error(mpl, list[dim].name + " not defined"); } } else expr(); /* check a token that follows the current component */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_RIGHT) break; else mpl_internal_error(mpl, "right parenthesis missing where expected"); } /* generate pseudo-code for */ if (dim == 1 && !slice) { /* is a parenthesized expression */ code = list[1].code; } else if (!slice) { /* is a n-tuple */ arg.list = null; for (j = 1; j <= dim; j++) arg.list = mpl_internal_expand_arg_list(mpl, arg.list, list[j].code); code = mpl_internal_make_code(mpl, O_TUPLE, arg, A_TUPLE, dim); } else { /* is a slice */ arg.slice = {}; for (j = 1; j <= dim; j++) mpl_internal_append_slot(mpl, arg.slice, list[j].name, list[j].code); /* note that actually pseudo-codes with op = O_SLICE are never evaluated */ code = mpl_internal_make_code(mpl, O_SLICE, arg, A_TUPLE, dim); } mpl_internal_get_token(mpl /* ) */); /* if is a slice, there must be the keyword 'in', which follows the right parenthesis */ if (slice && mpl.token != T_IN) mpl_internal_error(mpl, "keyword in missing where expected"); /* if the slice flag is set and there is the keyword 'in', which follows , the latter must be a slice */ if (flag_x && mpl.token == T_IN && !slice) { if (dim == 1) mpl_internal_error(mpl, "syntax error in indexing expression"); else mpl_internal_error(mpl, "0-ary slice not allowed"); } return code; } function mpl_internal_literal_set(mpl, code){ var arg = mpl_internal_create_operands(); var j; xassert(code != null); arg.list = null; /* parse */ for (j = 1; ; j++) { /* all member expressions must be n-tuples; so, if the current expression is not n-tuple, convert it to 1-tuple */ if (code.type == A_NUMERIC) code = mpl_internal_make_unary(mpl, O_CVTSYM, code, A_SYMBOLIC, 0); if (code.type == A_SYMBOLIC) code = mpl_internal_make_unary(mpl, O_CVTTUP, code, A_TUPLE, 1); /* now the expression must be n-tuple */ if (code.type != A_TUPLE) mpl_internal_error(mpl, "member expression has invalid type"); /* all member expressions must have identical dimension */ if (arg.list != null && arg.list.x.dim != code.dim) mpl_internal_error(mpl, "member " + (j-1) + " has " + arg.list.x.dim + " component" + (arg.list.x.dim == 1 ? "" : "s") + " while member " + j + " has " + code.dim + " component" + (code.dim == 1 ? "" : "s")); /* append the current expression to the member list */ arg.list = mpl_internal_expand_arg_list(mpl, arg.list, code); /* check a token that follows the current expression */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_RBRACE) break; else mpl_internal_error(mpl, "syntax error in literal set"); /* parse the next expression that follows the comma */ code = mpl_internal_expression_5(mpl); } /* generate pseudo-code for */ code = mpl_internal_make_code(mpl, O_MAKE, arg, A_ELEMSET, arg.list.x.dim); return code; } function mpl_internal_indexing_expression(mpl){ var domain; var block; var slot; var code; xassert(mpl.token == T_LBRACE); mpl_internal_get_token(mpl /* { */); if (mpl.token == T_RBRACE) mpl_internal_error(mpl, "empty indexing expression not allowed"); /* create domain to be constructed */ domain = {}; /* parse either or that follows the left brace */ for (;;) { /* domain block for is not created yet */ block = null; /* pseudo-code for is not generated yet */ code = null; /* check a token, which begins with */ if (mpl.token == T_NAME) { /* it is a symbolic name */ var next_token; var name; /* symbolic name is recognized as dummy index only if it is followed by the keyword 'in' and not declared */ mpl_internal_get_token(mpl /* */); next_token = mpl.token; mpl_internal_unget_token(mpl); if (next_token == T_IN && mpl.tree[mpl.image] == null) { /* create domain block with one slot, which is assigned the dummy index */ block = {}; name = mpl.image; mpl_internal_append_slot(mpl, block, name, null); mpl_internal_get_token(mpl /* */); /* the keyword 'in' is already checked above */ xassert(mpl.token == T_IN); mpl_internal_get_token(mpl /* in */); /* that follows the keyword 'in' will be parsed below */ } } else if (mpl.token == T_LEFT) { /* it is the left parenthesis; parse expression that begins with this parenthesis (the flag is set in order to allow recognizing slices; see the routine expression_list) */ mpl.flag_x = 1; code = mpl_internal_expression_9(mpl); if (code.op == O_SLICE) { /* this is a slice; besides the corresponding domain block is already created by expression_list() */ block = code.arg.slice; code = null; /* is not parsed yet */ /* the keyword 'in' following the slice is already checked by expression_list() */ xassert(mpl.token == T_IN); mpl_internal_get_token(mpl /* in */); /* that follows the keyword 'in' will be parsed below */ } } /* parse expression that follows either the keyword 'in' (in which case it can be as well as the very first in ); note that this expression can be already parsed above */ if (code == null) code = mpl_internal_expression_9(mpl); /* check the type of the expression just parsed */ if (code.type != A_ELEMSET) { /* it is not and therefore it can only be the very first in ; however, then there must be no dummy index neither slice between the left brace and this expression */ if (block != null) mpl_internal_error(mpl, "domain expression has invalid type"); /* parse the rest part of and make this set be , i.e. the construction {a, b, c} is parsed as it were written as {A}, where A = {a, b, c} is a temporary elemental set */ code = mpl_internal_literal_set(mpl, code); } /* now pseudo-code for has been built */ xassert(code != null); xassert(code.type == A_ELEMSET); xassert(code.dim > 0); /* if domain block for the current is still not created, create it for fake slice of the same dimension as */ if (block == null) { var j; block = {}; for (j = 1; j <= code.dim; j++) mpl_internal_append_slot(mpl, block, null, null); } /* number of indexing positions in must be the same as dimension of n-tuples in basic set */ { var dim = 0; for (slot = block.list; slot != null; slot = slot.next) dim++; if (dim != code.dim) mpl_internal_error(mpl, dim + " " + (dim == 1 ? "index" : "indices") + " specified for set of dimension " + code.dim); } /* store pseudo-code for in the domain block */ xassert(block.code == null); block.code = code; /* and append the domain block to the domain */ mpl_internal_append_block(mpl, domain, block); /* the current has been completely parsed; include all its dummy indices into the symbolic name table to make them available for referencing from expressions; implicit declarations of dummy indices remain valid while the corresponding domain scope is valid */ for (slot = block.list; slot != null; slot = slot.next) if (slot.name != null) { var node; xassert(mpl.tree[slot.name] == null); mpl.tree[slot.name] = node = {type: A_INDEX, link: slot}; } /* check a token that follows */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_COLON || mpl.token == T_RBRACE) break; else mpl_internal_error(mpl, "syntax error in indexing expression"); } /* parse that follows the colon */ if (mpl.token == T_COLON) { mpl_internal_get_token(mpl /* : */); code = mpl_internal_expression_13(mpl); /* convert the expression to logical type, if necessary */ if (code.type == A_SYMBOLIC) code = mpl_internal_make_unary(mpl, O_CVTNUM, code, A_NUMERIC, 0); if (code.type == A_NUMERIC) code = mpl_internal_make_unary(mpl, O_CVTLOG, code, A_LOGICAL, 0); /* now the expression must be of logical type */ if (code.type != A_LOGICAL) mpl_internal_error(mpl, "expression following colon has invalid type"); xassert(code.dim == 0); domain.code = code; /* the right brace must follow the logical expression */ if (mpl.token != T_RBRACE) mpl_internal_error(mpl, "syntax error in indexing expression"); } mpl_internal_get_token(mpl /* } */); return domain; } function mpl_internal_close_scope(mpl, domain){ var block; var slot; var node; xassert(domain != null); /* remove all dummy indices from the symbolic names table */ for (block = domain.list; block != null; block = block.next) { for (slot = block.list; slot != null; slot = slot.next) { if (slot.name != null) { node = mpl.tree[slot.name]; xassert(node != null); xassert(node.type == A_INDEX); delete mpl.tree[slot.name]; } } } } function mpl_internal_link_up(code) { /* if we have something like sum{(i+1,j,k-1) in E} x[i,j,k], where i and k are dummy indices defined out of the iterated expression, we should link up pseudo-code for computing i+1 and k-1 to pseudo-code for computing the iterated expression; this is needed to invalidate current value of the iterated expression once i or k have been changed */ var block; var slot; for (block = code.arg.loop.domain.list; block != null; block = block.next) { for (slot = block.list; slot != null; slot = slot.next) { if (slot.code != null) { xassert(slot.code.up == null); slot.code.up = code; } } } } function mpl_internal_iterated_expression(mpl){ var code; var arg = mpl_internal_create_operands(); var op; var opstr; // 8 /* determine operation code */ xassert(mpl.token == T_NAME); if (mpl.image == "sum") op = O_SUM; else if (mpl.image == "prod") op = O_PROD; else if (mpl.image == "min") op = O_MINIMUM; else if (mpl.image == "max") op = O_MAXIMUM; else if (mpl.image == "forall") op = O_FORALL; else if (mpl.image == "exists") op = O_EXISTS; else if (mpl.image == "setof") op = O_SETOF; else mpl_internal_error(mpl, "operator " + mpl.image + " unknown"); opstr = mpl.image; xassert(opstr.length < 8); mpl_internal_get_token(mpl /* */); /* check the left brace that follows the operator name */ xassert(mpl.token == T_LBRACE); /* parse indexing expression that controls iterating */ arg.loop.domain = mpl_internal_indexing_expression(mpl); function err(){ mpl_internal_error(mpl, "integrand following " + opstr + "{...} has invalid type"); } /* parse "integrand" expression and generate pseudo-code */ switch (op) { case O_SUM: case O_PROD: case O_MINIMUM: case O_MAXIMUM: arg.loop.x = mpl_internal_expression_3(mpl); /* convert the integrand to numeric type, if necessary */ if (arg.loop.x.type == A_SYMBOLIC) arg.loop.x = mpl_internal_make_unary(mpl, O_CVTNUM, arg.loop.x, A_NUMERIC, 0); /* now the integrand must be of numeric type or linear form (the latter is only allowed for the sum operator) */ if (!(arg.loop.x.type == A_NUMERIC || op == O_SUM && arg.loop.x.type == A_FORMULA)) err(); xassert(arg.loop.x.dim == 0); /* generate pseudo-code */ code = mpl_internal_make_code(mpl, op, arg, arg.loop.x.type, 0); break; case O_FORALL: case O_EXISTS: arg.loop.x = mpl_internal_expression_12(mpl); /* convert the integrand to logical type, if necessary */ if (arg.loop.x.type == A_SYMBOLIC) arg.loop.x = mpl_internal_make_unary(mpl, O_CVTNUM, arg.loop.x, A_NUMERIC, 0); if (arg.loop.x.type == A_NUMERIC) arg.loop.x = mpl_internal_make_unary(mpl, O_CVTLOG, arg.loop.x, A_LOGICAL, 0); /* now the integrand must be of logical type */ if (arg.loop.x.type != A_LOGICAL) err(); xassert(arg.loop.x.dim == 0); /* generate pseudo-code */ code = mpl_internal_make_code(mpl, op, arg, A_LOGICAL, 0); break; case O_SETOF: arg.loop.x = mpl_internal_expression_5(mpl); /* convert the integrand to 1-tuple, if necessary */ if (arg.loop.x.type == A_NUMERIC) arg.loop.x = mpl_internal_make_unary(mpl, O_CVTSYM, arg.loop.x, A_SYMBOLIC, 0); if (arg.loop.x.type == A_SYMBOLIC) arg.loop.x = mpl_internal_make_unary(mpl, O_CVTTUP, arg.loop.x, A_TUPLE, 1); /* now the integrand must be n-tuple */ if (arg.loop.x.type != A_TUPLE) err(); xassert(arg.loop.x.dim > 0); /* generate pseudo-code */ code = mpl_internal_make_code(mpl, op, arg, A_ELEMSET, arg.loop.x.dim); break; default: xassert(op != op); } /* close the scope of the indexing expression */ mpl_internal_close_scope(mpl, arg.loop.domain); mpl_internal_link_up(code); return code; } function mpl_internal_domain_arity(mpl, domain){ var arity = 0; for (var block = domain.list; block != null; block = block.next) for (var slot = block.list; slot != null; slot = slot.next) if (slot.code == null) arity++; return arity; } function mpl_internal_set_expression(mpl){ var code; var arg = mpl_internal_create_operands(); xassert(mpl.token == T_LBRACE); mpl_internal_get_token(mpl /* { */); /* check a token that follows the left brace */ if (mpl.token == T_RBRACE) { /* it is the right brace, so the resultant is an empty set of dimension 1 */ arg.list = null; /* generate pseudo-code to build the resultant set */ code = mpl_internal_make_code(mpl, O_MAKE, arg, A_ELEMSET, 1); mpl_internal_get_token(mpl /* } */); } else { /* the next token begins an indexing expression */ mpl_internal_unget_token(mpl); arg.loop.domain = mpl_internal_indexing_expression(mpl); arg.loop.x = null; /* integrand is not used */ /* close the scope of the indexing expression */ mpl_internal_close_scope(mpl, arg.loop.domain); /* generate pseudo-code to build the resultant set */ code = mpl_internal_make_code(mpl, O_BUILD, arg, A_ELEMSET, mpl_internal_domain_arity(mpl, arg.loop.domain)); mpl_internal_link_up(code); } return code; } function mpl_internal_branched_expression(mpl){ var x, y, z; xassert(mpl.token == T_IF); mpl_internal_get_token(mpl /* if */); /* parse that follows 'if' */ x = mpl_internal_expression_13(mpl); /* convert the expression to logical type, if necessary */ if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type == A_NUMERIC) x = mpl_internal_make_unary(mpl, O_CVTLOG, x, A_LOGICAL, 0); /* now the expression must be of logical type */ if (x.type != A_LOGICAL) mpl_internal_error(mpl, "expression following if has invalid type"); xassert(x.dim == 0); /* the keyword 'then' must follow the logical expression */ if (mpl.token != T_THEN) mpl_internal_error(mpl, "keyword then missing where expected"); mpl_internal_get_token(mpl /* then */); /* parse that follows 'then' and check its type */ y = mpl_internal_expression_9(mpl); if (!(y.type == A_NUMERIC || y.type == A_SYMBOLIC || y.type == A_ELEMSET || y.type == A_FORMULA)) mpl_internal_error(mpl, "expression following then has invalid type"); /* if the expression that follows the keyword 'then' is elemental set, the keyword 'else' cannot be omitted; otherwise else-part is optional */ if (mpl.token != T_ELSE) { if (y.type == A_ELEMSET) mpl_internal_error(mpl, "keyword else missing where expected"); z = null; } else { mpl_internal_get_token(mpl /* else */); /* parse that follow 'else' and check its type */ z = mpl_internal_expression_9(mpl); if (!(z.type == A_NUMERIC || z.type == A_SYMBOLIC || z.type == A_ELEMSET || z.type == A_FORMULA)) mpl_internal_error(mpl, "expression following else has invalid type"); /* convert to identical types, if necessary */ if (y.type == A_FORMULA || z.type == A_FORMULA) { if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type == A_NUMERIC) y = mpl_internal_make_unary(mpl, O_CVTLFM, y, A_FORMULA, 0); if (z.type == A_SYMBOLIC) z = mpl_internal_make_unary(mpl, O_CVTNUM, z, A_NUMERIC, 0); if (z.type == A_NUMERIC) z = mpl_internal_make_unary(mpl, O_CVTLFM, z, A_FORMULA, 0); } if (y.type == A_SYMBOLIC || z.type == A_SYMBOLIC) { if (y.type == A_NUMERIC) y = mpl_internal_make_unary(mpl, O_CVTSYM, y, A_SYMBOLIC, 0); if (z.type == A_NUMERIC) z = mpl_internal_make_unary(mpl, O_CVTSYM, z, A_SYMBOLIC, 0); } /* now both expressions must have identical types */ if (y.type != z.type) mpl_internal_error(mpl, "expressions following then and else have incompatible types"); /* and identical dimensions */ if (y.dim != z.dim) mpl_internal_error(mpl, "expressions following then and else have different" + " dimensions " + y.dim + " and " + z.dim + ", respectively"); } /* generate pseudo-code to perform branching */ return mpl_internal_make_ternary(mpl, O_FORK, x, y, z, y.type, y.dim); } function mpl_internal_primary_expression(mpl){ var code; if (mpl.token == T_NUMBER) { /* parse numeric literal */ code = mpl_internal_numeric_literal(mpl); } else if (mpl.token == T_INFINITY) { /* parse "infinity" */ var arg = mpl_internal_create_operands(); arg.num = DBL_MAX; code = mpl_internal_make_code(mpl, O_NUMBER, arg, A_NUMERIC, 0); mpl_internal_get_token(mpl /* Infinity */); } else if (mpl.token == T_STRING) { /* parse string literal */ code = mpl_internal_string_literal(mpl); } else if (mpl.token == T_NAME) { var next_token; mpl_internal_get_token(mpl /* */); next_token = mpl.token; mpl_internal_unget_token(mpl); /* check a token that follows */ switch (next_token) { case T_LBRACKET: /* parse reference to subscripted object */ code = mpl_internal_object_reference(mpl); break; case T_LEFT: /* parse reference to built-in function */ code = mpl_internal_function_reference(mpl); break; case T_LBRACE: /* parse iterated expression */ code = mpl_internal_iterated_expression(mpl); break; default: /* parse reference to unsubscripted object */ code = mpl_internal_object_reference(mpl); break; } } else if (mpl.token == T_LEFT) { /* parse parenthesized expression */ code = mpl_internal_expression_list(mpl); } else if (mpl.token == T_LBRACE) { /* parse set expression */ code = mpl_internal_set_expression(mpl); } else if (mpl.token == T_IF) { /* parse conditional expression */ code = mpl_internal_branched_expression(mpl); } else if (mpl_internal_is_reserved(mpl)) { /* other reserved keywords cannot be used here */ mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); } else mpl_internal_error(mpl, "syntax error in expression"); return code; } function mpl_internal_error_preceding(mpl, opstr){ mpl_internal_error(mpl, "operand preceding " + opstr + " has invalid type"); /* no return */ } function mpl_internal_error_following(mpl, opstr) { mpl_internal_error(mpl, "operand following " + opstr + " has invalid type"); /* no return */ } function mpl_internal_error_dimension(mpl, opstr, dim1, dim2) { mpl_internal_error(mpl, "operands preceding and following " + opstr + " have different di"+ "mensions " + dim1 + " and " + dim2 + ", respectively"); /* no return */ } function mpl_internal_expression_0(mpl){ return mpl_internal_primary_expression(mpl); } function mpl_internal_expression_1(mpl){ var y; var x = mpl_internal_expression_0(mpl); if (mpl.token == T_POWER) { var opstr = mpl.image; xassert(opstr.length < 8); if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type != A_NUMERIC) mpl_internal_error_preceding(mpl, opstr); mpl_internal_get_token(mpl /* ^ | ** */); if (mpl.token == T_PLUS || mpl.token == T_MINUS) y = mpl_internal_expression_2(mpl); else y = mpl_internal_expression_1(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type != A_NUMERIC) mpl_internal_error_following(mpl, opstr); x = mpl_internal_make_binary(mpl, O_POWER, x, y, A_NUMERIC, 0); } return x; } function mpl_internal_expression_2(mpl){ var x; if (mpl.token == T_PLUS) { mpl_internal_get_token(mpl /* + */); x = mpl_internal_expression_1(mpl); if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x.type == A_NUMERIC || x.type == A_FORMULA)) mpl_internal_error_following(mpl, "+"); x = mpl_internal_make_unary(mpl, O_PLUS, x, x.type, 0); } else if (mpl.token == T_MINUS) { mpl_internal_get_token(mpl /* - */); x = mpl_internal_expression_1(mpl); if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x.type == A_NUMERIC || x.type == A_FORMULA)) mpl_internal_error_following(mpl, "-"); x = mpl_internal_make_unary(mpl, O_MINUS, x, x.type, 0); } else x = mpl_internal_expression_1(mpl); return x; } function mpl_internal_expression_3(mpl){ var y; var x = mpl_internal_expression_2(mpl); for (;;) { if (mpl.token == T_ASTERISK) { if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x.type == A_NUMERIC || x.type == A_FORMULA)) mpl_internal_error_preceding(mpl, "*"); mpl_internal_get_token(mpl /* * */); y = mpl_internal_expression_2(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (!(y.type == A_NUMERIC || y.type == A_FORMULA)) mpl_internal_error_following(mpl, "*"); if (x.type == A_FORMULA && y.type == A_FORMULA) mpl_internal_error(mpl, "multiplication of linear forms not allowed"); if (x.type == A_NUMERIC && y.type == A_NUMERIC) x = mpl_internal_make_binary(mpl, O_MUL, x, y, A_NUMERIC, 0); else x = mpl_internal_make_binary(mpl, O_MUL, x, y, A_FORMULA, 0); } else if (mpl.token == T_SLASH) { if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x.type == A_NUMERIC || x.type == A_FORMULA)) mpl_internal_error_preceding(mpl, "/"); mpl_internal_get_token(mpl /* / */); y = mpl_internal_expression_2(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type != A_NUMERIC) mpl_internal_error_following(mpl, "/"); if (x.type == A_NUMERIC) x = mpl_internal_make_binary(mpl, O_DIV, x, y, A_NUMERIC, 0); else x = mpl_internal_make_binary(mpl, O_DIV, x, y, A_FORMULA, 0); } else if (mpl.token == T_DIV) { if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type != A_NUMERIC) mpl_internal_error_preceding(mpl, "div"); mpl_internal_get_token(mpl /* div */); y = mpl_internal_expression_2(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type != A_NUMERIC) mpl_internal_error_following(mpl, "div"); x = mpl_internal_make_binary(mpl, O_IDIV, x, y, A_NUMERIC, 0); } else if (mpl.token == T_MOD) { if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type != A_NUMERIC) mpl_internal_error_preceding(mpl, "mod"); mpl_internal_get_token(mpl /* mod */); y = mpl_internal_expression_2(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type != A_NUMERIC) mpl_internal_error_following(mpl, "mod"); x = mpl_internal_make_binary(mpl, O_MOD, x, y, A_NUMERIC, 0); } else break; } return x; } function mpl_internal_expression_4(mpl){ var y; var x = mpl_internal_expression_3(mpl); for (;;) { if (mpl.token == T_PLUS) { if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x.type == A_NUMERIC || x.type == A_FORMULA)) mpl_internal_error_preceding(mpl, "+"); mpl_internal_get_token(mpl /* + */); y = mpl_internal_expression_3(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (!(y.type == A_NUMERIC || y.type == A_FORMULA)) mpl_internal_error_following(mpl, "+"); if (x.type == A_NUMERIC && y.type == A_FORMULA) x = mpl_internal_make_unary(mpl, O_CVTLFM, x, A_FORMULA, 0); if (x.type == A_FORMULA && y.type == A_NUMERIC) y = mpl_internal_make_unary(mpl, O_CVTLFM, y, A_FORMULA, 0); x = mpl_internal_make_binary(mpl, O_ADD, x, y, x.type, 0); } else if (mpl.token == T_MINUS) { if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (!(x.type == A_NUMERIC || x.type == A_FORMULA)) mpl_internal_error_preceding(mpl, "-"); mpl_internal_get_token(mpl /* - */); y = mpl_internal_expression_3(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (!(y.type == A_NUMERIC || y.type == A_FORMULA)) mpl_internal_error_following(mpl, "-"); if (x.type == A_NUMERIC && y.type == A_FORMULA) x = mpl_internal_make_unary(mpl, O_CVTLFM, x, A_FORMULA, 0); if (x.type == A_FORMULA && y.type == A_NUMERIC) y = mpl_internal_make_unary(mpl, O_CVTLFM, y, A_FORMULA, 0); x = mpl_internal_make_binary(mpl, O_SUB, x, y, x.type, 0); } else if (mpl.token == T_LESS) { if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type != A_NUMERIC) mpl_internal_error_preceding(mpl, "less"); mpl_internal_get_token(mpl /* less */); y = mpl_internal_expression_3(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type != A_NUMERIC) mpl_internal_error_following(mpl, "less"); x = mpl_internal_make_binary(mpl, O_LESS, x, y, A_NUMERIC, 0); } else break; } return x; } function mpl_internal_expression_5(mpl){ var y; var x = mpl_internal_expression_4(mpl); for (;;) { if (mpl.token == T_CONCAT) { if (x.type == A_NUMERIC) x = mpl_internal_make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); if (x.type != A_SYMBOLIC) mpl_internal_error_preceding(mpl, "&"); mpl_internal_get_token(mpl /* & */); y = mpl_internal_expression_4(mpl); if (y.type == A_NUMERIC) y = mpl_internal_make_unary(mpl, O_CVTSYM, y, A_SYMBOLIC, 0); if (y.type != A_SYMBOLIC) mpl_internal_error_following(mpl, "&"); x = mpl_internal_make_binary(mpl, O_CONCAT, x, y, A_SYMBOLIC, 0); } else break; } return x; } function mpl_internal_expression_6(mpl){ var y, z; var x = mpl_internal_expression_5(mpl); if (mpl.token == T_DOTS) { if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type != A_NUMERIC) mpl_internal_error_preceding(mpl, ".."); mpl_internal_get_token(mpl /* .. */); y = mpl_internal_expression_5(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type != A_NUMERIC) mpl_internal_error_following(mpl, ".."); if (mpl.token == T_BY) { mpl_internal_get_token(mpl /* by */); z = mpl_internal_expression_5(mpl); if (z.type == A_SYMBOLIC) z = mpl_internal_make_unary(mpl, O_CVTNUM, z, A_NUMERIC, 0); if (z.type != A_NUMERIC) mpl_internal_error_following(mpl, "by"); } else z = null; x = mpl_internal_make_ternary(mpl, O_DOTS, x, y, z, A_ELEMSET, 1); } return x; } function mpl_internal_expression_7(mpl){ var y; var x = mpl_internal_expression_6(mpl); for (;;) { if (mpl.token == T_CROSS) { if (x.type != A_ELEMSET) mpl_internal_error_preceding(mpl, "cross"); mpl_internal_get_token(mpl /* cross */); y = mpl_internal_expression_6(mpl); if (y.type != A_ELEMSET) mpl_internal_error_following(mpl, "cross"); x = mpl_internal_make_binary(mpl, O_CROSS, x, y, A_ELEMSET, x.dim + y.dim); } else break; } return x; } function mpl_internal_expression_8(mpl){ var y; var x = mpl_internal_expression_7(mpl); for (;;) { if (mpl.token == T_INTER) { if (x.type != A_ELEMSET) mpl_internal_error_preceding(mpl, "inter"); mpl_internal_get_token(mpl /* inter */); y = mpl_internal_expression_7(mpl); if (y.type != A_ELEMSET) mpl_internal_error_following(mpl, "inter"); if (x.dim != y.dim) mpl_internal_error_dimension(mpl, "inter", x.dim, y.dim); x = mpl_internal_make_binary(mpl, O_INTER, x, y, A_ELEMSET, x.dim); } else break; } return x; } function mpl_internal_expression_9(mpl){ var y; var x = mpl_internal_expression_8(mpl); for (;;) { if (mpl.token == T_UNION) { if (x.type != A_ELEMSET) mpl_internal_error_preceding(mpl, "union"); mpl_internal_get_token(mpl /* union */); y = mpl_internal_expression_8(mpl); if (y.type != A_ELEMSET) mpl_internal_error_following(mpl, "union"); if (x.dim != y.dim) mpl_internal_error_dimension(mpl, "union", x.dim, y.dim); x = mpl_internal_make_binary(mpl, O_UNION, x, y, A_ELEMSET, x.dim); } else if (mpl.token == T_DIFF) { if (x.type != A_ELEMSET) mpl_internal_error_preceding(mpl, "diff"); mpl_internal_get_token(mpl /* diff */); y = mpl_internal_expression_8(mpl); if (y.type != A_ELEMSET) mpl_internal_error_following(mpl, "diff"); if (x.dim != y.dim) mpl_internal_error_dimension(mpl, "diff", x.dim, y.dim); x = mpl_internal_make_binary(mpl, O_DIFF, x, y, A_ELEMSET, x.dim); } else if (mpl.token == T_SYMDIFF) { if (x.type != A_ELEMSET) mpl_internal_error_preceding(mpl, "symdiff"); mpl_internal_get_token(mpl /* symdiff */); y = mpl_internal_expression_8(mpl); if (y.type != A_ELEMSET) mpl_internal_error_following(mpl, "symdiff"); if (x.dim != y.dim) mpl_internal_error_dimension(mpl, "symdiff", x.dim, y.dim); x = mpl_internal_make_binary(mpl, O_SYMDIFF, x, y, A_ELEMSET, x.dim); } else break; } return x; } function mpl_internal_expression_10(mpl){ var y; var op = -1; var opstr = ""; // [16]; var x = mpl_internal_expression_9(mpl); switch (mpl.token) { case T_LT: op = O_LT; break; case T_LE: op = O_LE; break; case T_EQ: op = O_EQ; break; case T_GE: op = O_GE; break; case T_GT: op = O_GT; break; case T_NE: op = O_NE; break; case T_IN: op = O_IN; break; case T_WITHIN: op = O_WITHIN; break; case T_NOT: opstr = mpl.image; mpl_internal_get_token(mpl /* not | ! */); if (mpl.token == T_IN) op = O_NOTIN; else if (mpl.token == T_WITHIN) op = O_NOTWITHIN; else mpl_internal_error(mpl, "invalid use of " + opstr); opstr += " "; break; default: return x; } opstr += mpl.image; xassert(opstr.length < 16); switch (op) { case O_EQ: case O_NE: case O_LT: case O_LE: case O_GT: case O_GE: if (!(x.type == A_NUMERIC || x.type == A_SYMBOLIC)) mpl_internal_error_preceding(mpl, opstr); mpl_internal_get_token(mpl /* */); y = mpl_internal_expression_9(mpl); if (!(y.type == A_NUMERIC || y.type == A_SYMBOLIC)) mpl_internal_error_following(mpl, opstr); if (x.type == A_NUMERIC && y.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); if (x.type == A_SYMBOLIC && y.type == A_NUMERIC) y = mpl_internal_make_unary(mpl, O_CVTSYM, y, A_SYMBOLIC, 0); x = mpl_internal_make_binary(mpl, op, x, y, A_LOGICAL, 0); break; case O_IN: case O_NOTIN: if (x.type == A_NUMERIC) x = mpl_internal_make_unary(mpl, O_CVTSYM, x, A_SYMBOLIC, 0); if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTTUP, x, A_TUPLE, 1); if (x.type != A_TUPLE) mpl_internal_error_preceding(mpl, opstr); mpl_internal_get_token(mpl /* */); y = mpl_internal_expression_9(mpl); if (y.type != A_ELEMSET) mpl_internal_error_following(mpl, opstr); if (x.dim != y.dim) mpl_internal_error_dimension(mpl, opstr, x.dim, y.dim); x = mpl_internal_make_binary(mpl, op, x, y, A_LOGICAL, 0); break; case O_WITHIN: case O_NOTWITHIN: if (x.type != A_ELEMSET) mpl_internal_error_preceding(mpl, opstr); mpl_internal_get_token(mpl /* */); y = mpl_internal_expression_9(mpl); if (y.type != A_ELEMSET) mpl_internal_error_following(mpl, opstr); if (x.dim != y.dim) mpl_internal_error_dimension(mpl, opstr, x.dim, y.dim); x = mpl_internal_make_binary(mpl, op, x, y, A_LOGICAL, 0); break; default: xassert(op != op); } return x; } function mpl_internal_expression_11(mpl){ var x; var opstr; //[8]; if (mpl.token == T_NOT) { opstr = mpl.image; xassert(opstr.length < 8); mpl_internal_get_token(mpl /* not | ! */); x = mpl_internal_expression_10(mpl); if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type == A_NUMERIC) x = mpl_internal_make_unary(mpl, O_CVTLOG, x, A_LOGICAL, 0); if (x.type != A_LOGICAL) mpl_internal_error_following(mpl, opstr); x = mpl_internal_make_unary(mpl, O_NOT, x, A_LOGICAL, 0); } else x = mpl_internal_expression_10(mpl); return x; } function mpl_internal_expression_12(mpl){ var y; var opstr = ""; //[8]; var x = mpl_internal_expression_11(mpl); for (;;) { if (mpl.token == T_AND) { opstr = mpl.image; xassert(opstr.length < 8); if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type == A_NUMERIC) x = mpl_internal_make_unary(mpl, O_CVTLOG, x, A_LOGICAL, 0); if (x.type != A_LOGICAL) mpl_internal_error_preceding(mpl, opstr); mpl_internal_get_token(mpl /* and | && */); y = mpl_internal_expression_11(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type == A_NUMERIC) y = mpl_internal_make_unary(mpl, O_CVTLOG, y, A_LOGICAL, 0); if (y.type != A_LOGICAL) mpl_internal_error_following(mpl, opstr); x = mpl_internal_make_binary(mpl, O_AND, x, y, A_LOGICAL, 0); } else break; } return x; } function mpl_internal_expression_13(mpl){ var y; var x = mpl_internal_expression_12(mpl); for (;;) { if (mpl.token == T_OR) { var opstr = mpl.image; xassert(opstr.length < 8); if (x.type == A_SYMBOLIC) x = mpl_internal_make_unary(mpl, O_CVTNUM, x, A_NUMERIC, 0); if (x.type == A_NUMERIC) x = mpl_internal_make_unary(mpl, O_CVTLOG, x, A_LOGICAL, 0); if (x.type != A_LOGICAL) mpl_internal_error_preceding(mpl, opstr); mpl_internal_get_token(mpl /* or | || */); y = mpl_internal_expression_12(mpl); if (y.type == A_SYMBOLIC) y = mpl_internal_make_unary(mpl, O_CVTNUM, y, A_NUMERIC, 0); if (y.type == A_NUMERIC) y = mpl_internal_make_unary(mpl, O_CVTLOG, y, A_LOGICAL, 0); if (y.type != A_LOGICAL) mpl_internal_error_following(mpl, opstr); x = mpl_internal_make_binary(mpl, O_OR, x, y, A_LOGICAL, 0); } else break; } return x; } function mpl_internal_set_statement(mpl){ var set, node; var dimen_used = 0; var gadget; function err(){mpl_internal_error(mpl, "at most one := or default/data allowed")} function err1(){mpl_internal_error(mpl, mpl.image + " not a plain set")} function err2(){mpl_internal_error(mpl, "dimension of " + mpl.image + " too small")} function err3(){mpl_internal_error(mpl, "component number must be integer between 1 and " + gadget.set.dimen)}; xassert(mpl_internal_is_keyword(mpl, "set")); mpl_internal_get_token(mpl /* set */); /* symbolic name must follow the keyword 'set' */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (mpl.tree[mpl.image] != null) mpl_internal_error(mpl, mpl.image + " multiply declared"); /* create model set */ set = {}; set.name = mpl.image; set.alias = null; set.dim = 0; set.domain = null; set.dimen = 0; set.within = null; set.assign = null; set.option = null; set.gadget = null; set.data = 0; set.array = null; mpl_internal_get_token(mpl /* */); /* parse optional alias */ if (mpl.token == T_STRING) { set.alias = mpl.image; mpl_internal_get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl.token == T_LBRACE) { set.domain = mpl_internal_indexing_expression(mpl); set.dim = mpl_internal_domain_arity(mpl, set.domain); } /* include the set name in the symbolic names table */ { node = mpl.tree[set.name] = {}; node.type = A_SET; node.link = set; } /* parse the list of optional attributes */ for (;;) { if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_SEMICOLON) break; if (mpl_internal_is_keyword(mpl, "dimen")) { /* dimension of set members */ var dimen; mpl_internal_get_token(mpl /* dimen */); if (!(mpl.token == T_NUMBER && 1.0 <= mpl.value && mpl.value <= 20.0 && Math.floor(mpl.value) == mpl.value)) mpl_internal_error(mpl, "dimension must be integer between 1 and 20"); dimen = (mpl.value + 0.5)|0; if (dimen_used) mpl_internal_error(mpl, "at most one dimension attribute allowed"); if (set.dimen > 0) mpl_internal_error(mpl, "dimension " + dimen + " conflicts with dimension " + set.dimen + " already determined"); set.dimen = dimen; dimen_used = 1; mpl_internal_get_token(mpl /* */); } else if (mpl.token == T_WITHIN || mpl.token == T_IN) { /* restricting superset */ var within, temp; if (mpl.token == T_IN && !mpl.as_within) { mpl_internal_warning(mpl, "keyword in understood as within"); mpl.as_within = 1; } mpl_internal_get_token(mpl /* within */); /* create new restricting superset list entry and append it to the within-list */ within = {}; within.code = null; within.next = null; if (set.within == null) set.within = within; else { for (temp = set.within; temp.next != null; temp = temp.next){} temp.next = within; } /* parse an expression that follows 'within' */ within.code = mpl_internal_expression_9(mpl); if (within.code.type != A_ELEMSET) mpl_internal_error(mpl, "expression following within has invalid type"); xassert(within.code.dim > 0); /* check/set dimension of set members */ if (set.dimen == 0) set.dimen = within.code.dim; if (set.dimen != within.code.dim) mpl_internal_error(mpl, "set expression following within must have di"+ "mension " + set.dimen + " rather than " + within.code.dim); } else if (mpl.token == T_ASSIGN) { /* assignment expression */ if (!(set.assign == null && set.option == null && set.gadget == null)) err(); mpl_internal_get_token(mpl /* := */); /* parse an expression that follows ':=' */ set.assign = mpl_internal_expression_9(mpl); if (set.assign.type != A_ELEMSET) mpl_internal_error(mpl, "expression following := has invalid type"); xassert(set.assign.dim > 0); /* check/set dimension of set members */ if (set.dimen == 0) set.dimen = set.assign.dim; if (set.dimen != set.assign.dim) mpl_internal_error(mpl, "set expression following := must have dimens" + "ion " + set.dimen + " rather than " + set.assign.dim); } else if (mpl_internal_is_keyword(mpl, "default")) { /* expression for default value */ if (!(set.assign == null && set.option == null)) err(); mpl_internal_get_token(mpl /* := */); /* parse an expression that follows 'default' */ set.option = mpl_internal_expression_9(mpl); if (set.option.type != A_ELEMSET) mpl_internal_error(mpl, "expression following default has invalid type"); xassert(set.option.dim > 0); /* check/set dimension of set members */ if (set.dimen == 0) set.dimen = set.option.dim; if (set.dimen != set.option.dim) mpl_internal_error(mpl, "set expression following default must have d" + "imension " + set.dimen + " rather than " + set.option.dim); } else if (mpl_internal_is_keyword(mpl, "data")) { /* gadget to initialize the set by data from plain set */ var i = 0, k, fff = new Array(20); //[20]; if (!(set.assign == null && set.gadget == null)) err(); mpl_internal_get_token(mpl /* data */); set.gadget = gadget = {}; /* set name must follow the keyword 'data' */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "set name missing where expected"); /* find the set in the symbolic name table */ node = mpl.tree[mpl.image]; if (node == null) mpl_internal_error(mpl, mpl.image + " not defined"); if (node.type != A_SET) err1(); gadget.set = node.link; if (gadget.set.dim != 0) err1(); if (gadget.set == set) mpl_internal_error(mpl, "set cannot be initialized by itself"); /* check and set dimensions */ if (set.dim >= gadget.set.dimen) err2(); if (set.dimen == 0) set.dimen = gadget.set.dimen - set.dim; if (set.dim + set.dimen > gadget.set.dimen) err2(); else if (set.dim + set.dimen < gadget.set.dimen) mpl_internal_error(mpl, "dimension of " + mpl.image + " too big"); mpl_internal_get_token(mpl /* set name */); /* left parenthesis must follow the set name */ if (mpl.token == T_LEFT) mpl_internal_get_token(mpl /* ( */); else mpl_internal_error(mpl, "left parenthesis missing where expected"); /* parse permutation of component numbers */ for (k = 0; k < gadget.set.dimen; k++) fff[k] = 0; k = 0; for (;;) { if (mpl.token != T_NUMBER) mpl_internal_error(mpl, "component number missing where expected"); if (str2int(mpl.image, function(v){i = v}) != 0) err3(); if (!(1 <= i && i <= gadget.set.dimen)) err3(); if (fff[i-1] != 0) mpl_internal_error(mpl, "component " + i + " multiply specified"); gadget.ind[k++] = i; fff[i-1] = 1; xassert(k <= gadget.set.dimen); mpl_internal_get_token(mpl /* number */); if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_RIGHT) break; else mpl_internal_error(mpl, "syntax error in data attribute"); } if (k < gadget.set.dimen) mpl_internal_error(mpl, "there are must be " + gadget.set.dimen + " components rather than " + k); mpl_internal_get_token(mpl /* ) */); } else mpl_internal_error(mpl, "syntax error in set statement"); } /* close the domain scope */ if (set.domain != null) mpl_internal_close_scope(mpl, set.domain); /* if dimension of set members is still unknown, set it to 1 */ if (set.dimen == 0) set.dimen = 1; /* the set statement has been completely parsed */ xassert(mpl.token == T_SEMICOLON); mpl_internal_get_token(mpl /* ; */); return set; } function mpl_internal_parameter_statement(mpl){ var par, temp; var integer_used = 0, binary_used = 0, symbolic_used = 0; function process_binary(){ if (binary_used) mpl_internal_error(mpl, "at most one binary allowed"); if (par.type == A_SYMBOLIC) mpl_internal_error(mpl, "symbolic parameter cannot be binary"); par.type = A_BINARY; binary_used = 1; mpl_internal_get_token(mpl /* binary */); } function err(){mpl_internal_error(mpl, "at most one := or default allowed")} xassert(mpl_internal_is_keyword(mpl, "param")); mpl_internal_get_token(mpl /* param */); /* symbolic name must follow the keyword 'param' */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (mpl.tree[mpl.image] != null) mpl_internal_error(mpl, mpl.image + " multiply declared"); /* create model parameter */ par = {}; par.name = mpl.image; par.alias = null; par.dim = 0; par.domain = null; par.type = A_NUMERIC; par.cond = null; par.in_ = null; par.assign = null; par.option = null; par.data = 0; par.defval = null; par.array = null; mpl_internal_get_token(mpl /* */); /* parse optional alias */ if (mpl.token == T_STRING) { par.alias = mpl.image; mpl_internal_get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl.token == T_LBRACE) { par.domain = mpl_internal_indexing_expression(mpl); par.dim = mpl_internal_domain_arity(mpl, par.domain); } /* include the parameter name in the symbolic names table */ { var node = mpl.tree[par.name] = {}; node.type = A_PARAMETER; node.link = par; } /* parse the list of optional attributes */ for (;;) { if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_SEMICOLON) break; if (mpl_internal_is_keyword(mpl, "integer")) { if (integer_used) mpl_internal_error(mpl, "at most one integer allowed"); if (par.type == A_SYMBOLIC) mpl_internal_error(mpl, "symbolic parameter cannot be integer"); if (par.type != A_BINARY) par.type = A_INTEGER; integer_used = 1; mpl_internal_get_token(mpl /* integer */); } else if (mpl_internal_is_keyword(mpl, "binary")) process_binary(); else if (mpl_internal_is_keyword(mpl, "logical")) { if (!mpl.as_binary) { mpl_internal_warning(mpl, "keyword logical understood as binary"); mpl.as_binary = 1; } process_binary(); } else if (mpl_internal_is_keyword(mpl, "symbolic")) { if (symbolic_used) mpl_internal_error(mpl, "at most one symbolic allowed"); if (par.type != A_NUMERIC) mpl_internal_error(mpl, "integer or binary parameter cannot be symbolic"); /* the parameter may be referenced from expressions given in the same parameter declaration, so its type must be completed before parsing that expressions */ if (!(par.cond == null && par.in_ == null && par.assign == null && par.option == null)) mpl_internal_error(mpl, "keyword symbolic must precede any other parameter attributes"); par.type = A_SYMBOLIC; symbolic_used = 1; mpl_internal_get_token(mpl /* symbolic */); } else if (mpl.token == T_LT || mpl.token == T_LE || mpl.token == T_EQ || mpl.token == T_GE || mpl.token == T_GT || mpl.token == T_NE) { /* restricting condition */ var opstr; // [8]; /* create new restricting condition list entry and append it to the conditions list */ var cond = {}; switch (mpl.token) { case T_LT: cond.rho = O_LT; opstr = mpl.image; break; case T_LE: cond.rho = O_LE; opstr = mpl.image; break; case T_EQ: cond.rho = O_EQ; opstr = mpl.image; break; case T_GE: cond.rho = O_GE; opstr = mpl.image; break; case T_GT: cond.rho = O_GT; opstr = mpl.image; break; case T_NE: cond.rho = O_NE; opstr = mpl.image; break; default: xassert(mpl.token != mpl.token); } xassert(opstr.length < 8); cond.code = null; cond.next = null; if (par.cond == null) par.cond = cond; else { for (temp = par.cond; temp.next != null; temp = temp.next){} temp.next = cond; } mpl_internal_get_token(mpl /* rho */); /* parse an expression that follows relational operator */ cond.code = mpl_internal_expression_5(mpl); if (!(cond.code.type == A_NUMERIC || cond.code.type == A_SYMBOLIC)) mpl_internal_error(mpl, "expression following " + opstr + " has invalid type"); xassert(cond.code.dim == 0); /* convert to the parameter type, if necessary */ if (par.type != A_SYMBOLIC && cond.code.type == A_SYMBOLIC) cond.code = mpl_internal_make_unary(mpl, O_CVTNUM, cond.code, A_NUMERIC, 0); if (par.type == A_SYMBOLIC && cond.code.type != A_SYMBOLIC) cond.code = mpl_internal_make_unary(mpl, O_CVTSYM, cond.code, A_SYMBOLIC, 0); } else if (mpl.token == T_IN || mpl.token == T_WITHIN) { /* restricting superset */ var in_; if (mpl.token == T_WITHIN && !mpl.as_in) { mpl_internal_warning(mpl, "keyword within understood as in"); mpl.as_in = 1; } mpl_internal_get_token(mpl /* in */); /* create new restricting superset list entry and append it to the in-list */ in_ = {}; in_.code = null; in_.next = null; if (par.in_ == null) par.in_ = in_; else { for (temp = par.in_; temp.next != null; temp = temp.next){} temp.next = in_; } /* parse an expression that follows 'in' */ in_.code = mpl_internal_expression_9(mpl); if (in_.code.type != A_ELEMSET) mpl_internal_error(mpl, "expression following in has invalid type"); xassert(in_.code.dim > 0); if (in_.code.dim != 1) mpl_internal_error(mpl, "set expression following in must have dimens"+ "ion 1 rather than " + in_.code.dim); } else if (mpl.token == T_ASSIGN) { /* assignment expression */ if (!(par.assign == null && par.option == null)) err(); mpl_internal_get_token(mpl /* := */); /* parse an expression that follows ':=' */ par.assign = mpl_internal_expression_5(mpl); /* the expression must be of numeric/symbolic type */ if (!(par.assign.type == A_NUMERIC || par.assign.type == A_SYMBOLIC)) mpl_internal_error(mpl, "expression following := has invalid type"); xassert(par.assign.dim == 0); /* convert to the parameter type, if necessary */ if (par.type != A_SYMBOLIC && par.assign.type == A_SYMBOLIC) par.assign = mpl_internal_make_unary(mpl, O_CVTNUM, par.assign, A_NUMERIC, 0); if (par.type == A_SYMBOLIC && par.assign.type != A_SYMBOLIC) par.assign = mpl_internal_make_unary(mpl, O_CVTSYM, par.assign, A_SYMBOLIC, 0); } else if (mpl_internal_is_keyword(mpl, "default")) { /* expression for default value */ if (!(par.assign == null && par.option == null)) err(); mpl_internal_get_token(mpl /* default */); /* parse an expression that follows 'default' */ par.option = mpl_internal_expression_5(mpl); if (!(par.option.type == A_NUMERIC || par.option.type == A_SYMBOLIC)) mpl_internal_error(mpl, "expression following default has invalid type"); xassert(par.option.dim == 0); /* convert to the parameter type, if necessary */ if (par.type != A_SYMBOLIC && par.option.type == A_SYMBOLIC) par.option = mpl_internal_make_unary(mpl, O_CVTNUM, par.option, A_NUMERIC, 0); if (par.type == A_SYMBOLIC && par.option.type != A_SYMBOLIC) par.option = mpl_internal_make_unary(mpl, O_CVTSYM, par.option, A_SYMBOLIC, 0); } else mpl_internal_error(mpl, "syntax error in parameter statement"); } /* close the domain scope */ if (par.domain != null) mpl_internal_close_scope(mpl, par.domain); /* the parameter statement has been completely parsed */ xassert(mpl.token == T_SEMICOLON); mpl_internal_get_token(mpl /* ; */); return par; } function mpl_internal_variable_statement(mpl){ var integer_used = 0, binary_used = 0; function process_binary(){ if (binary_used) mpl_internal_error(mpl, "at most one binary allowed"); var_.type = A_BINARY; binary_used = 1; mpl_internal_get_token(mpl /* binary */); } xassert(mpl_internal_is_keyword(mpl, "var")); if (mpl.flag_s) mpl_internal_error(mpl, "variable statement must precede solve statement"); mpl_internal_get_token(mpl /* var */); /* symbolic name must follow the keyword 'var' */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (mpl.tree[mpl.image] != null) mpl_internal_error(mpl, mpl.image + " multiply declared"); /* create model variable */ var var_ = {}; var_.name = mpl.image; var_.alias = null; var_.dim = 0; var_.domain = null; var_.type = A_NUMERIC; var_.lbnd = null; var_.ubnd = null; var_.array = null; mpl_internal_get_token(mpl /* */); /* parse optional alias */ if (mpl.token == T_STRING) { var_.alias = mpl.image; mpl_internal_get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl.token == T_LBRACE) { var_.domain = mpl_internal_indexing_expression(mpl); var_.dim = mpl_internal_domain_arity(mpl, var_.domain); } /* include the variable name in the symbolic names table */ { var node = mpl.tree[var_.name] = {}; node.type = A_VARIABLE; node.link = var_; } /* parse the list of optional attributes */ for (;;) { if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_SEMICOLON) break; if (mpl_internal_is_keyword(mpl, "integer")) { if (integer_used) mpl_internal_error(mpl, "at most one integer allowed"); if (var_.type != A_BINARY) var_.type = A_INTEGER; integer_used = 1; mpl_internal_get_token(mpl /* integer */); } else if (mpl_internal_is_keyword(mpl, "binary")) process_binary(); else if (mpl_internal_is_keyword(mpl, "logical")) { if (!mpl.as_binary) { mpl_internal_warning(mpl, "keyword logical understood as binary"); mpl.as_binary = 1; } process_binary(); } else if (mpl_internal_is_keyword(mpl, "symbolic")) mpl_internal_error(mpl, "variable cannot be symbolic"); else if (mpl.token == T_GE) { /* lower bound */ if (var_.lbnd != null) { if (var_.lbnd == var_.ubnd) mpl_internal_error(mpl, "both fixed value and lower bound not allowed"); else mpl_internal_error(mpl, "at most one lower bound allowed"); } mpl_internal_get_token(mpl /* >= */); /* parse an expression that specifies the lower bound */ var_.lbnd = mpl_internal_expression_5(mpl); if (var_.lbnd.type == A_SYMBOLIC) var_.lbnd = mpl_internal_make_unary(mpl, O_CVTNUM, var_.lbnd, A_NUMERIC, 0); if (var_.lbnd.type != A_NUMERIC) mpl_internal_error(mpl, "expression following >= has invalid type"); xassert(var_.lbnd.dim == 0); } else if (mpl.token == T_LE) { /* upper bound */ if (var_.ubnd != null) { if (var_.ubnd == var_.lbnd) mpl_internal_error(mpl, "both fixed value and upper bound not allowed"); else mpl_internal_error(mpl, "at most one upper bound allowed"); } mpl_internal_get_token(mpl /* <= */); /* parse an expression that specifies the upper bound */ var_.ubnd = mpl_internal_expression_5(mpl); if (var_.ubnd.type == A_SYMBOLIC) var_.ubnd = mpl_internal_make_unary(mpl, O_CVTNUM, var_.ubnd, A_NUMERIC, 0); if (var_.ubnd.type != A_NUMERIC) mpl_internal_error(mpl, "expression following <= has invalid type"); xassert(var_.ubnd.dim == 0); } else if (mpl.token == T_EQ) { /* fixed value */ var opstr; //[8] if (!(var_.lbnd == null && var_.ubnd == null)) { if (var_.lbnd == var_.ubnd) mpl_internal_error(mpl, "at most one fixed value allowed"); else if (var_.lbnd != null) mpl_internal_error(mpl, "both lower bound and fixed value not allowed"); else mpl_internal_error(mpl, "both upper bound and fixed value not allowed"); } opstr = mpl.image; xassert(opstr.length < 8); mpl_internal_get_token(mpl /* = | == */); /* parse an expression that specifies the fixed value */ var_.lbnd = mpl_internal_expression_5(mpl); if (var_.lbnd.type == A_SYMBOLIC) var_.lbnd = mpl_internal_make_unary(mpl, O_CVTNUM, var_.lbnd, A_NUMERIC, 0); if (var_.lbnd.type != A_NUMERIC) mpl_internal_error(mpl, "expression following " + opstr + " has invalid type"); xassert(var_.lbnd.dim == 0); /* indicate that the variable is fixed, not bounded */ var_.ubnd = var_.lbnd; } else if (mpl.token == T_LT || mpl.token == T_GT || mpl.token == T_NE) mpl_internal_error(mpl, "strict bound not allowed"); else mpl_internal_error(mpl, "syntax error in variable statement"); } /* close the domain scope */ if (var_.domain != null) mpl_internal_close_scope(mpl, var_.domain); /* the variable statement has been completely parsed */ xassert(mpl.token == T_SEMICOLON); mpl_internal_get_token(mpl /* ; */); return var_; } function mpl_internal_constraint_statement(mpl){ var first, second, third; var rho; var opstr; //[8]; function err(){mpl_internal_error(mpl, "syntax error in constraint statement")} if (mpl.flag_s) mpl_internal_error(mpl, "constraint statement must precede solve statement"); if (mpl_internal_is_keyword(mpl, "subject")) { mpl_internal_get_token(mpl /* subject */); if (!mpl_internal_is_keyword(mpl, "to")) mpl_internal_error(mpl, "keyword subject to incomplete"); mpl_internal_get_token(mpl /* to */); } else if (mpl_internal_is_keyword(mpl, "subj")) { mpl_internal_get_token(mpl /* subj */); if (!mpl_internal_is_keyword(mpl, "to")) mpl_internal_error(mpl, "keyword subj to incomplete"); mpl_internal_get_token(mpl /* to */); } else if (mpl.token == T_SPTP) mpl_internal_get_token(mpl /* s.t. */); /* the current token must be symbolic name of constraint */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (mpl.tree[mpl.image] != null) mpl_internal_error(mpl, mpl.image + " multiply declared"); /* create model constraint */ var con = {}; con.name = mpl.image; con.alias = null; con.dim = 0; con.domain = null; con.type = A_CONSTRAINT; con.code = null; con.lbnd = null; con.ubnd = null; con.array = null; mpl_internal_get_token(mpl /* */); /* parse optional alias */ if (mpl.token == T_STRING) { con.alias = mpl.image; mpl_internal_get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl.token == T_LBRACE) { con.domain = mpl_internal_indexing_expression(mpl); con.dim = mpl_internal_domain_arity(mpl, con.domain); } /* include the constraint name in the symbolic names table */ { var node = mpl.tree[con.name] = {}; node.type = A_CONSTRAINT; node.link = con; } /* the colon must precede the first expression */ if (mpl.token != T_COLON) mpl_internal_error(mpl, "colon missing where expected"); mpl_internal_get_token(mpl /* : */); /* parse the first expression */ first = mpl_internal_expression_5(mpl); if (first.type == A_SYMBOLIC) first = mpl_internal_make_unary(mpl, O_CVTNUM, first, A_NUMERIC, 0); if (!(first.type == A_NUMERIC || first.type == A_FORMULA)) mpl_internal_error(mpl, "expression following colon has invalid type"); xassert(first.dim == 0); /* relational operator must follow the first expression */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); switch (mpl.token) { case T_LE: case T_GE: case T_EQ: break; case T_LT: case T_GT: case T_NE: mpl_internal_error(mpl, "strict inequality not allowed"); break; case T_SEMICOLON: mpl_internal_error(mpl, "constraint must be equality or inequality"); break; default: err(); } rho = mpl.token; opstr = mpl.image; xassert(opstr.length < 8); mpl_internal_get_token(mpl /* rho */); /* parse the second expression */ second = mpl_internal_expression_5(mpl); if (second.type == A_SYMBOLIC) second = mpl_internal_make_unary(mpl, O_CVTNUM, second, A_NUMERIC, 0); if (!(second.type == A_NUMERIC || second.type == A_FORMULA)) mpl_internal_error(mpl, "expression following " + opstr + " has invalid type"); xassert(second.dim == 0); /* check a token that follow the second expression */ if (mpl.token == T_COMMA) { mpl_internal_get_token(mpl /* , */); if (mpl.token == T_SEMICOLON) err(); } if (mpl.token == T_LT || mpl.token == T_LE || mpl.token == T_EQ || mpl.token == T_GE || mpl.token == T_GT || mpl.token == T_NE) { /* it is another relational operator, therefore the constraint is double inequality */ if (rho == T_EQ || mpl.token != rho) mpl_internal_error(mpl, "double inequality must be ... <= ... <= ... or " + "... >= ... >= ..."); /* the first expression cannot be linear form */ if (first.type == A_FORMULA) mpl_internal_error(mpl, "leftmost expression in double inequality cannot" + " be linear form"); mpl_internal_get_token(mpl /* rho */); /* parse the third expression */ third = mpl_internal_expression_5(mpl); if (third.type == A_SYMBOLIC) third = mpl_internal_make_unary(mpl, O_CVTNUM, second, A_NUMERIC, 0); if (!(third.type == A_NUMERIC || third.type == A_FORMULA)) mpl_internal_error(mpl, "rightmost expression in double inequality const" + "raint has invalid type"); xassert(third.dim == 0); /* the third expression also cannot be linear form */ if (third.type == A_FORMULA) mpl_internal_error(mpl, "rightmost expression in double inequality canno" + "t be linear form"); } else { /* the constraint is equality or single inequality */ third = null; } /* close the domain scope */ if (con.domain != null) mpl_internal_close_scope(mpl, con.domain); /* convert all expressions to linear form, if necessary */ if (first.type != A_FORMULA) first = mpl_internal_make_unary(mpl, O_CVTLFM, first, A_FORMULA, 0); if (second.type != A_FORMULA) second = mpl_internal_make_unary(mpl, O_CVTLFM, second, A_FORMULA, 0); if (third != null) third = mpl_internal_make_unary(mpl, O_CVTLFM, third, A_FORMULA, 0); /* arrange expressions in the constraint */ if (third == null) { /* the constraint is equality or single inequality */ switch (rho) { case T_LE: /* first <= second */ con.code = first; con.lbnd = null; con.ubnd = second; break; case T_GE: /* first >= second */ con.code = first; con.lbnd = second; con.ubnd = null; break; case T_EQ: /* first = second */ con.code = first; con.lbnd = second; con.ubnd = second; break; default: xassert(rho != rho); } } else { /* the constraint is double inequality */ switch (rho) { case T_LE: /* first <= second <= third */ con.code = second; con.lbnd = first; con.ubnd = third; break; case T_GE: /* first >= second >= third */ con.code = second; con.lbnd = third; con.ubnd = first; break; default: xassert(rho != rho); } } /* the constraint statement has been completely parsed */ if (mpl.token != T_SEMICOLON) err(); mpl_internal_get_token(mpl /* ; */); return con; } function mpl_internal_objective_statement(mpl){ var obj; var type; if (mpl_internal_is_keyword(mpl, "minimize")) type = A_MINIMIZE; else if (mpl_internal_is_keyword(mpl, "maximize")) type = A_MAXIMIZE; else xassert(mpl != mpl); if (mpl.flag_s) mpl_internal_error(mpl, "objective statement must precede solve statement"); mpl_internal_get_token(mpl /* minimize | maximize */); /* symbolic name must follow the verb 'minimize' or 'maximize' */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (mpl.tree[mpl.image] != null) mpl_internal_error(mpl, mpl.image + " multiply declared"); /* create model objective */ obj = {}; obj.name = mpl.image; obj.alias = null; obj.dim = 0; obj.domain = null; obj.type = type; obj.code = null; obj.lbnd = null; obj.ubnd = null; obj.array = null; mpl_internal_get_token(mpl /* */); /* parse optional alias */ if (mpl.token == T_STRING) { obj.alias = mpl.image; mpl_internal_get_token(mpl /* */); } /* parse optional indexing expression */ if (mpl.token == T_LBRACE) { obj.domain = mpl_internal_indexing_expression(mpl); obj.dim = mpl_internal_domain_arity(mpl, obj.domain); } /* include the constraint name in the symbolic names table */ { var node = mpl.tree[obj.name] = {}; node.type = A_CONSTRAINT; node.link = obj; } /* the colon must precede the objective expression */ if (mpl.token != T_COLON) mpl_internal_error(mpl, "colon missing where expected"); mpl_internal_get_token(mpl /* : */); /* parse the objective expression */ obj.code = mpl_internal_expression_5(mpl); if (obj.code.type == A_SYMBOLIC) obj.code = mpl_internal_make_unary(mpl, O_CVTNUM, obj.code, A_NUMERIC, 0); if (obj.code.type == A_NUMERIC) obj.code = mpl_internal_make_unary(mpl, O_CVTLFM, obj.code, A_FORMULA, 0); if (obj.code.type != A_FORMULA) mpl_internal_error(mpl, "expression following colon has invalid type"); xassert(obj.code.dim == 0); /* close the domain scope */ if (obj.domain != null) mpl_internal_close_scope(mpl, obj.domain); /* the objective statement has been completely parsed */ if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "syntax error in objective statement"); mpl_internal_get_token(mpl /* ; */); return obj; } function mpl_internal_table_statement(mpl){ var last_arg, arg; var last_fld, fld; var last_in, in_; var last_out, out; var node; var nflds; var name; // [MAX_LENGTH+1]; xassert(mpl_internal_is_keyword(mpl, "table")); mpl_internal_get_token(mpl /* solve */); /* symbolic name must follow the keyword table */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "symbolic name missing where expected"); /* there must be no other object with the same name */ if (mpl.tree[mpl.image] != null) mpl_internal_error(mpl, mpl.image + " multiply declared"); /* create data table */ var tab = {u: {in_: {}, out: {}}}; tab.name = mpl.image; mpl_internal_get_token(mpl /* */); /* parse optional alias */ if (mpl.token == T_STRING) { tab.alias = mpl.image; mpl_internal_get_token(mpl /* */); } else tab.alias = null; /* parse optional indexing expression */ if (mpl.token == T_LBRACE) { /* this is output table */ tab.type = A_OUTPUT; tab.u.out.domain = mpl_internal_indexing_expression(mpl); if (!mpl_internal_is_keyword(mpl, "OUT")) mpl_internal_error(mpl, "keyword OUT missing where expected"); mpl_internal_get_token(mpl /* OUT */); } else { /* this is input table */ tab.type = A_INPUT; if (!mpl_internal_is_keyword(mpl, "IN")) mpl_internal_error(mpl, "keyword IN missing where expected"); mpl_internal_get_token(mpl /* IN */); } /* parse argument list */ tab.arg = last_arg = null; for (;;) { /* create argument list entry */ arg = {}; /* parse argument expression */ if (mpl.token == T_COMMA || mpl.token == T_COLON || mpl.token == T_SEMICOLON) mpl_internal_error(mpl, "argument expression missing where expected"); arg.code = mpl_internal_expression_5(mpl); /* convert the result to symbolic type, if necessary */ if (arg.code.type == A_NUMERIC) arg.code = mpl_internal_make_unary(mpl, O_CVTSYM, arg.code, A_SYMBOLIC, 0); /* check that now the result is of symbolic type */ if (arg.code.type != A_SYMBOLIC) mpl_internal_error(mpl, "argument expression has invalid type"); /* add the entry to the end of the list */ arg.next = null; if (last_arg == null) tab.arg = arg; else last_arg.next = arg; last_arg = arg; /* argument expression has been parsed */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_COLON || mpl.token == T_SEMICOLON) break; } xassert(tab.arg != null); /* argument list must end with colon */ if (mpl.token == T_COLON) mpl_internal_get_token(mpl /* : */); else mpl_internal_error(mpl, "colon missing where expected"); /* parse specific part of the table statement */ switch (tab.type) { case A_INPUT: /* parse optional set name */ if (mpl.token == T_NAME) { node = mpl.tree[mpl.image]; if (node == null) mpl_internal_error(mpl, mpl.image + " not defined"); if (node.type != A_SET) mpl_internal_error(mpl, mpl.image + " not a set"); tab.u.in_.set = node.link; if (tab.u.in_.set.assign != null) mpl_internal_error(mpl, mpl.image + " needs no data"); if (tab.u.in_.set.dim != 0) mpl_internal_error(mpl, mpl.image + " must be a simple set"); mpl_internal_get_token(mpl /* */); if (mpl.token == T_INPUT) mpl_internal_get_token(mpl /* <- */); else mpl_internal_error(mpl, "delimiter <- missing where expected"); } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else tab.u.in_.set = null; /* parse field list */ tab.u.in_.fld = last_fld = null; nflds = 0; if (mpl.token == T_LBRACKET) mpl_internal_get_token(mpl /* [ */); else mpl_internal_error(mpl, "field list missing where expected"); for (;;) { /* create field list entry */ fld = {}; /* parse field name */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "field name missing where expected"); fld.name = mpl.image; mpl_internal_get_token(mpl /* */); /* add the entry to the end of the list */ fld.next = null; if (last_fld == null) tab.u.in_.fld = fld; else last_fld.next = fld; last_fld = fld; nflds++; /* field name has been parsed */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_RBRACKET) break; else mpl_internal_error(mpl, "syntax error in field list"); } /* check that the set dimen is equal to the number of fields */ if (tab.u.in_.set != null && tab.u.in_.set.dimen != nflds) mpl_internal_error(mpl, "there must be " + tab.u.in_.set.dimen + " field" + (tab.u.in_.set.dimen == 1 ? "" : "s") + " rather than " + nflds); mpl_internal_get_token(mpl /* ] */); /* parse optional input list */ tab.u.in_.list = last_in = null; while (mpl.token == T_COMMA) { mpl_internal_get_token(mpl /* , */); /* create input list entry */ in_ = {}; /* parse parameter name */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "parameter name missing where expected"); node = mpl.tree[mpl.image]; if (node == null) mpl_internal_error(mpl, mpl.image + " not defined"); if (node.type != A_PARAMETER) mpl_internal_error(mpl, mpl.image + " not a parameter"); in_.par = node.link; if (in_.par.dim != nflds) mpl_internal_error(mpl, mpl.image + " must have " + nflds + " subscript" + (nflds == 1 ? "" : "s") + " rather than " + in_.par.dim); if (in_.par.assign != null) mpl_internal_error(mpl, mpl.image + " needs no data"); mpl_internal_get_token(mpl /* */); /* parse optional field name */ if (mpl.token == T_TILDE) { mpl_internal_get_token(mpl /* ~ */); /* parse field name */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "field name missing where expected"); //xassert(mpl.image.length < MAX_LENGTH+1); name = mpl.image; mpl_internal_get_token(mpl /* */); } else { /* field name is the same as the parameter name */ //xassert(in_.par.name.length < MAX_LENGTH+1); name = in_.par.name; } /* assign field name */ in_.name = name; /* add the entry to the end of the list */ in_.next = null; if (last_in == null) tab.u.in_.list = in_; else last_in.next = in_; last_in = in_; } break; case A_OUTPUT: /* parse output list */ tab.u.out.list = last_out = null; for (;;) { /* create output list entry */ out = {}; /* parse expression */ if (mpl.token == T_COMMA || mpl.token == T_SEMICOLON) mpl_internal_error(mpl, "expression missing where expected"); if (mpl.token == T_NAME) { //xassert(mpl.image.length < MAX_LENGTH+1); name = mpl.image; } else name = ''; out.code = mpl_internal_expression_5(mpl); /* parse optional field name */ if (mpl.token == T_TILDE) { mpl_internal_get_token(mpl /* ~ */); /* parse field name */ if (mpl.token == T_NAME){ } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "field name missing where expected"); //xassert(mpl.image.length < MAX_LENGTH+1); name = mpl.image; mpl_internal_get_token(mpl /* */); } /* assign field name */ if (name == '') mpl_internal_error(mpl, "field name required"); out.name = name; /* add the entry to the end of the list */ out.next = null; if (last_out == null) tab.u.out.list = out; else last_out.next = out; last_out = out; /* output item has been parsed */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_SEMICOLON) break; else mpl_internal_error(mpl, "syntax error in output list"); } /* close the domain scope */ mpl_internal_close_scope(mpl,tab.u.out.domain); break; default: xassert(tab != tab); } /* the table statement must end with semicolon */ if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "syntax error in table statement"); mpl_internal_get_token(mpl /* ; */); return tab; } function mpl_internal_solve_statement(mpl){ xassert(mpl_internal_is_keyword(mpl, "solve")); if (mpl.flag_s) mpl_internal_error(mpl, "at most one solve statement allowed"); mpl.flag_s = 1; mpl_internal_get_token(mpl /* solve */); /* semicolon must follow solve statement */ if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "syntax error in solve statement"); mpl_internal_get_token(mpl /* ; */); return null; } function mpl_internal_check_statement(mpl){ xassert(mpl_internal_is_keyword(mpl, "check")); /* create check descriptor */ var chk = {}; chk.domain = null; chk.code = null; mpl_internal_get_token(mpl /* check */); /* parse optional indexing expression */ if (mpl.token == T_LBRACE) { chk.domain = mpl_internal_indexing_expression(mpl); } /* skip optional colon */ if (mpl.token == T_COLON) mpl_internal_get_token(mpl /* : */); /* parse logical expression */ chk.code = mpl_internal_expression_13(mpl); if (chk.code.type != A_LOGICAL) mpl_internal_error(mpl, "expression has invalid type"); xassert(chk.code.dim == 0); /* close the domain scope */ if (chk.domain != null) mpl_internal_close_scope(mpl, chk.domain); /* the check statement has been completely parsed */ if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "syntax error in check statement"); mpl_internal_get_token(mpl /* ; */); return chk; } function mpl_internal_display_statement(mpl){ var last_entry; xassert(mpl_internal_is_keyword(mpl, "display")); /* create display descriptor */ var dpy = {}; dpy.domain = null; dpy.list = last_entry = null; mpl_internal_get_token(mpl /* display */); /* parse optional indexing expression */ if (mpl.token == T_LBRACE) dpy.domain = mpl_internal_indexing_expression(mpl); /* skip optional colon */ if (mpl.token == T_COLON) mpl_internal_get_token(mpl /* : */); /* parse display list */ for (;;) { /* create new display entry */ var entry = {u: {}}; function expr(){ /* display entry is expression */ entry.type = A_EXPRESSION; entry.u.code = mpl_internal_expression_13(mpl); } entry.type = 0; entry.next = null; /* and append it to the display list */ if (dpy.list == null) dpy.list = entry; else last_entry.next = entry; last_entry = entry; /* parse display entry */ if (mpl.token == T_NAME) { var node; var next_token; mpl_internal_get_token(mpl /* */); next_token = mpl.token; mpl_internal_unget_token(mpl); if (!(next_token == T_COMMA || next_token == T_SEMICOLON)) { /* symbolic name begins expression */ expr(); } else { /* display entry is dummy index or model object */ node = mpl.tree[mpl.image]; if (node == null) mpl_internal_error(mpl, mpl.image + " not defined"); entry.type = node.type; switch (node.type) { case A_INDEX: entry.u.slot = node.link; break; case A_SET: entry.u.set = node.link; break; case A_PARAMETER: entry.u.par = node.link; break; case A_VARIABLE: entry.u.var_ = node.link; if (!mpl.flag_s) mpl_internal_error(mpl, "invalid reference to variable " + entry.u.var_.name + " above solve statement"); break; case A_CONSTRAINT: entry.u.con = node.link; if (!mpl.flag_s) mpl_internal_error(mpl, "invalid reference to " + (entry.u.con.type == A_CONSTRAINT ?"constraint" : "objective") + " " + entry.u.con.name + " above solve statement"); break; default: xassert(node != node); } mpl_internal_get_token(mpl /* */); } } else expr(); /* check a token that follows the entry parsed */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else break; } /* close the domain scope */ if (dpy.domain != null) mpl_internal_close_scope(mpl, dpy.domain); /* the display statement has been completely parsed */ if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "syntax error in display statement"); mpl_internal_get_token(mpl /* ; */); return dpy; } function mpl_internal_printf_statement(mpl){ var entry, last_entry; xassert(mpl_internal_is_keyword(mpl, "printf")); /* create printf descriptor */ var prt = {}; prt.domain = null; prt.fmt = null; prt.list = last_entry = null; mpl_internal_get_token(mpl /* printf */); /* parse optional indexing expression */ if (mpl.token == T_LBRACE) { prt.domain = mpl_internal_indexing_expression(mpl); } /* skip optional colon */ if (mpl.token == T_COLON) mpl_internal_get_token(mpl /* : */); /* parse expression for format string */ prt.fmt = mpl_internal_expression_5(mpl); /* convert it to symbolic type, if necessary */ if (prt.fmt.type == A_NUMERIC) prt.fmt = mpl_internal_make_unary(mpl, O_CVTSYM, prt.fmt, A_SYMBOLIC, 0); /* check that now the expression is of symbolic type */ if (prt.fmt.type != A_SYMBOLIC) mpl_internal_error(mpl, "format expression has invalid type"); /* parse printf list */ while (mpl.token == T_COMMA) { mpl_internal_get_token(mpl /* , */); /* create new printf entry */ entry = {}; entry.code = null; entry.next = null; /* and append it to the printf list */ if (prt.list == null) prt.list = entry; else last_entry.next = entry; last_entry = entry; /* parse printf entry */ entry.code = mpl_internal_expression_9(mpl); if (!(entry.code.type == A_NUMERIC || entry.code.type == A_SYMBOLIC || entry.code.type == A_LOGICAL)) mpl_internal_error(mpl, "only numeric, symbolic, or logical expression allowed"); } /* close the domain scope */ if (prt.domain != null) mpl_internal_close_scope(mpl, prt.domain); /* parse optional redirection */ prt.fname = null; prt.app = 0; if (mpl.token == T_GT || mpl.token == T_APPEND) { prt.app = (mpl.token == T_APPEND); mpl_internal_get_token(mpl /* > or >> */); /* parse expression for file name string */ prt.fname = mpl_internal_expression_5(mpl); /* convert it to symbolic type, if necessary */ if (prt.fname.type == A_NUMERIC) prt.fname = mpl_internal_make_unary(mpl, O_CVTSYM, prt.fname, A_SYMBOLIC, 0); /* check that now the expression is of symbolic type */ if (prt.fname.type != A_SYMBOLIC) mpl_internal_error(mpl, "file name expression has invalid type"); } /* the printf statement has been completely parsed */ if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "syntax error in printf statement"); mpl_internal_get_token(mpl /* ; */); return prt; } function mpl_internal_for_statement(mpl){ var stmt, last_stmt; xassert(mpl_internal_is_keyword(mpl, "for")); /* create for descriptor */ var fur = {}; fur.domain = null; fur.list = last_stmt = null; mpl_internal_get_token(mpl /* for */); /* parse indexing expression */ if (mpl.token != T_LBRACE) mpl_internal_error(mpl, "indexing expression missing where expected"); fur.domain = mpl_internal_indexing_expression(mpl); /* skip optional colon */ if (mpl.token == T_COLON) mpl_internal_get_token(mpl /* : */); /* parse for statement body */ if (mpl.token != T_LBRACE) { /* parse simple statement */ fur.list = mpl_internal_simple_statement(mpl, 1); } else { /* parse compound statement */ mpl_internal_get_token(mpl /* { */); while (mpl.token != T_RBRACE) { /* parse statement */ stmt = mpl_internal_simple_statement(mpl, 1); /* and append it to the end of the statement list */ if (last_stmt == null) fur.list = stmt; else last_stmt.next = stmt; last_stmt = stmt; } mpl_internal_get_token(mpl /* } */); } /* close the domain scope */ xassert(fur.domain != null); mpl_internal_close_scope(mpl, fur.domain); /* the for statement has been completely parsed */ return fur; } function mpl_internal_end_statement(mpl){ if (!mpl.flag_d && mpl_internal_is_keyword(mpl, "end") || mpl.flag_d && mpl_internal_is_literal(mpl, "end")) { mpl_internal_get_token(mpl /* end */); if (mpl.token == T_SEMICOLON) mpl_internal_get_token(mpl /* ; */); else mpl_internal_warning(mpl, "no semicolon following end statement; missing" + " semicolon inserted"); } else mpl_internal_warning(mpl, "unexpected end of file; missing end statement inserted"); if (mpl.token != T_EOF) mpl_internal_warning(mpl, "some text detected beyond end statement; text ignored"); } function mpl_internal_simple_statement(mpl, spec){ var stmt = {u: {}}; stmt.line = mpl.line; stmt.column = mpl.column; stmt.next = null; if (mpl_internal_is_keyword(mpl, "set")) { if (spec) mpl_internal_error(mpl, "set statement not allowed here"); stmt.type = A_SET; stmt.u.set = mpl_internal_set_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "param")) { if (spec) mpl_internal_error(mpl, "parameter statement not allowed here"); stmt.type = A_PARAMETER; stmt.u.par = mpl_internal_parameter_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "var")) { if (spec) mpl_internal_error(mpl, "variable statement not allowed here"); stmt.type = A_VARIABLE; stmt.u.var_ = mpl_internal_variable_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "subject") || mpl_internal_is_keyword(mpl, "subj") || mpl.token == T_SPTP) { if (spec) mpl_internal_error(mpl, "constraint statement not allowed here"); stmt.type = A_CONSTRAINT; stmt.u.con = mpl_internal_constraint_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "minimize") || mpl_internal_is_keyword(mpl, "maximize")) { if (spec) mpl_internal_error(mpl, "objective statement not allowed here"); stmt.type = A_CONSTRAINT; stmt.u.con = mpl_internal_objective_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "table")) { if (spec) mpl_internal_error(mpl, "table statement not allowed here"); stmt.type = A_TABLE; stmt.u.tab = mpl_internal_table_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "solve")) { if (spec) mpl_internal_error(mpl, "solve statement not allowed here"); stmt.type = A_SOLVE; stmt.u.slv = mpl_internal_solve_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "check")) { stmt.type = A_CHECK; stmt.u.chk = mpl_internal_check_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "display")) { stmt.type = A_DISPLAY; stmt.u.dpy = mpl_internal_display_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "printf")) { stmt.type = A_PRINTF; stmt.u.prt = mpl_internal_printf_statement(mpl); } else if (mpl_internal_is_keyword(mpl, "for")) { stmt.type = A_FOR; stmt.u.fur = mpl_internal_for_statement(mpl); } else if (mpl.token == T_NAME) { if (spec) mpl_internal_error(mpl, "constraint statement not allowed here"); stmt.type = A_CONSTRAINT; stmt.u.con = mpl_internal_constraint_statement(mpl); } else if (mpl_internal_is_reserved(mpl)) mpl_internal_error(mpl, "invalid use of reserved keyword " + mpl.image); else mpl_internal_error(mpl, "syntax error in model section"); return stmt; } function mpl_internal_model_section(mpl){ var stmt, last_stmt; xassert(mpl.model == null); last_stmt = null; while (!(mpl.token == T_EOF || mpl_internal_is_keyword(mpl, "data") || mpl_internal_is_keyword(mpl, "end"))) { /* parse statement */ stmt = mpl_internal_simple_statement(mpl, 0); /* and append it to the end of the statement list */ if (last_stmt == null) mpl.model = stmt; else last_stmt.next = stmt; last_stmt = stmt; } } /* glpmpl02.c */ /**********************************************************************/ /* * * PROCESSING DATA SECTION * * */ /**********************************************************************/ function mpl_internal_expand_slice ( mpl, slice, /* destroyed */ sym /* destroyed */ ){ var temp; /* create a new component */ var tail = {}; tail.sym = sym; tail.next = null; /* and append it to the component list */ if (slice == null) slice = tail; else { for (temp = slice; temp.next != null; temp = temp.next){} temp.next = tail; } return slice; } function mpl_internal_slice_dimen ( mpl, slice /* not changed */ ){ var temp; var dim = 0; for (temp = slice; temp != null; temp = temp.next) dim++; return dim; } function mpl_internal_slice_arity ( mpl, slice /* not changed */ ){ var temp; var arity = 0; for (temp = slice; temp != null; temp = temp.next) if (temp.sym == null) arity++; return arity; } function mpl_internal_fake_slice(mpl, dim){ var slice = null; while (dim-- > 0) slice = mpl_internal_expand_slice(mpl, slice, null); return slice; } function mpl_internal_delete_slice ( mpl, slice /* destroyed */ ){ var temp; while (slice != null) { temp = slice; slice = temp.next; } } function mpl_internal_is_number(mpl){ return mpl.token == T_NUMBER; } function mpl_internal_is_symbol(mpl){ return mpl.token == T_NUMBER || mpl.token == T_SYMBOL || mpl.token == T_STRING; } function mpl_internal_is_literal(mpl, literal){ return mpl_internal_is_symbol(mpl) && mpl.image == literal; } function mpl_internal_read_number(mpl){ xassert(mpl_internal_is_number(mpl)); var num = mpl.value; mpl_internal_get_token(mpl /* */); return num; } function mpl_internal_read_symbol(mpl){ var sym; xassert(mpl_internal_is_symbol(mpl)); if (mpl_internal_is_number(mpl)) sym = mpl_internal_create_symbol_num(mpl, mpl.value); else sym = mpl_internal_create_symbol_str(mpl, mpl.image); mpl_internal_get_token(mpl /* */); return sym; } function mpl_internal_read_slice(mpl, name, dim){ var slice; var close; xassert(name != null); switch (mpl.token) { case T_LBRACKET: close = T_RBRACKET; break; case T_LEFT: xassert(dim > 0); close = T_RIGHT; break; default: xassert(mpl != mpl); } if (dim == 0) mpl_internal_error(mpl, name + " cannot be subscripted"); mpl_internal_get_token(mpl /* ( | [ */); /* read slice components */ slice = null; for (;;) { /* the current token must be a symbol or asterisk */ if (mpl_internal_is_symbol(mpl)) slice = mpl_internal_expand_slice(mpl, slice, mpl_internal_read_symbol(mpl)); else if (mpl.token == T_ASTERISK) { slice = mpl_internal_expand_slice(mpl, slice, null); mpl_internal_get_token(mpl /* * */); } else mpl_internal_error(mpl, "number, symbol, or asterisk missing where expected"); /* check a token that follows the symbol */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == close) break; else mpl_internal_error(mpl, "syntax error in slice"); } /* number of slice components must be the same as the appropriate dimension */ if (mpl_internal_slice_dimen(mpl, slice) != dim) { switch (close) { case T_RBRACKET: mpl_internal_error(mpl, name + " must have " + dim + " subscript" + (dim == 1 ? "" : "s") + ", not " + mpl_internal_slice_dimen(mpl, slice)); break; case T_RIGHT: mpl_internal_error(mpl, name + " has dimension " + dim + ", not " + mpl_internal_slice_dimen(mpl, slice)); break; default: xassert(close != close); } } mpl_internal_get_token(mpl /* ) | ] */); return slice; } function mpl_internal_select_set ( mpl, name /* not changed */ ){ var set; var node; xassert(name != null); node = mpl.tree[name]; if (node == null || node.type != A_SET) mpl_internal_error(mpl, name + " not a set"); set = node.link; if (set.assign != null || set.gadget != null) mpl_internal_error(mpl, name + " needs no data"); set.data = 1; return set; } function mpl_internal_simple_format ( mpl, set, /* not changed */ memb, /* modified */ slice /* not changed */ ){ var tuple; var temp; var sym, with_ = null; xassert(set != null); xassert(memb != null); xassert(slice != null); xassert(set.dimen == mpl_internal_slice_dimen(mpl, slice)); xassert(memb.value.set.dim == set.dimen); if (mpl_internal_slice_arity(mpl, slice) > 0) xassert(mpl_internal_is_symbol(mpl)); /* read symbols and construct complete n-tuple */ tuple = null; for (temp = slice; temp != null; temp = temp.next) { if (temp.sym == null) { /* substitution is needed; read symbol */ if (!mpl_internal_is_symbol(mpl)) { var lack = mpl_internal_slice_arity(mpl, temp); /* with cannot be null due to assertion above */ xassert(with_ != null); if (lack == 1) mpl_internal_error(mpl, "one item missing in data group beginning with " + mpl_internal_format_symbol(mpl, with_)); else mpl_internal_error(mpl, lack + " items missing in data group beginning with " + mpl_internal_format_symbol(mpl, with_)); } sym = mpl_internal_read_symbol(mpl); if (with_ == null) with_ = sym; } else { /* copy symbol from the slice */ sym = mpl_internal_copy_symbol(mpl, temp.sym); } /* append the symbol to the n-tuple */ tuple = mpl_internal_expand_tuple(mpl, tuple, sym); /* skip optional comma *between* */ if (temp.next != null && mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); } /* add constructed n-tuple to elemental set */ mpl_internal_check_then_add(mpl, memb.value.set, tuple); } function mpl_internal_matrix_format ( mpl, set, /* not changed */ memb, /* modified */ slice, /* not changed */ tr ){ var list, col, temp; var tuple; var row; xassert(set != null); xassert(memb != null); xassert(slice != null); xassert(set.dimen == mpl_internal_slice_dimen(mpl, slice)); xassert(memb.value.set.dim == set.dimen); xassert(mpl_internal_slice_arity(mpl, slice) == 2); /* read the matrix heading that contains column symbols (there may be no columns at all) */ list = null; while (mpl.token != T_ASSIGN) { /* read column symbol and append it to the column list */ if (!mpl_internal_is_symbol(mpl)) mpl_internal_error(mpl, "number, symbol, or := missing where expected"); list = mpl_internal_expand_slice(mpl, list, mpl_internal_read_symbol(mpl)); } mpl_internal_get_token(mpl /* := */); /* read zero or more rows that contain matrix data */ while (mpl_internal_is_symbol(mpl)) { /* read row symbol (if the matrix has no columns, row symbols are just ignored) */ row = mpl_internal_read_symbol(mpl); /* read the matrix row accordingly to the column list */ for (col = list; col != null; col = col.next) { var which = 0; /* check indicator */ if (mpl_internal_is_literal(mpl, "+")){ } else if (mpl_internal_is_literal(mpl, "-")) { mpl_internal_get_token(mpl /* - */); continue; } else { var lack = mpl_internal_slice_dimen(mpl, col); if (lack == 1) mpl_internal_error(mpl, "one item missing in data group beginning with " + mpl_internal_format_symbol(mpl, row)); else mpl_internal_error(mpl, lack + " items missing in data group beginning with " + mpl_internal_format_symbol(mpl, row)); } /* construct complete n-tuple */ tuple = null; for (temp = slice; temp != null; temp = temp.next) { if (temp.sym == null) { /* substitution is needed */ switch (++which) { case 1: /* substitute in the first null position */ tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_copy_symbol(mpl, tr ? col.sym : row)); break; case 2: /* substitute in the second null position */ tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_copy_symbol(mpl, tr ? row : col.sym)); break; default: xassert(which != which); } } else { /* copy symbol from the slice */ tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_copy_symbol(mpl, temp.sym)); } } xassert(which == 2); /* add constructed n-tuple to elemental set */ mpl_internal_check_then_add(mpl, memb.value.set, tuple); mpl_internal_get_token(mpl /* + */); } } /* delete the column list */ mpl_internal_delete_slice(mpl, list); } function mpl_internal_set_data(mpl){ var set; var tuple; var memb; var slice; var tr = 0; function err1(){mpl_internal_error(mpl, "slice currently used must specify 2 asterisks, not " + mpl_internal_slice_arity(mpl, slice))} function err2(){mpl_internal_error(mpl, "transpose indicator (tr) incomplete")} function left(){ /* left parenthesis begins the "transpose" indicator, which is followed by data in the matrix format */ mpl_internal_get_token(mpl /* ( */); if (!mpl_internal_is_literal(mpl, "tr")) err2(); if (mpl_internal_slice_arity(mpl, slice) != 2) err1(); mpl_internal_get_token(mpl /* tr */); if (mpl.token != T_RIGHT) err2(); mpl_internal_get_token(mpl /* ) */); /* in this case the colon is optional */ if (mpl.token == T_COLON) mpl_internal_get_token(mpl /* : */); /* set the "transpose" indicator */ tr = 1; /* read elemental set data in the matrix format */ mpl_internal_matrix_format(mpl, set, memb, slice, tr); } xassert(mpl_internal_is_literal(mpl, "set")); mpl_internal_get_token(mpl /* set */); /* symbolic name of set must follows the keyword 'set' */ if (!mpl_internal_is_symbol(mpl)) mpl_internal_error(mpl, "set name missing where expected"); /* select the set to saturate it with data */ set = mpl_internal_select_set(mpl, mpl.image); mpl_internal_get_token(mpl /* */); /* read optional subscript list, which identifies member of the set to be read */ tuple = null; if (mpl.token == T_LBRACKET) { /* subscript list is specified */ if (set.dim == 0) mpl_internal_error(mpl, set.name + " cannot be subscripted"); mpl_internal_get_token(mpl /* [ */); /* read symbols and construct subscript list */ for (;;) { if (!mpl_internal_is_symbol(mpl)) mpl_internal_error(mpl, "number or symbol missing where expected"); tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_read_symbol(mpl)); if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); else if (mpl.token == T_RBRACKET) break; else mpl_internal_error(mpl, "syntax error in subscript list"); } if (set.dim != mpl_internal_tuple_dimen(mpl, tuple)) mpl_internal_error(mpl, set.name + " must have " + set.dim + " subscript" + (set.dim == 1 ? "" : "s") + " rather than " + mpl_internal_tuple_dimen(mpl, tuple)); mpl_internal_get_token(mpl /* ] */); } else { /* subscript list is not specified */ if (set.dim != 0) mpl_internal_error(mpl, set.name + " must be subscripted"); } /* there must be no member with the same subscript list */ if (mpl_internal_find_member(mpl, set.array, tuple) != null) mpl_internal_error(mpl, set.name + mpl_internal_format_tuple(mpl, '[', tuple) + " already defined"); /* add new member to the set and assign it empty elemental set */ memb = mpl_internal_add_member(mpl, set.array, tuple); memb.value.set = mpl_internal_create_elemset(mpl, set.dimen); /* create an initial fake slice of all asterisks */ slice = mpl_internal_fake_slice(mpl, set.dimen); /* read zero or more data assignments */ for (;;) { /* skip optional comma */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); /* process assignment element */ if (mpl.token == T_ASSIGN) { /* assignment ligature is non-significant element */ mpl_internal_get_token(mpl /* := */); } else if (mpl.token == T_LEFT) { /* left parenthesis begins either new slice or "transpose" indicator */ var is_tr; mpl_internal_get_token(mpl /* ( */); is_tr = mpl_internal_is_literal(mpl, "tr"); mpl_internal_unget_token(mpl /* ( */); if (is_tr) { left(); } else { /* delete the current slice and read new one */ mpl_internal_delete_slice(mpl, slice); slice = mpl_internal_read_slice(mpl, set.name, set.dimen); /* each new slice resets the "transpose" indicator */ tr = 0; /* if the new slice is 0-ary, formally there is one 0-tuple (in the simple format) that follows it */ if (mpl_internal_slice_arity(mpl, slice) == 0) mpl_internal_simple_format(mpl, set, memb, slice); } } else if (mpl_internal_is_symbol(mpl)) { /* number or symbol begins data in the simple format */ mpl_internal_simple_format(mpl, set, memb, slice); } else if (mpl.token == T_COLON) { /* colon begins data in the matrix format */ if (mpl_internal_slice_arity(mpl, slice) != 2) err1(); mpl_internal_get_token(mpl /* : */); /* read elemental set data in the matrix format */ mpl_internal_matrix_format(mpl, set, memb, slice, tr); } else if (mpl.token == T_LEFT){ left(); } else if (mpl.token == T_SEMICOLON) { /* semicolon terminates the data block */ mpl_internal_get_token(mpl /* ; */); break; } else mpl_internal_error(mpl, "syntax error in set data block"); } /* delete the current slice */ mpl_internal_delete_slice(mpl, slice); } function mpl_internal_select_parameter( mpl, name /* not changed */ ){ var par; var node; xassert(name != null); node = mpl.tree[name]; if (node == null || node.type != A_PARAMETER) mpl_internal_error(mpl, name + " not a parameter"); par = node.link; if (par.assign != null) mpl_internal_error(mpl, name + " needs no data"); if (par.data) mpl_internal_error(mpl, name + " already provided with data"); par.data = 1; return par; } function mpl_internal_set_default( mpl, par, /* not changed */ altval /* destroyed */ ){ xassert(par != null); xassert(altval != null); if (par.option != null) mpl_internal_error(mpl, "default value for " + par.name + " already specified in model section"); xassert(par.defval == null); par.defval = altval; } function mpl_internal_read_value ( mpl, par, /* not changed */ tuple /* destroyed */ ){ var memb; xassert(par != null); xassert(mpl_internal_is_symbol(mpl)); /* there must be no member with the same n-tuple */ if (mpl_internal_find_member(mpl, par.array, tuple) != null) mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " already defined"); /* create new parameter member with given n-tuple */ memb = mpl_internal_add_member(mpl, par.array, tuple); /* read value and assigns it to the new parameter member */ switch (par.type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: if (!mpl_internal_is_number(mpl)) mpl_internal_error(mpl, par.name + " requires numeric data"); memb.value.num = mpl_internal_read_number(mpl); break; case A_SYMBOLIC: memb.value.sym = mpl_internal_read_symbol(mpl); break; default: xassert(par != par); } return memb; } function mpl_internal_plain_format ( mpl, par, /* not changed */ slice /* not changed */ ) { var tuple; var temp; var sym, with_ = null; xassert(par != null); xassert(par.dim == mpl_internal_slice_dimen(mpl, slice)); xassert(mpl_internal_is_symbol(mpl)); /* read symbols and construct complete subscript list */ tuple = null; for (temp = slice; temp != null; temp = temp.next) { if (temp.sym == null) { /* substitution is needed; read symbol */ if (!mpl_internal_is_symbol(mpl)) { var lack = mpl_internal_slice_arity(mpl, temp) + 1; xassert(with_ != null); xassert(lack > 1); mpl_internal_error(mpl, lack + " items missing in data group beginning with " + mpl_internal_format_symbol(mpl, with_)); } sym = mpl_internal_read_symbol(mpl); if (with_ == null) with_ = sym; } else { /* copy symbol from the slice */ sym = mpl_internal_copy_symbol(mpl, temp.sym); } /* append the symbol to the subscript list */ tuple = mpl_internal_expand_tuple(mpl, tuple, sym); /* skip optional comma */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); } /* read value and assign it to new parameter member */ if (!mpl_internal_is_symbol(mpl)) { xassert(with_ != null); mpl_internal_error(mpl, "one item missing in data group beginning with " + mpl_internal_format_symbol(mpl, with_)); } mpl_internal_read_value(mpl, par, tuple); } function mpl_internal_tabular_format ( mpl, par, /* not changed */ slice, /* not changed */ tr ){ var list, col, temp; var tuple; var row; xassert(par != null); xassert(par.dim == mpl_internal_slice_dimen(mpl, slice)); xassert(mpl_internal_slice_arity(mpl, slice) == 2); /* read the table heading that contains column symbols (the table may have no columns) */ list = null; while (mpl.token != T_ASSIGN) { /* read column symbol and append it to the column list */ if (!mpl_internal_is_symbol(mpl)) mpl_internal_error(mpl, "number, symbol, or := missing where expected"); list = mpl_internal_expand_slice(mpl, list, mpl_internal_read_symbol(mpl)); } mpl_internal_get_token(mpl /* := */); /* read zero or more rows that contain tabular data */ while (mpl_internal_is_symbol(mpl)) { /* read row symbol (if the table has no columns, these symbols are just ignored) */ row = mpl_internal_read_symbol(mpl); /* read values accordingly to the column list */ for (col = list; col != null; col = col.next) { var which = 0; /* if the token is single point, no value is provided */ if (mpl_internal_is_literal(mpl, ".")) { mpl_internal_get_token(mpl /* . */); continue; } /* construct complete subscript list */ tuple = null; for (temp = slice; temp != null; temp = temp.next) { if (temp.sym == null) { /* substitution is needed */ switch (++which) { case 1: /* substitute in the first null position */ tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_copy_symbol(mpl, tr ? col.sym : row)); break; case 2: /* substitute in the second null position */ tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_copy_symbol(mpl, tr ? row : col.sym)); break; default: xassert(which != which); } } else { /* copy symbol from the slice */ tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_copy_symbol(mpl, temp.sym)); } } xassert(which == 2); /* read value and assign it to new parameter member */ if (!mpl_internal_is_symbol(mpl)) { var lack = mpl_internal_slice_dimen(mpl, col); if (lack == 1) mpl_internal_error(mpl, "one item missing in data group beginning with " + mpl_internal_format_symbol(mpl, row)); else mpl_internal_error(mpl, lack + " items missing in data group beginning with " + mpl_internal_format_symbol(mpl, row)); } mpl_internal_read_value(mpl, par, tuple); } } /* delete the column list */ mpl_internal_delete_slice(mpl, list); } function mpl_internal_tabbing_format ( mpl, altval /* not changed */ ){ var set = null; var par; var list, col; var tuple; var next_token, j, dim = 0; var last_name = null; /* read the optional */ if (mpl_internal_is_symbol(mpl)) { mpl_internal_get_token(mpl /* */); next_token = mpl.token; mpl_internal_unget_token(mpl /* */); if (next_token == T_COLON) { /* select the set to saturate it with data */ set = mpl_internal_select_set(mpl, mpl.image); /* the set must be simple (i.e. not set of sets) */ if (set.dim != 0) mpl_internal_error(mpl, set.name + " must be a simple set"); /* and must not be defined yet */ if (set.array.head != null) mpl_internal_error(mpl, set.name + " already defined"); /* add new (the only) member to the set and assign it empty elemental set */ mpl_internal_add_member(mpl, set.array, null).value.set = mpl_internal_create_elemset(mpl, set.dimen); last_name = set.name; dim = set.dimen; mpl_internal_get_token(mpl /* */); xassert(mpl.token == T_COLON); mpl_internal_get_token(mpl /* : */); } } /* read the table heading that contains parameter names */ list = null; while (mpl.token != T_ASSIGN) { /* there must be symbolic name of parameter */ if (!mpl_internal_is_symbol(mpl)) mpl_internal_error(mpl, "parameter name or := missing where expected"); /* select the parameter to saturate it with data */ par = mpl_internal_select_parameter(mpl, mpl.image); /* the parameter must be subscripted */ if (par.dim == 0) mpl_internal_error(mpl, mpl.image + " not a subscripted parameter"); /* the set (if specified) and all the parameters in the data block must have identical dimension */ if (dim != 0 && par.dim != dim) { xassert(last_name != null); mpl_internal_error(mpl, last_name + " has dimension " + dim + " while " + par.name + " has dimension " + par.dim); } /* set default value for the parameter (if specified) */ if (altval != null) mpl_internal_set_default(mpl, par, mpl_internal_copy_symbol(mpl, altval)); /* append the parameter to the column list */ list = mpl_internal_expand_slice(mpl, list, par); last_name = par.name; dim = par.dim; mpl_internal_get_token(mpl /* */); /* skip optional comma */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); } if (mpl_internal_slice_dimen(mpl, list) == 0) mpl_internal_error(mpl, "at least one parameter name required"); mpl_internal_get_token(mpl /* := */); /* skip optional comma */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); /* read rows that contain tabbing data */ while (mpl_internal_is_symbol(mpl)) { /* read subscript list */ var lack; tuple = null; for (j = 1; j <= dim; j++) { /* read j-th subscript */ if (!mpl_internal_is_symbol(mpl)) { lack = mpl_internal_slice_dimen(mpl, list) + dim - j + 1; xassert(tuple != null); xassert(lack > 1); mpl_internal_error(mpl, lack + " items missing in data group beginning with " + mpl_internal_format_symbol(mpl, tuple.sym)); } /* read and append j-th subscript to the n-tuple */ tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_read_symbol(mpl)); /* skip optional comma *between* */ if (j < dim && mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); } /* if the set is specified, add to it new n-tuple, which is a copy of the subscript list just read */ if (set != null) mpl_internal_check_then_add(mpl, set.array.head.value.set, mpl_internal_copy_tuple(mpl, tuple)); /* skip optional comma between and */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); /* read values accordingly to the column list */ for (col = list; col != null; col = col.next) { /* if the token is single point, no value is provided */ if (mpl_internal_is_literal(mpl, ".")) { mpl_internal_get_token(mpl /* . */); continue; } /* read value and assign it to new parameter member */ if (!mpl_internal_is_symbol(mpl)) { lack = mpl_internal_slice_dimen(mpl, col); xassert(tuple != null); if (lack == 1) mpl_internal_error(mpl, "one item missing in data group beginning with " + mpl_internal_format_symbol(mpl, tuple.sym)); else mpl_internal_error(mpl, lack + " items missing in data group beginning with " + mpl_internal_format_symbol(mpl, tuple.sym)); } mpl_internal_read_value(mpl, col.sym, mpl_internal_copy_tuple(mpl, tuple)); /* skip optional comma preceding the next value */ if (col.next != null && mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); } /* skip optional comma (only if there is next data group) */ if (mpl.token == T_COMMA) { mpl_internal_get_token(mpl /* , */); if (!mpl_internal_is_symbol(mpl)) mpl_internal_unget_token(mpl /* , */); } } /* delete the column list (it contains parameters, not symbols, so nullify it before) */ for (col = list; col != null; col = col.next) col.sym = null; mpl_internal_delete_slice(mpl, list); } function mpl_internal_parameter_data(mpl){ var par; var altval = null; var slice; var tr = 0; xassert(mpl_internal_is_literal(mpl, "param")); mpl_internal_get_token(mpl /* param */); /* read optional default value */ if (mpl_internal_is_literal(mpl, "default")) { mpl_internal_get_token(mpl /* default */); if (!mpl_internal_is_symbol(mpl)) mpl_internal_error(mpl, "default value missing where expected"); altval = mpl_internal_read_symbol(mpl); /* if the default value follows the keyword 'param', the next token must be only the colon */ if (mpl.token != T_COLON) mpl_internal_error(mpl, "colon missing where expected"); } /* being used after the keyword 'param' or the optional default value the colon begins data in the tabbing format */ if (mpl.token == T_COLON) { mpl_internal_get_token(mpl /* : */); /* skip optional comma */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); /* read parameter data in the tabbing format */ mpl_internal_tabbing_format(mpl, altval); /* the next token must be only semicolon */ if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "symbol, number, or semicolon missing where expected"); mpl_internal_get_token(mpl /* ; */); return; } /* in other cases there must be symbolic name of parameter, which follows the keyword 'param' */ if (!mpl_internal_is_symbol(mpl)) mpl_internal_error(mpl, "parameter name missing where expected"); /* select the parameter to saturate it with data */ par = mpl_internal_select_parameter(mpl, mpl.image); mpl_internal_get_token(mpl /* */); /* read optional default value */ if (mpl_internal_is_literal(mpl, "default")) { mpl_internal_get_token(mpl /* default */); if (!mpl_internal_is_symbol(mpl)) mpl_internal_error(mpl, "default value missing where expected"); altval = mpl_internal_read_symbol(mpl); /* set default value for the parameter */ mpl_internal_set_default(mpl, par, altval); } /* create initial fake slice of all asterisks */ slice = mpl_internal_fake_slice(mpl, par.dim); /* read zero or more data assignments */ function err1(){mpl_internal_error(mpl, par.name + " not a subscripted parameter")} function err2(){mpl_internal_error(mpl, "slice currently used must specify 2 asterisks, not " + mpl_internal_slice_arity(mpl, slice))} function err3(){mpl_internal_error(mpl, "transpose indicator (tr) incomplete")} for (;;) { /* skip optional comma */ if (mpl.token == T_COMMA) mpl_internal_get_token(mpl /* , */); /* process current assignment */ if (mpl.token == T_ASSIGN) { /* assignment ligature is non-significant element */ mpl_internal_get_token(mpl /* := */); } else if (mpl.token == T_LBRACKET) { /* left bracket begins new slice; delete the current slice and read new one */ mpl_internal_delete_slice(mpl, slice); slice = mpl_internal_read_slice(mpl, par.name, par.dim); /* each new slice resets the "transpose" indicator */ tr = 0; } else if (mpl_internal_is_symbol(mpl)) { /* number or symbol begins data in the plain format */ mpl_internal_plain_format(mpl, par, slice); } else if (mpl.token == T_COLON) { /* colon begins data in the tabular format */ if (par.dim == 0) err1(); if (mpl_internal_slice_arity(mpl, slice) != 2) err2(); mpl_internal_get_token(mpl /* : */); /* read parameter data in the tabular format */ mpl_internal_tabular_format(mpl, par, slice, tr); } else if (mpl.token == T_LEFT) { /* left parenthesis begins the "transpose" indicator, which is followed by data in the tabular format */ mpl_internal_get_token(mpl /* ( */); if (!mpl_internal_is_literal(mpl, "tr")) err3(); if (par.dim == 0) err1(); if (mpl_internal_slice_arity(mpl, slice) != 2) err2(); mpl_internal_get_token(mpl /* tr */); if (mpl.token != T_RIGHT) err3(); mpl_internal_get_token(mpl /* ) */); /* in this case the colon is optional */ if (mpl.token == T_COLON) mpl_internal_get_token(mpl /* : */); /* set the "transpose" indicator */ tr = 1; /* read parameter data in the tabular format */ mpl_internal_tabular_format(mpl, par, slice, tr); } else if (mpl.token == T_SEMICOLON) { /* semicolon terminates the data block */ mpl_internal_get_token(mpl /* ; */); break; } else mpl_internal_error(mpl, "syntax error in parameter data block"); } /* delete the current slice */ mpl_internal_delete_slice(mpl, slice); } function mpl_internal_data_section(mpl){ while (!(mpl.token == T_EOF || mpl_internal_is_literal(mpl, "end"))) { if (mpl_internal_is_literal(mpl, "set")) mpl_internal_set_data(mpl); else if (mpl_internal_is_literal(mpl, "param")) mpl_internal_parameter_data(mpl); else mpl_internal_error(mpl, "syntax error in data section"); } } /* glpmpl03.c */ /**********************************************************************/ /* * * FLOATING-POINT NUMBERS * * */ /**********************************************************************/ function mpl_internal_fp_add(mpl, x, y){ if (x > 0.0 && y > 0.0 && x > + 0.999 * DBL_MAX - y || x < 0.0 && y < 0.0 && x < - 0.999 * DBL_MAX - y) mpl_internal_error(mpl, x + " + " + y + "; floating-point overflow"); return x + y; } function mpl_internal_fp_sub(mpl, x, y){ if (x > 0.0 && y < 0.0 && x > + 0.999 * DBL_MAX + y || x < 0.0 && y > 0.0 && x < - 0.999 * DBL_MAX + y) mpl_internal_error(mpl, x + " - " + y + "; floating-point overflow"); return x - y; } function mpl_internal_fp_less(mpl, x, y){ if (x < y) return 0.0; if (x > 0.0 && y < 0.0 && x > + 0.999 * DBL_MAX + y) mpl_internal_error(mpl, x+ " less " + y + "; floating-point overflow"); return x - y; } function mpl_internal_fp_mul(mpl, x, y){ if (Math.abs(y) > 1.0 && Math.abs(x) > (0.999 * DBL_MAX) / Math.abs(y)) mpl_internal_error(mpl, x + " * " + y + "; floating-point overflow"); return x * y; } function mpl_internal_fp_div(mpl, x, y){ if (Math.abs(y) < DBL_MIN) mpl_internal_error(mpl, x + " / " + y + "; floating-point zero divide"); if (Math.abs(y) < 1.0 && Math.abs(x) > (0.999 * DBL_MAX) * Math.abs(y)) mpl_internal_error(mpl, x + " / " + y + "; floating-point overflow"); return x / y; } function mpl_internal_fp_idiv(mpl, x, y){ if (Math.abs(y) < DBL_MIN) mpl_internal_error(mpl, x + " div " + y + "; floating-point zero divide"); if (Math.abs(y) < 1.0 && Math.abs(x) > (0.999 * DBL_MAX) * Math.abs(y)) mpl_internal_error(mpl, x + " div " + y + "; floating-point overflow"); x /= y; return x > 0.0 ? Math.floor(x) : x < 0.0 ? Math.ceil(x) : 0.0; } function mpl_internal_fp_mod(mpl, x, y) { var r; if (x == 0.0) r = 0.0; else if (y == 0.0) r = x; else { r = Math.abs(x) % Math.abs(y); if (r != 0.0) { if (x < 0.0) r = - r; if (x > 0.0 && y < 0.0 || x < 0.0 && y > 0.0) r += y; } } return r; } function mpl_internal_fp_power(mpl, x, y) { var r; if (x == 0.0 && y <= 0.0 || x < 0.0 && y != Math.floor(y)) mpl_internal_error(mpl, x + " ** " + y + "; result undefined"); if (x == 0.0) { r = Math.pow(x, y); } else { if (Math.abs(x) > 1.0 && y > +1.0 && +Math.log(Math.abs(x)) > (0.999 * Math.log(DBL_MAX)) / y || Math.abs(x) < 1.0 && y < -1.0 && +Math.log(Math.abs(x)) < (0.999 * Math.log(DBL_MAX)) / y) mpl_internal_error(mpl, x + " ** " + y + "; floating-point overflow"); if (Math.abs(x) > 1.0 && y < -1.0 && -Math.log(Math.abs(x)) < (0.999 * Math.log(DBL_MAX)) / y || Math.abs(x) < 1.0 && y > +1.0 && -Math.log(Math.abs(x)) > (0.999 * Math.log(DBL_MAX)) / y) r = 0.0; else r = Math.pow(x, y); } return r; } function mpl_internal_fp_exp(mpl, x) { if (x > 0.999 * Math.log(DBL_MAX)) mpl_internal_error(mpl, "exp(" + x + "); floating-point overflow"); return Math.exp(x); } function mpl_internal_fp_log(mpl, x) { if (x <= 0.0) mpl_internal_error(mpl, "log(" + x + "); non-positive argument"); return Math.log(x); } function mpl_internal_fp_log10(mpl, x) { if (x <= 0.0) mpl_internal_error(mpl, "log10(" + x + "); non-positive argument"); return Math.log(x) / Math.LN10; } function mpl_internal_fp_sqrt(mpl, x) { if (x < 0.0) mpl_internal_error(mpl, "sqrt(" + x + "); negative argument"); return Math.sqrt(x); } function mpl_internal_fp_sin(mpl, x) { if (!(-1e6 <= x && x <= +1e6)) mpl_internal_error(mpl, "sin(" + x + "); argument too large"); return Math.sin(x); } function mpl_internal_fp_cos(mpl, x) { if (!(-1e6 <= x && x <= +1e6)) mpl_internal_error(mpl, "cos(" + x + "); argument too large"); return Math.cos(x); } function mpl_internal_fp_atan(mpl, x) { return Math.atan(x); } function mpl_internal_fp_atan2(mpl, y, x) { return Math.atan2(y, x); } function mpl_internal_fp_round(mpl, x, n) { var ten_to_n; if (n != Math.floor(n)) mpl_internal_error(mpl, "round(" + x + ", " + n + "); non-integer second argument"); if (n <= DBL_DIG + 2) { ten_to_n = Math.pow(10.0, n); if (Math.abs(x) < (0.999 * DBL_MAX) / ten_to_n) { x = Math.floor(x * ten_to_n + 0.5); if (x != 0.0) x /= ten_to_n; } } return x; } function mpl_internal_fp_trunc(mpl, x, n) { var ten_to_n; if (n != Math.floor(n)) mpl_internal_error(mpl, "trunc(" + x + ", " + n + "); non-integer second argument"); if (n <= DBL_DIG + 2) { ten_to_n = Math.pow(10.0, n); if (Math.abs(x) < (0.999 * DBL_MAX) / ten_to_n) { x = (x >= 0.0 ? Math.floor(x * ten_to_n) : Math.ceil(x * ten_to_n)); if (x != 0.0) x /= ten_to_n; } } return x; } /**********************************************************************/ /* * * PSEUDO-RANDOM NUMBER GENERATORS * * */ /**********************************************************************/ function mpl_internal_fp_irand224(mpl) { var two_to_the_24 = 0x1000000; return rng_unif_rand(mpl.rand, two_to_the_24); } function mpl_internal_fp_uniform01(mpl) { var two_to_the_31 = 0x80000000; return rng_next_rand(mpl.rand) / two_to_the_31; } function mpl_internal_fp_uniform(mpl, a, b){ var x; if (a >= b) mpl_internal_error(mpl, "Uniform(" + a + ", " + b + "); invalid range"); x = mpl_internal_fp_uniform01(mpl); x = mpl_internal_fp_add(mpl, a * (1.0 - x), b * x); return x; } function mpl_internal_fp_normal01(mpl){ var x, y, r2; do { /* choose x, y in uniform square (-1,-1) to (+1,+1) */ x = -1.0 + 2.0 * mpl_internal_fp_uniform01(mpl); y = -1.0 + 2.0 * mpl_internal_fp_uniform01(mpl); /* see if it is in the unit circle */ r2 = x * x + y * y; } while (r2 > 1.0 || r2 == 0.0); /* Box-Muller transform */ return y * Math.sqrt(-2.0 * Math.log(r2) / r2); } function mpl_internal_fp_normal(mpl, mu, sigma){ return mpl_internal_fp_add(mpl, mu, mpl_internal_fp_mul(mpl, sigma, mpl_internal_fp_normal01(mpl))); } /**********************************************************************/ /* * * SEGMENTED CHARACTER STRINGS * * */ /**********************************************************************/ function mpl_internal_compare_strings(mpl, str1, str2) { if (str1 == str2) return 0; else if (str1 > str2) return 1; else return -1; } /**********************************************************************/ /* * * SYMBOLS * * */ /**********************************************************************/ function mpl_internal_create_symbol_num(mpl, num){ var sym = {}; sym.num = num; sym.str = null; return sym; } function mpl_internal_create_symbol_str(mpl, str){ xassert(str != null); var sym = {}; sym.num = 0.0; sym.str = str; return sym; } function mpl_internal_copy_symbol(mpl, sym){ xassert(sym != null); var copy = {}; if (sym.str == null) { copy.num = sym.num; copy.str = null; } else { copy.num = 0.0; copy.str = sym.str; } return copy; } function mpl_internal_compare_symbols(mpl, sym1, sym2){ xassert(sym1 != null); xassert(sym2 != null); /* let all numeric quantities precede all symbolic quantities */ if (sym1.str == null && sym2.str == null) { if (sym1.num < sym2.num) return -1; if (sym1.num > sym2.num) return +1; return 0; } if (sym1.str == null) return -1; if (sym2.str == null) return +1; return mpl_internal_compare_strings(mpl, sym1.str, sym2.str); } function mpl_internal_format_symbol(mpl, sym){ xassert(sym != null); var buf; if (sym.str == null) buf = String(sym.num); else { var quoted, j, len; var str = sym.str; if (!(isalpha(str[0]) || str[0] == '_')) quoted = true; else { quoted = false; for (j = 1; j < str.length; j++) { if (!(isalnum(str[j]) || strchr("+-._", str[j]) >= 0)) { quoted = true; break; } } } buf = ''; len = 0; function safe_append(c){if (len < 255) {buf += c; len++}} if (quoted) safe_append('\''); for (j = 0; j < str.length; j++) { if (quoted && str[j] == '\'') safe_append('\''); safe_append(str[j]); } if (quoted) safe_append('\''); if (len == 255) buf = buf.slice(0, 252) + "..."; } xassert(buf.length <= 255); return buf; } function mpl_internal_concat_symbols ( mpl, sym1, /* destroyed */ sym2 /* destroyed */ ){ var str1, str2; //xassert(MAX_LENGTH >= DBL_DIG + DBL_DIG); if (sym1.str == null) str1 = String(sym1.num); else str1 = sym1.str; if (sym2.str == null) str2 = String(sym2.num); else str2 = sym2.str; /* if (str1.length + str2.length > MAX_LENGTH) { var buf = mpl_internal_format_symbol(mpl, sym1); xassert(buf.length < MAX_LENGTH); mpl_internal_error(mpl, buf + " & " + mpl_internal_format_symbol(mpl, sym2) + "; resultant symbol exceeds " + MAX_LENGTH + " characters"); } */ return mpl_internal_create_symbol_str(mpl, str1 + str2); } /**********************************************************************/ /* * * N-TUPLES * * */ /**********************************************************************/ function mpl_internal_expand_tuple(mpl, tuple, sym){ var temp; xassert(sym != null); /* create a new component */ var tail = {}; tail.sym = sym; tail.next = null; /* and append it to the component list */ if (tuple == null) tuple = tail; else { for (temp = tuple; temp.next != null; temp = temp.next){} temp.next = tail; } return tuple; } function mpl_internal_tuple_dimen(mpl, tuple){ var dim = 0; for (var temp = tuple; temp != null; temp = temp.next) dim++; return dim; } function mpl_internal_copy_tuple(mpl, tuple){ var head, tail; if (tuple == null) head = null; else { head = tail = {}; for (; tuple != null; tuple = tuple.next) { xassert(tuple.sym != null); tail.sym = mpl_internal_copy_symbol(mpl, tuple.sym); if (tuple.next != null) tail = tail.next = {}; } tail.next = null; } return head; } function mpl_internal_compare_tuples(mpl, tuple1, tuple2){ var item1, item2; var ret; for (item1 = tuple1, item2 = tuple2; item1 != null; item1 = item1.next, item2 = item2.next) { xassert(item2 != null); xassert(item1.sym != null); xassert(item2.sym != null); ret = mpl_internal_compare_symbols(mpl, item1.sym, item2.sym); if (ret != 0) return ret; } xassert(item2 == null); return 0; } function mpl_internal_build_subtuple(mpl, tuple, dim){ var head = null; for (var j = 1, temp = tuple; j <= dim; j++, temp = temp.next) { xassert(temp != null); head = mpl_internal_expand_tuple(mpl, head, mpl_internal_copy_symbol(mpl, temp.sym)); } return head; } function mpl_internal_format_tuple(mpl, c, tuple){ var temp; var j, len = 0; var buf = '', str = '', save; function safe_append(c){if (len < 255) buf += c; len++} var dim = mpl_internal_tuple_dimen(mpl, tuple); if (c == '[' && dim > 0) safe_append('['); if (c == '(' && dim > 1) safe_append('('); for (temp = tuple; temp != null; temp = temp.next) { if (temp != tuple) safe_append(','); xassert(temp.sym != null); str = mpl_internal_format_symbol(mpl, temp.sym); xassert(str.length <= 255); for (j = 0; j < str.length; j++) safe_append(str[j]); } if (c == '[' && dim > 0) safe_append(']'); if (c == '(' && dim > 1) safe_append(')'); if (len == 255) buf = buf.slice(0,252) + "..."; xassert(buf.length <= 255); return buf; } /**********************************************************************/ /* * * ELEMENTAL SETS * * */ /**********************************************************************/ function mpl_internal_create_elemset(mpl, dim){ xassert(dim > 0); return mpl_internal_create_array(mpl, A_NONE, dim); } function mpl_internal_find_tuple(mpl, set, tuple){ xassert(set != null); xassert(set.type == A_NONE); xassert(set.dim == mpl_internal_tuple_dimen(mpl, tuple)); return mpl_internal_find_member(mpl, set, tuple); } function mpl_internal_add_tuple(mpl, set, tuple){ var memb; xassert(set != null); xassert(set.type == A_NONE); xassert(set.dim == mpl_internal_tuple_dimen(mpl, tuple)); memb = mpl_internal_add_member(mpl, set, tuple); memb.value.none = null; return memb; } function mpl_internal_check_then_add(mpl, set, tuple){ if (mpl_internal_find_tuple(mpl, set, tuple) != null) mpl_internal_error(mpl, "duplicate tuple " + mpl_internal_format_tuple(mpl, '(', tuple) + " detected"); return mpl_internal_add_tuple(mpl, set, tuple); } function mpl_internal_copy_elemset(mpl, set){ var copy; var memb; xassert(set != null); xassert(set.type == A_NONE); xassert(set.dim > 0); copy = mpl_internal_create_elemset(mpl, set.dim); for (memb = set.head; memb != null; memb = memb.next) mpl_internal_add_tuple(mpl, copy, mpl_internal_copy_tuple(mpl, memb.tuple)); return copy; } function mpl_internal_arelset_size(mpl, t0, tf, dt){ var temp; if (dt == 0.0) mpl_internal_error(mpl, t0 + " .. " + tf + " by " + dt + "; zero stride not allowed"); if (tf > 0.0 && t0 < 0.0 && tf > + 0.999 * DBL_MAX + t0) temp = +DBL_MAX; else if (tf < 0.0 && t0 > 0.0 && tf < - 0.999 * DBL_MAX + t0) temp = -DBL_MAX; else temp = tf - t0; if (Math.abs(dt) < 1.0 && Math.abs(temp) > (0.999 * DBL_MAX) * Math.abs(dt)) { if (temp > 0.0 && dt > 0.0 || temp < 0.0 && dt < 0.0) temp = +DBL_MAX; else temp = 0.0; } else { temp = Math.floor(temp / dt) + 1.0; if (temp < 0.0) temp = 0.0; } xassert(temp >= 0.0); if (temp > (INT_MAX - 1)) mpl_internal_error(mpl, t0 + " .. " + tf + " by " + dt + "; set too large"); return (temp + 0.5)|0; } function mpl_internal_arelset_member(mpl, t0, tf, dt, j){ xassert(1 <= j && j <= mpl_internal_arelset_size(mpl, t0, tf, dt)); return t0 + (j - 1) * dt; } function mpl_internal_create_arelset(mpl, t0, tf, dt){ var set = mpl_internal_create_elemset(mpl, 1); var n = mpl_internal_arelset_size(mpl, t0, tf, dt); for (var j = 1; j <= n; j++) { mpl_internal_add_tuple(mpl, set, mpl_internal_expand_tuple(mpl, null, mpl_internal_create_symbol_num(mpl, mpl_internal_arelset_member(mpl, t0, tf, dt, j)))); } return set; } function mpl_internal_set_union(mpl, X, Y){ xassert(X != null); xassert(X.type == A_NONE); xassert(X.dim > 0); xassert(Y != null); xassert(Y.type == A_NONE); xassert(Y.dim > 0); xassert(X.dim == Y.dim); for (var memb = Y.head; memb != null; memb = memb.next) { if (mpl_internal_find_tuple(mpl, X, memb.tuple) == null) mpl_internal_add_tuple(mpl, X, mpl_internal_copy_tuple(mpl, memb.tuple)); } return X; } function mpl_internal_set_diff(mpl, X, Y){ xassert(X != null); xassert(X.type == A_NONE); xassert(X.dim > 0); xassert(Y != null); xassert(Y.type == A_NONE); xassert(Y.dim > 0); xassert(X.dim == Y.dim); var Z = mpl_internal_create_elemset(mpl, X.dim); for (var memb = X.head; memb != null; memb = memb.next) { if (mpl_internal_find_tuple(mpl, Y, memb.tuple) == null) mpl_internal_add_tuple(mpl, Z, mpl_internal_copy_tuple(mpl, memb.tuple)); } return Z; } function mpl_internal_set_symdiff(mpl, X, Y){ var memb; xassert(X != null); xassert(X.type == A_NONE); xassert(X.dim > 0); xassert(Y != null); xassert(Y.type == A_NONE); xassert(Y.dim > 0); xassert(X.dim == Y.dim); /* Z := X \ Y */ var Z = mpl_internal_create_elemset(mpl, X.dim); for (memb = X.head; memb != null; memb = memb.next) { if (mpl_internal_find_tuple(mpl, Y, memb.tuple) == null) mpl_internal_add_tuple(mpl, Z, mpl_internal_copy_tuple(mpl, memb.tuple)); } /* Z := Z U (Y \ X) */ for (memb = Y.head; memb != null; memb = memb.next) { if (mpl_internal_find_tuple(mpl, X, memb.tuple) == null) mpl_internal_add_tuple(mpl, Z, mpl_internal_copy_tuple(mpl, memb.tuple)); } return Z; } function mpl_internal_set_inter(mpl, X, Y){ xassert(X != null); xassert(X.type == A_NONE); xassert(X.dim > 0); xassert(Y != null); xassert(Y.type == A_NONE); xassert(Y.dim > 0); xassert(X.dim == Y.dim); var Z = mpl_internal_create_elemset(mpl, X.dim); for (var memb = X.head; memb != null; memb = memb.next) { if (mpl_internal_find_tuple(mpl, Y, memb.tuple) != null) mpl_internal_add_tuple(mpl, Z, mpl_internal_copy_tuple(mpl, memb.tuple)); } return Z; } function mpl_internal_set_cross(mpl, X, Y){ var memx, memy; var tuple, temp; xassert(X != null); xassert(X.type == A_NONE); xassert(X.dim > 0); xassert(Y != null); xassert(Y.type == A_NONE); xassert(Y.dim > 0); var Z = mpl_internal_create_elemset(mpl, X.dim + Y.dim); for (memx = X.head; memx != null; memx = memx.next) { for (memy = Y.head; memy != null; memy = memy.next) { tuple = mpl_internal_copy_tuple(mpl, memx.tuple); for (temp = memy.tuple; temp != null; temp = temp.next) tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_copy_symbol(mpl, temp.sym)); mpl_internal_add_tuple(mpl, Z, tuple); } } return Z; } /**********************************************************************/ /* * * LINEAR FORMS * * */ /**********************************************************************/ function mpl_internal_constant_term(mpl, coef){ var form; if (coef == 0.0) form = null; else { form = {}; form.coef = coef; form.var_ = null; form.next = null; } return form; } function mpl_internal_single_variable(mpl, var_){ xassert(var_ != null); var form = {}; form.coef = 1.0; form.var_ = var_; form.next = null; return form; } function mpl_internal_copy_formula(mpl, form){ var head, tail; if (form == null) head = null; else { head = tail = {}; for (; form != null; form = form.next) { tail.coef = form.coef; tail.var_ = form.var_; if (form.next != null) tail = tail.next = {}; } tail.next = null; } return head; } function mpl_internal_linear_comb(mpl, a, fx, b, fy){ var form = null, term, temp; var c0 = 0.0; for (term = fx; term != null; term = term.next) { if (term.var_ == null) c0 = mpl_internal_fp_add(mpl, c0, mpl_internal_fp_mul(mpl, a, term.coef)); else term.var_.temp = mpl_internal_fp_add(mpl, term.var_.temp, mpl_internal_fp_mul(mpl, a, term.coef)); } for (term = fy; term != null; term = term.next) { if (term.var_ == null) c0 = mpl_internal_fp_add(mpl, c0, mpl_internal_fp_mul(mpl, b, term.coef)); else term.var_.temp = mpl_internal_fp_add(mpl, term.var_.temp, mpl_internal_fp_mul(mpl, b, term.coef)); } for (term = fx; term != null; term = term.next) { if (term.var_ != null && term.var_.temp != 0.0) { temp = {}; temp.coef = term.var_.temp; temp.var_ = term.var_; temp.next = form; form = temp; term.var_.temp = 0.0; } } for (term = fy; term != null; term = term.next) { if (term.var_ != null && term.var_.temp != 0.0) { temp = {}; temp.coef = term.var_.temp; temp.var_ = term.var_; temp.next = form; form = temp; term.var_.temp = 0.0; } } if (c0 != 0.0) { temp = {}; temp.coef = c0; temp.var_ = null; temp.next = form; form = temp; } return form; } function mpl_internal_remove_constant(mpl, form, callback){ var head = null, temp; var coef = 0.0; while (form != null) { temp = form; form = form.next; if (temp.var_ == null) { /* constant term */ coef = mpl_internal_fp_add(mpl, coef, temp.coef); } else { /* linear term */ temp.next = head; head = temp; } } callback(coef); return head; } function mpl_internal_reduce_terms(mpl, form){ var term, next_term; var c0 = 0.0; for (term = form; term != null; term = term.next) { if (term.var_ == null) c0 = mpl_internal_fp_add(mpl, c0, term.coef); else term.var_.temp = mpl_internal_fp_add(mpl, term.var_.temp, term.coef); } next_term = form; form = null; for (term = next_term; term != null; term = next_term) { next_term = term.next; if (term.var_ == null && c0 != 0.0) { term.coef = c0; c0 = 0.0; term.next = form; form = term; } else if (term.var_ != null && term.var_.temp != 0.0) { term.coef = term.var_.temp; term.var_.temp = 0.0; term.next = form; form = term; } } return form; } /**********************************************************************/ /* * * GENERIC VALUES * * */ /**********************************************************************/ function mpl_internal_delete_value(mpl, type, value){ xassert(value != null); switch (type) { case A_NONE: value.none = null; break; case A_NUMERIC: value.num = 0.0; break; case A_SYMBOLIC: value.sym = null; break; case A_LOGICAL: value.bit = 0; break; case A_TUPLE: value.tuple = null; break; case A_ELEMSET: value.set = null; break; case A_ELEMVAR: value.var_ = null; break; case A_FORMULA: value.form = null; break; case A_ELEMCON: value.con = null; break; default: xassert(type != type); } } /**********************************************************************/ /* * * SYMBOLICALLY INDEXED ARRAYS * * */ /**********************************************************************/ function mpl_internal_create_array(mpl, type, dim){ xassert(type == A_NONE || type == A_NUMERIC || type == A_SYMBOLIC || type == A_ELEMSET || type == A_ELEMVAR || type == A_ELEMCON); xassert(dim >= 0); var array = {}; array.type = type; array.dim = dim; array.size = 0; array.head = null; array.tail = null; array.tree = false; array.prev = null; array.next = mpl.a_list; /* include the array in the global array list */ if (array.next != null) array.next.prev = array; mpl.a_list = array; return array; } function mpl_internal_compare_member_tuples(info, key1, key2){ /* this is an auxiliary routine used to compare keys, which are n-tuples assigned to array members */ return mpl_internal_compare_tuples(info, key1, key2); } function mpl_internal_find_member(mpl, array, tuple){ var memb; xassert(array != null); /* the n-tuple must have the same dimension as the array */ xassert(mpl_internal_tuple_dimen(mpl, tuple) == array.dim); /* if the array is large enough, create the search tree and index all existing members of the array */ if (array.size > 30 && !array.tree) { array.tree = avl_create_tree(mpl_internal_compare_member_tuples, mpl); for (memb = array.head; memb != null; memb = memb.next) avl_set_node_link(avl_insert_node(array.tree, memb.tuple), memb); } /* find a member, which has the given tuple */ memb = null; if (!array.tree) { /* the search tree doesn't exist; use the linear search */ for (memb = array.head; memb != null; memb = memb.next) if (mpl_internal_compare_tuples(mpl, memb.tuple, tuple) == 0) break; } else { /* the search tree exists; use the binary search */ var node = avl_find_node(array.tree, tuple); memb = (node == null ? null : avl_get_node_link(node)); } return memb; } function mpl_internal_add_member(mpl, array, tuple){ xassert(array != null); /* the n-tuple must have the same dimension as the array */ xassert(mpl_internal_tuple_dimen(mpl, tuple) == array.dim); /* create new member */ var memb = {}; memb.tuple = tuple; memb.next = null; memb.value = {}; /* and append it to the member list */ array.size++; if (array.head == null) array.head = memb; else array.tail.next = memb; array.tail = memb; /* if the search tree exists, index the new member */ if (array.tree != null) avl_set_node_link(avl_insert_node(array.tree, memb.tuple), memb); return memb; } /**********************************************************************/ /* * * DOMAINS AND DUMMY INDICES * * */ /**********************************************************************/ function mpl_internal_assign_dummy_index(mpl, slot, value){ var leaf, code; xassert(slot != null); xassert(value != null); /* delete the current value assigned to the dummy index */ if (slot.value != null) { /* if the current value and the new one are identical, actual assignment is not needed */ if (mpl_internal_compare_symbols(mpl, slot.value, value) == 0) return; /* delete a symbol, which is the current value */ slot.value = null; } /* now walk through all the pseudo-codes with op = O_INDEX, which refer to the dummy index to be changed (these pseudo-codes are leaves in the forest of *all* expressions in the database) */ for (leaf = slot.list; leaf != null; leaf = leaf.arg.index. next) { xassert(leaf.op == O_INDEX); /* invalidate all resultant values, which depend on the dummy index, walking from the current leaf toward the root of the corresponding expression tree */ for (code = leaf; code != null; code = code.up) { if (code.valid) { /* invalidate and delete resultant value */ code.valid = 0; mpl_internal_delete_value(mpl, code.type, code.value); } } } /* assign new value to the dummy index */ slot.value = mpl_internal_copy_symbol(mpl, value); } function mpl_internal_update_dummy_indices(mpl, block){ var slot; var temp; if (block.backup != null) { for (slot = block.list, temp = block.backup; slot != null; slot = slot.next, temp = temp.next) { xassert(temp != null); xassert(temp.sym != null); mpl_internal_assign_dummy_index(mpl, slot, temp.sym); } } } function mpl_internal_enter_domain_block(mpl, block, tuple, info, func){ var backup; var ret = 0; /* check if the given n-tuple is a member of the basic set */ xassert(block.code != null); if (!mpl_internal_is_member(mpl, block.code, tuple)) { ret = 1; return ret; } /* save reference to "backup" n-tuple, which was used to assign current values of the dummy indices (it is sufficient to save reference, not value, because that n-tuple is defined in some outer level of recursion and therefore cannot be changed on this and deeper recursive calls) */ backup = block.backup; /* set up new "backup" n-tuple, which defines new values of the dummy indices */ block.backup = tuple; /* assign new values to the dummy indices */ mpl_internal_update_dummy_indices(mpl, block); /* call the formal routine that does the rest part of the job */ func(mpl, info); /* restore reference to the former "backup" n-tuple */ block.backup = backup; /* restore former values of the dummy indices; note that if the domain block just escaped has no other active instances which may exist due to recursion (it is indicated by a null pointer to the former n-tuple), former values of the dummy indices are undefined; therefore in this case the routine keeps currently assigned values of the dummy indices that involves keeping all dependent temporary results and thereby, if this domain block is not used recursively, allows improving efficiency */ mpl_internal_update_dummy_indices(mpl, block); return ret; } function mpl_internal_eval_domain_func(mpl, my_info) { /* this routine recursively enters into the domain scope and then calls the routine func */ if (my_info.block != null) { /* the current domain block to be entered exists */ var block; var slot; var tuple = null, temp = null; /* save pointer to the current domain block */ block = my_info.block; /* and get ready to enter the next block (if it exists) */ my_info.block = block.next; /* construct temporary n-tuple, whose components correspond to dummy indices (slots) of the current domain; components of the temporary n-tuple that correspond to free dummy indices are assigned references (not values!) to symbols specified in the corresponding components of the given n-tuple, while other components that correspond to non-free dummy indices are assigned symbolic values computed here */ for (slot = block.list; slot != null; slot = slot.next) { /* create component that corresponds to the current slot */ if (tuple == null) tuple = temp = {}; else temp = temp.next = {}; if (slot.code == null) { /* dummy index is free; take reference to symbol, which is specified in the corresponding component of given n-tuple */ xassert(my_info.tuple != null); temp.sym = my_info.tuple.sym; xassert(temp.sym != null); my_info.tuple = my_info.tuple.next; } else { /* dummy index is non-free; compute symbolic value to be temporarily assigned to the dummy index */ temp.sym = mpl_internal_eval_symbolic(mpl, slot.code); } } temp.next = null; /* enter the current domain block */ if (mpl_internal_enter_domain_block(mpl, block, tuple, my_info, mpl_internal_eval_domain_func)) my_info.failure = 1; /* delete temporary n-tuple as well as symbols that correspond to non-free dummy indices (they were computed here) */ for (slot = block.list; slot != null; slot = slot.next) { xassert(tuple != null); temp = tuple; tuple = tuple.next; } } else { /* there are no more domain blocks, i.e. we have reached the domain scope */ xassert(my_info.tuple == null); /* check optional predicate specified for the domain */ if (my_info.domain.code != null && !mpl_internal_eval_logical(mpl, my_info.domain.code)) { /* the predicate is false */ my_info.failure = 2; } else { /* the predicate is true; do the job */ my_info.func(mpl, my_info.info); } } } function mpl_internal_eval_within_domain(mpl, domain, tuple, info, func){ /* this routine performs evaluation within domain scope */ var my_info = {}; if (domain == null) { xassert(tuple == null); func(mpl, info); my_info.failure = 0; } else { xassert(tuple != null); my_info.domain = domain; my_info.block = domain.list; my_info.tuple = tuple; my_info.info = info; my_info.func = func; my_info.failure = 0; /* enter the very first domain block */ mpl_internal_eval_domain_func(mpl, my_info); } return my_info.failure; } function mpl_internal_loop_domain_func(mpl, my_info){ /* this routine enumerates all n-tuples in the basic set of the current domain block, enters recursively into the domain scope for every n-tuple, and then calls the routine func */ if (my_info.block != null) { /* the current domain block to be entered exists */ var block; var slot; var bound; /* save pointer to the current domain block */ block = my_info.block; /* and get ready to enter the next block (if it exists) */ my_info.block = block.next; /* compute symbolic values, at which non-free dummy indices of the current domain block are bound; since that values don't depend on free dummy indices of the current block, they can be computed once out of the enumeration loop */ bound = null; for (slot = block.list; slot != null; slot = slot.next) { if (slot.code != null) bound = mpl_internal_expand_tuple(mpl, bound, mpl_internal_eval_symbolic(mpl, slot.code)); } /* start enumeration */ xassert(block.code != null); if (block.code.op == O_DOTS) { /* the basic set is "arithmetic", in which case it doesn't need to be computed explicitly */ var tuple; var n, j; var t0, tf, dt; /* compute "parameters" of the basic set */ t0 = mpl_internal_eval_numeric(mpl, block.code.arg.arg.x); tf = mpl_internal_eval_numeric(mpl, block.code.arg.arg.y); if (block.code.arg.arg.z == null) dt = 1.0; else dt = mpl_internal_eval_numeric(mpl, block.code.arg.arg.z); /* determine cardinality of the basic set */ n = mpl_internal_arelset_size(mpl, t0, tf, dt); /* create dummy 1-tuple for members of the basic set */ tuple = mpl_internal_expand_tuple(mpl, null, mpl_internal_create_symbol_num(mpl, 0.0)); /* in case of "arithmetic" set there is exactly one dummy index, which cannot be non-free */ xassert(bound == null); /* walk through 1-tuples of the basic set */ for (j = 1; j <= n && my_info.looping; j++) { /* construct dummy 1-tuple for the current member */ tuple.sym.num = mpl_internal_arelset_member(mpl, t0, tf, dt, j); /* enter the current domain block */ mpl_internal_enter_domain_block(mpl, block, tuple, my_info, mpl_internal_loop_domain_func); } } else { /* the basic set is of general kind, in which case it needs to be explicitly computed */ var set; var memb; var temp1, temp2; /* compute the basic set */ set = mpl_internal_eval_elemset(mpl, block.code); /* walk through all n-tuples of the basic set */ for (memb = set.head; memb != null && my_info.looping; memb = memb.next) { /* all components of the current n-tuple that correspond to non-free dummy indices must be feasible; otherwise the n-tuple is not in the basic set */ temp1 = memb.tuple; temp2 = bound; var found = false; for (slot = block.list; slot != null; slot = slot.next) { xassert(temp1 != null); if (slot.code != null) { /* non-free dummy index */ xassert(temp2 != null); if (mpl_internal_compare_symbols(mpl, temp1.sym, temp2.sym) != 0) { /* the n-tuple is not in the basic set */ found = true; break; } temp2 = temp2.next; } temp1 = temp1.next; } if (!found){ xassert(temp1 == null); xassert(temp2 == null); /* enter the current domain block */ mpl_internal_enter_domain_block(mpl, block, memb.tuple, my_info, mpl_internal_loop_domain_func); } } } /* restore pointer to the current domain block */ my_info.block = block; } else { /* there are no more domain blocks, i.e. we have reached the domain scope */ /* check optional predicate specified for the domain */ if (my_info.domain.code != null && !mpl_internal_eval_logical(mpl, my_info.domain.code)) { /* the predicate is false */ /* nop */ } else { /* the predicate is true; do the job */ my_info.looping = !my_info.func(mpl, my_info.info); } } } function mpl_internal_loop_within_domain(mpl, domain, info, func){ /* this routine performs iterations within domain scope */ var my_info = {}; if (domain == null) func(mpl, info); else { my_info.domain = domain; my_info.block = domain.list; my_info.looping = 1; my_info.info = info; my_info.func = func; /* enter the very first domain block */ mpl_internal_loop_domain_func(mpl, my_info); } } function mpl_internal_out_of_domain(mpl, name, tuple){ xassert(name != null); xassert(tuple != null); mpl_internal_error(mpl, name + mpl_internal_format_tuple(mpl, '[', tuple) + " out of domain"); } function mpl_internal_get_domain_tuple(mpl, domain){ var tuple = null; if (domain != null) { for (var block = domain.list; block != null; block = block.next) { for (var slot = block.list; slot != null; slot = slot.next) { if (slot.code == null) { xassert(slot.value != null); tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_copy_symbol(mpl, slot.value)); } } } } return tuple; } /**********************************************************************/ /* * * MODEL SETS * * */ /**********************************************************************/ function mpl_internal_check_elem_set(mpl, set, tuple, refer){ /* elemental set must be within all specified supersets */ for (var within = set.within, eqno = 1; within != null; within = within.next, eqno++) { xassert(within.code != null); for (var memb = refer.head; memb != null; memb = memb.next) { if (!mpl_internal_is_member(mpl, within.code, memb.tuple)) { var buf = mpl_internal_format_tuple(mpl, '(', memb.tuple); xassert(buf.length < 255); mpl_internal_error(mpl, set.name + mpl_internal_format_tuple(mpl, '[', tuple) + " contains " + buf + " which not within specified set; see (" + eqno + ")"); } } } } function mpl_internal_take_member_set(mpl, set, tuple){ var refer; /* find member in the set array */ var memb = mpl_internal_find_member(mpl, set.array, tuple); function add(){ /* check that the elemental set satisfies to all restrictions, assign it to new member, and add the member to the array */ mpl_internal_check_elem_set(mpl, set, tuple, refer); memb = mpl_internal_add_member(mpl, set.array, mpl_internal_copy_tuple(mpl, tuple)); memb.value.set = refer; } if (memb != null) { /* member exists, so just take the reference */ refer = memb.value.set; } else if (set.assign != null) { /* compute value using assignment expression */ refer = mpl_internal_eval_elemset(mpl, set.assign); add(); } else if (set.option != null) { /* compute default elemental set */ refer = mpl_internal_eval_elemset(mpl, set.option); add(); } else { /* no value (elemental set) is provided */ mpl_internal_error(mpl, "no value for " + set.name + mpl_internal_format_tuple(mpl, '[', tuple)); } return refer; } function mpl_internal_eval_set_func(mpl, info){ /* this is auxiliary routine to work within domain scope */ if (info.memb != null) { /* checking call; check elemental set being assigned */ mpl_internal_check_elem_set(mpl, info.set, info.memb.tuple, info.memb.value.set); } else { /* normal call; evaluate member, which has given n-tuple */ info.refer = mpl_internal_take_member_set(mpl, info.set, info.tuple); } } function mpl_internal_saturate_set(mpl, set){ var gadget = set.gadget; var data; var elem, memb; var tuple, work = new Array(20); var i; xprintf("Generating " + set.name + "..."); mpl_internal_eval_whole_set(mpl, gadget.set); /* gadget set must have exactly one member */ xassert(gadget.set.array != null); xassert(gadget.set.array.head != null); xassert(gadget.set.array.head == gadget.set.array.tail); data = gadget.set.array.head.value.set; xassert(data.type == A_NONE); xassert(data.dim == gadget.set.dimen); /* walk thru all elements of the plain set */ for (elem = data.head; elem != null; elem = elem.next) { /* create a copy of n-tuple */ tuple = mpl_internal_copy_tuple(mpl, elem.tuple); /* rearrange component of the n-tuple */ for (i = 0; i < gadget.set.dimen; i++) work[i] = null; for (i = 0; tuple != null; tuple = tuple.next) work[gadget.ind[i++]-1] = tuple; xassert(i == gadget.set.dimen); for (i = 0; i < gadget.set.dimen; i++) { xassert(work[i] != null); work[i].next = work[i+1]; } /* construct subscript list from first set.dim components */ if (set.dim == 0) tuple = null; else { tuple = work[0]; work[set.dim-1].next = null; } /* find corresponding member of the set to be initialized */ memb = mpl_internal_find_member(mpl, set.array, tuple); if (memb == null) { /* not found; add new member to the set and assign it empty elemental set */ memb = mpl_internal_add_member(mpl, set.array, tuple); memb.value.set = mpl_internal_create_elemset(mpl, set.dimen); } /* construct new n-tuple from rest set.dimen components */ tuple = work[set.dim]; xassert(set.dim + set.dimen == gadget.set.dimen); work[gadget.set.dimen-1].next = null; /* and add it to the elemental set assigned to the member (no check for duplicates is needed) */ mpl_internal_add_tuple(mpl, memb.value.set, tuple); } /* the set has been saturated with data */ set.data = 1; } function mpl_internal_eval_member_set(mpl, set, tuple){ /* this routine evaluates set member */ var info = {}; xassert(set.dim == mpl_internal_tuple_dimen(mpl, tuple)); info.set = set; info.tuple = tuple; if (set.gadget != null && set.data == 0) { /* initialize the set with data from a plain set */ mpl_internal_saturate_set(mpl, set); } if (set.data == 1) { /* check data, which are provided in the data section, but not checked yet */ /* save pointer to the last array member; note that during the check new members may be added beyond the last member due to references to the same parameter from default expression as well as from expressions that define restricting supersets; however, values assigned to the new members will be checked by other routine, so we don't need to check them here */ var tail = set.array.tail; /* change the data status to prevent infinite recursive loop due to references to the same set during the check */ set.data = 2; /* check elemental sets assigned to array members in the data section until the marked member has been reached */ for (info.memb = set.array.head; info.memb != null; info.memb = info.memb.next) { if (mpl_internal_eval_within_domain(mpl, set.domain, info.memb.tuple, info, mpl_internal_eval_set_func)) mpl_internal_out_of_domain(mpl, set.name, info.memb.tuple); if (info.memb == tail) break; } /* the check has been finished */ } /* evaluate member, which has given n-tuple */ info.memb = null; if (mpl_internal_eval_within_domain(mpl, info.set.domain, info.tuple, info, mpl_internal_eval_set_func)) mpl_internal_out_of_domain(mpl, set.name, info.tuple); /* bring evaluated reference to the calling program */ return info.refer; } function mpl_internal_whole_set_func(mpl, info){ /* this is auxiliary routine to work within domain scope */ var tuple = mpl_internal_get_domain_tuple(mpl, info.domain); mpl_internal_eval_member_set(mpl, info, tuple); return 0; } function mpl_internal_eval_whole_set(mpl, set){ mpl_internal_loop_within_domain(mpl, set.domain, set, mpl_internal_whole_set_func); } /**********************************************************************/ /* * * MODEL PARAMETERS * * */ /**********************************************************************/ function mpl_internal_check_value_num(mpl, par, tuple, value){ var cond; var eqno; /* the value must satisfy to the parameter type */ switch (par.type) { case A_NUMERIC: break; case A_INTEGER: if (value != Math.floor(value)) mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + value + " not integer"); break; case A_BINARY: if (!(value == 0.0 || value == 1.0)) mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + value + " not binary"); break; default: xassert(par != par); } /* the value must satisfy to all specified conditions */ for (cond = par.cond, eqno = 1; cond != null; cond = cond.next, eqno++) { var bound; //var rho; xassert(cond.code != null); bound = mpl_internal_eval_numeric(mpl, cond.code); function err(rho){mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + value + " not " + rho + " " + bound + "; see (" + eqno + ")")} switch (cond.rho) { case O_LT: if (!(value < bound)) err("<"); break; case O_LE: if (!(value <= bound)) err("<="); break; case O_EQ: if (!(value == bound)) err("="); break; case O_GE: if (!(value >= bound)) err(">="); break; case O_GT: if (!(value > bound)) err(">"); break; case O_NE: if (!(value != bound)) err("<>"); break; default: xassert(cond != cond); } } /* the value must be in_ all specified supersets */ eqno = 1; for (var in_ = par.in_; in_ != null; in_ = in_.next, eqno++) { xassert(in_.code != null); xassert(in_.code.dim == 1); var dummy = mpl_internal_expand_tuple(mpl, null, mpl_internal_create_symbol_num(mpl, value)); if (!mpl_internal_is_member(mpl, in_.code, dummy)) mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + value + " not in specified set; see (" + eqno + ")"); } } function mpl_internal_take_member_num(mpl, par, tuple){ /* find member in the parameter array */ var memb = mpl_internal_find_member(mpl, par.array, tuple); function add(value){ /* check that the value satisfies to all restrictions, assign it to new member, and add the member to the array */ mpl_internal_check_value_num(mpl, par, tuple, value); memb = mpl_internal_add_member(mpl, par.array, mpl_internal_copy_tuple(mpl, tuple)); memb.value.num = value; return value; } if (memb != null) /* member exists, so just take its value */ return memb.value.num; else if (par.assign != null) /* compute value using assignment expression */ return add(mpl_internal_eval_numeric(mpl, par.assign)); else if (par.option != null) /* compute default value */ return add(mpl_internal_eval_numeric(mpl, par.option)); else if (par.defval != null) { /* take default value provided in the data section */ if (par.defval.str != null) mpl_internal_error(mpl, "cannot convert " + mpl_internal_format_symbol(mpl, par.defval) + " to floating-point number"); return add(par.defval.num); } else /* no value is provided */ return mpl_internal_error(mpl, "no value for " + par.name + mpl_internal_format_tuple(mpl, '[', tuple)); } function mpl_internal_eval_num_func(mpl, info){ /* this is auxiliary routine to work within domain scope */ if (info.memb != null) { /* checking call; check numeric value being assigned */ mpl_internal_check_value_num(mpl, info.par, info.memb.tuple, info.memb.value.num); } else { /* normal call; evaluate member, which has given n-tuple */ info.value = mpl_internal_take_member_num(mpl, info.par, info.tuple); } } function mpl_internal_eval_member_num(mpl, par, tuple){ /* this routine evaluates numeric parameter member */ var info = {}; xassert(par.type == A_NUMERIC || par.type == A_INTEGER || par.type == A_BINARY); xassert(par.dim == mpl_internal_tuple_dimen(mpl, tuple)); info.par = par; info.tuple = tuple; if (par.data == 1) { /* check data, which are provided in the data section, but not checked yet */ /* save pointer to the last array member; note that during the check new members may be added beyond the last member due to references to the same parameter from default expression as well as from expressions that define restricting conditions; however, values assigned to the new members will be checked by other routine, so we don't need to check them here */ var tail = par.array.tail; /* change the data status to prevent infinite recursive loop due to references to the same parameter during the check */ par.data = 2; /* check values assigned to array members in the data section until the marked member has been reached */ for (info.memb = par.array.head; info.memb != null; info.memb = info.memb.next) { if (mpl_internal_eval_within_domain(mpl, par.domain, info.memb.tuple, info, mpl_internal_eval_num_func)) mpl_internal_out_of_domain(mpl, par.name, info.memb.tuple); if (info.memb == tail) break; } /* the check has been finished */ } /* evaluate member, which has given n-tuple */ info.memb = null; if (mpl_internal_eval_within_domain(mpl, info.par.domain, info.tuple, info, mpl_internal_eval_num_func)) mpl_internal_out_of_domain(mpl, par.name, info.tuple); /* bring evaluated value to the calling program */ return info.value; } function mpl_internal_check_value_sym(mpl, par, tuple, value){ var in_; var eqno = 1; /* the value must satisfy to all specified conditions */ for (var cond = par.cond; cond != null; cond = cond.next, eqno++) { var buf; // 255 xassert(cond.code != null); var bound = mpl_internal_eval_symbolic(mpl, cond.code); switch (cond.rho) { case O_LT: if (!(mpl_internal_compare_symbols(mpl, value, bound) < 0)) { buf = mpl_internal_format_symbol(mpl, bound); xassert(buf.length <= 255); mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + mpl_internal_format_symbol(mpl, value) + " not < " + buf); } break; case O_LE: if (!(mpl_internal_compare_symbols(mpl, value, bound) <= 0)) { buf = mpl_internal_format_symbol(mpl, bound); xassert(buf.length <= 255); mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + mpl_internal_format_symbol(mpl, value) + " not <= " + buf); } break; case O_EQ: if (!(mpl_internal_compare_symbols(mpl, value, bound) == 0)) { buf = mpl_internal_format_symbol(mpl, bound); xassert(buf.length <= 255); mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + mpl_internal_format_symbol(mpl, value) + " not = " + buf); } break; case O_GE: if (!(mpl_internal_compare_symbols(mpl, value, bound) >= 0)) { buf = mpl_internal_format_symbol(mpl, bound); xassert(buf.length <= 255); mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + mpl_internal_format_symbol(mpl, value) + " not >= " + buf); } break; case O_GT: if (!(mpl_internal_compare_symbols(mpl, value, bound) > 0)) { buf = mpl_internal_format_symbol(mpl, bound); xassert(buf.length <= 255); mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " = " + mpl_internal_format_symbol(mpl, value) + " not > " + buf); } break; case O_NE: if (!(mpl_internal_compare_symbols(mpl, value, bound) != 0)) { buf = mpl_internal_format_symbol(mpl, bound); xassert(buf.length <= 255); mpl_internal_error(mpl, par.name + mpl_internal_format_tuple(mpl, '[', tuple) + " <> " + mpl_internal_format_symbol(mpl, value) + " not > " + buf); } break; default: xassert(cond != cond); } } /* the value must be in all specified supersets */ eqno = 1; for (in_ = par.in_; in_ != null; in_ = in_.next, eqno++) { xassert(in_.code != null); xassert(in_.code.dim == 1); var dummy = mpl_internal_expand_tuple(mpl, null, mpl_internal_copy_symbol(mpl, value)); if (!mpl_internal_is_member(mpl, in_.code, dummy)) mpl_internal_error(mpl, par.name, mpl_internal_format_tuple(mpl, '[', tuple) + " = " + mpl_internal_format_symbol(mpl, value) + " not in specified set; see (" + eqno + ")"); } } function mpl_internal_take_member_sym(mpl, par, tuple){ /* find member in the parameter array */ var memb = mpl_internal_find_member(mpl, par.array, tuple); function add(value){ /* check that the value satisfies to all restrictions, assign it to new member, and add the member to the array */ mpl_internal_check_value_sym(mpl, par, tuple, value); memb = mpl_internal_add_member(mpl, par.array, mpl_internal_copy_tuple(mpl, tuple)); memb.value.sym = mpl_internal_copy_symbol(mpl, value); return value; } if (memb != null) { /* member exists, so just take its value */ return mpl_internal_copy_symbol(mpl, memb.value.sym); } else if (par.assign != null) /* compute value using assignment expression */ return add(mpl_internal_eval_symbolic(mpl, par.assign)); else if (par.option != null) /* compute default value */ return add(mpl_internal_eval_symbolic(mpl, par.option)); else if (par.defval != null) /* take default value provided in the data section */ return(mpl_internal_copy_symbol(mpl, par.defval)); else /* no value is provided */ return mpl_internal_error(mpl, "no value for " + par.name + mpl_internal_format_tuple(mpl, '[', tuple)); } function mpl_internal_eval_sym_func(mpl, info) { /* this is auxiliary routine to work within domain scope */ if (info.memb != null) { /* checking call; check symbolic value being assigned */ mpl_internal_check_value_sym(mpl, info.par, info.memb.tuple, info.memb.value.sym); } else { /* normal call; evaluate member, which has given n-tuple */ info.value = mpl_internal_take_member_sym(mpl, info.par, info.tuple); } } function mpl_internal_eval_member_sym(mpl, par, tuple){ /* this routine evaluates symbolic parameter member */ var info = {}; xassert(par.type == A_SYMBOLIC); xassert(par.dim == mpl_internal_tuple_dimen(mpl, tuple)); info.par = par; info.tuple = tuple; if (par.data == 1) { /* check data, which are provided in the data section, but not checked yet */ /* save pointer to the last array member; note that during the check new members may be added beyond the last member due to references to the same parameter from default expression as well as from expressions that define restricting conditions; however, values assigned to the new members will be checked by other routine, so we don't need to check them here */ var tail = par.array.tail; /* change the data status to prevent infinite recursive loop due to references to the same parameter during the check */ par.data = 2; /* check values assigned to array members in the data section until the marked member has been reached */ for (info.memb = par.array.head; info.memb != null; info.memb = info.memb.next) { if (mpl_internal_eval_within_domain(mpl, par.domain, info.memb.tuple, info, mpl_internal_eval_sym_func)) mpl_internal_out_of_domain(mpl, par.name, info.memb.tuple); if (info.memb == tail) break; } /* the check has been finished */ } /* evaluate member, which has given n-tuple */ info.memb = null; if (mpl_internal_eval_within_domain(mpl, info.par.domain, info.tuple, info, mpl_internal_eval_sym_func)) mpl_internal_out_of_domain(mpl, par.name, info.tuple); /* bring evaluated value to the calling program */ return info.value; } function mpl_internal_whole_par_func(mpl, par){ /* this is auxiliary routine to work within domain scope */ var tuple = mpl_internal_get_domain_tuple(mpl, par.domain); switch (par.type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: mpl_internal_eval_member_num(mpl, par, tuple); break; case A_SYMBOLIC: mpl_internal_eval_member_sym(mpl, par, tuple); break; default: xassert(par != par); } return 0; } function mpl_internal_eval_whole_par(mpl, par){ mpl_internal_loop_within_domain(mpl, par.domain, par, mpl_internal_whole_par_func); } /**********************************************************************/ /* * * MODEL VARIABLES * * */ /**********************************************************************/ function mpl_internal_take_member_var(mpl, var_, tuple){ var refer; /* find member in the variable array */ var memb = mpl_internal_find_member(mpl, var_.array, tuple); if (memb != null) { /* member exists, so just take the reference */ refer = memb.value.var_; } else { /* member is referenced for the first time and therefore does not exist; create new elemental variable, assign it to new member, and add the member to the variable array */ memb = mpl_internal_add_member(mpl, var_.array, mpl_internal_copy_tuple(mpl, tuple)); refer = memb.value.var_ = {}; refer.j = 0; refer.var_ = var_; refer.memb = memb; /* compute lower bound */ if (var_.lbnd == null) refer.lbnd = 0.0; else refer.lbnd = mpl_internal_eval_numeric(mpl, var_.lbnd); /* compute upper bound */ if (var_.ubnd == null) refer.ubnd = 0.0; else if (var_.ubnd == var_.lbnd) refer.ubnd = refer.lbnd; else refer.ubnd = mpl_internal_eval_numeric(mpl, var_.ubnd); /* nullify working quantity */ refer.temp = 0.0; /* solution has not been obtained by the solver yet */ refer.stat = 0; refer.prim = refer.dual = 0.0; } return refer; } function mpl_internal_eval_var_func(mpl, info) { /* this is auxiliary routine to work within domain scope */ info.refer = mpl_internal_take_member_var(mpl, info.var_, info.tuple); } function mpl_internal_eval_member_var(mpl, var_, tuple){ /* this routine evaluates variable member */ var info = {}; xassert(var_.dim == mpl_internal_tuple_dimen(mpl, tuple)); info.var_ = var_; info.tuple = tuple; /* evaluate member, which has given n-tuple */ if (mpl_internal_eval_within_domain(mpl, info.var_.domain, info.tuple, info, mpl_internal_eval_var_func)) mpl_internal_out_of_domain(mpl, var_.name, info.tuple); /* bring evaluated reference to the calling program */ return info.refer; } function mpl_internal_whole_var_func(mpl, var_){ /* this is auxiliary routine to work within domain scope */ var tuple = mpl_internal_get_domain_tuple(mpl, var_.domain); mpl_internal_eval_member_var(mpl, var_, tuple); return 0; } function mpl_internal_eval_whole_var(mpl, var_){ mpl_internal_loop_within_domain(mpl, var_.domain, var_, mpl_internal_whole_var_func); } /**********************************************************************/ /* * * MODEL CONSTRAINTS AND OBJECTIVES * * */ /**********************************************************************/ function mpl_internal_take_member_con(mpl, con, tuple){ var refer, temp = null; /* find member in the constraint array */ var memb = mpl_internal_find_member(mpl, con.array, tuple); if (memb != null) { /* member exists, so just take the reference */ refer = memb.value.con; } else { /* member is referenced for the first time and therefore does not exist; create new elemental constraint, assign it to new member, and add the member to the constraint array */ memb = mpl_internal_add_member(mpl, con.array, mpl_internal_copy_tuple(mpl, tuple)); refer = memb.value.con = {}; refer.i = 0; refer.con = con; refer.memb = memb; /* compute linear form */ xassert(con.code != null); refer.form = mpl_internal_eval_formula(mpl, con.code); /* compute lower and upper bounds */ if (con.lbnd == null && con.ubnd == null) { /* objective has no bounds */ xassert(con.type == A_MINIMIZE || con.type == A_MAXIMIZE); /* carry the constant term to the right-hand side */ refer.form = mpl_internal_remove_constant(mpl, refer.form, function(v){temp = v}); refer.lbnd = refer.ubnd = - temp; } else if (con.lbnd != null && con.ubnd == null) { /* constraint a * x + b >= c * y + d is transformed to the standard form a * x - c * y >= d - b */ xassert(con.type == A_CONSTRAINT); refer.form = mpl_internal_linear_comb(mpl, +1.0, refer.form, -1.0, mpl_internal_eval_formula(mpl, con.lbnd)); refer.form = mpl_internal_remove_constant(mpl, refer.form, function(v){temp = v}); refer.lbnd = - temp; refer.ubnd = 0.0; } else if (con.lbnd == null && con.ubnd != null) { /* constraint a * x + b <= c * y + d is transformed to the standard form a * x - c * y <= d - b */ xassert(con.type == A_CONSTRAINT); refer.form = mpl_internal_linear_comb(mpl, +1.0, refer.form, -1.0, mpl_internal_eval_formula(mpl, con.ubnd)); refer.form = mpl_internal_remove_constant(mpl, refer.form, function(v){temp = v}); refer.lbnd = 0.0; refer.ubnd = - temp; } else if (con.lbnd == con.ubnd) { /* constraint a * x + b = c * y + d is transformed to the standard form a * x - c * y = d - b */ xassert(con.type == A_CONSTRAINT); refer.form = mpl_internal_linear_comb(mpl, +1.0, refer.form, -1.0, mpl_internal_eval_formula(mpl, con.lbnd)); refer.form = mpl_internal_remove_constant(mpl, refer.form, function(v){temp = v}); refer.lbnd = refer.ubnd = - temp; } else { /* ranged constraint c <= a * x + b <= d is transformed to the standard form c - b <= a * x <= d - b */ var temp1 = null, temp2 = null; xassert(con.type == A_CONSTRAINT); refer.form = mpl_internal_remove_constant(mpl, refer.form, function(v){temp = v}); xassert(mpl_internal_remove_constant(mpl, mpl_internal_eval_formula(mpl, con.lbnd), function(v){temp1 = v}) == null); xassert(mpl_internal_remove_constant(mpl, mpl_internal_eval_formula(mpl, con.ubnd), function(v){temp2 = v}) == null); refer.lbnd = mpl_internal_fp_sub(mpl, temp1, temp); refer.ubnd = mpl_internal_fp_sub(mpl, temp2, temp); } /* solution has not been obtained by the solver yet */ refer.stat = 0; refer.prim = refer.dual = 0.0; } return refer; } function mpl_internal_eval_con_func(mpl, info) { /* this is auxiliary routine to work within domain scope */ info.refer = mpl_internal_take_member_con(mpl, info.con, info.tuple); } function mpl_internal_eval_member_con(mpl, con, tuple){ /* this routine evaluates constraint member */ var info = {}; xassert(con.dim == mpl_internal_tuple_dimen(mpl, tuple)); info.con = con; info.tuple = tuple; /* evaluate member, which has given n-tuple */ if (mpl_internal_eval_within_domain(mpl, info.con.domain, info.tuple, info, mpl_internal_eval_con_func)) mpl_internal_out_of_domain(mpl, con.name, info.tuple); /* bring evaluated reference to the calling program */ return info.refer; } function mpl_internal_whole_con_func(mpl, con){ /* this is auxiliary routine to work within domain scope */ var tuple = mpl_internal_get_domain_tuple(mpl, con.domain); mpl_internal_eval_member_con(mpl, con, tuple); return 0; } function mpl_internal_eval_whole_con(mpl, con){ mpl_internal_loop_within_domain(mpl, con.domain, con, mpl_internal_whole_con_func); } /**********************************************************************/ /* * * PSEUDO-CODE * * */ /**********************************************************************/ function mpl_internal_iter_num_func(mpl, info){ /* this is auxiliary routine used to perform iterated operation on numeric "integrand" within domain scope */ var temp = mpl_internal_eval_numeric(mpl, info.code.arg.loop.x); switch (info.code.op) { case O_SUM: /* summation over domain */ info.value = mpl_internal_fp_add(mpl, info.value, temp); break; case O_PROD: /* multiplication over domain */ info.value = mpl_internal_fp_mul(mpl, info.value, temp); break; case O_MINIMUM: /* minimum over domain */ if (info.value > temp) info.value = temp; break; case O_MAXIMUM: /* maximum over domain */ if (info.value < temp) info.value = temp; break; default: xassert(info != info); } return 0; } function mpl_internal_eval_numeric(mpl, code){ var value, tuple, e, sym, str, temp, info; xassert(code != null); xassert(code.type == A_NUMERIC); xassert(code.dim == 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code.vflag && code.valid) { code.valid = 0; mpl_internal_delete_value(mpl, code.type, code.value); } /* if resultant value is valid, no evaluation is needed */ if (code.valid) { return code.value.num; } /* evaluate pseudo-code recursively */ switch (code.op) { case O_NUMBER: /* take floating-point number */ value = code.arg.num; break; case O_MEMNUM: /* take member of numeric parameter */ { tuple = null; for (e = code.arg.par.list; e != null; e = e.next) tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_eval_symbolic(mpl, e.x)); value = mpl_internal_eval_member_num(mpl, code.arg.par.par, tuple); } break; case O_MEMVAR: /* take computed value of elemental variable */ { var var_; tuple = null; for (e = code.arg.var_.list; e != null; e = e.next) tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_eval_symbolic(mpl, e.x)); var_ = mpl_internal_eval_member_var(mpl, code.arg.var_.var_, tuple); switch (code.arg.var_.suff) { case DOT_LB: if (var_.var_.lbnd == null) value = -DBL_MAX; else value = var_.lbnd; break; case DOT_UB: if (var_.var_.ubnd == null) value = +DBL_MAX; else value = var_.ubnd; break; case DOT_STATUS: value = var_.stat; break; case DOT_VAL: value = var_.prim; break; case DOT_DUAL: value = var_.dual; break; default: xassert(code != code); } } break; case O_MEMCON: /* take computed value of elemental constraint */ { var con; tuple = null; for (e = code.arg.con.list; e != null; e = e.next) tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_eval_symbolic(mpl, e.x)); con = mpl_internal_eval_member_con(mpl, code.arg.con.con, tuple); switch (code.arg.con.suff) { case DOT_LB: if (con.con.lbnd == null) value = -DBL_MAX; else value = con.lbnd; break; case DOT_UB: if (con.con.ubnd == null) value = +DBL_MAX; else value = con.ubnd; break; case DOT_STATUS: value = con.stat; break; case DOT_VAL: value = con.prim; break; case DOT_DUAL: value = con.dual; break; default: xassert(code != code); } } break; case O_IRAND224: /* pseudo-random in [0, 2^24-1] */ value = mpl_internal_fp_irand224(mpl); break; case O_UNIFORM01: /* pseudo-random in [0, 1) */ value = mpl_internal_fp_uniform01(mpl); break; case O_NORMAL01: /* gaussian random, mu = 0, sigma = 1 */ value = mpl_internal_fp_normal01(mpl); break; case O_GMTIME: /* current calendar time */ value = mpl_internal_fn_gmtime(mpl); break; case O_CVTNUM: /* conversion to numeric */ { sym = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); if (sym.str == null) value = sym.num; else { if (str2num(sym.str, function(v){value= v})) mpl_internal_error(mpl, "cannot convert " + mpl_internal_format_symbol(mpl, sym) + " to floating-point number"); } } break; case O_PLUS: /* unary plus */ value = + mpl_internal_eval_numeric(mpl, code.arg.arg.x); break; case O_MINUS: /* unary minus */ value = - mpl_internal_eval_numeric(mpl, code.arg.arg.x); break; case O_ABS: /* absolute value */ value = Math.abs(mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_CEIL: /* round upward ("ceiling of x") */ value = Math.ceil(mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_FLOOR: /* round downward ("floor of x") */ value = Math.floor(mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_EXP: /* base-e exponential */ value = mpl_internal_fp_exp(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_LOG: /* natural logarithm */ value = mpl_internal_fp_log(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_LOG10: /* common (decimal) logarithm */ value = mpl_internal_fp_log10(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_SQRT: /* square root */ value = mpl_internal_fp_sqrt(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_SIN: /* trigonometric sine */ value = mpl_internal_fp_sin(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_COS: /* trigonometric cosine */ value = mpl_internal_fp_cos(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_ATAN: /* trigonometric arctangent (one argument) */ value = mpl_internal_fp_atan(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_ATAN2: /* trigonometric arctangent (two arguments) */ value = mpl_internal_fp_atan2(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_ROUND: /* round to nearest integer */ value = mpl_internal_fp_round(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), 0.0); break; case O_ROUND2: /* round to n fractional digits */ value = mpl_internal_fp_round(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_TRUNC: /* truncate to nearest integer */ value = mpl_internal_fp_trunc(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), 0.0); break; case O_TRUNC2: /* truncate to n fractional digits */ value = mpl_internal_fp_trunc(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_ADD: /* addition */ value = mpl_internal_fp_add(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_SUB: /* subtraction */ value = mpl_internal_fp_sub(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_LESS: /* non-negative subtraction */ value = mpl_internal_fp_less(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_MUL: /* multiplication */ value = mpl_internal_fp_mul(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_DIV: /* division */ value = mpl_internal_fp_div(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_IDIV: /* quotient of exact division */ value = mpl_internal_fp_idiv(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_MOD: /* remainder of exact division */ value = mpl_internal_fp_mod(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_POWER: /* exponentiation (raise to power) */ value = mpl_internal_fp_power(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_UNIFORM: /* pseudo-random in [a, b) */ value = mpl_internal_fp_uniform(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_NORMAL: /* gaussian random, given mu and sigma */ value = mpl_internal_fp_normal(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y)); break; case O_CARD: { var set = mpl_internal_eval_elemset(mpl, code.arg.arg.x); value = set.size; } break; case O_LENGTH: { sym = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); if (sym.str == null) str = String(sym.num); else str = sym.str; value = str.length; } break; case O_STR2TIME: { var fmt; sym = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); if (sym.str == null) str = String(sym.num); else str = sym.str; sym = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); if (sym.str == null) fmt = String(sym.num); else fmt = sym.str; value = mpl_internal_fn_str2time(mpl, str, fmt); } break; case O_FORK: /* if-then-else */ if (mpl_internal_eval_logical(mpl, code.arg.arg.x)) value = mpl_internal_eval_numeric(mpl, code.arg.arg.y); else if (code.arg.arg.z == null) value = 0.0; else value = mpl_internal_eval_numeric(mpl, code.arg.arg.z); break; case O_MIN: /* minimal value (n-ary) */ { value = +DBL_MAX; for (e = code.arg.list; e != null; e = e.next) { temp = mpl_internal_eval_numeric(mpl, e.x); if (value > temp) value = temp; } } break; case O_MAX: /* maximal value (n-ary) */ { value = -DBL_MAX; for (e = code.arg.list; e != null; e = e.next) { temp = mpl_internal_eval_numeric(mpl, e.x); if (value < temp) value = temp; } } break; case O_SUM: /* summation over domain */ { info = {}; info.code = code; info.value = 0.0; mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_num_func); value = info.value; } break; case O_PROD: /* multiplication over domain */ { info = {}; info.code = code; info.value = 1.0; mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_num_func); value = info.value; } break; case O_MINIMUM: /* minimum over domain */ { info = {}; info.code = code; info.value = +DBL_MAX; mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_num_func); if (info.value == +DBL_MAX) mpl_internal_error(mpl, "min{} over empty set; result undefined"); value = info.value; } break; case O_MAXIMUM: /* maximum over domain */ { info = {}; info.code = code; info.value = -DBL_MAX; mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_num_func); if (info.value == -DBL_MAX) mpl_internal_error(mpl, "max{} over empty set; result undefined"); value = info.value; } break; default: xassert(code != code); } /* save resultant value */ xassert(!code.valid); code.valid = 1; code.value.num = value; return value; } function mpl_internal_eval_symbolic(mpl, code){ var value, str; xassert(code != null); xassert(code.type == A_SYMBOLIC); xassert(code.dim == 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code.vflag && code.valid) { code.valid = 0; mpl_internal_delete_value(mpl, code.type, code.value); } /* if resultant value is valid, no evaluation is needed */ if (code.valid) { return mpl_internal_copy_symbol(mpl, code.value.sym); } /* evaluate pseudo-code recursively */ switch (code.op) { case O_STRING: /* take character string */ value = mpl_internal_create_symbol_str(mpl, code.arg.str); break; case O_INDEX: /* take dummy index */ xassert(code.arg.index.slot.value != null); value = mpl_internal_copy_symbol(mpl, code.arg.index.slot.value); break; case O_MEMSYM: /* take member of symbolic parameter */ { var tuple; var e; tuple = null; for (e = code.arg.par.list; e != null; e = e.next) tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_eval_symbolic(mpl, e.x)); value = mpl_internal_eval_member_sym(mpl, code.arg.par.par, tuple); } break; case O_CVTSYM: /* conversion to symbolic */ value = mpl_internal_create_symbol_num(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_CONCAT: /* concatenation */ value = mpl_internal_concat_symbols(mpl, mpl_internal_eval_symbolic(mpl, code.arg.arg.x), mpl_internal_eval_symbolic(mpl, code.arg.arg.y)); break; case O_FORK: /* if-then-else */ if (mpl_internal_eval_logical(mpl, code.arg.arg.x)) value = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); else if (code.arg.arg.z == null) value = mpl_internal_create_symbol_num(mpl, 0.0); else value = mpl_internal_eval_symbolic(mpl, code.arg.arg.z); break; case O_SUBSTR: case O_SUBSTR3: { var pos, len; value = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); if (value.str == null) str = String(value.num); else str = value.str; if (code.op == O_SUBSTR) { pos = mpl_internal_eval_numeric(mpl, code.arg.arg.y); if (pos != Math.floor(pos)) mpl_internal_error(mpl, "substr('...', " + pos + "); non-integer second argument"); if (pos < 1 || pos > str.length + 1) mpl_internal_error(mpl, "substr('...', " + pos + "); substring out of range"); } else { pos = mpl_internal_eval_numeric(mpl, code.arg.arg.y); len = mpl_internal_eval_numeric(mpl, code.arg.arg.z); if (pos != Math.floor(pos) || len != Math.floor(len)) mpl_internal_error(mpl, "substr('...', " + pos + ", " + len + "); non-integer second and/or third argument"); if (pos < 1 || len < 0 || pos + len > str.length + 1) mpl_internal_error(mpl, "substr('...', " + pos + ", " + len + "); substring out of range"); //str[pos + len - 1] = '\0'; } value = mpl_internal_create_symbol_str(mpl, str.slice(pos-1, pos+len-1)); } break; case O_TIME2STR: { var num; var sym; var fmt; //[MAX_LENGTH+1], fmt[MAX_LENGTH+1]; num = mpl_internal_eval_numeric(mpl, code.arg.arg.x); sym = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); if (sym.str == null) fmt = String(sym.num); else fmt = sym.str; str = mpl_internal_fn_time2str(mpl, num, fmt); value = mpl_internal_create_symbol_str(mpl, str); } break; default: xassert(code != code); } /* save resultant value */ xassert(!code.valid); code.valid = 1; code.value.sym = mpl_internal_copy_symbol(mpl, value); return value; } function mpl_internal_iter_log_func(mpl, info){ /* this is auxiliary routine used to perform iterated operation on logical "integrand" within domain scope */ var ret = 0; switch (info.code.op) { case O_FORALL: /* conjunction over domain */ info.value &= mpl_internal_eval_logical(mpl, info.code.arg.loop.x); if (!info.value) ret = 1; break; case O_EXISTS: /* disjunction over domain */ info.value |= mpl_internal_eval_logical(mpl, info.code.arg.loop.x); if (info.value) ret = 1; break; default: xassert(info != info); } return ret; } function mpl_internal_eval_logical(mpl, code){ var value, sym1, sym2, tuple, set, memb, info; xassert(code.type == A_LOGICAL); xassert(code.dim == 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code.vflag && code.valid) { code.valid = 0; mpl_internal_delete_value(mpl, code.type, code.value); } /* if resultant value is valid, no evaluation is needed */ if (code.valid) { return code.value.bit; } /* evaluate pseudo-code recursively */ switch (code.op) { case O_CVTLOG: /* conversion to logical */ value = (mpl_internal_eval_numeric(mpl, code.arg.arg.x) != 0.0); break; case O_NOT: /* negation (logical "not") */ value = !mpl_internal_eval_logical(mpl, code.arg.arg.x); break; case O_LT: /* comparison on 'less than' */ xassert(code.arg.arg.x != null); if (code.arg.arg.x.type == A_NUMERIC) value = (mpl_internal_eval_numeric(mpl, code.arg.arg.x) < mpl_internal_eval_numeric(mpl, code.arg.arg.y)); else { sym1 = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); sym2 = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); value = (mpl_internal_compare_symbols(mpl, sym1, sym2) < 0); } break; case O_LE: /* comparison on 'not greater than' */ xassert(code.arg.arg.x != null); if (code.arg.arg.x.type == A_NUMERIC) value = (mpl_internal_eval_numeric(mpl, code.arg.arg.x) <= mpl_internal_eval_numeric(mpl, code.arg.arg.y)); else { sym1 = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); sym2 = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); value = (mpl_internal_compare_symbols(mpl, sym1, sym2) <= 0); } break; case O_EQ: /* comparison on 'equal to' */ xassert(code.arg.arg.x != null); if (code.arg.arg.x.type == A_NUMERIC) value = (mpl_internal_eval_numeric(mpl, code.arg.arg.x) == mpl_internal_eval_numeric(mpl, code.arg.arg.y)); else { sym1 = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); sym2 = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); value = (mpl_internal_compare_symbols(mpl, sym1, sym2) == 0); } break; case O_GE: /* comparison on 'not less than' */ xassert(code.arg.arg.x != null); if (code.arg.arg.x.type == A_NUMERIC) value = (mpl_internal_eval_numeric(mpl, code.arg.arg.x) >= mpl_internal_eval_numeric(mpl, code.arg.arg.y)); else { sym1 = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); sym2 = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); value = (mpl_internal_compare_symbols(mpl, sym1, sym2) >= 0); } break; case O_GT: /* comparison on 'greater than' */ xassert(code.arg.arg.x != null); if (code.arg.arg.x.type == A_NUMERIC) value = (mpl_internal_eval_numeric(mpl, code.arg.arg.x) > mpl_internal_eval_numeric(mpl, code.arg.arg.y)); else { sym1 = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); sym2 = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); value = (mpl_internal_compare_symbols(mpl, sym1, sym2) > 0); } break; case O_NE: /* comparison on 'not equal to' */ xassert(code.arg.arg.x != null); if (code.arg.arg.x.type == A_NUMERIC) value = (mpl_internal_eval_numeric(mpl, code.arg.arg.x) != mpl_internal_eval_numeric(mpl, code.arg.arg.y)); else { sym1 = mpl_internal_eval_symbolic(mpl, code.arg.arg.x); sym2 = mpl_internal_eval_symbolic(mpl, code.arg.arg.y); value = (mpl_internal_compare_symbols(mpl, sym1, sym2) != 0); } break; case O_AND: /* conjunction (logical "and") */ value = mpl_internal_eval_logical(mpl, code.arg.arg.x) && mpl_internal_eval_logical(mpl, code.arg.arg.y); break; case O_OR: /* disjunction (logical "or") */ value = mpl_internal_eval_logical(mpl, code.arg.arg.x) || mpl_internal_eval_logical(mpl, code.arg.arg.y); break; case O_IN: /* test on 'x in Y' */ { tuple = mpl_internal_eval_tuple(mpl, code.arg.arg.x); value = mpl_internal_is_member(mpl, code.arg.arg.y, tuple); } break; case O_NOTIN: /* test on 'x not in Y' */ { tuple = mpl_internal_eval_tuple(mpl, code.arg.arg.x); value = !mpl_internal_is_member(mpl, code.arg.arg.y, tuple); } break; case O_WITHIN: /* test on 'X within Y' */ { set = mpl_internal_eval_elemset(mpl, code.arg.arg.x); value = 1; for (memb = set.head; memb != null; memb = memb.next) { if (!mpl_internal_is_member(mpl, code.arg.arg.y, memb.tuple)) { value = 0; break; } } } break; case O_NOTWITHIN: /* test on 'X not within Y' */ { set = mpl_internal_eval_elemset(mpl, code.arg.arg.x); value = 1; for (memb = set.head; memb != null; memb = memb.next) { if (mpl_internal_is_member(mpl, code.arg.arg.y, memb.tuple)) { value = 0; break; } } } break; case O_FORALL: /* conjunction (A-quantification) */ { info = {}; info.code = code; info.value = 1; mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_log_func); value = info.value; } break; case O_EXISTS: /* disjunction (E-quantification) */ { info = {}; info.code = code; info.value = 0; mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_log_func); value = info.value; } break; default: xassert(code != code); } /* save resultant value */ xassert(!code.valid); code.valid = 1; code.value.bit = value; return value; } function mpl_internal_eval_tuple(mpl, code){ var value; xassert(code != null); xassert(code.type == A_TUPLE); xassert(code.dim > 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code.vflag && code.valid) { code.valid = 0; mpl_internal_delete_value(mpl, code.type, code.value); } /* if resultant value is valid, no evaluation is needed */ if (code.valid) { return mpl_internal_copy_tuple(mpl, code.value.tuple); } /* evaluate pseudo-code recursively */ switch (code.op) { case O_TUPLE: /* make n-tuple */ { value = null; for (var e = code.arg.list; e != null; e = e.next) value = mpl_internal_expand_tuple(mpl, value, mpl_internal_eval_symbolic(mpl, e.x)); } break; case O_CVTTUP: /* convert to 1-tuple */ value = mpl_internal_expand_tuple(mpl, null, mpl_internal_eval_symbolic(mpl, code.arg.arg.x)); break; default: xassert(code != code); } /* save resultant value */ xassert(!code.valid); code.valid = 1; code.value.tuple = mpl_internal_copy_tuple(mpl, value); return value; } function mpl_internal_iter_set_func(mpl, info) { /* this is auxiliary routine used to perform iterated operation on n-tuple "integrand" within domain scope */ var tuple; switch (info.code.op) { case O_SETOF: /* compute next n-tuple and add it to the set; in this case duplicate n-tuples are silently ignored */ tuple = mpl_internal_eval_tuple(mpl, info.code.arg.loop.x); if (mpl_internal_find_tuple(mpl, info.value, tuple) == null) mpl_internal_add_tuple(mpl, info.value, tuple); break; case O_BUILD: /* construct next n-tuple using current values assigned to *free* dummy indices as its components and add it to the set; in this case duplicate n-tuples cannot appear */ mpl_internal_add_tuple(mpl, info.value, mpl_internal_get_domain_tuple(mpl, info.code.arg.loop.domain)); break; default: xassert(info != info); } return 0; } function mpl_internal_eval_elemset(mpl, code){ var value, e, info; xassert(code != null); xassert(code.type == A_ELEMSET); xassert(code.dim > 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code.vflag && code.valid) { code.valid = 0; mpl_internal_delete_value(mpl, code.type, code.value); } /* if resultant value is valid, no evaluation is needed */ if (code.valid) { return mpl_internal_copy_elemset(mpl, code.value.set); } /* evaluate pseudo-code recursively */ switch (code.op) { case O_MEMSET: /* take member of set */ { var tuple; tuple = null; for (e = code.arg.set.list; e != null; e = e.next) tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_eval_symbolic(mpl, e.x)); value = mpl_internal_copy_elemset(mpl, mpl_internal_eval_member_set(mpl, code.arg.set.set, tuple)); } break; case O_MAKE: /* make elemental set of n-tuples */ { value = mpl_internal_create_elemset(mpl, code.dim); for (e = code.arg.list; e != null; e = e.next) mpl_internal_check_then_add(mpl, value, mpl_internal_eval_tuple(mpl, e.x)); } break; case O_UNION: /* union of two elemental sets */ value = mpl_internal_set_union(mpl, mpl_internal_eval_elemset(mpl, code.arg.arg.x), mpl_internal_eval_elemset(mpl, code.arg.arg.y)); break; case O_DIFF: /* difference between two elemental sets */ value = mpl_internal_set_diff(mpl, mpl_internal_eval_elemset(mpl, code.arg.arg.x), mpl_internal_eval_elemset(mpl, code.arg.arg.y)); break; case O_SYMDIFF: /* symmetric difference between two elemental sets */ value = mpl_internal_set_symdiff(mpl, mpl_internal_eval_elemset(mpl, code.arg.arg.x), mpl_internal_eval_elemset(mpl, code.arg.arg.y)); break; case O_INTER: /* intersection of two elemental sets */ value = mpl_internal_set_inter(mpl, mpl_internal_eval_elemset(mpl, code.arg.arg.x), mpl_internal_eval_elemset(mpl, code.arg.arg.y)); break; case O_CROSS: /* cross (Cartesian) product of two elemental sets */ value = mpl_internal_set_cross(mpl, mpl_internal_eval_elemset(mpl, code.arg.arg.x), mpl_internal_eval_elemset(mpl, code.arg.arg.y)); break; case O_DOTS: /* build "arithmetic" elemental set */ value = mpl_internal_create_arelset(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_numeric(mpl, code.arg.arg.y), code.arg.arg.z == null ? 1.0 : mpl_internal_eval_numeric(mpl, code.arg.arg.z)); break; case O_FORK: /* if-then-else */ if (mpl_internal_eval_logical(mpl, code.arg.arg.x)) value = mpl_internal_eval_elemset(mpl, code.arg.arg.y); else value = mpl_internal_eval_elemset(mpl, code.arg.arg.z); break; case O_SETOF: /* compute elemental set */ { info ={}; info.code = code; info.value = mpl_internal_create_elemset(mpl, code.dim); mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_set_func); value = info.value; } break; case O_BUILD: /* build elemental set identical to domain set */ { info = {}; info.code = code; info.value = mpl_internal_create_elemset(mpl, code.dim); mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_set_func); value = info.value; } break; default: xassert(code != code); } /* save resultant value */ xassert(!code.valid); code.valid = 1; code.value.set = mpl_internal_copy_elemset(mpl, value); return value; } function mpl_internal_null_func(mpl, info){ /* this is dummy routine used to enter the domain scope */ xassert(info == null); } function mpl_internal_is_member(mpl, code, tuple){ var value, e, temp, j; xassert(code != null); xassert(code.type == A_ELEMSET); xassert(code.dim > 0); xassert(tuple != null); switch (code.op) { case O_MEMSET: /* check if given n-tuple is member of elemental set, which is assigned to member of model set */ { var set; /* evaluate reference to elemental set */ temp = null; for (e = code.arg.set.list; e != null; e = e.next) temp = mpl_internal_expand_tuple(mpl, temp, mpl_internal_eval_symbolic(mpl, e.x)); set = mpl_internal_eval_member_set(mpl, code.arg.set.set, temp); /* check if the n-tuple is contained in the set array */ temp = mpl_internal_build_subtuple(mpl, tuple, set.dim); value = (mpl_internal_find_tuple(mpl, set, temp) != null); } break; case O_MAKE: /* check if given n-tuple is member of literal set */ { var that; value = 0; temp = mpl_internal_build_subtuple(mpl, tuple, code.dim); for (e = code.arg.list; e != null; e = e.next) { that = mpl_internal_eval_tuple(mpl, e.x); value = (mpl_internal_compare_tuples(mpl, temp, that) == 0); if (value) break; } } break; case O_UNION: value = mpl_internal_is_member(mpl, code.arg.arg.x, tuple) || mpl_internal_is_member(mpl, code.arg.arg.y, tuple); break; case O_DIFF: value = mpl_internal_is_member(mpl, code.arg.arg.x, tuple) && !mpl_internal_is_member(mpl, code.arg.arg.y, tuple); break; case O_SYMDIFF: { var in1 = mpl_internal_is_member(mpl, code.arg.arg.x, tuple); var in2 = mpl_internal_is_member(mpl, code.arg.arg.y, tuple); value = (in1 && !in2) || (!in1 && in2); } break; case O_INTER: value = mpl_internal_is_member(mpl, code.arg.arg.x, tuple) && mpl_internal_is_member(mpl, code.arg.arg.y, tuple); break; case O_CROSS: { value = mpl_internal_is_member(mpl, code.arg.arg.x, tuple); if (value) { for (j = 1; j <= code.arg.arg.x.dim; j++) { xassert(tuple != null); tuple = tuple.next; } value = mpl_internal_is_member(mpl, code.arg.arg.y, tuple); } } break; case O_DOTS: /* check if given 1-tuple is member of "arithmetic" set */ { var x, t0, tf, dt; xassert(code.dim == 1); /* compute "parameters" of the "arithmetic" set */ t0 = mpl_internal_eval_numeric(mpl, code.arg.arg.x); tf = mpl_internal_eval_numeric(mpl, code.arg.arg.y); if (code.arg.arg.z == null) dt = 1.0; else dt = mpl_internal_eval_numeric(mpl, code.arg.arg.z); /* make sure the parameters are correct */ mpl_internal_arelset_size(mpl, t0, tf, dt); /* if component of 1-tuple is symbolic, not numeric, the 1-tuple cannot be member of "arithmetic" set */ xassert(tuple.sym != null); if (tuple.sym.str != null) { value = 0; break; } /* determine numeric value of the component */ x = tuple.sym.num; /* if the component value is out of the set range, the 1-tuple is not in the set */ if (dt > 0.0 && !(t0 <= x && x <= tf) || dt < 0.0 && !(tf <= x && x <= t0)) { value = 0; break; } /* estimate ordinal number of the 1-tuple in the set */ j = ((((x - t0) / dt) + 0.5)|0) + 1; /* perform the main check */ value = (mpl_internal_arelset_member(mpl, t0, tf, dt, j) == x); } break; case O_FORK: /* check if given n-tuple is member of conditional set */ if (mpl_internal_eval_logical(mpl, code.arg.arg.x)) value = mpl_internal_is_member(mpl, code.arg.arg.y, tuple); else value = mpl_internal_is_member(mpl, code.arg.arg.z, tuple); break; case O_SETOF: /* check if given n-tuple is member of computed set */ /* it is not clear how to efficiently perform the check not computing the entire elemental set :+( */ mpl_internal_error(mpl, "implementation restriction; in/within setof{} not allowed"); break; case O_BUILD: /* check if given n-tuple is member of domain set */ { temp = mpl_internal_build_subtuple(mpl, tuple, code.dim); /* try to enter the domain scope; if it is successful, the n-tuple is in the domain set */ value = (mpl_internal_eval_within_domain(mpl, code.arg.loop.domain, temp, null, mpl_internal_null_func) == 0); } break; default: xassert(code != code); } return value; } function mpl_internal_iter_form_func(mpl, info) { /* this is auxiliary routine used to perform iterated operation on linear form "integrand" within domain scope */ switch (info.code.op) { case O_SUM: /* summation over domain */ /* the routine linear_comb needs to look through all terms of both linear forms to reduce identical terms, so using it here is not a good idea (for example, evaluation of sum{i in 1..n} x[i] required quadratic time); the better idea is to gather all terms of the integrand in one list and reduce identical terms only once after all terms of the resultant linear form have been evaluated */ { var term; var form = mpl_internal_eval_formula(mpl, info.code.arg.loop.x); if (info.value == null) { xassert(info.tail == null); info.value = form; } else { xassert(info.tail != null); info.tail.next = form; } for (term = form; term != null; term = term.next) info.tail = term; } break; default: xassert(info != info); } return 0; } function mpl_internal_eval_formula(mpl, code){ var value; xassert(code != null); xassert(code.type == A_FORMULA); xassert(code.dim == 0); /* if the operation has a side effect, invalidate and delete the resultant value */ if (code.vflag && code.valid) { code.valid = 0; mpl_internal_delete_value(mpl, code.type, code.value); } /* if resultant value is valid, no evaluation is needed */ if (code.valid) { return mpl_internal_copy_formula(mpl, code.value.form); } /* evaluate pseudo-code recursively */ switch (code.op) { case O_MEMVAR: /* take member of variable */ { var e; var tuple = null; for (e = code.arg.var_.list; e != null; e = e.next) tuple = mpl_internal_expand_tuple(mpl, tuple, mpl_internal_eval_symbolic(mpl, e.x)); xassert(code.arg.var_.suff == DOT_NONE); value = mpl_internal_single_variable(mpl, mpl_internal_eval_member_var(mpl, code.arg.var_.var_, tuple)); } break; case O_CVTLFM: /* convert to linear form */ value = mpl_internal_constant_term(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x)); break; case O_PLUS: /* unary plus */ value = mpl_internal_linear_comb(mpl, 0.0, mpl_internal_constant_term(mpl, 0.0), +1.0, mpl_internal_eval_formula(mpl, code.arg.arg.x)); break; case O_MINUS: /* unary minus */ value = mpl_internal_linear_comb(mpl, 0.0, mpl_internal_constant_term(mpl, 0.0), -1.0, mpl_internal_eval_formula(mpl, code.arg.arg.x)); break; case O_ADD: /* addition */ value = mpl_internal_linear_comb(mpl, +1.0, mpl_internal_eval_formula(mpl, code.arg.arg.x), +1.0, mpl_internal_eval_formula(mpl, code.arg.arg.y)); break; case O_SUB: /* subtraction */ value = mpl_internal_linear_comb(mpl, +1.0, mpl_internal_eval_formula(mpl, code.arg.arg.x), -1.0, mpl_internal_eval_formula(mpl, code.arg.arg.y)); break; case O_MUL: /* multiplication */ xassert(code.arg.arg.x != null); xassert(code.arg.arg.y != null); if (code.arg.arg.x.type == A_NUMERIC) { xassert(code.arg.arg.y.type == A_FORMULA); value = mpl_internal_linear_comb(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.x), mpl_internal_eval_formula(mpl, code.arg.arg.y), 0.0, mpl_internal_constant_term(mpl, 0.0)); } else { xassert(code.arg.arg.x.type == A_FORMULA); xassert(code.arg.arg.y.type == A_NUMERIC); value = mpl_internal_linear_comb(mpl, mpl_internal_eval_numeric(mpl, code.arg.arg.y), mpl_internal_eval_formula(mpl, code.arg.arg.x), 0.0, mpl_internal_constant_term(mpl, 0.0)); } break; case O_DIV: /* division */ value = mpl_internal_linear_comb(mpl, mpl_internal_fp_div(mpl, 1.0, mpl_internal_eval_numeric(mpl, code.arg.arg.y)), mpl_internal_eval_formula(mpl, code.arg.arg.x), 0.0, mpl_internal_constant_term(mpl, 0.0)); break; case O_FORK: /* if-then-else */ if (mpl_internal_eval_logical(mpl, code.arg.arg.x)) value = mpl_internal_eval_formula(mpl, code.arg.arg.y); else if (code.arg.arg.z == null) value = mpl_internal_constant_term(mpl, 0.0); else value = mpl_internal_eval_formula(mpl, code.arg.arg.z); break; case O_SUM: /* summation over domain */ { var info = {}; info.code = code; info.value = mpl_internal_constant_term(mpl, 0.0); info.tail = null; mpl_internal_loop_within_domain(mpl, code.arg.loop.domain, info, mpl_internal_iter_form_func); value = mpl_internal_reduce_terms(mpl, info.value); } break; default: xassert(code != code); } /* save resultant value */ xassert(!code.valid); code.valid = 1; code.value.form = mpl_internal_copy_formula(mpl, value); return value; } /**********************************************************************/ /* * * DATA TABLES * * */ /**********************************************************************/ var mpl_tab_num_args = exports["mpl_tab_num_args"] = function(dca){ /* returns the number of arguments */ return dca.na; }; var mpl_tab_get_arg = exports["mpl_tab_get_arg"] = function(dca, k){ /* returns pointer to k-th argument */ xassert(1 <= k && k <= dca.na); return dca.arg[k]; }; var mpl_tab_get_args = exports["mpl_tab_get_args"] = function(dca, k){ return dca.arg; }; var mpl_tab_num_flds = exports["mpl_tab_num_flds"] = function (dca){ /* returns the number of fields */ return dca.nf; }; var mpl_tab_get_name = exports["mpl_tab_get_name"] = function(dca, k) { /* returns pointer to name of k-th field */ xassert(1 <= k && k <= dca.nf); return dca.name[k]; }; var mpl_tab_get_type = exports["mpl_tab_get_type"] = function(dca, k) { /* returns type of k-th field */ xassert(1 <= k && k <= dca.nf); return dca.type[k]; }; var mpl_tab_get_num = exports["mpl_tab_get_num"] = function(dca, k){ /* returns numeric value of k-th field */ xassert(1 <= k && k <= dca.nf); xassert(dca.type[k] == 'N'); return dca.num[k]; }; var mpl_tab_get_str = exports["mpl_tab_get_str"] = function(dca, k){ /* returns pointer to string value of k-th field */ xassert(1 <= k && k <= dca.nf); xassert(dca.type[k] == 'S'); xassert(dca.str[k] != null); return dca.str[k]; }; var mpl_tab_set_num = exports["mpl_tab_set_num"] = function(dca, k, num){ /* assign numeric value to k-th field */ xassert(1 <= k && k <= dca.nf); xassert(dca.type[k] == '?'); dca.type[k] = 'N'; dca.num[k] = num; }; var mpl_tab_set_str = exports["mpl_tab_set_str"] = function(dca, k, str){ /* assign string value to k-th field */ xassert(1 <= k && k <= dca.nf); xassert(dca.type[k] == '?'); //xassert(str.length <= MAX_LENGTH); xassert(dca.str[k] != null); dca.type[k] = 'S'; dca.str[k] = str; }; function mpl_internal_write_func(mpl, tab){ /* this is auxiliary routine to work within domain scope */ var dca = mpl.dca; var out; var sym; var k; /* evaluate field values */ k = 0; for (out = tab.u.out.list; out != null; out = out.next) { k++; switch (out.code.type) { case A_NUMERIC: dca.type[k] = 'N'; dca.num[k] = mpl_internal_eval_numeric(mpl, out.code); dca.str[k][0] = '\0'; break; case A_SYMBOLIC: sym = mpl_internal_eval_symbolic(mpl, out.code); if (sym.str == null) { dca.type[k] = 'N'; dca.num[k] = sym.num; dca.str[k][0] = '\0'; } else { dca.type[k] = 'S'; dca.num[k] = 0.0; dca.str[k] = sym.str; } break; default: xassert(out != out); } } /* write record to output table */ mpl_tab_drv_write(mpl); return 0; } function mpl_internal_execute_table(mpl, tab){ /* execute table statement */ var arg; var fld; var in_; var out; var dca; var set; var k; var buf; // [MAX_LENGTH+1]; /* allocate table driver communication area */ xassert(mpl.dca == null); mpl.dca = dca = {}; dca.id = 0; dca.link = null; dca.na = 0; dca.arg = null; dca.nf = 0; dca.name = null; dca.type = null; dca.num = null; dca.str = null; /* allocate arguments */ xassert(dca.na == 0); for (arg = tab.arg; arg != null; arg = arg.next) dca.na++; dca.arg = new Array(1+dca.na); for (k = 1; k <= dca.na; k++) dca.arg[k] = null; /* evaluate argument values */ k = 0; for (arg = tab.arg; arg != null; arg = arg.next) { k++; xassert(arg.code.type == A_SYMBOLIC); var sym = mpl_internal_eval_symbolic(mpl, arg.code); if (sym.str == null) buf = String(sym.num); else buf = sym.str; dca.arg[k] = buf; } /* perform table input/output */ switch (tab.type) { case A_INPUT: /* read data from input table */ /* add the only member to the control set and assign it empty elemental set */ set = tab.u.in_.set; if (set != null) { if (set.data) mpl_internal_error(mpl, set.name + " already provided with data"); xassert(set.array.head == null); mpl_internal_add_member(mpl, set.array, null).value.set = mpl_internal_create_elemset(mpl, set.dimen); set.data = 1; } /* check parameters specified in the input list */ for (in_ = tab.u.in_.list; in_ != null; in_ = in_.next) { if (in_.par.data) mpl_internal_error(mpl, in_.par.name + " already provided with data"); in_.par.data = 1; } /* allocate and initialize fields */ xassert(dca.nf == 0); for (fld = tab.u.in_.fld; fld != null; fld = fld.next) dca.nf++; for (in_ = tab.u.in_.list; in_ != null; in_ = in_.next) dca.nf++; dca.name = new Array(1+dca.nf); dca.type = new Array(1+dca.nf); dca.num = new Float64Array(1+dca.nf); dca.str = new Array(1+dca.nf); k = 0; for (fld = tab.u.in_.fld; fld != null; fld = fld.next) { k++; dca.name[k] = fld.name; dca.type[k] = '?'; dca.num[k] = 0.0; dca.str[k] = ''; } for (in_ = tab.u.in_.list; in_ != null; in_ = in_.next) { k++; dca.name[k] = in_.name; dca.type[k] = '?'; dca.num[k] = 0.0; dca.str[k] = ''; } /* open input table */ mpl_tab_drv_open(mpl, 'R'); /* read and process records */ for (;;) { var tup; /* reset field types */ for (k = 1; k <= dca.nf; k++) dca.type[k] = '?'; /* read next record */ if (mpl_tab_drv_read(mpl)) break; /* all fields must be set by the driver */ for (k = 1; k <= dca.nf; k++) { if (dca.type[k] == '?') mpl_internal_error(mpl, "field " + dca.name[k] + " missing in input table"); } /* construct n-tuple */ tup = null; k = 0; for (fld = tab.u.in_.fld; fld != null; fld = fld.next) { k++; xassert(k <= dca.nf); switch (dca.type[k]) { case 'N': tup = mpl_internal_expand_tuple(mpl, tup, mpl_internal_create_symbol_num(mpl, dca.num[k])); break; case 'S': //xassert(dca.str[k].length <= MAX_LENGTH); tup = mpl_internal_expand_tuple(mpl, tup, mpl_internal_create_symbol_str(mpl, dca.str[k])); break; default: xassert(dca != dca); } } /* add n-tuple just read to the control set */ if (tab.u.in_.set != null) mpl_internal_check_then_add(mpl, tab.u.in_.set.array.head.value.set, mpl_internal_copy_tuple(mpl, tup)); /* assign values to the parameters in the input list */ for (in_ = tab.u.in_.list; in_ != null; in_ = in_.next) { var memb; k++; xassert(k <= dca.nf); /* there must be no member with the same n-tuple */ if (mpl_internal_find_member(mpl, in_.par.array, tup) != null) mpl_internal_error(mpl, in_.par.name + mpl_internal_format_tuple(mpl, '[', tup) + " already defined"); /* create new parameter member with given n-tuple */ memb = mpl_internal_add_member(mpl, in_.par.array, mpl_internal_copy_tuple(mpl, tup)) ; /* assign value to the parameter member */ switch (in_.par.type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: if (dca.type[k] != 'N') mpl_internal_error(mpl, in_.par.name + " requires numeric data"); memb.value.num = dca.num[k]; break; case A_SYMBOLIC: switch (dca.type[k]) { case 'N': memb.value.sym = mpl_internal_create_symbol_num(mpl, dca.num[k]); break; case 'S': //xassert(dca.str[k].length <= MAX_LENGTH); memb.value.sym = mpl_internal_create_symbol_str(mpl, dca.str[k]); break; default: xassert(dca != dca); } break; default: xassert(in_ != in_); } } } /* close input table */ mpl.dca = null; break; case A_OUTPUT: /* write data to output table */ /* allocate and initialize fields */ xassert(dca.nf == 0); for (out = tab.u.out.list; out != null; out = out.next) dca.nf++; dca.name = new Array(1+dca.nf); dca.type = new Array(1+dca.nf); dca.num = new Float64Array(1+dca.nf); dca.str = new Array(1+dca.nf); k = 0; for (out = tab.u.out.list; out != null; out = out.next) { k++; dca.name[k] = out.name; dca.type[k] = '?'; dca.num[k] = 0.0; dca.str[k] = ''; } /* open output table */ mpl_tab_drv_open(mpl, 'W'); /* evaluate fields and write records */ mpl_internal_loop_within_domain(mpl, tab.u.out.domain, tab, mpl_internal_write_func); /* close output table */ mpl_tab_drv_flush(mpl); mpl.dca = null; break; default: xassert(tab != tab); } } /**********************************************************************/ /* * * MODEL STATEMENTS * * */ /**********************************************************************/ function mpl_internal_check_func(mpl, chk){ /* this is auxiliary routine to work within domain scope */ if (!mpl_internal_eval_logical(mpl, chk.code)) mpl_internal_error(mpl, "check" + mpl_internal_format_tuple(mpl, '[', mpl_internal_get_domain_tuple(mpl, chk.domain)) + " failed"); return 0; } function mpl_internal_execute_check(mpl, chk){ mpl_internal_loop_within_domain(mpl, chk.domain, chk, mpl_internal_check_func); } function mpl_internal_display_set(mpl, set, memb){ /* display member of model set */ var s = memb.value.set; var m; mpl_internal_write_text(mpl, set.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + (s.head == null ? " is empty" : ":")); for (m = s.head; m != null; m = m.next) mpl_internal_write_text(mpl, " " + mpl_internal_format_tuple(mpl, '(', m.tuple)); } function mpl_internal_display_par(mpl, par, memb){ /* display member of model parameter */ switch (par.type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: mpl_internal_write_text(mpl, par.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + " = " + memb.value.num); break; case A_SYMBOLIC: mpl_internal_write_text(mpl, par.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + " = " + mpl_internal_format_symbol(mpl, memb.value.sym)); break; default: xassert(par != par); } } function mpl_internal_display_var(mpl, var_, memb, suff){ /* display member of model variable */ if (suff == DOT_NONE || suff == DOT_VAL) mpl_internal_write_text(mpl, var_.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".val = " + memb.value.var_.prim); else if (suff == DOT_LB) mpl_internal_write_text(mpl, var_.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".lb = " + (memb.value.var_.var_.lbnd == null ? -DBL_MAX : memb.value.var_.lbnd)); else if (suff == DOT_UB) mpl_internal_write_text(mpl, var_.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".ub = " + (memb.value.var_.var_.ubnd == null ? +DBL_MAX : memb.value.var_.ubnd)); else if (suff == DOT_STATUS) mpl_internal_write_text(mpl, var_.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".status = " + memb.value.var_.stat); else if (suff == DOT_DUAL) mpl_internal_write_text(mpl, var_.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".dual = " + memb.value.var_.dual); else xassert(suff != suff); } function mpl_internal_display_con(mpl, con, memb, suff){ /* display member of model constraint */ if (suff == DOT_NONE || suff == DOT_VAL) mpl_internal_write_text(mpl, con.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".val = " + memb.value.con.prim); else if (suff == DOT_LB) mpl_internal_write_text(mpl, con.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".lb = " + (memb.value.con.con.lbnd == null ? -DBL_MAX : memb.value.con.lbnd)); else if (suff == DOT_UB) mpl_internal_write_text(mpl, con.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".ub = " + (memb.value.con.con.ubnd == null ? +DBL_MAX : memb.value.con.ubnd)); else if (suff == DOT_STATUS) mpl_internal_write_text(mpl, con.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".status = " + memb.value.con.stat); else if (suff == DOT_DUAL) mpl_internal_write_text(mpl, con.name + mpl_internal_format_tuple(mpl, '[', memb.tuple) + ".dual = " + memb.value.con.dual); else xassert(suff != suff); } function mpl_internal_display_memb(mpl, code){ /* display member specified by pseudo-code */ var memb = {value:{}}; var e; xassert(code.op == O_MEMNUM || code.op == O_MEMSYM || code.op == O_MEMSET || code.op == O_MEMVAR || code.op == O_MEMCON); memb.tuple = null; for (e = code.arg.par.list || code.arg.var_.list; e != null; e = e.next) memb.tuple = mpl_internal_expand_tuple(mpl, memb.tuple, mpl_internal_eval_symbolic(mpl, e.x)); switch (code.op) { case O_MEMNUM: memb.value.num = mpl_internal_eval_member_num(mpl, code.arg.par.par, memb.tuple); mpl_internal_display_par(mpl, code.arg.par.par, memb); break; case O_MEMSYM: memb.value.sym = mpl_internal_eval_member_sym(mpl, code.arg.par.par, memb.tuple); mpl_internal_display_par(mpl, code.arg.par.par, memb); break; case O_MEMSET: memb.value.set = mpl_internal_eval_member_set(mpl, code.arg.set.set, memb.tuple); mpl_internal_display_set(mpl, code.arg.set.set, memb); break; case O_MEMVAR: memb.value.var_ = mpl_internal_eval_member_var(mpl, code.arg.var_.var_, memb.tuple); mpl_internal_display_var (mpl, code.arg.var_.var_, memb, code.arg.var_.suff); break; case O_MEMCON: memb.value.con = mpl_internal_eval_member_con(mpl, code.arg.con.con, memb.tuple); mpl_internal_display_con (mpl, code.arg.con.con, memb, code.arg.con.suff); break; default: xassert(code != code); } } function mpl_internal_display_code(mpl, code){ /* display value of expression */ switch (code.type) { case A_NUMERIC: /* numeric value */ { var num = mpl_internal_eval_numeric(mpl, code); mpl_internal_write_text(mpl, String(num)); } break; case A_SYMBOLIC: /* symbolic value */ { var sym = mpl_internal_eval_symbolic(mpl, code); mpl_internal_write_text(mpl, mpl_internal_format_symbol(mpl, sym)); } break; case A_LOGICAL: /* logical value */ { var bit = mpl_internal_eval_logical(mpl, code); mpl_internal_write_text(mpl, bit ? "true" : "false"); } break; case A_TUPLE: /* n-tuple */ { var tuple = mpl_internal_eval_tuple(mpl, code); mpl_internal_write_text(mpl, mpl_internal_format_tuple(mpl, '(', tuple)); } break; case A_ELEMSET: /* elemental set */ { var set = mpl_internal_eval_elemset(mpl, code); if (set.head == 0) mpl_internal_write_text(mpl, "set is empty"); for (var memb = set.head; memb != null; memb = memb.next) mpl_internal_write_text(mpl, " " + mpl_internal_format_tuple(mpl, '(', memb.tuple)); } break; case A_FORMULA: /* linear form */ { var term; var form = mpl_internal_eval_formula(mpl, code); if (form == null) mpl_internal_write_text(mpl, "linear form is empty"); for (term = form; term != null; term = term.next) { if (term.var_ == null) mpl_internal_write_text(mpl, " " + term.coef); else mpl_internal_write_text(mpl, " " + term.coef + " " + term.var_.var_.name + mpl_internal_format_tuple(mpl, '[', term.var_.memb.tuple)); } } break; default: xassert(code != code); } } function mpl_internal_display_func(mpl, dpy){ var memb; /* this is auxiliary routine to work within domain scope */ for (var entry = dpy.list; entry != null; entry = entry.next) { if (entry.type == A_INDEX) { /* dummy index */ var slot = entry.u.slot; mpl_internal_write_text(mpl, slot.name + " = " + mpl_internal_format_symbol(mpl, slot.value)); } else if (entry.type == A_SET) { /* model set */ var set = entry.u.set; if (set.assign != null) { /* the set has assignment expression; evaluate all its members over entire domain */ mpl_internal_eval_whole_set(mpl, set); } else { /* the set has no assignment expression; refer to its any existing member ignoring resultant value to check the data provided the data section */ if (set.gadget != null && set.data == 0) { /* initialize the set with data from a plain set */ mpl_internal_saturate_set(mpl, set); } if (set.array.head != null) mpl_internal_eval_member_set(mpl, set, set.array.head.tuple); } /* display all members of the set array */ if (set.array.head == null) mpl_internal_write_text(mpl, set.name + " has empty content"); for (memb = set.array.head; memb != null; memb = memb.next) mpl_internal_display_set(mpl, set, memb); } else if (entry.type == A_PARAMETER) { /* model parameter */ var par = entry.u.par; if (par.assign != null) { /* the parameter has an assignment expression; evaluate all its member over entire domain */ mpl_internal_eval_whole_par(mpl, par); } else { /* the parameter has no assignment expression; refer to its any existing member ignoring resultant value to check the data provided in the data section */ if (par.array.head != null) { if (par.type != A_SYMBOLIC) mpl_internal_eval_member_num(mpl, par, par.array.head.tuple); else mpl_internal_eval_member_sym(mpl, par, par.array.head.tuple); } } /* display all members of the parameter array */ if (par.array.head == null) mpl_internal_write_text(mpl, par.name + " has empty content"); for (memb = par.array.head; memb != null; memb = memb.next) mpl_internal_display_par(mpl, par, memb); } else if (entry.type == A_VARIABLE) { /* model variable */ var var_ = entry.u.var_; xassert(mpl.flag_p); /* display all members of the variable array */ if (var_.array.head == null) mpl_internal_write_text(mpl, var_.name + " has empty content"); for (memb = var_.array.head; memb != null; memb = memb.next) mpl_internal_display_var(mpl, var_, memb, DOT_NONE); } else if (entry.type == A_CONSTRAINT) { /* model constraint */ var con = entry.u.con; xassert(mpl.flag_p); /* display all members of the constraint array */ if (con.array.head == null) mpl_internal_write_text(mpl, con.name + " has empty content"); for (memb = con.array.head; memb != null; memb = memb.next) mpl_internal_display_con(mpl, con, memb, DOT_NONE); } else if (entry.type == A_EXPRESSION) { /* expression */ var code = entry.u.code; if (code.op == O_MEMNUM || code.op == O_MEMSYM || code.op == O_MEMSET || code.op == O_MEMVAR || code.op == O_MEMCON) mpl_internal_display_memb(mpl, code); else mpl_internal_display_code(mpl, code); } else xassert(entry != entry); } return 0; } function mpl_internal_execute_display(mpl, dpy){ mpl_internal_loop_within_domain(mpl, dpy.domain, dpy, mpl_internal_display_func); } function mpl_internal_print_char(mpl, c){ if (mpl.prt_fp == null) mpl_internal_write_char(mpl, c); else mpl.prt_fp(c); } function mpl_internal_print_text(mpl, buf){ xassert(buf.length < OUTBUF_SIZE); for (var c = 0; c < buf.length; c++) mpl_internal_print_char(mpl, buf[c]); } function mpl_internal_printf_func(mpl, prt){ /* this is auxiliary routine to work within domain scope */ var entry; var fmt; var from; var c; var value; /* evaluate format control string */ var sym = mpl_internal_eval_symbolic(mpl, prt.fmt); if (sym.str == null) fmt = String(sym.num); else fmt = sym.str; /* scan format control string and perform formatting output */ entry = prt.list; for (c = 0; c < fmt.length; c++) { if (fmt[c] == '%') { /* scan format specifier */ from = c++; if (fmt[c] == '%') { mpl_internal_print_char(mpl, '%'); continue; } if (entry == null) break; /* scan optional flags */ while (fmt[c] == '-' || fmt[c] == '+' || fmt[c] == ' ' || fmt[c] == '#' || fmt[c] == '0') c++; /* scan optional minimum field width */ while (isdigit(fmt[c])) c++; /* scan optional precision */ if (fmt[c] == '.') { c++; while (isdigit(fmt[c])) c++; } /* scan conversion specifier and perform formatting */ // save = (c+1); *(c+1) = '\0'; if (fmt[c] == 'd' || fmt[c] == 'i' || fmt[c] == 'e' || fmt[c] == 'E' || fmt[c] == 'f' || fmt[c] == 'F' || fmt[c] == 'g' || fmt[c] == 'G') { /* the specifier requires numeric value */ xassert(entry != null); switch (entry.code.type) { case A_NUMERIC: value = mpl_internal_eval_numeric(mpl, entry.code); break; case A_SYMBOLIC: sym = mpl_internal_eval_symbolic(mpl, entry.code); if (sym.str != null) mpl_internal_error(mpl, "cannot convert " + mpl_internal_format_symbol(mpl, sym) + " to floating-point number"); value = sym.num; break; case A_LOGICAL: if (mpl_internal_eval_logical(mpl, entry.code)) value = 1.0; else value = 0.0; break; default: xassert(entry != entry); } if (fmt[c] == 'd' || fmt[c] == 'i') { var int_max = INT_MAX; if (!(-int_max <= value && value <= +int_max)) mpl_internal_error(mpl, "cannot convert " + value + " to integer"); mpl_internal_print_text(mpl, sprintf(fmt.slice(from, c+1), Math.floor(value + 0.5)|0)); } else mpl_internal_print_text(mpl, sprintf(fmt.slice(from, c+1), value)); } else if (fmt[c] == 's') { /* the specifier requires symbolic value */ switch (entry.code.type) { case A_NUMERIC: value = String(mpl_internal_eval_numeric(mpl, entry.code)); break; case A_LOGICAL: if (mpl_internal_eval_logical(mpl, entry.code)) value = "T"; else value = "F"; break; case A_SYMBOLIC: sym = mpl_internal_eval_symbolic(mpl, entry.code); if (sym.str == null) value = String(sym.num); else value = sym.str; break; default: xassert(entry != entry); } mpl_internal_print_text(mpl, sprintf(fmt.slice(from, c+1), value)); } else mpl_internal_error(mpl, "format specifier missing or invalid"); //*(c+1) = save; entry = entry.next; } else if (fmt[c] == '\\') { /* write some control character */ c++; if (fmt[c] == 't') mpl_internal_print_char(mpl, '\t'); else if (fmt[c] == 'n') mpl_internal_print_char(mpl, '\n'); else if (fmt[c] == '\0') { /* format string ends with backslash */ mpl_internal_error(mpl, "invalid use of escape character \\ in format control string"); } else mpl_internal_print_char(mpl, fmt[c]); } else { /* write character without formatting */ mpl_internal_print_char(mpl, fmt[c]); } } return 0; } function mpl_internal_execute_printf(mpl, prt){ if (prt.fname == null) { mpl.prt_file = null; } else { /* evaluate file name string */ var sym = mpl_internal_eval_symbolic(mpl, prt.fname); if (sym.str == null) mpl.prt_file = sym.num; else mpl.prt_file = sym.str; } mpl_internal_loop_within_domain(mpl, prt.domain, prt, mpl_internal_printf_func); } function mpl_internal_for_func(mpl, fur){ /* this is auxiliary routine to work within domain scope */ var save = mpl.stmt; for (var stmt = fur.list; stmt != null; stmt = stmt.next) mpl_internal_execute_statement(mpl, stmt); mpl.stmt = save; return 0; } function mpl_internal_execute_for(mpl, fur){ mpl_internal_loop_within_domain(mpl, fur.domain, fur, mpl_internal_for_func); } function mpl_internal_execute_statement(mpl, stmt){ mpl.stmt = stmt; switch (stmt.type) { case A_SET: case A_PARAMETER: case A_VARIABLE: break; case A_CONSTRAINT: xprintf("Generating " + stmt.u.con.name + "..."); mpl_internal_eval_whole_con(mpl, stmt.u.con); break; case A_TABLE: switch (stmt.u.tab.type) { case A_INPUT: xprintf("Reading " + stmt.u.tab.name + "..."); break; case A_OUTPUT: xprintf("Writing " + stmt.u.tab.name + "..."); break; default: xassert(stmt != stmt); } mpl_internal_execute_table(mpl, stmt.u.tab); break; case A_SOLVE: break; case A_CHECK: xprintf("Checking (line " + stmt.line + ")..."); mpl_internal_execute_check(mpl, stmt.u.chk); break; case A_DISPLAY: mpl_internal_write_text(mpl, "Display statement at line " + stmt.line); mpl_internal_execute_display(mpl, stmt.u.dpy); break; case A_PRINTF: mpl_internal_execute_printf(mpl, stmt.u.prt); break; case A_FOR: mpl_internal_execute_for(mpl, stmt.u.fur); break; default: xassert(stmt != stmt); } } /* glpmpl04.c */ /**********************************************************************/ /* * * GENERATING AND POSTSOLVING MODEL * * */ /**********************************************************************/ function mpl_internal_alloc_content(mpl){ var stmt; /* walk through all model statements */ for (stmt = mpl.model; stmt != null; stmt = stmt.next) { switch (stmt.type) { case A_SET: /* model set */ xassert(stmt.u.set.array == null); stmt.u.set.array = mpl_internal_create_array(mpl, A_ELEMSET, stmt.u.set.dim); break; case A_PARAMETER: /* model parameter */ xassert(stmt.u.par.array == null); switch (stmt.u.par.type) { case A_NUMERIC: case A_INTEGER: case A_BINARY: stmt.u.par.array = mpl_internal_create_array(mpl, A_NUMERIC, stmt.u.par.dim); break; case A_SYMBOLIC: stmt.u.par.array = mpl_internal_create_array(mpl, A_SYMBOLIC, stmt.u.par.dim); break; default: xassert(stmt != stmt); } break; case A_VARIABLE: /* model variable */ xassert(stmt.u.var_.array == null); stmt.u.var_.array = mpl_internal_create_array(mpl, A_ELEMVAR, stmt.u.var_.dim); break; case A_CONSTRAINT: /* model constraint/objective */ xassert(stmt.u.con.array == null); stmt.u.con.array = mpl_internal_create_array(mpl, A_ELEMCON, stmt.u.con.dim); break; case A_TABLE: case A_SOLVE: case A_CHECK: case A_DISPLAY: case A_PRINTF: case A_FOR: /* functional statements have no content array */ break; default: xassert(stmt != stmt); } } } function mpl_internal_generate_model(mpl){ var stmt; xassert(!mpl.flag_p); for (stmt = mpl.model; stmt != null; stmt = stmt.next) { mpl_internal_execute_statement(mpl, stmt); if (mpl.stmt.type == A_SOLVE) break; } mpl.stmt = stmt; } function mpl_internal_build_problem(mpl){ var stmt; var memb; var v; var c; var t; var i, j; xassert(mpl.m == 0); xassert(mpl.n == 0); xassert(mpl.row == null); xassert(mpl.col == null); /* check that all elemental variables has zero column numbers */ for (stmt = mpl.model; stmt != null; stmt = stmt.next) { if (stmt.type == A_VARIABLE) { v = stmt.u.var_; for (memb = v.array.head; memb != null; memb = memb.next) xassert(memb.value.var_.j == 0); } } /* assign row numbers to elemental constraints and objectives */ for (stmt = mpl.model; stmt != null; stmt = stmt.next) { if (stmt.type == A_CONSTRAINT) { c = stmt.u.con; for (memb = c.array.head; memb != null; memb = memb.next) { xassert(memb.value.con.i == 0); memb.value.con.i = ++mpl.m; /* walk through linear form and mark elemental variables, which are referenced at least once */ for (t = memb.value.con.form; t != null; t = t.next) { xassert(t.var_ != null); t.var_.memb.value.var_.j = -1; } } } } /* assign column numbers to marked elemental variables */ for (stmt = mpl.model; stmt != null; stmt = stmt.next) { if (stmt.type == A_VARIABLE) { v = stmt.u.var_; for (memb = v.array.head; memb != null; memb = memb.next) if (memb.value.var_.j != 0) memb.value.var_.j = ++mpl.n; } } /* build list of rows */ mpl.row = new Array(1+mpl.m); for (i = 1; i <= mpl.m; i++) mpl.row[i] = null; for (stmt = mpl.model; stmt != null; stmt = stmt.next) { if (stmt.type == A_CONSTRAINT) { c = stmt.u.con; for (memb = c.array.head; memb != null; memb = memb.next) { i = memb.value.con.i; xassert(1 <= i && i <= mpl.m); xassert(mpl.row[i] == null); mpl.row[i] = memb.value.con; } } } for (i = 1; i <= mpl.m; i++) xassert(mpl.row[i] != null); /* build list of columns */ mpl.col = new Array(1+mpl.n); for (j = 1; j <= mpl.n; j++) mpl.col[j] = null; for (stmt = mpl.model; stmt != null; stmt = stmt.next) { if (stmt.type == A_VARIABLE) { v = stmt.u.var_; for (memb = v.array.head; memb != null; memb = memb.next) { j = memb.value.var_.j; if (j == 0) continue; xassert(1 <= j && j <= mpl.n); xassert(mpl.col[j] == null); mpl.col[j] = memb.value.var_; } } } for (j = 1; j <= mpl.n; j++) xassert(mpl.col[j] != null); } function mpl_internal_postsolve_model(mpl){ var stmt; xassert(!mpl.flag_p); mpl.flag_p = 1; for (stmt = mpl.stmt; stmt != null; stmt = stmt.next) mpl_internal_execute_statement(mpl, stmt); mpl.stmt = null; } /**********************************************************************/ /* * * INPUT/OUTPUT * * */ /**********************************************************************/ function mpl_internal_open_input(mpl, name, callback){ mpl.line = 0; mpl.column = 0; mpl.c = '\n'; mpl.token = 0; mpl.imlen = 0; mpl.image = ''; mpl.value = 0.0; mpl.b_token = T_EOF; mpl.b_imlen = 0; mpl.b_image = ''; mpl.b_value = 0.0; mpl.f_dots = 0; mpl.f_scan = 0; mpl.f_token = 0; mpl.f_imlen = 0; mpl.f_image = ''; mpl.f_value = 0.0; xfillArr(mpl.context, 0, ' ', CONTEXT_SIZE); mpl.c_ptr = 0; xassert(mpl.in_fp == null); mpl.in_fp = callback; mpl.in_file = name || 'input'; /* scan the very first character */ mpl_internal_get_char(mpl); /* scan the very first token */ mpl_internal_get_token(mpl); } function mpl_internal_read_char(mpl){ var c; xassert(mpl.in_fp != null); c = mpl.in_fp(); if (c < 0) { c = MPL_EOF; } return c; } function mpl_internal_close_input(mpl){ xassert(mpl.in_fp != null); mpl.in_fp = null; } function mpl_internal_open_output(mpl, name, callback){ xassert(mpl.out_fp == null); if (callback == null) { mpl.out_fp = function(data){xprintf(data)}; } else { mpl.out_fp = callback; mpl.out_file = name; } mpl.out_buffer = ''; } function mpl_internal_write_char(mpl, c){ xassert(mpl.out_fp != null); if (c == '\n'){ mpl.out_fp(mpl.out_buffer, mpl.prt_file); mpl.out_buffer = ''; } else mpl.out_buffer += c; } function mpl_internal_write_text(mpl, str){ xassert(mpl.out_fp != null); mpl.out_fp(str, mpl.prt_file); } function mpl_internal_flush_output(mpl){ xassert(mpl.out_fp != null); if (mpl.out_buffer.length > 0){ mpl.out_fp(mpl.out_buffer, mpl.prt_file); mpl.out_buffer = ''; } } /**********************************************************************/ /* * * SOLVER INTERFACE * * */ /**********************************************************************/ function mpl_internal_error(mpl, msg){ var error; switch (mpl.phase) { case 1: case 2: /* translation phase */ error = new Error(mpl.in_file + ":" + mpl.line + ": " + msg); error["line"] = mpl.line; error["column"] = mpl.column; mpl_internal_print_context(mpl); break; case 3: /* generation/postsolve phase */ var line = (mpl.stmt == null ? 0 : mpl.stmt.line); var column = (mpl.stmt == null ? 0 : mpl.stmt.column); error = new Error(line + ": " + msg); error["line"] = line; error["column"] = column; break; default: xassert(mpl != mpl); } mpl.phase = 4; throw error; } function mpl_internal_warning(mpl, msg){ switch (mpl.phase) { case 1: case 2: /* translation phase */ xprintf(mpl.in_file + ":" + mpl.line + ": warning: " + msg); break; case 3: /* generation/postsolve phase */ xprintf(mpl.mod_file + ":" + (mpl.stmt == null ? 0 : mpl.stmt.line) + ": warning: " + msg); break; default: xassert(mpl != mpl); } } var mpl_initialize = exports["mpl_initialize"] = function(){ var mpl = {}; /* scanning segment */ mpl.line = 0; mpl.column = 0; mpl.c = 0; mpl.token = 0; mpl.imlen = 0; mpl.image = ''; mpl.value = 0.0; mpl.b_token = 0; mpl.b_imlen = 0; mpl.b_image = ''; mpl.b_value = 0.0; mpl.f_dots = 0; mpl.f_scan = 0; mpl.f_token = 0; mpl.f_imlen = 0; mpl.f_image = ''; mpl.f_value = 0.0; mpl.context = new Array(CONTEXT_SIZE); xfillArr(mpl.context, 0, ' ', CONTEXT_SIZE); mpl.c_ptr = 0; mpl.flag_d = 0; /* translating segment */ //mpl.pool = dmp_create_poolx(0); mpl.tree = {}; mpl.model = null; mpl.flag_x = 0; mpl.as_within = 0; mpl.as_in = 0; mpl.as_binary = 0; mpl.flag_s = 0; /* common segment mpl.strings = {}; mpl.symbols = {}; mpl.tuples = {}; mpl.arrays = {}; mpl.members = {}; mpl.elemvars = {}; mpl.formulae = {}; mpl.elemcons = {};*/ mpl.a_list = null; mpl.sym_buf = ''; mpl.tup_buf = ''; /* generating/postsolving segment */ mpl.rand = rng_create_rand(); mpl.flag_p = 0; mpl.stmt = null; mpl.dca = null; mpl.m = 0; mpl.n = 0; mpl.row = null; mpl.col = null; /* input/output segment */ mpl.in_fp = null; mpl.in_file = null; mpl.out_fp = null; mpl.out_file = null; mpl.prt_fp = null; mpl.prt_file = null; /* solver interface segment */ mpl.phase = 0; mpl.mod_file = null; mpl.mpl_buf = ''; return mpl; }; var mpl_read_model = exports["mpl_read_model"] = function(mpl, name, callback, skip_data){ function skip(){ xprintf(mpl.line + " line" + (mpl.line == 1 ? "" : "s") + " were read"); mpl_internal_close_input(mpl); /* return to the calling program */ return mpl.phase; } if (mpl.phase != 0) xerror("mpl_read_model: invalid call sequence"); if (callback == null) xerror("mpl_read_model: no input specified"); /* translate model section */ mpl.phase = 1; xprintf("Reading model section from " + name + " ..."); mpl_internal_open_input(mpl, name, callback); mpl_internal_model_section(mpl); if (mpl.model == null) mpl_internal_error(mpl, "empty model section not allowed"); /* save name of the input text file containing model section for error diagnostics during the generation phase */ mpl.mod_file = mpl.in_file; /* allocate content arrays for all model objects */ mpl_internal_alloc_content(mpl); /* optional data section may begin with the keyword 'data' */ if (mpl_internal_is_keyword(mpl, "data")) { if (skip_data) { mpl_internal_warning(mpl, "data section ignored"); return skip(); } mpl.flag_d = 1; mpl_internal_get_token(mpl /* data */); if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "semicolon missing where expected"); mpl_internal_get_token(mpl /* ; */); /* translate data section */ mpl.phase = 2; xprintf("Reading data section from " + name + " ..."); mpl_internal_data_section(mpl); } /* process end statement */ mpl_internal_end_statement(mpl); return skip(); }; var mpl_read_data = exports["mpl_read_data"] = function(mpl, name, callback){ if (!(mpl.phase == 1 || mpl.phase == 2)) xerror("mpl_read_data: invalid call sequence"); if (callback == null) xerror("mpl_read_data: no input specified"); /* process data section */ mpl.phase = 2; xprintf("Reading data section from " + name + " ..."); mpl.flag_d = 1; mpl_internal_open_input(mpl, name, callback); /* in this case the keyword 'data' is optional */ if (mpl_internal_is_literal(mpl, "data")) { mpl_internal_get_token(mpl /* data */); if (mpl.token != T_SEMICOLON) mpl_internal_error(mpl, "semicolon missing where expected"); mpl_internal_get_token(mpl /* ; */); } mpl_internal_data_section(mpl); /* process end statement */ mpl_internal_end_statement(mpl); xprintf(mpl.line + " line" + (mpl.line == 1 ? "" : "s") + " were read"); mpl_internal_close_input(mpl); /* return to the calling program */ return mpl.phase; }; var mpl_generate = exports["mpl_generate"] = function(mpl, name, callback, tablecb){ if (!(mpl.phase == 1 || mpl.phase == 2)) xerror("mpl_generate: invalid call sequence"); /* generate model */ mpl.phase = 3; mpl.tablecb = tablecb; mpl_internal_open_output(mpl, name, callback); mpl_internal_generate_model(mpl); mpl_internal_flush_output(mpl); /* build problem instance */ mpl_internal_build_problem(mpl); /* generation phase has been finished */ xprintf("Model has been successfully generated"); /* return to the calling program */ return mpl.phase; }; var mpl_get_prob_name = exports["mpl_get_prob_name"] = function(mpl){ return mpl.mod_file; }; var mpl_get_num_rows = exports["mpl_get_num_rows"] = function(mpl){ if (mpl.phase != 3) xerror("mpl_get_num_rows: invalid call sequence"); return mpl.m; }; var mpl_get_num_cols = exports["mpl_get_num_cols"] = function(mpl){ if (mpl.phase != 3) xerror("mpl_get_num_cols: invalid call sequence"); return mpl.n; }; var mpl_get_row_name = exports["mpl_get_row_name"] = function(mpl, i){ if (mpl.phase != 3) xerror("mpl_get_row_name: invalid call sequence"); if (!(1 <= i && i <= mpl.m)) xerror("mpl_get_row_name: i = " + i + "; row number out of range"); var name = mpl.row[i].con.name; var len = name.length; xassert(len <= 255); name += mpl_internal_format_tuple(mpl, '[', mpl.row[i].memb.tuple).slice(0, 255); if (name.length == 255) name = name.slice(0,252) + '...'; xassert(name.length <= 255); return name; }; var mpl_get_row_kind = exports["mpl_get_row_kind"] = function(mpl, i){ var kind; if (mpl.phase != 3) xerror("mpl_get_row_kind: invalid call sequence"); if (!(1 <= i && i <= mpl.m)) xerror("mpl_get_row_kind: i = " + i + "; row number out of range"); switch (mpl.row[i].con.type) { case A_CONSTRAINT: kind = MPL_ST; break; case A_MINIMIZE: kind = MPL_MIN; break; case A_MAXIMIZE: kind = MPL_MAX; break; default: xassert(mpl != mpl); } return kind; }; var mpl_get_row_bnds = exports["mpl_get_row_bnds"] = function(mpl, i, callback){ var con; var type; var lb, ub; if (mpl.phase != 3) xerror("mpl_get_row_bnds: invalid call sequence"); if (!(1 <= i && i <= mpl.m)) xerror("mpl_get_row_bnds: i = " + i + "; row number out of range"); con = mpl.row[i]; lb = (con.con.lbnd == null ? -DBL_MAX : con.lbnd); ub = (con.con.ubnd == null ? +DBL_MAX : con.ubnd); if (lb == -DBL_MAX && ub == +DBL_MAX){ type = MPL_FR; lb = ub = 0.0; } else if (ub == +DBL_MAX){ type = MPL_LO; ub = 0.0; } else if (lb == -DBL_MAX){ type = MPL_UP; lb = 0.0; } else if (con.con.lbnd != con.con.ubnd) type = MPL_DB; else type = MPL_FX; callback(lb, ub); return type; }; var mpl_get_mat_row = exports["mpl_get_mat_row"] = function(mpl, i, ndx, val){ var term; var len = 0; if (mpl.phase != 3) xerror("mpl_get_mat_row: invalid call sequence"); if (!(1 <= i && i <= mpl.m)) xerror("mpl_get_mat_row: i = " + i + "; row number out of range"); for (term = mpl.row[i].form; term != null; term = term.next) { xassert(term.var_ != null); len++; xassert(len <= mpl.n); if (ndx != null) ndx[len] = term.var_.j; if (val != null) val[len] = term.coef; } return len; }; var mpl_get_row_c0 = exports["mpl_get_row_c0"] = function(mpl, i){ var con; var c0; if (mpl.phase != 3) xerror("mpl_get_row_c0: invalid call sequence"); if (!(1 <= i && i <= mpl.m)) xerror("mpl_get_row_c0: i = " + i + "; row number out of range"); con = mpl.row[i]; if (con.con.lbnd == null && con.con.ubnd == null) c0 = - con.lbnd; else c0 = 0.0; return c0; }; var mpl_get_col_name = exports["mpl_get_col_name"] = function(mpl, j){ if (mpl.phase != 3) xerror("mpl_get_col_name: invalid call sequence"); if (!(1 <= j && j <= mpl.n)) xerror("mpl_get_col_name: j = " + j + "; column number out of range"); var name = mpl.col[j].var_.name; var len = name.length; xassert(len <= 255); name += mpl_internal_format_tuple(mpl, '[', mpl.col[j].memb.tuple); if (name.length == 255) name = name.slice(0,252) + '...'; xassert(name.length <= 255); return name; }; var mpl_get_col_kind = exports["mpl_get_col_kind"] = function(mpl, j){ var kind; if (mpl.phase != 3) xerror("mpl_get_col_kind: invalid call sequence"); if (!(1 <= j && j <= mpl.n)) xerror("mpl_get_col_kind: j = " + j + "; column number out of range"); switch (mpl.col[j].var_.type) { case A_NUMERIC: kind = MPL_NUM; break; case A_INTEGER: kind = MPL_INT; break; case A_BINARY: kind = MPL_BIN; break; default: xassert(mpl != mpl); } return kind; }; var mpl_get_col_bnds = exports["mpl_get_col_bnds"] = function(mpl, j, callback){ var var_; var type; var lb, ub; if (mpl.phase != 3) xerror("mpl_get_col_bnds: invalid call sequence"); if (!(1 <= j && j <= mpl.n)) xerror("mpl_get_col_bnds: j = " + j + "; column number out of range"); var_ = mpl.col[j]; lb = (var_.var_.lbnd == null ? -DBL_MAX : var_.lbnd); ub = (var_.var_.ubnd == null ? +DBL_MAX : var_.ubnd); if (lb == -DBL_MAX && ub == +DBL_MAX){ type = MPL_FR; lb = ub = 0.0; } else if (ub == +DBL_MAX){ type = MPL_LO; ub = 0.0; } else if (lb == -DBL_MAX){ type = MPL_UP; lb = 0.0; } else if (var_.var_.lbnd != var_.var_.ubnd) type = MPL_DB; else type = MPL_FX; callback(lb, ub); return type; }; var mpl_has_solve_stmt = exports["mpl_has_solve_stmt"] = function(mpl){ if (mpl.phase != 3) xerror("mpl_has_solve_stmt: invalid call sequence"); return mpl.flag_s; }; var mpl_put_row_soln = exports["mpl_put_row_soln"] = function(mpl, i, stat, prim, dual){ /* store row (constraint/objective) solution components */ xassert(mpl.phase == 3); xassert(1 <= i && i <= mpl.m); mpl.row[i].stat = stat; mpl.row[i].prim = prim; mpl.row[i].dual = dual; }; var mpl_put_col_soln = exports["mpl_put_col_soln"] = function (mpl, j, stat, prim, dual){ /* store column (variable) solution components */ xassert(mpl.phase == 3); xassert(1 <= j && j <= mpl.n); mpl.col[j].stat = stat; mpl.col[j].prim = prim; mpl.col[j].dual = dual; }; var mpl_postsolve = exports["mpl_postsolve"] = function(mpl){ if (!(mpl.phase == 3 && !mpl.flag_p)) xerror("mpl_postsolve: invalid call sequence"); /* perform postsolving */ mpl_internal_postsolve_model(mpl); mpl_internal_flush_output(mpl); /* postsolving phase has been finished */ xprintf("Model has been successfully processed"); /* return to the calling program */ return mpl.phase; }; /* glpmpl05.c */ function mpl_internal_fn_gmtime(mpl){ /* obtain the current calendar time (UTC) */ return Math.round(Date.now() / 1000); } var mpl_internal_week = ["Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"]; var mpl_internal_moon = ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"]; function mpl_internal_mulstr(v, n){ var ret = ''; while (n > 0) { ret += v; n--; } return ret; } function mpl_internal_error1(mpl, str, s, fmt, f, msg){ xprintf("Input string passed to str2time:"); xprintf(str); xprintf(mpl_internal_mulstr('^', s + 1)); xprintf("Format string passed to str2time:\n"); xprintf(fmt); xprintf(mpl_internal_mulstr('^', f + 1)); mpl_internal_error(mpl, msg); } function mpl_internal_fn_str2time(mpl, str, fmt){ /* convert character string to the calendar time */ var j, year, month, day, hh, mm, ss, zone; var s, f; function err1(){mpl_internal_error1(mpl, str, s, fmt, f, "time zone offset value incomplete or invalid")} function err2(){mpl_internal_error1(mpl, str, s, fmt, f, "time zone offset value out of range")} function test(){ /* check a matching character in the input string */ if (str[s] != fmt[f]) mpl_internal_error1(mpl, str, s, fmt, f, "character mismatch"); s++; } year = month = day = hh = mm = ss = -1; zone = INT_MAX; s = 0; for (f = 0; f < fmt.length; f++) { if (fmt[f] == '%') { f++; if (fmt[f] == 'b' || fmt[f] == 'h') { /* the abbreviated month name */ var k; var name; if (month >= 0) mpl_internal_error1(mpl, str, s, fmt, f, "month multiply specified"); while (str[s] == ' ') s++; for (month = 1; month <= 12; month++) { name = mpl_internal_moon[month-1]; var b = false; for (k = 0; k <= 2; k++) { if (s[k].toUpperCase() != name[k].toUpperCase()) {b = true; break} } if (b) continue; s += 3; for (k = 3; name[k] != '\0'; k++) { if (str[s].toUpperCase() != name[k].toUpperCase()) break; s++; } break; } if (month > 12) mpl_internal_error1(mpl, str, s, fmt, f, "abbreviated month name missing or invalid"); } else if (fmt[f] == 'd') { /* the day of the month as a decimal number (01..31) */ if (day >= 0) mpl_internal_error1(mpl, str, s, fmt, f, "day multiply specified"); while (str[s] == ' ') s++; if (!('0' <= str[s] && str[s] <= '9')) mpl_internal_error1(mpl, str, s, fmt, f, "day missing or invalid"); day = (str[s++]) - '0'; if ('0' <= str[s] && str[s] <= '9') day = 10 * day + ((str[s++]) - '0'); if (!(1 <= day && day <= 31)) mpl_internal_error1(mpl, str, s, fmt, f, "day out of range"); } else if (fmt[f] == 'H') { /* the hour as a decimal number, using a 24-hour clock (00..23) */ if (hh >= 0) mpl_internal_error1(mpl, str, s, fmt, f, "hour multiply specified") ; while (str[s] == ' ') s++; if (!('0' <= str[s] && str[s] <= '9')) mpl_internal_error1(mpl, str, s, fmt, f, "hour missing or invalid") ; hh = (str[s++]) - '0'; if ('0' <= str[s] && str[s] <= '9') hh = 10 * hh + ((str[s++]) - '0'); if (!(0 <= hh && hh <= 23)) mpl_internal_error1(mpl, str, s, fmt, f, "hour out of range"); } else if (fmt[f] == 'm') { /* the month as a decimal number (01..12) */ if (month >= 0) mpl_internal_error1(mpl, str, s, fmt, f, "month multiply specified" ); while (str[s] == ' ') s++; if (!('0' <= str[s] && str[s] <= '9')) mpl_internal_error1(mpl, str, s, fmt, f, "month missing or invalid" ); month = (str[s++]) - '0'; if ('0' <= str[s] && str[s] <= '9') month = 10 * month + ((str[s++]) - '0'); if (!(1 <= month && month <= 12)) mpl_internal_error1(mpl, str, s, fmt, f, "month out of range"); } else if (fmt[f] == 'M') { /* the minute as a decimal number (00..59) */ if (mm >= 0) mpl_internal_error1(mpl, str, s, fmt, f, "minute multiply specified"); while (str[s] == ' ') s++; if (!('0' <= str[s] && str[s] <= '9')) mpl_internal_error1(mpl, str, s, fmt, f, "minute missing or invalid"); mm = (str[s++]) - '0'; if ('0' <= str[s] && str[s] <= '9') mm = 10 * mm + ((str[s++]) - '0'); if (!(0 <= mm && mm <= 59)) mpl_internal_error1(mpl, str, s, fmt, f, "minute out of range"); } else if (fmt[f] == 'S') { /* the second as a decimal number (00..60) */ if (ss >= 0) mpl_internal_error1(mpl, str, s, fmt, f, "second multiply specified"); while (str[s] == ' ') s++; if (!('0' <= str[s] && str[s] <= '9')) mpl_internal_error1(mpl, str, s, fmt, f, "second missing or invalid"); ss = (str[s++]) - '0'; if ('0' <= str[s] && str[s] <= '9') ss = 10 * ss + ((str[s++]) - '0'); if (!(0 <= ss && ss <= 60)) mpl_internal_error1(mpl, str, s, fmt, f, "second out of range"); } else if (fmt[f] == 'y') { /* the year without a century as a decimal number (00..99); the values 00 to 68 mean the years 2000 to 2068 while the values 69 to 99 mean the years 1969 to 1999 */ if (year >= 0) mpl_internal_error1(mpl, str, s, fmt, f, "year multiply specified") ; while (str[s] == ' ') s++; if (!('0' <= str[s] && str[s] <= '9')) mpl_internal_error1(mpl, str, s, fmt, f, "year missing or invalid") ; year = (str[s++]) - '0'; if ('0' <= str[s] && str[s] <= '9') year = 10 * year + ((str[s++]) - '0'); year += (year >= 69 ? 1900 : 2000); } else if (fmt[f] == 'Y') { /* the year as a decimal number, using the Gregorian calendar */ if (year >= 0) mpl_internal_error1(mpl, str, s, fmt, f, "year multiply specified") ; while (str[s] == ' ') s++; if (!('0' <= str[s] && str[s] <= '9')) mpl_internal_error1(mpl, str, s, fmt, f, "year missing or invalid") ; year = 0; for (j = 1; j <= 4; j++) { if (!('0' <= str[s] && str[s] <= '9')) break; year = 10 * year + ((str[s++]) - '0'); } if (!(1 <= year && year <= 4000)) mpl_internal_error1(mpl, str, s, fmt, f, "year out of range"); } else if (fmt[f] == 'z') { /* time zone offset in the form zhhmm */ var z; if (zone != INT_MAX) mpl_internal_error1(mpl, str, s, fmt, f, "time zone offset multiply specified"); while (str[s] == ' ') s++; if (str[s] == 'Z') { z = hh = mm = 0; s++; } else { if (str[s] == '+'){ z = +1; s++; } else if (str[s] == '-'){ z = -1; s++; } else mpl_internal_error1(mpl, str, s, fmt, f, "time zone offset sign missing"); hh = 0; for (j = 1; j <= 2; j++) { if (!('0' <= str[s] && str[s] <= '9')) err1(); hh = 10 * hh + ((str[s++]) - '0'); } if (hh > 23) err2(); if (str[s] == ':') { s++; if (!('0' <= str[s] && str[s] <= '9')) err1(); } mm = 0; if (('0' <= str[s] && str[s] <= '9')){ for (j = 1; j <= 2; j++) { if (!('0' <= str[s] && str[s] <= '9')) err1(); mm = 10 * mm + ((str[s++]) - '0'); } if (mm > 59) err2(); } } zone = z * (60 * hh + mm); } else if (fmt[f] == '%') { /* literal % character */ test(); } else mpl_internal_error1(mpl, str, s, fmt, f, "invalid conversion specifier"); } else if (fmt[f] == ' '){ } else test() } if (year < 0) year = 1970; if (month < 0) month = 1; if (day < 0) day = 1; if (hh < 0) hh = 0; if (mm < 0) mm = 0; if (ss < 0) ss = 0; if (zone == INT_MAX) zone = 0; j = jday(day, month, year); xassert(j >= 0); return (((j - jday(1, 1, 1970)) * 24.0 + hh) * 60.0 + mm) * 60.0 + ss - 60.0 * zone; } function mpl_internal_error2(mpl, fmt, f, msg) { xprintf("Format string passed to time2str:"); xprintf(fmt); xprintf(mpl_internal_mulstr('^', f)); mpl_internal_error(mpl, msg); } function mpl_internal_weekday(j){ /* determine weekday number (1 = Mon, ..., 7 = Sun) */ return (j + jday(1, 1, 1970)) % 7 + 1; } function mpl_internal_firstday(year){ /* determine the first day of the first week for a specified year according to ISO 8601 */ var j; /* if 1 January is Monday, Tuesday, Wednesday or Thursday, it is in week 01; if 1 January is Friday, Saturday or Sunday, it is in week 52 or 53 of the previous year */ j = jday(1, 1, year) - jday(1, 1, 1970); switch (mpl_internal_weekday(j)) { case 1: /* 1 Jan is Mon */ j += 0; break; case 2: /* 1 Jan is Tue */ j -= 1; break; case 3: /* 1 Jan is Wed */ j -= 2; break; case 4: /* 1 Jan is Thu */ j -= 3; break; case 5: /* 1 Jan is Fri */ j += 3; break; case 6: /* 1 Jan is Sat */ j += 2; break; case 7: /* 1 Jan is Sun */ j += 1; break; default: xassert(j != j); } /* the first day of the week must be Monday */ xassert(mpl_internal_weekday(j) == 1); return j; } function mpl_internal_fn_time2str(mpl, t, fmt){ /* convert the calendar time to character string */ var j, year = 0, month = 0, day = 0, hh, mm, ss, len; var temp; var f; var str = '', buf; if (!(-62135596800.0 <= t && t <= 64092211199.0)) mpl_internal_error(mpl, "time2str(" + t + ",...); argument out of range"); t = Math.floor(t + 0.5); temp = Math.abs(t) / 86400.0; j = Math.floor(temp); if (t < 0.0) { if (temp == Math.floor(temp)) j = - j; else j = - (j + 1); } xassert(jdate(j + jday(1, 1, 1970), function(d,m,y){day=d;month=m;year=y}) == 0); ss = (t - 86400.0 * j)|0; xassert(0 <= ss && ss < 86400); mm = ss / 60; ss %= 60; hh = mm / 60; mm %= 60; len = 0; for (f = 0; f < fmt.length; f++) { if (fmt[f] == '%') { f++; if (fmt[f] == 'a') { /* the abbreviated weekday name */ buf = mpl_internal_week[mpl_internal_weekday(j)-1].slice(0,3); } else if (fmt[f] == 'A') { /* the full weekday name */ buf = mpl_internal_week[mpl_internal_weekday(j)-1]; } else if (fmt[f] == 'b' || fmt[f] == 'h') { /* the abbreviated month name */ buf = mpl_internal_moon[month-1].slice(0, 3); } else if (fmt[f] == 'B') { /* the full month name */ buf = mpl_internal_moon[month-1]; } else if (fmt[f] == 'C') { /* the century of the year */ buf = String(Math.floor(year / 100)); } else if (fmt[f] == 'd') { /* the day of the month as a decimal number (01..31) */ buf = String(day); } else if (fmt[f] == 'D') { /* the date using the format %m/%d/%y */ buf = month + "/" + day + "/" + (year % 100); } else if (fmt[f] == 'e') { /* the day of the month like with %d, but padded with blank (1..31) */ buf = String(day); } else if (fmt[f] == 'F') { /* the date using the format %Y-%m-%d */ sprintf(buf, year + "-" + month + "-" + day); } else if (fmt[f] == 'g') { /* the year corresponding to the ISO week number, but without the century (range 00 through 99); this has the same format and value as %y, except that if the ISO week number (see %V) belongs to the previous or next year, that year is used instead */ var iso; if (j < mpl_internal_firstday(year)) iso = year - 1; else if (j < mpl_internal_firstday(year + 1)) iso = year; else iso = year + 1; buf = String(iso % 100); } else if (fmt[f] == 'G') { /* the year corresponding to the ISO week number; this has the same format and value as %Y, excepth that if the ISO week number (see %V) belongs to the previous or next year, that year is used instead */ var iso; if (j < mpl_internal_firstday(year)) iso = year - 1; else if (j < mpl_internal_firstday(year + 1)) iso = year; else iso = year + 1; buf = String(iso); } else if (fmt[f] == 'H') { /* the hour as a decimal number, using a 24-hour clock (00..23) */ buf = String(hh); } else if (fmt[f] == 'I') { /* the hour as a decimal number, using a 12-hour clock (01..12) */ buf = String(hh == 0 ? 12 : hh <= 12 ? hh : hh - 12); } else if (fmt[f] == 'j') { /* the day of the year as a decimal number (001..366) */ buf = String(jday(day, month, year) - jday(1, 1, year) + 1); } else if (fmt[f] == 'k') { /* the hour as a decimal number, using a 24-hour clock like %H, but padded with blank (0..23) */ buf = String(hh); } else if (fmt[f] == 'l') { /* the hour as a decimal number, using a 12-hour clock like %I, but padded with blank (1..12) */ buf = String(hh == 0 ? 12 : hh <= 12 ? hh : hh - 12); } else if (fmt[f] == 'm') { /* the month as a decimal number (01..12) */ buf = String(month); } else if (fmt[f] == 'M') { /* the minute as a decimal number (00..59) */ buf = String(mm); } else if (fmt[f] == 'p') { /* either AM or PM, according to the given time value; noon is treated as PM and midnight as AM */ buf = (hh <= 11 ? "AM" : "PM"); } else if (fmt[f] == 'P') { /* either am or pm, according to the given time value; noon is treated as pm and midnight as am */ buf = (hh <= 11 ? "am" : "pm"); } else if (fmt[f] == 'r') { /* the calendar time using the format %I:%M:%S %p */ buf = (hh == 0 ? 12 : hh <= 12 ? hh : hh - 12) + ":" + mm + ":" + ss + " " + (hh <= 11 ? "AM" : "PM"); } else if (fmt[f] == 'R') { /* the hour and minute using the format %H:%M */ buf = hh + ":" + mm; } else if (fmt[f] == 'S') { /* the second as a decimal number (00..59) */ buf = String(ss); } else if (fmt[f] == 'T') { /* the time of day using the format %H:%M:%S */ buf = hh + ":" + mm + ":" + ss; } else if (fmt[f] == 'u') { /* the day of the week as a decimal number (1..7), Monday being 1 */ buf = String(mpl_internal_weekday(j)); } else if (fmt[f] == 'U') { /* the week number of the current year as a decimal number (range 00 through 53), starting with the first Sunday as the first day of the first week; days preceding the first Sunday in the year are considered to be in week 00 */ /* sun = the first Sunday of the year */ var sun = jday(1, 1, year) - jday(1, 1, 1970); sun += (7 - mpl_internal_weekday(sun)); buf = String((j + 7 - sun) / 7); } else if (fmt[f] == 'V') { /* the ISO week number as a decimal number (range 01 through 53); ISO weeks start with Monday and end with Sunday; week 01 of a year is the first week which has the majority of its days in that year; week 01 of a year can contain days from the previous year; the week before week 01 of a year is the last week (52 or 53) of the previous year even if it contains days from the new year */ var iso; if (j < mpl_internal_firstday(year)) iso = j - mpl_internal_firstday(year - 1); else if (j < mpl_internal_firstday(year + 1)) iso = j - mpl_internal_firstday(year); else iso = j - mpl_internal_firstday(year + 1); buf = String(iso / 7 + 1); } else if (fmt[f] == 'w') { /* the day of the week as a decimal number (0..6), Sunday being 0 */ buf = String(mpl_internal_weekday(j) % 7); } else if (fmt[f] == 'W') { /* the week number of the current year as a decimal number (range 00 through 53), starting with the first Monday as the first day of the first week; days preceding the first Monday in the year are considered to be in week 00 */ /* mon = the first Monday of the year */ var mon = jday(1, 1, year) - jday(1, 1, 1970); mon += (8 - mpl_internal_weekday(mon)) % 7; buf = String((j + 7 - mon) / 7); } else if (fmt[f] == 'y') { /* the year without a century as a decimal number (00..99) */ buf = String(year % 100); } else if (fmt[f] == 'Y') { /* the year as a decimal number, using the Gregorian calendar */ buf = String(year); } else if (fmt[f] == '%') { /* a literal % character */ buf = '%'; } else mpl_internal_error2(mpl, fmt, f, "invalid conversion specifier"); } else{ buf = fmt[f]; //buf[1] = '\0'; } /* if (len + buf.length > MAX_LENGTH) mpl_internal_error(mpl, "time2str; output string length exceeds " + MAX_LENGTH + " charaters"); */ str += buf; len += buf.length; } return str; } /* glpmpl06.c */ /***************************************** Driver API *****************************************/ var MPL_DRIVERS = {}; function mpl_tab_drv_open(mpl, mode){ var dca = mpl.dca; xassert(dca.id == 0); xassert(dca.link == null); xassert(dca.na >= 1); var Driver = MPL_DRIVERS[dca.arg[1].toLowerCase()]; if (Driver) dca.link = new Driver(dca, mode, mpl.tablecb); else mpl_internal_error(mpl, "Invalid table driver '" + dca.arg[1] + "'"); if (dca.link == null) mpl_internal_error(mpl, "error on opening table " + mpl.stmt.u.tab.name); } function mpl_tab_drv_read(mpl){ var dca = mpl.dca; var ret = dca.link["readRecord"](dca); if (ret > 0) mpl_internal_error(mpl, "error on reading data from table " + mpl.stmt.u.tab.name); return ret; } function mpl_tab_drv_write(mpl){ var dca = mpl.dca; var ret = dca.link["writeRecord"](dca); if (ret) mpl_internal_error(mpl, "error on writing data to table " + mpl.stmt.u.tab.name); } function mpl_tab_drv_flush(mpl){ var dca = mpl.dca; dca.link["flush"](dca); } var mpl_tab_drv_register = exports["mpl_tab_drv_register"] = function (name, driver){ MPL_DRIVERS[name.toLowerCase()] = driver; }; /***************************************** CSV Driver *****************************************/ function CSVDriver(dca, mode, tablecb){ /* open csv data file */ /* create control structure */ this.mode = mode; this.fname = null; this.count = 0; this.c = '\n'; this.what = 0; this.field = ''; this.nf = 0; this.ref = []; this.tablecb = tablecb; this.CSV_EOF = 0; /* end-of-file */ this.CSV_EOR = 1; /* end-of-record */ this.CSV_NUM = 2; /* floating-point number */ this.CSV_STR = 3; /* character string */ /* try to open the csv data file */ if (mpl_tab_num_args(dca) < 2) xerror("csv_driver: file name not specified\n"); this.fname = mpl_tab_get_arg(dca, 2); var k; if (mode == 'R') { /* open the file for reading */ if (tablecb){ this.data = tablecb(dca.arg, mode); this.cursor = 0; } else xerror("csv_driver: unable to open " + this.fname); this.nskip = 0; /* skip fake new-line */ this.readField(); xassert(this.what == this.CSV_EOR); /* read field names */ xassert(this.nf == 0); for (;;) { this.readField(); if (this.what == this.CSV_EOR) break; if (this.what != this.CSV_STR) xerror(this.fname + ":" + this.count + ": invalid field name\n"); this.nf++; /* find corresponding field in the table statement */ for (k = mpl_tab_num_flds(dca); k >= 1; k--) { if (mpl_tab_get_name(dca, k) == this.field) break; } this.ref[this.nf] = k; } /* find dummy RECNO field in the table statement */ for (k = mpl_tab_num_flds(dca); k >= 1; k--) if (mpl_tab_get_name(dca, k) == "RECNO") break; this.ref[0] = k; } else if (mode == 'W') { this.data = ''; /* write field names */ var nf = mpl_tab_num_flds(dca); for (k = 1; k <= nf; k++) this.data += mpl_tab_get_name(dca, k) + ((k < nf)?',':'\n'); this.count++; } else xassert(mode != mode); } CSVDriver.prototype.readField = function(){ /* read field from csv data file */ /* check for end of file */ if (this.c == XEOF) { this.what = this.CSV_EOF; this.field = "EOF"; return; } /* check for end of record */ if (this.c == '\n') { this.what = this.CSV_EOR; this.field = "EOR"; this.readChar(); if (this.c == ',') xerror(this.fname + ":" + this.count + ": empty field not allowed\n"); if (this.c == '\n') xerror(this.fname + ":" + this.count + ": empty record not allowed\n"); /* skip comment records; may appear only before the very first record containing field names */ if (this.c == '#' && this.count == 1) { while (this.c == '#') { while (this.c != '\n') this.readChar(); this.readChar(); this.nskip++; } } return; } /* skip comma before next field */ if (this.c == ',') this.readChar(); /* read field */ if (this.c == '\'' || this.c == '"') { /* read a field enclosed in quotes */ var quote = this.c; this.field = ''; this.what = this.CSV_STR; /* skip opening quote */ this.readChar(); /* read field characters within quotes */ for (;;) { /* check for closing quote and read it */ if (this.c == quote) { this.readChar(); if (this.c == quote){ } else if (this.c == ',' || this.c == '\n') break; else xerror(this.fname + ":" + this.count + ": invalid field"); } /* add the current character to the field */ this.field += this.c; /* read the next character */ this.readChar(); } /* the field has been read */ if (this.field.length == 0) xerror(this.fname + ":" + this.count + ": empty field not allowed"); } else { /* read a field not enclosed in quotes */ this.field = ''; var temp; this.what = this.CSV_NUM; while (!(this.c == ',' || this.c == '\n')) { /* quotes within the field are not allowed */ if (this.c == '\'' || this.c == '"') xerror(this.fname + ":" + this.count + ": invalid use of single or double quote within field"); /* add the current character to the field */ this.field += this.c; /* read the next character */ this.readChar(); } /* the field has been read */ if (this.field.length == 0) xerror(this.fname + ":" + this.count + ": empty field not allowed"); /* check the field type */ if (str2num(this.field, function(v){temp=v})) this.what = this.CSV_STR; } }; CSVDriver.prototype.readChar = function (){ /* read character from csv data file */ var c; xassert(this.c != XEOF); if (this.c == '\n') this.count++; while (true){ if (this.cursor < this.data.length) c = this.data[this.cursor++]; else c = XEOF; if (c == '\r') continue; else if (c == '\n'){ } else if (iscntrl(c)) { xerror(this.fname +":" + this.count +": invalid control character " + c); } break; } this.c = c; }; CSVDriver.prototype["readRecord"] = function(dca){ /* read next record from csv data file */ var k, ret = 0; xassert(this.mode == 'R'); /* read dummy RECNO field */ if (this.ref[0] > 0) mpl_tab_set_num(dca, this.ref[0], this.count-this.nskip-1); /* read fields */ for (k = 1; k <= this.nf; k++) { this.readField(); if (this.what == this.CSV_EOF) { /* end-of-file reached */ xassert(k == 1); return XEOF; } else if (this.what == this.CSV_EOR) { /* end-of-record reached */ var lack = this.nf - k + 1; if (lack == 1) xerror(this.fname + ":" + this.count + ": one field missing"); else xerror(this.fname + ":" + this.count + ": " + lack + " fields missing"); } else if (this.what == this.CSV_NUM) { /* floating-point number */ if (this.ref[k] > 0) { var num = 0; xassert(str2num(this.field, function(v){num=v}) == 0); mpl_tab_set_num(dca, this.ref[k], num); } } else if (this.what == this.CSV_STR) { /* character string */ if (this.ref[k] > 0) mpl_tab_set_str(dca, this.ref[k], this.field); } else xassert(this != this); } /* now there must be NL */ this.readField(); xassert(this.what != this.CSV_EOF); if (this.what != this.CSV_EOR) xerror(this.fname + ":" + this.count + ": too many fields"); return ret; }; CSVDriver.prototype["writeRecord"] = function(dca){ /* write next record to csv data file */ var k, nf, ret = 0; var c, n; xassert(this.mode == 'W'); nf = mpl_tab_num_flds(dca); for (k = 1; k <= nf; k++) { switch (mpl_tab_get_type(dca, k)) { case 'N': this.data += mpl_tab_get_num(dca, k); break; case 'S': this.data += '"'; for (c = mpl_tab_get_str(dca, k), n = 0; c.length > n; n++){ if (c[n] == '"') this.data += '""'; else this.data += c[n]; } this.data += '"'; break; default: xassert(dca != dca); } this.data += (k < nf)?',':'\n'; } this.count++; return ret; }; CSVDriver.prototype["flush"] = function(dca){ this.tablecb(dca.arg, this.mode, this.data); }; mpl_tab_drv_register("CSV", CSVDriver); /***************************************** JSON Driver *****************************************/ function JSONDriver(dca, mode, tablecb){ this.mode = mode; this.fname = null; if (mpl_tab_num_args(dca) < 2) xerror("json driver: file name not specified"); this.fname = mpl_tab_get_arg(dca, 2); var k; if (mode == 'R') { this.ref = {}; if (tablecb){ this.data = tablecb(dca.arg, mode); if (typeof this.data == 'string') this.data = JSON.parse(this.data); this.cursor = 1; } else xerror("json driver: unable to open " + this.fname); for (var i = 0, meta = this.data[0]; i < meta.length; i++) this.ref[meta[i]] = i; } else if (mode == 'W') { this.tablecb = tablecb; var names = []; this.data = [names]; var nf = mpl_tab_num_flds(dca); for (k = 1; k <= nf; k++) names.push(mpl_tab_get_name(dca, k)); } else xassert(mode != mode); } JSONDriver.prototype["writeRecord"] = function(dca){ var k; xassert(this.mode == 'W'); var nf = mpl_tab_num_flds(dca); var line = []; for (k = 1; k <= nf; k++){ switch (mpl_tab_get_type(dca, k)){ case 'N': line.push(mpl_tab_get_num(dca, k)); break; case 'S': line.push(mpl_tab_get_str(dca, k)); break; default: xassert(dca != dca); } } this.data.push(line); return 0; }; JSONDriver.prototype["readRecord"] = function(dca){ /* read next record from csv data file */ var ret = 0; xassert(this.mode == 'R'); /* read fields */ var line = this.data[this.cursor++]; if (line == null) return XEOF; for (var k = 1; k <= mpl_tab_num_flds(dca); k++){ var index = this.ref[mpl_tab_get_name(dca, k)]; if (index != null){ var value = line[index]; switch (typeof value){ case 'number': mpl_tab_set_num(dca, k, value); break; case 'boolean': mpl_tab_set_num(dca, k, Number(value)); break; case 'string': mpl_tab_set_str(dca, k, value); break; default: xerror('Unexpected data type ' + value + " in " + this.fname); } } } return 0; }; JSONDriver.prototype["flush"] = function(dca){ this.tablecb(dca.arg, this.mode, this.data); }; mpl_tab_drv_register("JSON", JSONDriver);function npp_error(){ } function npp_create_wksp(){ /* create LP/MIP preprocessor workspace */ var npp = {}; npp.orig_dir = 0; npp.orig_m = npp.orig_n = npp.orig_nnz = 0; npp.name = npp.obj = null; npp.c0 = 0.0; npp.nrows = npp.ncols = 0; npp.r_head = npp.r_tail = null; npp.c_head = npp.c_tail = null; npp.top = null; npp.m = npp.n = npp.nnz = 0; npp.row_ref = npp.col_ref = null; npp.sol = npp.scaling = 0; npp.p_stat = npp.d_stat = npp.t_stat = npp.i_stat = 0; npp.r_stat = null; /*npp.r_prim =*/ npp.r_pi = null; npp.c_stat = null; npp.c_value = /*npp.c_dual =*/ null; return npp; } function npp_insert_row(npp, row, where){ /* insert row to the row list */ if (where == 0) { /* insert row to the beginning of the row list */ row.prev = null; row.next = npp.r_head; if (row.next == null) npp.r_tail = row; else row.next.prev = row; npp.r_head = row; } else { /* insert row to the end of the row list */ row.prev = npp.r_tail; row.next = null; if (row.prev == null) npp.r_head = row; else row.prev.next = row; npp.r_tail = row; } } function npp_remove_row(npp, row){ /* remove row from the row list */ if (row.prev == null) npp.r_head = row.next; else row.prev.next = row.next; if (row.next == null) npp.r_tail = row.prev; else row.next.prev = row.prev; } function npp_activate_row(npp, row){ /* make row active */ if (!row.temp) { row.temp = 1; /* move the row to the beginning of the row list */ npp_remove_row(npp, row); npp_insert_row(npp, row, 0); } } function npp_deactivate_row(npp, row){ /* make row inactive */ if (row.temp) { row.temp = 0; /* move the row to the end of the row list */ npp_remove_row(npp, row); npp_insert_row(npp, row, 1); } } function npp_insert_col(npp, col, where){ /* insert column to the column list */ if (where == 0) { /* insert column to the beginning of the column list */ col.prev = null; col.next = npp.c_head; if (col.next == null) npp.c_tail = col; else col.next.prev = col; npp.c_head = col; } else { /* insert column to the end of the column list */ col.prev = npp.c_tail; col.next = null; if (col.prev == null) npp.c_head = col; else col.prev.next = col; npp.c_tail = col; } } function npp_remove_col(npp, col){ /* remove column from the column list */ if (col.prev == null) npp.c_head = col.next; else col.prev.next = col.next; if (col.next == null) npp.c_tail = col.prev; else col.next.prev = col.prev; } function npp_activate_col(npp, col){ /* make column active */ if (!col.temp) { col.temp = 1; /* move the column to the beginning of the column list */ npp_remove_col(npp, col); npp_insert_col(npp, col, 0); } } function npp_deactivate_col(npp, col){ /* make column inactive */ if (col.temp) { col.temp = 0; /* move the column to the end of the column list */ npp_remove_col(npp, col); npp_insert_col(npp, col, 1); } } function npp_add_row(npp){ /* add new row to the current problem */ var row = {}; row.i = ++(npp.nrows); row.name = null; row.lb = -DBL_MAX; row.ub = +DBL_MAX; row.ptr = null; row.temp = 0; npp_insert_row(npp, row, 1); return row; } function npp_add_col(npp){ /* add new column to the current problem */ var col = {}; col.j = ++(npp.ncols); col.name = null; col.is_int = 0; col.lb = col.ub = col.coef = 0.0; col.ptr = null; col.temp = 0; col.ll = {}; col.uu = {}; npp_insert_col(npp, col, 1); return col; } function npp_add_aij(row, col, val){ /* add new element to the constraint matrix */ var aij = {}; aij.row = row; aij.col = col; aij.val = val; aij.r_prev = null; aij.r_next = row.ptr; aij.c_prev = null; aij.c_next = col.ptr; if (aij.r_next != null) aij.r_next.r_prev = aij; if (aij.c_next != null) aij.c_next.c_prev = aij; row.ptr = col.ptr = aij; return aij; } function npp_row_nnz(row){ /* count number of non-zero coefficients in row */ var nnz = 0; for (var aij = row.ptr; aij != null; aij = aij.r_next) nnz++; return nnz; } function npp_col_nnz(col){ /* count number of non-zero coefficients in column */ var nnz = 0; for (var aij = col.ptr; aij != null; aij = aij.c_next) nnz++; return nnz; } function npp_push_tse(npp, func){ /* push new entry to the transformation stack */ var tse; tse = {}; tse.func = func; tse.info = {}; tse.link = npp.top; npp.top = tse; return tse.info; } function npp_erase_row(row){ /* erase row content to make it empty */ var aij; while (row.ptr != null) { aij = row.ptr; row.ptr = aij.r_next; if (aij.c_prev == null) aij.col.ptr = aij.c_next; else aij.c_prev.c_next = aij.c_next; if (aij.c_next != null) aij.c_next.c_prev = aij.c_prev; } } function npp_del_row(npp, row){ /* remove row from the current problem */ npp_erase_row(row); npp_remove_row(npp, row); } function npp_del_col(npp, col){ /* remove column from the current problem */ var aij; while (col.ptr != null) { aij = col.ptr; col.ptr = aij.c_next; if (aij.r_prev == null) aij.row.ptr = aij.r_next; else aij.r_prev.r_next = aij.r_next; if (aij.r_next != null) aij.r_next.r_prev = aij.r_prev; } npp_remove_col(npp, col); } function npp_del_aij(aij){ /* remove element from the constraint matrix */ if (aij.r_prev == null) aij.row.ptr = aij.r_next; else aij.r_prev.r_next = aij.r_next; if (aij.r_next != null) aij.r_next.r_prev = aij.r_prev; if (aij.c_prev == null) aij.col.ptr = aij.c_next; else aij.c_prev.c_next = aij.c_next; if (aij.c_next != null) aij.c_next.c_prev = aij.c_prev; } function npp_load_prob(npp, orig, names, sol, scaling){ /* load original problem into the preprocessor workspace */ var m = orig.m; var n = orig.n; var link; var i, j; var dir; xassert(names == GLP_OFF || names == GLP_ON); xassert(sol == GLP_SOL || sol == GLP_IPT || sol == GLP_MIP); xassert(scaling == GLP_OFF || scaling == GLP_ON); if (sol == GLP_MIP) xassert(!scaling); npp.orig_dir = orig.dir; if (npp.orig_dir == GLP_MIN) dir = +1.0; else if (npp.orig_dir == GLP_MAX) dir = -1.0; else xassert(npp != npp); npp.orig_m = m; npp.orig_n = n; npp.orig_nnz = orig.nnz; if (names && orig.name != null) npp.name = orig.name; if (names && orig.obj != null) npp.obj = orig.obj; npp.c0 = dir * orig.c0; /* load rows */ link = new Array(1+m); for (i = 1; i <= m; i++) { var rrr = orig.row[i]; var row; link[i] = row = npp_add_row(npp); xassert(row.i == i); if (names && rrr.name != null) row.name = rrr.name; if (!scaling) { if (rrr.type == GLP_FR){ row.lb = -DBL_MAX; row.ub = +DBL_MAX; } else if (rrr.type == GLP_LO){ row.lb = rrr.lb; row.ub = +DBL_MAX; } else if (rrr.type == GLP_UP){ row.lb = -DBL_MAX; row.ub = rrr.ub; } else if (rrr.type == GLP_DB){ row.lb = rrr.lb; row.ub = rrr.ub; } else if (rrr.type == GLP_FX) row.lb = row.ub = rrr.lb; else xassert(rrr != rrr); } else { var rii = rrr.rii; if (rrr.type == GLP_FR){ row.lb = -DBL_MAX; row.ub = +DBL_MAX; } else if (rrr.type == GLP_LO){ row.lb = rrr.lb * rii; row.ub = +DBL_MAX; } else if (rrr.type == GLP_UP){ row.lb = -DBL_MAX; row.ub = rrr.ub * rii; } else if (rrr.type == GLP_DB){ row.lb = rrr.lb * rii; row.ub = rrr.ub * rii; } else if (rrr.type == GLP_FX) row.lb = row.ub = rrr.lb * rii; else xassert(rrr != rrr); } } /* load columns and constraint coefficients */ for (j = 1; j <= n; j++) { var ccc = orig.col[j]; var aaa; var col; col = npp_add_col(npp); xassert(col.j == j); if (names && ccc.name != null) col.name = ccc.name; if (sol == GLP_MIP) col.is_int = Number(ccc.kind == GLP_IV); if (!scaling){ if (ccc.type == GLP_FR){ col.lb = -DBL_MAX; col.ub = +DBL_MAX; } else if (ccc.type == GLP_LO){ col.lb = ccc.lb; col.ub = +DBL_MAX; } else if (ccc.type == GLP_UP){ col.lb = -DBL_MAX; col.ub = ccc.ub; } else if (ccc.type == GLP_DB){ col.lb = ccc.lb; col.ub = ccc.ub; } else if (ccc.type == GLP_FX) col.lb = col.ub = ccc.lb; else xassert(ccc != ccc); col.coef = dir * ccc.coef; for (aaa = ccc.ptr; aaa != null; aaa = aaa.c_next) npp_add_aij(link[aaa.row.i], col, aaa.val); } else { var sjj = ccc.sjj; if (ccc.type == GLP_FR){ col.lb = -DBL_MAX; col.ub = +DBL_MAX; } else if (ccc.type == GLP_LO){ col.lb = ccc.lb / sjj; col.ub = +DBL_MAX; } else if (ccc.type == GLP_UP){ col.lb = -DBL_MAX; col.ub = ccc.ub / sjj; } else if (ccc.type == GLP_DB){ col.lb = ccc.lb / sjj; col.ub = ccc.ub / sjj; } else if (ccc.type == GLP_FX) col.lb = col.ub = ccc.lb / sjj; else xassert(ccc != ccc); col.coef = dir * ccc.coef * sjj; for (aaa = ccc.ptr; aaa != null; aaa = aaa.c_next) npp_add_aij(link[aaa.row.i], col, aaa.row.rii * aaa.val * sjj); } } /* keep solution indicator and scaling option */ npp.sol = sol; npp.scaling = scaling; } function npp_build_prob(npp, prob){ /* build resultant (preprocessed) problem */ var row; var col; var aij; var i, j, type, len, ind; var dir, val; glp_erase_prob(prob); glp_set_prob_name(prob, npp.name); glp_set_obj_name(prob, npp.obj); glp_set_obj_dir(prob, npp.orig_dir); if (npp.orig_dir == GLP_MIN) dir = +1.0; else if (npp.orig_dir == GLP_MAX) dir = -1.0; else xassert(npp != npp); glp_set_obj_coef(prob, 0, dir * npp.c0); /* build rows */ for (row = npp.r_head; row != null; row = row.next) { row.temp = i = glp_add_rows(prob, 1); glp_set_row_name(prob, i, row.name); if (row.lb == -DBL_MAX && row.ub == +DBL_MAX) type = GLP_FR; else if (row.ub == +DBL_MAX) type = GLP_LO; else if (row.lb == -DBL_MAX) type = GLP_UP; else if (row.lb != row.ub) type = GLP_DB; else type = GLP_FX; glp_set_row_bnds(prob, i, type, row.lb, row.ub); } /* build columns and the constraint matrix */ ind = new Int32Array(1+prob.m); val = new Float64Array(1+prob.m); for (col = npp.c_head; col != null; col = col.next) { j = glp_add_cols(prob, 1); glp_set_col_name(prob, j, col.name); glp_set_col_kind(prob, j, col.is_int ? GLP_IV : GLP_CV); if (col.lb == -DBL_MAX && col.ub == +DBL_MAX) type = GLP_FR; else if (col.ub == +DBL_MAX) type = GLP_LO; else if (col.lb == -DBL_MAX) type = GLP_UP; else if (col.lb != col.ub) type = GLP_DB; else type = GLP_FX; glp_set_col_bnds(prob, j, type, col.lb, col.ub); glp_set_obj_coef(prob, j, dir * col.coef); len = 0; for (aij = col.ptr; aij != null; aij = aij.c_next) { len++; ind[len] = aij.row.temp; val[len] = aij.val; } glp_set_mat_col(prob, j, len, ind, val); } /* resultant problem has been built */ npp.m = prob.m; npp.n = prob.n; npp.nnz = prob.nnz; npp.row_ref = new Int32Array(1+npp.m); npp.col_ref = new Int32Array(1+npp.n); for (row = npp.r_head, i = 0; row != null; row = row.next) npp.row_ref[++i] = row.i; for (col = npp.c_head, j = 0; col != null; col = col.next) npp.col_ref[++j] = col.j; /* transformed problem segment is no longer needed */ npp.name = npp.obj = null; npp.c0 = 0.0; npp.r_head = npp.r_tail = null; npp.c_head = npp.c_tail = null; } function npp_postprocess(npp, prob){ /* postprocess solution from the resultant problem */ var row; var col; var tse; var i, j, k; var dir; xassert(npp.orig_dir == prob.dir); if (npp.orig_dir == GLP_MIN) dir = +1.0; else if (npp.orig_dir == GLP_MAX) dir = -1.0; else xassert(npp != npp); xassert(npp.m == prob.m); xassert(npp.n == prob.n); xassert(npp.nnz == prob.nnz); /* copy solution status */ if (npp.sol == GLP_SOL) { npp.p_stat = prob.pbs_stat; npp.d_stat = prob.dbs_stat; } else if (npp.sol == GLP_IPT) npp.t_stat = prob.ipt_stat; else if (npp.sol == GLP_MIP) npp.i_stat = prob.mip_stat; else xassert(npp != npp); /* allocate solution arrays */ if (npp.sol == GLP_SOL) { if (npp.r_stat == null) npp.r_stat = new Int8Array(1+npp.nrows); for (i = 1; i <= npp.nrows; i++) npp.r_stat[i] = 0; if (npp.c_stat == null) npp.c_stat = new Int8Array(1+npp.ncols); for (j = 1; j <= npp.ncols; j++) npp.c_stat[j] = 0; } if (npp.c_value == null) npp.c_value = new Float64Array(1+npp.ncols); for (j = 1; j <= npp.ncols; j++) npp.c_value[j] = DBL_MAX; if (npp.sol != GLP_MIP) { if (npp.r_pi == null) npp.r_pi = new Float64Array(1+npp.nrows); for (i = 1; i <= npp.nrows; i++) npp.r_pi[i] = DBL_MAX; } /* copy solution components from the resultant problem */ if (npp.sol == GLP_SOL) { for (i = 1; i <= npp.m; i++) { row = prob.row[i]; k = npp.row_ref[i]; npp.r_stat[k] = row.stat; /*npp.r_prim[k] = row.prim;*/ npp.r_pi[k] = dir * row.dual; } for (j = 1; j <= npp.n; j++) { col = prob.col[j]; k = npp.col_ref[j]; npp.c_stat[k] = col.stat; npp.c_value[k] = col.prim; /*npp.c_dual[k] = dir * col.dual;*/ } } else if (npp.sol == GLP_IPT) { for (i = 1; i <= npp.m; i++) { row = prob.row[i]; k = npp.row_ref[i]; /*npp.r_prim[k] = row.pval;*/ npp.r_pi[k] = dir * row.dval; } for (j = 1; j <= npp.n; j++) { col = prob.col[j]; k = npp.col_ref[j]; npp.c_value[k] = col.pval; /*npp.c_dual[k] = dir * col.dval;*/ } } else if (npp.sol == GLP_MIP) { for (j = 1; j <= npp.n; j++) { col = prob.col[j]; k = npp.col_ref[j]; npp.c_value[k] = col.mipx; } } else xassert(npp != npp); /* perform postprocessing to construct solution to the original problem */ for (tse = npp.top; tse != null; tse = tse.link) { xassert(tse.func != null); xassert(tse.func(npp, tse.info) == 0); } } function npp_unload_sol(npp, orig){ /* store solution to the original problem */ var row; var col; var i, j; var dir; var aij, temp; xassert(npp.orig_dir == orig.dir); if (npp.orig_dir == GLP_MIN) dir = +1.0; else if (npp.orig_dir == GLP_MAX) dir = -1.0; else xassert(npp != npp); xassert(npp.orig_m == orig.m); xassert(npp.orig_n == orig.n); xassert(npp.orig_nnz == orig.nnz); if (npp.sol == GLP_SOL) { /* store basic solution */ orig.valid = 0; orig.pbs_stat = npp.p_stat; orig.dbs_stat = npp.d_stat; orig.obj_val = orig.c0; orig.some = 0; for (i = 1; i <= orig.m; i++) { row = orig.row[i]; row.stat = npp.r_stat[i]; if (!npp.scaling) { /*row.prim = npp.r_prim[i];*/ row.dual = dir * npp.r_pi[i]; } else { /*row.prim = npp.r_prim[i] / row.rii;*/ row.dual = dir * npp.r_pi[i] * row.rii; } if (row.stat == GLP_BS) row.dual = 0.0; else if (row.stat == GLP_NL) { xassert(row.type == GLP_LO || row.type == GLP_DB); row.prim = row.lb; } else if (row.stat == GLP_NU) { xassert(row.type == GLP_UP || row.type == GLP_DB); row.prim = row.ub; } else if (row.stat == GLP_NF) { xassert(row.type == GLP_FR); row.prim = 0.0; } else if (row.stat == GLP_NS) { xassert(row.type == GLP_FX); row.prim = row.lb; } else xassert(row != row); } for (j = 1; j <= orig.n; j++) { col = orig.col[j]; col.stat = npp.c_stat[j]; if (!npp.scaling) { col.prim = npp.c_value[j]; /*col.dual = dir * npp.c_dual[j];*/ } else { col.prim = npp.c_value[j] * col.sjj; /*col.dual = dir * npp.c_dual[j] / col.sjj;*/ } if (col.stat == GLP_BS) col.dual = 0.0; else if (col.stat == GLP_NL) { xassert(col.type == GLP_LO || col.type == GLP_DB); col.prim = col.lb; } else if (col.stat == GLP_NU) { xassert(col.type == GLP_UP || col.type == GLP_DB); col.prim = col.ub; } else if (col.stat == GLP_NF) { xassert(col.type == GLP_FR); col.prim = 0.0; } else if (col.stat == GLP_NS) { xassert(col.type == GLP_FX); col.prim = col.lb; } else xassert(col != col); orig.obj_val += col.coef * col.prim; } /* compute primal values of inactive rows */ for (i = 1; i <= orig.m; i++) { row = orig.row[i]; if (row.stat == GLP_BS) { temp = 0.0; for (aij = row.ptr; aij != null; aij = aij.r_next) temp += aij.val * aij.col.prim; row.prim = temp; } } /* compute reduced costs of active columns */ for (j = 1; j <= orig.n; j++) { col = orig.col[j]; if (col.stat != GLP_BS) { temp = col.coef; for (aij = col.ptr; aij != null; aij = aij.c_next) temp -= aij.val * aij.row.dual; col.dual = temp; } } } else if (npp.sol == GLP_IPT) { /* store interior-point solution */ orig.ipt_stat = npp.t_stat; orig.ipt_obj = orig.c0; for (i = 1; i <= orig.m; i++) { row = orig.row[i]; if (!npp.scaling) { /*row.pval = npp.r_prim[i];*/ row.dval = dir * npp.r_pi[i]; } else { /*row.pval = npp.r_prim[i] / row.rii;*/ row.dval = dir * npp.r_pi[i] * row.rii; } } for (j = 1; j <= orig.n; j++) { col = orig.col[j]; if (!npp.scaling) { col.pval = npp.c_value[j]; /*col.dval = dir * npp.c_dual[j];*/ } else { col.pval = npp.c_value[j] * col.sjj; /*col.dval = dir * npp.c_dual[j] / col.sjj;*/ } orig.ipt_obj += col.coef * col.pval; } /* compute row primal values */ for (i = 1; i <= orig.m; i++) { row = orig.row[i]; { temp = 0.0; for (aij = row.ptr; aij != null; aij = aij.r_next) temp += aij.val * aij.col.pval; row.pval = temp; } } /* compute column dual values */ for (j = 1; j <= orig.n; j++) { col = orig.col[j]; { temp = col.coef; for (aij = col.ptr; aij != null; aij = aij.c_next) temp -= aij.val * aij.row.dval; col.dval = temp; } } } else if (npp.sol == GLP_MIP) { /* store MIP solution */ xassert(!npp.scaling); orig.mip_stat = npp.i_stat; orig.mip_obj = orig.c0; for (j = 1; j <= orig.n; j++) { col = orig.col[j]; col.mipx = npp.c_value[j]; if (col.kind == GLP_IV) xassert(col.mipx == Math.floor(col.mipx)); orig.mip_obj += col.coef * col.mipx; } /* compute row primal values */ for (i = 1; i <= orig.m; i++) { row = orig.row[i]; { temp = 0.0; for (aij = row.ptr; aij != null; aij = aij.r_next) temp += aij.val * aij.col.mipx; row.mipx = temp; } } } else xassert(npp != npp); } function npp_free_row(npp, p){ /* process free (unbounded) row */ var info; /* the row must be free */ xassert(p.lb == -DBL_MAX && p.ub == +DBL_MAX); /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover free (unbounded) row */ if (npp.sol == GLP_SOL) npp.r_stat[info.p] = GLP_BS; if (npp.sol != GLP_MIP) npp.r_pi[info.p] = 0.0; return 0; } ); info.p = p.i; /* remove the row from the problem */ npp_del_row(npp, p); } function npp_geq_row(npp, p){ /* process row of 'not less than' type */ var info; var s; /* the row must have lower bound */ xassert(p.lb != -DBL_MAX); xassert(p.lb < p.ub); /* create column for surplus variable */ s = npp_add_col(npp); s.lb = 0.0; s.ub = (p.ub == +DBL_MAX ? +DBL_MAX : p.ub - p.lb); /* and add it to the transformed problem */ npp_add_aij(p, s, -1.0); /* create transformation stack entry */ info = npp_push_tse(npp, function rcv_geq_row(npp, info){ /* recover row of 'not less than' type */ if (npp.sol == GLP_SOL) { if (npp.r_stat[info.p] == GLP_BS) { if (npp.c_stat[info.s] == GLP_BS) { npp_error(); return 1; } else if (npp.c_stat[info.s] == GLP_NL || npp.c_stat[info.s] == GLP_NU) npp.r_stat[info.p] = GLP_BS; else { npp_error(); return 1; } } else if (npp.r_stat[info.p] == GLP_NS) { if (npp.c_stat[info.s] == GLP_BS) npp.r_stat[info.p] = GLP_BS; else if (npp.c_stat[info.s] == GLP_NL) npp.r_stat[info.p] = GLP_NL; else if (npp.c_stat[info.s] == GLP_NU) npp.r_stat[info.p] = GLP_NU; else { npp_error(); return 1; } } else { npp_error(); return 1; } } return 0; } ); info.p = p.i; info.s = s.j; /* replace the row by equality constraint */ p.ub = p.lb; } function npp_leq_row(npp, p){ /* process row of 'not greater than' type */ var info; var s; /* the row must have upper bound */ xassert(p.ub != +DBL_MAX); xassert(p.lb < p.ub); /* create column for slack variable */ s = npp_add_col(npp); s.lb = 0.0; s.ub = (p.lb == -DBL_MAX ? +DBL_MAX : p.ub - p.lb); /* and add it to the transformed problem */ npp_add_aij(p, s, +1.0); /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover row of 'not greater than' type */ if (npp.sol == GLP_SOL) { if (npp.r_stat[info.p] == GLP_BS) { if (npp.c_stat[info.s] == GLP_BS) { npp_error(); return 1; } else if (npp.c_stat[info.s] == GLP_NL || npp.c_stat[info.s] == GLP_NU) npp.r_stat[info.p] = GLP_BS; else { npp_error(); return 1; } } else if (npp.r_stat[info.p] == GLP_NS) { if (npp.c_stat[info.s] == GLP_BS) npp.r_stat[info.p] = GLP_BS; else if (npp.c_stat[info.s] == GLP_NL) npp.r_stat[info.p] = GLP_NU; else if (npp.c_stat[info.s] == GLP_NU) npp.r_stat[info.p] = GLP_NL; else { npp_error(); return 1; } } else { npp_error(); return 1; } } return 0; } ); info.p = p.i; info.s = s.j; /* replace the row by equality constraint */ p.lb = p.ub; } function npp_free_col(npp, q){ /* process free (unbounded) column */ var info; var s; var aij; /* the column must be free */ xassert(q.lb == -DBL_MAX && q.ub == +DBL_MAX); /* variable x[q] becomes s' */ q.lb = 0.0; q.ub = +DBL_MAX; /* create variable s'' */ s = npp_add_col(npp); s.is_int = q.is_int; s.lb = 0.0; s.ub = +DBL_MAX; /* duplicate objective coefficient */ s.coef = -q.coef; /* duplicate column of the constraint matrix */ for (aij = q.ptr; aij != null; aij = aij.c_next) npp_add_aij(aij.row, s, -aij.val); /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover free (unbounded) column */ if (npp.sol == GLP_SOL) { if (npp.c_stat[info.q] == GLP_BS) { if (npp.c_stat[info.s] == GLP_BS) { npp_error(); return 1; } else if (npp.c_stat[info.s] == GLP_NL) npp.c_stat[info.q] = GLP_BS; else { npp_error(); return -1; } } else if (npp.c_stat[info.q] == GLP_NL) { if (npp.c_stat[info.s] == GLP_BS) npp.c_stat[info.q] = GLP_BS; else if (npp.c_stat[info.s] == GLP_NL) npp.c_stat[info.q] = GLP_NF; else { npp_error(); return -1; } } else { npp_error(); return -1; } } /* compute value of x[q] with formula (2) */ npp.c_value[info.q] -= npp.c_value[info.s]; return 0; } ); info.q = q.j; info.s = s.j; } function npp_lbnd_col(npp, q){ /* process column with (non-zero) lower bound */ var info; var i; var aij; /* the column must have non-zero lower bound */ xassert(q.lb != 0.0); xassert(q.lb != -DBL_MAX); xassert(q.lb < q.ub); /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover column with (non-zero) lower bound */ if (npp.sol == GLP_SOL) { if (npp.c_stat[info.q] == GLP_BS || npp.c_stat[info.q] == GLP_NL || npp.c_stat[info.q] == GLP_NU) npp.c_stat[info.q] = npp.c_stat[info.q]; else { npp_error(); return 1; } } /* compute value of x[q] with formula (2) */ npp.c_value[info.q] = info.bnd + npp.c_value[info.q]; return 0; } ); info.q = q.j; info.bnd = q.lb; /* substitute x[q] into objective row */ npp.c0 += q.coef * q.lb; /* substitute x[q] into constraint rows */ for (aij = q.ptr; aij != null; aij = aij.c_next) { i = aij.row; if (i.lb == i.ub) i.ub = (i.lb -= aij.val * q.lb); else { if (i.lb != -DBL_MAX) i.lb -= aij.val * q.lb; if (i.ub != +DBL_MAX) i.ub -= aij.val * q.lb; } } /* column x[q] becomes column s */ if (q.ub != +DBL_MAX) q.ub -= q.lb; q.lb = 0.0; } function npp_ubnd_col(npp, q){ /* process column with upper bound */ var info; var i; var aij; /* the column must have upper bound */ xassert(q.ub != +DBL_MAX); xassert(q.lb < q.ub); /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover column with upper bound */ if (npp.sol == GLP_BS) { if (npp.c_stat[info.q] == GLP_BS) npp.c_stat[info.q] = GLP_BS; else if (npp.c_stat[info.q] == GLP_NL) npp.c_stat[info.q] = GLP_NU; else if (npp.c_stat[info.q] == GLP_NU) npp.c_stat[info.q] = GLP_NL; else { npp_error(); return 1; } } /* compute value of x[q] with formula (2) */ npp.c_value[info.q] = info.bnd - npp.c_value[info.q]; return 0; } ); info.q = q.j; info.bnd = q.ub; /* substitute x[q] into objective row */ npp.c0 += q.coef * q.ub; q.coef = -q.coef; /* substitute x[q] into constraint rows */ for (aij = q.ptr; aij != null; aij = aij.c_next) { i = aij.row; if (i.lb == i.ub) i.ub = (i.lb -= aij.val * q.ub); else { if (i.lb != -DBL_MAX) i.lb -= aij.val * q.ub; if (i.ub != +DBL_MAX) i.ub -= aij.val * q.ub; } aij.val = -aij.val; } /* column x[q] becomes column s */ if (q.lb != -DBL_MAX) q.ub -= q.lb; else q.ub = +DBL_MAX; q.lb = 0.0; } function npp_dbnd_col(npp, q){ /* process non-negative column with upper bound */ var info; var p; var s; /* the column must be non-negative with upper bound */ xassert(q.lb == 0.0); xassert(q.ub > 0.0); xassert(q.ub != +DBL_MAX); /* create variable s */ s = npp_add_col(npp); s.is_int = q.is_int; s.lb = 0.0; s.ub = +DBL_MAX; /* create equality constraint (2) */ p = npp_add_row(npp); p.lb = p.ub = q.ub; npp_add_aij(p, q, +1.0); npp_add_aij(p, s, +1.0); /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover non-negative column with upper bound */ if (npp.sol == GLP_BS) { if (npp.c_stat[info.q] == GLP_BS) { if (npp.c_stat[info.s] == GLP_BS) npp.c_stat[info.q] = GLP_BS; else if (npp.c_stat[info.s] == GLP_NL) npp.c_stat[info.q] = GLP_NU; else { npp_error(); return 1; } } else if (npp.c_stat[info.q] == GLP_NL) { if (npp.c_stat[info.s] == GLP_BS || npp.c_stat[info.s] == GLP_NL) npp.c_stat[info.q] = GLP_NL; else { npp_error(); return 1; } } else { npp_error(); return 1; } } return 0; } ); info.q = q.j; info.s = s.j; /* remove upper bound of x[q] */ q.ub = +DBL_MAX; } function npp_fixed_col(npp, q){ /* process fixed column */ var info; var i; var aij; /* the column must be fixed */ xassert(q.lb == q.ub); /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover fixed column */ if (npp.sol == GLP_SOL) npp.c_stat[info.q] = GLP_NS; npp.c_value[info.q] = info.s; return 0; } ); info.q = q.j; info.s = q.lb; /* substitute x[q] = s[q] into objective row */ npp.c0 += q.coef * q.lb; /* substitute x[q] = s[q] into constraint rows */ for (aij = q.ptr; aij != null; aij = aij.c_next) { i = aij.row; if (i.lb == i.ub) i.ub = (i.lb -= aij.val * q.lb); else { if (i.lb != -DBL_MAX) i.lb -= aij.val * q.lb; if (i.ub != +DBL_MAX) i.ub -= aij.val * q.lb; } } /* remove the column from the problem */ npp_del_col(npp, q); } function npp_make_equality(npp, p){ /* process row with almost identical bounds */ var info; var b, eps, nint; /* the row must be double-sided inequality */ xassert(p.lb != -DBL_MAX); xassert(p.ub != +DBL_MAX); xassert(p.lb < p.ub); /* check row bounds */ eps = 1e-9 + 1e-12 * Math.abs(p.lb); if (p.ub - p.lb > eps) return 0; /* row bounds are very close to each other */ /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover row with almost identical bounds */ if (npp.sol == GLP_SOL) { if (npp.r_stat[info.p] == GLP_BS) npp.r_stat[info.p] = GLP_BS; else if (npp.r_stat[info.p] == GLP_NS) { if (npp.r_pi[info.p] >= 0.0) npp.r_stat[info.p] = GLP_NL; else npp.r_stat[info.p] = GLP_NU; } else { npp_error(); return 1; } } return 0; } ); info.p = p.i; /* compute right-hand side */ b = 0.5 * (p.ub + p.lb); nint = Math.floor(b + 0.5); if (Math.abs(b - nint) <= eps) b = nint; /* replace row p by almost equivalent equality constraint */ p.lb = p.ub = b; return 1; } function npp_make_fixed(npp, q){ /* process column with almost identical bounds */ var info; var aij; var lfe; var s, eps, nint; /* the column must be double-bounded */ xassert(q.lb != -DBL_MAX); xassert(q.ub != +DBL_MAX); xassert(q.lb < q.ub); /* check column bounds */ eps = 1e-9 + 1e-12 * Math.abs(q.lb); if (q.ub - q.lb > eps) return 0; /* column bounds are very close to each other */ /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover column with almost identical bounds */ var lfe; var lambda; if (npp.sol == GLP_SOL) { if (npp.c_stat[info.q] == GLP_BS) npp.c_stat[info.q] = GLP_BS; else if (npp.c_stat[info.q] == GLP_NS) { /* compute multiplier for column q with formula (6) */ lambda = info.c; for (lfe = info.ptr; lfe != null; lfe = lfe.next) lambda -= lfe.val * npp.r_pi[lfe.ref]; /* assign status to non-basic column */ if (lambda >= 0.0) npp.c_stat[info.q] = GLP_NL; else npp.c_stat[info.q] = GLP_NU; } else { npp_error(); return 1; } } return 0; } ); info.q = q.j; info.c = q.coef; info.ptr = null; /* save column coefficients a[i,q] (needed for basic solution only) */ if (npp.sol == GLP_SOL) { for (aij = q.ptr; aij != null; aij = aij.c_next) { lfe = {}; lfe.ref = aij.row.i; lfe.val = aij.val; lfe.next = info.ptr; info.ptr = lfe; } } /* compute column fixed value */ s = 0.5 * (q.ub + q.lb); nint = Math.floor(s + 0.5); if (Math.abs(s - nint) <= eps) s = nint; /* make column q fixed */ q.lb = q.ub = s; return 1; } function npp_empty_row(npp, p){ /* process empty row */ var eps = 1e-3; /* the row must be empty */ xassert(p.ptr == null); /* check primal feasibility */ if (p.lb > +eps || p.ub < -eps) return 1; /* replace the row by equivalent free (unbounded) row */ p.lb = -DBL_MAX; p.ub = +DBL_MAX; /* and process it */ npp_free_row(npp, p); return 0; } function npp_empty_col(npp, q){ /* process empty column */ var info; var eps = 1e-3; /* the column must be empty */ xassert(q.ptr == null); /* check dual feasibility */ if (q.coef > +eps && q.lb == -DBL_MAX) return 1; if (q.coef < -eps && q.ub == +DBL_MAX) return 1; /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover empty column */ if (npp.sol == GLP_SOL) npp.c_stat[info.q] = info.stat; return 0; } ); info.q = q.j; /* fix the column */ function lo(){ /* column with lower bound */ info.stat = GLP_NL; q.ub = q.lb; } function up(){ /* column with upper bound */ info.stat = GLP_NU; q.lb = q.ub; } if (q.lb == -DBL_MAX && q.ub == +DBL_MAX) { /* free column */ info.stat = GLP_NF; q.lb = q.ub = 0.0; } else if (q.ub == +DBL_MAX) lo(); else if (q.lb == -DBL_MAX) up(); else if (q.lb != q.ub) { /* double-bounded column */ if (q.coef >= +DBL_EPSILON) lo(); else if (q.coef <= -DBL_EPSILON) up(); else if (Math.abs(q.lb) <= Math.abs(q.ub)) lo(); else up(); } else { /* fixed column */ info.stat = GLP_NS; } /* process fixed column */ npp_fixed_col(npp, q); return 0; } function npp_implied_value(npp, q, s){ /* process implied column value */ var eps, nint; xassert(npp == npp); /* column must not be fixed */ xassert(q.lb < q.ub); /* check integrality */ if (q.is_int) { nint = Math.floor(s + 0.5); if (Math.abs(s - nint) <= 1e-5) s = nint; else return 2; } /* check current column lower bound */ if (q.lb != -DBL_MAX) { eps = (q.is_int ? 1e-5 : 1e-5 + 1e-8 * Math.abs(q.lb)); if (s < q.lb - eps) return 1; /* if s[q] is close to l[q], fix column at its lower bound rather than at the implied value */ if (s < q.lb + 1e-3 * eps) { q.ub = q.lb; return 0; } } /* check current column upper bound */ if (q.ub != +DBL_MAX) { eps = (q.is_int ? 1e-5 : 1e-5 + 1e-8 * Math.abs(q.ub)); if (s > q.ub + eps) return 1; /* if s[q] is close to u[q], fix column at its upper bound rather than at the implied value */ if (s > q.ub - 1e-3 * eps) { q.lb = q.ub; return 0; } } /* fix column at the implied value */ q.lb = q.ub = s; return 0; } function npp_eq_singlet(npp, p){ /* process row singleton (equality constraint) */ var info; var q; var aij; var lfe; var ret; var s; /* the row must be singleton equality constraint */ xassert(p.lb == p.ub); xassert(p.ptr != null && p.ptr.r_next == null); /* compute and process implied column value */ aij = p.ptr; q = aij.col; s = p.lb / aij.val; ret = npp_implied_value(npp, q, s); xassert(0 <= ret && ret <= 2); if (ret != 0) return ret; /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover row singleton (equality constraint) */ var lfe; var temp; if (npp.sol == GLP_SOL) { /* column q must be already recovered as GLP_NS */ if (npp.c_stat[info.q] != GLP_NS) { npp_error(); return 1; } npp.r_stat[info.p] = GLP_NS; npp.c_stat[info.q] = GLP_BS; } if (npp.sol != GLP_MIP) { /* compute multiplier for row p with formula (3) */ temp = info.c; for (lfe = info.ptr; lfe != null; lfe = lfe.next) temp -= lfe.val * npp.r_pi[lfe.ref]; npp.r_pi[info.p] = temp / info.apq; } return 0; } ); info.p = p.i; info.q = q.j; info.apq = aij.val; info.c = q.coef; info.ptr = null; /* save column coefficients a[i,q], i != p (not needed for MIP solution) */ if (npp.sol != GLP_MIP) { for (aij = q.ptr; aij != null; aij = aij.c_next) { if (aij.row == p) continue; /* skip a[p,q] */ lfe = {}; lfe.ref = aij.row.i; lfe.val = aij.val; lfe.next = info.ptr; info.ptr = lfe; } } /* remove the row from the problem */ npp_del_row(npp, p); return 0; } function npp_implied_lower(npp, q, l){ /* process implied column lower bound */ var ret; var eps, nint; xassert(npp == npp); /* column must not be fixed */ xassert(q.lb < q.ub); /* implied lower bound must be finite */ xassert(l != -DBL_MAX); /* if column is integral, round up l'[q] */ if (q.is_int) { nint = Math.floor(l + 0.5); if (Math.abs(l - nint) <= 1e-5) l = nint; else l = Math.ceil(l); } /* check current column lower bound */ if (q.lb != -DBL_MAX) { eps = (q.is_int ? 1e-3 : 1e-3 + 1e-6 * Math.abs(q.lb)); if (l < q.lb + eps) { ret = 0; /* redundant */ return ret; } } /* check current column upper bound */ if (q.ub != +DBL_MAX) { eps = (q.is_int ? 1e-5 : 1e-5 + 1e-8 * Math.abs(q.ub)); if (l > q.ub + eps) { ret = 4; /* infeasible */ return ret; } /* if l'[q] is close to u[q], fix column at its upper bound */ if (l > q.ub - 1e-3 * eps) { q.lb = q.ub; ret = 3; /* fixed */ return ret; } } /* check if column lower bound changes significantly */ if (q.lb == -DBL_MAX) ret = 2; /* significantly */ else if (q.is_int && l > q.lb + 0.5) ret = 2; /* significantly */ else if (l > q.lb + 0.30 * (1.0 + Math.abs(q.lb))) ret = 2; /* significantly */ else ret = 1; /* not significantly */ /* set new column lower bound */ q.lb = l; return ret; } function npp_implied_upper(npp, q, u){ var ret; var eps, nint; xassert(npp == npp); /* column must not be fixed */ xassert(q.lb < q.ub); /* implied upper bound must be finite */ xassert(u != +DBL_MAX); /* if column is integral, round down u'[q] */ if (q.is_int) { nint = Math.floor(u + 0.5); if (Math.abs(u - nint) <= 1e-5) u = nint; else u = Math.floor(u); } /* check current column upper bound */ if (q.ub != +DBL_MAX) { eps = (q.is_int ? 1e-3 : 1e-3 + 1e-6 * Math.abs(q.ub)); if (u > q.ub - eps) { ret = 0; /* redundant */ return ret; } } /* check current column lower bound */ if (q.lb != -DBL_MAX) { eps = (q.is_int ? 1e-5 : 1e-5 + 1e-8 * Math.abs(q.lb)); if (u < q.lb - eps) { ret = 4; /* infeasible */ return ret; } /* if u'[q] is close to l[q], fix column at its lower bound */ if (u < q.lb + 1e-3 * eps) { q.ub = q.lb; ret = 3; /* fixed */ return ret; } } /* check if column upper bound changes significantly */ if (q.ub == +DBL_MAX) ret = 2; /* significantly */ else if (q.is_int && u < q.ub - 0.5) ret = 2; /* significantly */ else if (u < q.ub - 0.30 * (1.0 + Math.abs(q.ub))) ret = 2; /* significantly */ else ret = 1; /* not significantly */ /* set new column upper bound */ q.ub = u; return ret; } function npp_ineq_singlet(npp, p){ /* process row singleton (inequality constraint) */ var info; var q; var apq, aij; var lfe; var lb_changed, ub_changed; var ll, uu; /* the row must be singleton inequality constraint */ xassert(p.lb != -DBL_MAX || p.ub != +DBL_MAX); xassert(p.lb < p.ub); xassert(p.ptr != null && p.ptr.r_next == null); /* compute implied column bounds */ apq = p.ptr; q = apq.col; xassert(q.lb < q.ub); if (apq.val > 0.0) { ll = (p.lb == -DBL_MAX ? -DBL_MAX : p.lb / apq.val); uu = (p.ub == +DBL_MAX ? +DBL_MAX : p.ub / apq.val); } else { ll = (p.ub == +DBL_MAX ? -DBL_MAX : p.ub / apq.val); uu = (p.lb == -DBL_MAX ? +DBL_MAX : p.lb / apq.val); } /* process implied column lower bound */ if (ll == -DBL_MAX) lb_changed = 0; else { lb_changed = npp_implied_lower(npp, q, ll); xassert(0 <= lb_changed && lb_changed <= 4); if (lb_changed == 4) return 4; /* infeasible */ } /* process implied column upper bound */ if (uu == +DBL_MAX) ub_changed = 0; else if (lb_changed == 3) { /* column was fixed on its upper bound due to l'[q] = u[q] */ /* note that L[p] < U[p], so l'[q] = u[q] < u'[q] */ ub_changed = 0; } else { ub_changed = npp_implied_upper(npp, q, uu); xassert(0 <= ub_changed && ub_changed <= 4); if (ub_changed == 4) return 4; /* infeasible */ } /* if neither lower nor upper column bound was changed, the row is originally redundant and can be replaced by free row */ if (!lb_changed && !ub_changed) { p.lb = -DBL_MAX; p.ub = +DBL_MAX; npp_free_row(npp, p); return 0; } /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover row singleton (inequality constraint) */ var lfe; var lambda; if (npp.sol == GLP_MIP) return 0; /* compute lambda~[q] in solution to the transformed problem with formula (8) */ lambda = info.c; for (lfe = info.ptr; lfe != null; lfe = lfe.next) lambda -= lfe.val * npp.r_pi[lfe.ref]; if (npp.sol == GLP_SOL) { /* recover basic solution */ function nl(){ /* column q is non-basic with lower bound active */ if (info.lb_changed) { /* it is implied bound, so actually row p is active while column q is basic */ npp.r_stat[info.p] = (info.apq > 0.0 ? GLP_NL : GLP_NU); npp.c_stat[info.q] = GLP_BS; npp.r_pi[info.p] = lambda / info.apq; } else { /* it is original bound, so row p is inactive */ npp.r_stat[info.p] = GLP_BS; npp.r_pi[info.p] = 0.0; } return 0; } function nu(){ /* column q is non-basic with upper bound active */ if (info.ub_changed) { /* it is implied bound, so actually row p is active while column q is basic */ npp.r_stat[info.p] = (info.apq > 0.0 ? GLP_NU : GLP_NL); npp.c_stat[info.q] = GLP_BS; npp.r_pi[info.p] = lambda / info.apq; } else { /* it is original bound, so row p is inactive */ npp.r_stat[info.p] = GLP_BS; npp.r_pi[info.p] = 0.0; } return 0; } if (npp.c_stat[info.q] == GLP_BS) { /* column q is basic, so row p is inactive */ npp.r_stat[info.p] = GLP_BS; npp.r_pi[info.p] = 0.0; } else if (npp.c_stat[info.q] == GLP_NL) nl(); else if (npp.c_stat[info.q] == GLP_NU) nu(); else if (npp.c_stat[info.q] == GLP_NS) { /* column q is non-basic and fixed; note, however, that in in the original problem it is non-fixed */ if (lambda > +1e-7) { if (info.apq > 0.0 && info.lb != -DBL_MAX || info.apq < 0.0 && info.ub != +DBL_MAX || !info.lb_changed) { /* either corresponding bound of row p exists or column q remains non-basic with its original lower bound active */ npp.c_stat[info.q] = GLP_NL; return nl(); } } if (lambda < -1e-7) { if (info.apq > 0.0 && info.ub != +DBL_MAX || info.apq < 0.0 && info.lb != -DBL_MAX || !info.ub_changed) { /* either corresponding bound of row p exists or column q remains non-basic with its original upper bound active */ npp.c_stat[info.q] = GLP_NU; return nu(); } } /* either lambda~[q] is close to zero, or corresponding bound of row p does not exist, because lambda~[q] has wrong sign due to round-off errors; in the latter case lambda~[q] is also assumed to be close to zero; so, we can make row p active on its existing bound and column q basic; pi[p] will have wrong sign, but it also will be close to zero (rarus casus of dual degeneracy) */ if (info.lb != -DBL_MAX && info.ub == +DBL_MAX) { /* row lower bound exists, but upper bound doesn't */ npp.r_stat[info.p] = GLP_NL; } else if (info.lb == -DBL_MAX && info.ub != +DBL_MAX) { /* row upper bound exists, but lower bound doesn't */ npp.r_stat[info.p] = GLP_NU; } else if (info.lb != -DBL_MAX && info.ub != +DBL_MAX) { /* both row lower and upper bounds exist */ /* to choose proper active row bound we should not use lambda~[q], because its value being close to zero is unreliable; so we choose that bound which provides primal feasibility for original constraint (1) */ if (info.apq * npp.c_value[info.q] <= 0.5 * (info.lb + info.ub)) npp.r_stat[info.p] = GLP_NL; else npp.r_stat[info.p] = GLP_NU; } else { npp_error(); return 1; } npp.c_stat[info.q] = GLP_BS; npp.r_pi[info.p] = lambda / info.apq; } else { npp_error(); return 1; } } if (npp.sol == GLP_IPT) { /* recover interior-point solution */ if (lambda > +DBL_EPSILON && info.lb_changed || lambda < -DBL_EPSILON && info.ub_changed) { /* actually row p has corresponding active bound */ npp.r_pi[info.p] = lambda / info.apq; } else { /* either bounds of column q are both inactive or its original bound is active */ npp.r_pi[info.p] = 0.0; } } return 0; } ); info.p = p.i; info.q = q.j; info.apq = apq.val; info.c = q.coef; info.lb = p.lb; info.ub = p.ub; info.lb_changed = lb_changed; info.ub_changed = ub_changed; info.ptr = null; /* save column coefficients a[i,q], i != p (not needed for MIP solution) */ if (npp.sol != GLP_MIP) { for (aij = q.ptr; aij != null; aij = aij.c_next) { if (aij == apq) continue; /* skip a[p,q] */ lfe = {}; lfe.ref = aij.row.i; lfe.val = aij.val; lfe.next = info.ptr; info.ptr = lfe; } } /* remove the row from the problem */ npp_del_row(npp, p); return lb_changed >= ub_changed ? lb_changed : ub_changed; } function npp_implied_slack(npp, q){ /* process column singleton (implied slack variable) */ var info; var p; var aij; var lfe; /* the column must be non-integral non-fixed singleton */ xassert(!q.is_int); xassert(q.lb < q.ub); xassert(q.ptr != null && q.ptr.c_next == null); /* corresponding row must be equality constraint */ aij = q.ptr; p = aij.row; xassert(p.lb == p.ub); /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover column singleton (implied slack variable) */ var temp; var lfe; if (npp.sol == GLP_SOL) { /* assign statuses to row p and column q */ if (npp.r_stat[info.p] == GLP_BS || npp.r_stat[info.p] == GLP_NF) npp.c_stat[info.q] = npp.r_stat[info.p]; else if (npp.r_stat[info.p] == GLP_NL) npp.c_stat[info.q] = (info.apq > 0.0 ? GLP_NU : GLP_NL); else if (npp.r_stat[info.p] == GLP_NU) npp.c_stat[info.q] = (info.apq > 0.0 ? GLP_NL : GLP_NU); else { npp_error(); return 1; } npp.r_stat[info.p] = GLP_NS; } if (npp.sol != GLP_MIP) { /* compute multiplier for row p */ npp.r_pi[info.p] += info.c / info.apq; } /* compute value of column q */ temp = info.b; for (lfe = info.ptr; lfe != null; lfe = lfe.next) temp -= lfe.val * npp.c_value[lfe.ref]; npp.c_value[info.q] = temp / info.apq; return 0; } ); info.p = p.i; info.q = q.j; info.apq = aij.val; info.b = p.lb; info.c = q.coef; info.ptr = null; /* save row coefficients a[p,j], j != q, and substitute x[q] into the objective row */ for (aij = p.ptr; aij != null; aij = aij.r_next) { if (aij.col == q) continue; /* skip a[p,q] */ lfe = {}; lfe.ref = aij.col.j; lfe.val = aij.val; lfe.next = info.ptr; info.ptr = lfe; aij.col.coef -= info.c * (aij.val / info.apq); } npp.c0 += info.c * (info.b / info.apq); /* compute new row bounds */ if (info.apq > 0.0) { p.lb = (q.ub == +DBL_MAX ? -DBL_MAX : info.b - info.apq * q.ub); p.ub = (q.lb == -DBL_MAX ? +DBL_MAX : info.b - info.apq * q.lb); } else { p.lb = (q.lb == -DBL_MAX ? -DBL_MAX : info.b - info.apq * q.lb); p.ub = (q.ub == +DBL_MAX ? +DBL_MAX : info.b - info.apq * q.ub); } /* remove the column from the problem */ npp_del_col(npp, q); } function npp_implied_free(npp, q){ /* process column singleton (implied free variable) */ var info; var p; var apq, aij; var alfa, beta, l, u, pi, eps; /* the column must be non-fixed singleton */ xassert(q.lb < q.ub); xassert(q.ptr != null && q.ptr.c_next == null); /* corresponding row must be inequality constraint */ apq = q.ptr; p = apq.row; xassert(p.lb != -DBL_MAX || p.ub != +DBL_MAX); xassert(p.lb < p.ub); /* compute alfa */ alfa = p.lb; if (alfa != -DBL_MAX) { for (aij = p.ptr; aij != null; aij = aij.r_next) { if (aij == apq) continue; /* skip a[p,q] */ if (aij.val > 0.0) { if (aij.col.ub == +DBL_MAX) { alfa = -DBL_MAX; break; } alfa -= aij.val * aij.col.ub; } else /* < 0.0 */ { if (aij.col.lb == -DBL_MAX) { alfa = -DBL_MAX; break; } alfa -= aij.val * aij.col.lb; } } } /* compute beta */ beta = p.ub; if (beta != +DBL_MAX) { for (aij = p.ptr; aij != null; aij = aij.r_next) { if (aij == apq) continue; /* skip a[p,q] */ if (aij.val > 0.0) { if (aij.col.lb == -DBL_MAX) { beta = +DBL_MAX; break; } beta -= aij.val * aij.col.lb; } else /* < 0.0 */ { if (aij.col.ub == +DBL_MAX) { beta = +DBL_MAX; break; } beta -= aij.val * aij.col.ub; } } } /* compute implied column lower bound l'[q] */ if (apq.val > 0.0) l = (alfa == -DBL_MAX ? -DBL_MAX : alfa / apq.val); else /* < 0.0 */ l = (beta == +DBL_MAX ? -DBL_MAX : beta / apq.val); /* compute implied column upper bound u'[q] */ if (apq.val > 0.0) u = (beta == +DBL_MAX ? +DBL_MAX : beta / apq.val); else u = (alfa == -DBL_MAX ? +DBL_MAX : alfa / apq.val); /* check if column lower bound l[q] can be active */ if (q.lb != -DBL_MAX) { eps = 1e-9 + 1e-12 * Math.abs(q.lb); if (l < q.lb - eps) return 1; /* yes, it can */ } /* check if column upper bound u[q] can be active */ if (q.ub != +DBL_MAX) { eps = 1e-9 + 1e-12 * Math.abs(q.ub); if (u > q.ub + eps) return 1; /* yes, it can */ } /* okay; make column q free (unbounded) */ q.lb = -DBL_MAX; q.ub = +DBL_MAX; /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover column singleton (implied free variable) */ if (npp.sol == GLP_SOL) { if (npp.r_stat[info.p] == GLP_BS) npp.r_stat[info.p] = GLP_BS; else if (npp.r_stat[info.p] == GLP_NS) { xassert(info.stat == GLP_NL || info.stat == GLP_NU); npp.r_stat[info.p] = info.stat; } else { npp_error(); return 1; } } return 0; } ); info.p = p.i; info.stat = -1; /* compute row multiplier pi[p] */ pi = q.coef / apq.val; /* check dual feasibility for row p */ function nl(){ info.stat = GLP_NL; p.ub = p.lb; } function nu(){ info.stat = GLP_NU; p.lb = p.ub; } if (pi > +DBL_EPSILON) { /* lower bound L[p] must be active */ if (p.lb != -DBL_MAX) nl(); else { if (pi > +1e-5) return 2; /* dual infeasibility */ /* take a chance on U[p] */ xassert(p.ub != +DBL_MAX); nu(); } } else if (pi < -DBL_EPSILON) { /* upper bound U[p] must be active */ if (p.ub != +DBL_MAX) nu(); else { if (pi < -1e-5) return 2; /* dual infeasibility */ /* take a chance on L[p] */ xassert(p.lb != -DBL_MAX); nl(); } } else { /* any bound (either L[p] or U[p]) can be made active */ if (p.ub == +DBL_MAX) { xassert(p.lb != -DBL_MAX); nl(); } else if (p.lb == -DBL_MAX) { xassert(p.ub != +DBL_MAX); nu(); } else { if (Math.abs(p.lb) <= Math.abs(p.ub)) nl(); else nu(); } } return 0; } function npp_eq_doublet(npp, p){ /* process row doubleton (equality constraint) */ var info; var i; var q, r; var apq, apr, aiq, air, next; var lfe; var gamma; /* the row must be doubleton equality constraint */ xassert(p.lb == p.ub); xassert(p.ptr != null && p.ptr.r_next != null && p.ptr.r_next.r_next == null); /* choose column to be eliminated */ { var a1, a2; a1 = p.ptr; a2 = a1.r_next; if (Math.abs(a2.val) < 0.001 * Math.abs(a1.val)) { /* only first column can be eliminated, because second one has too small constraint coefficient */ apq = a1; apr = a2; } else if (Math.abs(a1.val) < 0.001 * Math.abs(a2.val)) { /* only second column can be eliminated, because first one has too small constraint coefficient */ apq = a2; apr = a1; } else { /* both columns are appropriate; choose that one which is shorter to minimize fill-in */ if (npp_col_nnz(a1.col) <= npp_col_nnz(a2.col)) { /* first column is shorter */ apq = a1; apr = a2; } else { /* second column is shorter */ apq = a2; apr = a1; } } } /* now columns q and r have been chosen */ q = apq.col; r = apr.col; /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover row doubleton (equality constraint) */ var lfe; var gamma, temp; /* we assume that processing row p is followed by processing column q as singleton of type "implied slack variable", in which case row p must always be active equality constraint */ if (npp.sol == GLP_SOL) { if (npp.r_stat[info.p] != GLP_NS) { npp_error(); return 1; } } if (npp.sol != GLP_MIP) { /* compute value of multiplier for row p; see (14) */ temp = npp.r_pi[info.p]; for (lfe = info.ptr; lfe != null; lfe = lfe.next) { gamma = lfe.val / info.apq; /* a[i,q] / a[p,q] */ temp -= gamma * npp.r_pi[lfe.ref]; } npp.r_pi[info.p] = temp; } return 0; } ); info.p = p.i; info.apq = apq.val; info.ptr = null; /* transform each row i (i != p), where a[i,q] != 0, to eliminate column q */ for (aiq = q.ptr; aiq != null; aiq = next) { next = aiq.c_next; if (aiq == apq) continue; /* skip row p */ i = aiq.row; /* row i to be transformed */ /* save constraint coefficient a[i,q] */ if (npp.sol != GLP_MIP) { lfe = {}; lfe.ref = i.i; lfe.val = aiq.val; lfe.next = info.ptr; info.ptr = lfe; } /* find coefficient a[i,r] in row i */ for (air = i.ptr; air != null; air = air.r_next) if (air.col == r) break; /* if a[i,r] does not exist, create a[i,r] = 0 */ if (air == null) air = npp_add_aij(i, r, 0.0); /* compute gamma[i] = a[i,q] / a[p,q] */ gamma = aiq.val / apq.val; /* (row i) := (row i) - gamma[i] * (row p); see (3)-(6) */ /* new a[i,q] is exact zero due to elimnation; remove it from row i */ npp_del_aij(aiq); /* compute new a[i,r] */ air.val -= gamma * apr.val; /* if new a[i,r] is close to zero due to numeric cancelation, remove it from row i */ if (Math.abs(air.val) <= 1e-10) npp_del_aij(air); /* compute new lower and upper bounds of row i */ if (i.lb == i.ub) i.lb = i.ub = (i.lb - gamma * p.lb); else { if (i.lb != -DBL_MAX) i.lb -= gamma * p.lb; if (i.ub != +DBL_MAX) i.ub -= gamma * p.lb; } } return q; } function npp_forcing_row(npp, p, at){ /* process forcing row */ var info; var col = null; var j; var apj, aij; var lfe; var big; xassert(at == 0 || at == 1); /* determine maximal magnitude of the row coefficients */ big = 1.0; for (apj = p.ptr; apj != null; apj = apj.r_next) if (big < Math.abs(apj.val)) big = Math.abs(apj.val); /* if there are too small coefficients in the row, transformation should not be applied */ for (apj = p.ptr; apj != null; apj = apj.r_next) if (Math.abs(apj.val) < 1e-7 * big) return 1; /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover forcing row */ var col, piv; var lfe; var d, big, temp; if (npp.sol == GLP_MIP) return 0; /* initially solution to the original problem is the same as to the transformed problem, where row p is inactive constraint with pi[p] = 0, and all columns are non-basic */ if (npp.sol == GLP_SOL) { if (npp.r_stat[info.p] != GLP_BS) { npp_error(); return 1; } for (col = info.ptr; col != null; col = col.next) { if (npp.c_stat[col.j] != GLP_NS) { npp_error(); return 1; } npp.c_stat[col.j] = col.stat; /* original status */ } } /* compute reduced costs d[j] for all columns with formula (10) and store them in col.c instead objective coefficients */ for (col = info.ptr; col != null; col = col.next) { d = col.c; for (lfe = col.ptr; lfe != null; lfe = lfe.next) d -= lfe.val * npp.r_pi[lfe.ref]; col.c = d; } /* consider columns j, whose multipliers lambda[j] has wrong sign in solution to the transformed problem (where lambda[j] = d[j]), and choose column q, whose multipler lambda[q] reaches zero last on changing row multiplier pi[p]; see (14) */ piv = null; big = 0.0; for (col = info.ptr; col != null; col = col.next) { d = col.c; /* d[j] */ temp = Math.abs(d / col.a); if (col.stat == GLP_NL) { /* column j has active lower bound */ if (d < 0.0 && big < temp){ piv = col; big = temp; } } else if (col.stat == GLP_NU) { /* column j has active upper bound */ if (d > 0.0 && big < temp){ piv = col; big = temp; } } else { npp_error(); return 1; } } /* if column q does not exist, no correction is needed */ if (piv != null) { /* correct solution; row p becomes active constraint while column q becomes basic */ if (npp.sol == GLP_SOL) { npp.r_stat[info.p] = info.stat; npp.c_stat[piv.j] = GLP_BS; } /* assign new value to row multiplier pi[p] = d[p] / a[p,q] */ npp.r_pi[info.p] = piv.c / piv.a; } return 0; } ); info.p = p.i; if (p.lb == p.ub) { /* equality constraint */ info.stat = GLP_NS; } else if (at == 0) { /* inequality constraint; case L[p] = U'[p] */ info.stat = GLP_NL; xassert(p.lb != -DBL_MAX); } else /* at == 1 */ { /* inequality constraint; case U[p] = L'[p] */ info.stat = GLP_NU; xassert(p.ub != +DBL_MAX); } info.ptr = null; /* scan the forcing row, fix columns at corresponding bounds, and save column information (the latter is not needed for MIP) */ for (apj = p.ptr; apj != null; apj = apj.r_next) { /* column j has non-zero coefficient in the forcing row */ j = apj.col; /* it must be non-fixed */ xassert(j.lb < j.ub); /* allocate stack entry to save column information */ if (npp.sol != GLP_MIP) { col = {}; col.j = j.j; col.stat = -1; /* will be set below */ col.a = apj.val; col.c = j.coef; col.ptr = null; col.next = info.ptr; info.ptr = col; } /* fix column j */ if (at == 0 && apj.val < 0.0 || at != 0 && apj.val > 0.0) { /* at its lower bound */ if (npp.sol != GLP_MIP) col.stat = GLP_NL; xassert(j.lb != -DBL_MAX); j.ub = j.lb; } else { /* at its upper bound */ if (npp.sol != GLP_MIP) col.stat = GLP_NU; xassert(j.ub != +DBL_MAX); j.lb = j.ub; } /* save column coefficients a[i,j], i != p */ if (npp.sol != GLP_MIP) { for (aij = j.ptr; aij != null; aij = aij.c_next) { if (aij == apj) continue; /* skip a[p,j] */ lfe = {}; lfe.ref = aij.row.i; lfe.val = aij.val; lfe.next = col.ptr; col.ptr = lfe; } } } /* make the row free (unbounded) */ p.lb = -DBL_MAX; p.ub = +DBL_MAX; return 0; } function npp_analyze_row(npp, p){ /* perform general row analysis */ var aij; var ret = 0x00; var l, u, eps; xassert(npp == npp); /* compute implied lower bound L'[p]; see (3) */ l = 0.0; for (aij = p.ptr; aij != null; aij = aij.r_next) { if (aij.val > 0.0) { if (aij.col.lb == -DBL_MAX) { l = -DBL_MAX; break; } l += aij.val * aij.col.lb; } else /* aij.val < 0.0 */ { if (aij.col.ub == +DBL_MAX) { l = -DBL_MAX; break; } l += aij.val * aij.col.ub; } } /* compute implied upper bound U'[p]; see (4) */ u = 0.0; for (aij = p.ptr; aij != null; aij = aij.r_next) { if (aij.val > 0.0) { if (aij.col.ub == +DBL_MAX) { u = +DBL_MAX; break; } u += aij.val * aij.col.ub; } else /* aij.val < 0.0 */ { if (aij.col.lb == -DBL_MAX) { u = +DBL_MAX; break; } u += aij.val * aij.col.lb; } } /* column bounds are assumed correct, so L'[p] <= U'[p] */ /* check if row lower bound is consistent */ if (p.lb != -DBL_MAX) { eps = 1e-3 + 1e-6 * Math.abs(p.lb); if (p.lb - eps > u) { ret = 0x33; return ret; } } /* check if row upper bound is consistent */ if (p.ub != +DBL_MAX) { eps = 1e-3 + 1e-6 * Math.abs(p.ub); if (p.ub + eps < l) { ret = 0x33; return ret; } } /* check if row lower bound can be active/forcing */ if (p.lb != -DBL_MAX) { eps = 1e-9 + 1e-12 * Math.abs(p.lb); if (p.lb - eps > l) { if (p.lb + eps <= u) ret |= 0x01; else ret |= 0x02; } } /* check if row upper bound can be active/forcing */ if (p.ub != +DBL_MAX) { eps = 1e-9 + 1e-12 * Math.abs(p.ub); if (p.ub + eps < u) { /* check if the upper bound is forcing */ if (p.ub - eps >= l) ret |= 0x10; else ret |= 0x20; } } return ret; } function npp_inactive_bound(npp, p, which){ /* remove row lower/upper inactive bound */ var info; if (npp.sol == GLP_SOL) { /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info){ /* recover row status */ if (npp.sol != GLP_SOL) { npp_error(); return 1; } if (npp.r_stat[info.p] == GLP_BS) npp.r_stat[info.p] = GLP_BS; else npp.r_stat[info.p] = info.stat; return 0; } ); info.p = p.i; if (p.ub == +DBL_MAX) info.stat = GLP_NL; else if (p.lb == -DBL_MAX) info.stat = GLP_NU; else if (p.lb != p.ub) info.stat = (which == 0 ? GLP_NU : GLP_NL); else info.stat = GLP_NS; } /* remove row inactive bound */ if (which == 0) { xassert(p.lb != -DBL_MAX); p.lb = -DBL_MAX; } else if (which == 1) { xassert(p.ub != +DBL_MAX); p.ub = +DBL_MAX; } else xassert(which != which); } function npp_implied_bounds(npp, p){ var apj, apk; var big, eps, temp; var skip = false; xassert(npp == npp); /* initialize implied bounds for all variables and determine maximal magnitude of row coefficients a[p,j] */ big = 1.0; for (apj = p.ptr; apj != null; apj = apj.r_next) { apj.col.ll.ll = -DBL_MAX; apj.col.uu.uu = +DBL_MAX; if (big < Math.abs(apj.val)) big = Math.abs(apj.val); } eps = 1e-6 * big; /* process row lower bound (assuming that it can be active) */ if (p.lb != -DBL_MAX){ apk = null; for (apj = p.ptr; apj != null; apj = apj.r_next){ if (apj.val > 0.0 && apj.col.ub == +DBL_MAX || apj.val < 0.0 && apj.col.lb == -DBL_MAX){ if (apk == null) apk = apj; else { skip = true; break; } } } if (!skip){ /* if a[p,k] = null then |J'| = 0 else J' = { k } */ temp = p.lb; for (apj = p.ptr; apj != null; apj = apj.r_next) { if (apj == apk){ /* skip a[p,k] */ } else if (apj.val > 0.0) temp -= apj.val * apj.col.ub; else /* apj.val < 0.0 */ temp -= apj.val * apj.col.lb; } /* compute column implied bounds */ if (apk == null) { /* temp = L[p] - U'[p] */ for (apj = p.ptr; apj != null; apj = apj.r_next) { if (apj.val >= +eps) { /* l'[j] := u[j] + (L[p] - U'[p]) / a[p,j] */ apj.col.ll.ll = apj.col.ub + temp / apj.val; } else if (apj.val <= -eps) { /* u'[j] := l[j] + (L[p] - U'[p]) / a[p,j] */ apj.col.uu.uu = apj.col.lb + temp / apj.val; } } } else { /* temp = L[p,k] */ if (apk.val >= +eps) { /* l'[k] := L[p,k] / a[p,k] */ apk.col.ll.ll = temp / apk.val; } else if (apk.val <= -eps) { /* u'[k] := L[p,k] / a[p,k] */ apk.col.uu.uu = temp / apk.val; } } } } skip = false; /* process row upper bound (assuming that it can be active) */ if (p.ub != +DBL_MAX) { apk = null; for (apj = p.ptr; apj != null; apj = apj.r_next){ if (apj.val > 0.0 && apj.col.lb == -DBL_MAX || apj.val < 0.0 && apj.col.ub == +DBL_MAX){ if (apk == null) apk = apj; else { skip = true; break; } } } if (!skip){ /* if a[p,k] = null then |J''| = 0 else J'' = { k } */ temp = p.ub; for (apj = p.ptr; apj != null; apj = apj.r_next) { if (apj == apk){ /* skip a[p,k] */ } else if (apj.val > 0.0) temp -= apj.val * apj.col.lb; else /* apj.val < 0.0 */ temp -= apj.val * apj.col.ub; } /* compute column implied bounds */ if (apk == null) { /* temp = U[p] - L'[p] */ for (apj = p.ptr; apj != null; apj = apj.r_next) { if (apj.val >= +eps) { /* u'[j] := l[j] + (U[p] - L'[p]) / a[p,j] */ apj.col.uu.uu = apj.col.lb + temp / apj.val; } else if (apj.val <= -eps) { /* l'[j] := u[j] + (U[p] - L'[p]) / a[p,j] */ apj.col.ll.ll = apj.col.ub + temp / apj.val; } } } else { /* temp = U[p,k] */ if (apk.val >= +eps) { /* u'[k] := U[p,k] / a[p,k] */ apk.col.uu.uu = temp / apk.val; } else if (apk.val <= -eps) { /* l'[k] := U[p,k] / a[p,k] */ apk.col.ll.ll = temp / apk.val; } } } } } function npp_binarize_prob(npp){ /* binarize MIP problem */ var info; var row; var col, bin; var aij; var u, n, k, temp, nfails, nvars, nbins, nrows; /* new variables will be added to the end of the column list, so we go from the end to beginning of the column list */ nfails = nvars = nbins = nrows = 0; for (col = npp.c_tail; col != null; col = col.prev) { /* skip continuous variable */ if (!col.is_int) continue; /* skip fixed variable */ if (col.lb == col.ub) continue; /* skip binary variable */ if (col.lb == 0.0 && col.ub == 1.0) continue; /* check if the transformation is applicable */ if (col.lb < -1e6 || col.ub > +1e6 || col.ub - col.lb > 4095.0) { /* unfortunately, not */ nfails++; continue; } /* process integer non-binary variable x[q] */ nvars++; /* make x[q] non-negative, if its lower bound is non-zero */ if (col.lb != 0.0) npp_lbnd_col(npp, col); /* now 0 <= x[q] <= u[q] */ xassert(col.lb == 0.0); u = col.ub|0; xassert(col.ub == u); /* if x[q] is binary, further processing is not needed */ if (u == 1) continue; /* determine smallest n such that u <= 2^n - 1 (thus, n is the number of binary variables needed) */ n = 2; temp = 4; while (u >= temp){ n++; temp += temp; } nbins += n; /* create transformation stack entry */ info = npp_push_tse(npp, function (npp, info) { /* recovery binarized variable */ var k, temp; /* compute value of x[q]; see formula (3) */ var sum = npp.c_value[info.q]; for (k = 1, temp = 2; k < info.n; k++, temp += temp) sum += temp * npp.c_value[info.j + (k-1)]; npp.c_value[info.q] = sum; return 0; } ); info.q = col.j; info.j = 0; /* will be set below */ info.n = n; /* if u < 2^n - 1, we need one additional row for (4) */ if (u < temp - 1) { row = npp_add_row(npp); nrows++; row.lb = -DBL_MAX; row.ub = u; } else row = null; /* in the transformed problem variable x[q] becomes binary variable x[0], so its objective and constraint coefficients are not changed */ col.ub = 1.0; /* include x[0] into constraint (4) */ if (row != null) npp_add_aij(row, col, 1.0); /* add other binary variables x[1], ..., x[n-1] */ for (k = 1, temp = 2; k < n; k++, temp += temp) { /* add new binary variable x[k] */ bin = npp_add_col(npp); bin.is_int = 1; bin.lb = 0.0; bin.ub = 1.0; bin.coef = temp * col.coef; /* store column reference number for x[1] */ if (info.j == 0) info.j = bin.j; else xassert(info.j + (k-1) == bin.j); /* duplicate constraint coefficients for x[k]; this also automatically includes x[k] into constraint (4) */ for (aij = col.ptr; aij != null; aij = aij.c_next) npp_add_aij(aij.row, bin, temp * aij.val); } } if (nvars > 0) xprintf(nvars + " integer variable(s) were replaced by " + nbins + " binary ones"); if (nrows > 0) xprintf(nrows + " row(s) were added due to binarization"); if (nfails > 0) xprintf("Binarization failed for " + nfails + " integer variable(s)"); return nfails; } function copy_form(row, s){ /* copy linear form */ var aij; var ptr, e; ptr = null; for (aij = row.ptr; aij != null; aij = aij.r_next) { e = {}; e.aj = s * aij.val; e.xj = aij.col; e.next = ptr; ptr = e; } return ptr; } function npp_is_packing(npp, row){ /* test if constraint is packing inequality */ var col; var aij; var b; xassert(npp == npp); if (!(row.lb == -DBL_MAX && row.ub != +DBL_MAX)) return 0; b = 1; for (aij = row.ptr; aij != null; aij = aij.r_next) { col = aij.col; if (!(col.is_int && col.lb == 0.0 && col.ub == 1.0)) return 0; if (aij.val == +1.0){ } else if (aij.val == -1.0) b--; else return 0; } if (row.ub != b) return 0; return 1; } function hidden_packing(npp, ptr, b, callback) { /* process inequality constraint: sum a[j] x[j] <= b; 0 - specified row is NOT hidden packing inequality; 1 - specified row is packing inequality; 2 - specified row is hidden packing inequality. */ var e, ej, ek; var neg; var eps; xassert(npp == npp); /* a[j] must be non-zero, x[j] must be binary, for all j in J */ for (e = ptr; e != null; e = e.next) { xassert(e.aj != 0.0); xassert(e.xj.is_int); xassert(e.xj.lb == 0.0 && e.xj.ub == 1.0); } /* check if the specified inequality constraint already has the form of packing inequality */ neg = 0; /* neg is |Jn| */ for (e = ptr; e != null; e = e.next) { if (e.aj == +1.0){ } else if (e.aj == -1.0) neg++; else break; } if (e == null) { /* all coefficients a[j] are +1 or -1; check rhs b */ if (b == (1 - neg)) { /* it is packing inequality; no processing is needed */ return 1; } } /* substitute x[j] = 1 - x~[j] for all j in Jn to make all a[j] positive; the result is a~[j] = |a[j]| and new rhs b */ for (e = ptr; e != null; e = e.next) if (e.aj < 0) b -= e.aj; /* now a[j] > 0 for all j in J (actually |a[j]| are used) */ /* if a[j] > b, skip processing--this case must not appear */ for (e = ptr; e != null; e = e.next) if (Math.abs(e.aj) > b) return 0; /* now 0 < a[j] <= b for all j in J */ /* find two minimal coefficients a[j] and a[k], j != k */ ej = null; for (e = ptr; e != null; e = e.next) if (ej == null || Math.abs(ej.aj) > Math.abs(e.aj)) ej = e; xassert(ej != null); ek = null; for (e = ptr; e != null; e = e.next) if (e != ej) if (ek == null || Math.abs(ek.aj) > Math.abs(e.aj)) ek = e; xassert(ek != null); /* the specified constraint is equivalent to packing inequality iff a[j] + a[k] > b + eps */ eps = 1e-3 + 1e-6 * Math.abs(b); if (Math.abs(ej.aj) + Math.abs(ek.aj) <= b + eps) return 0; /* perform back substitution x~[j] = 1 - x[j] and construct the final equivalent packing inequality in generalized format */ b = 1.0; for (e = ptr; e != null; e = e.next) { if (e.aj > 0.0) e.aj = +1.0; else /* e.aj < 0.0 */{ e.aj = -1.0; b -= 1.0 } } callback(b); return 2; } function npp_hidden_packing(npp, row){ /* identify hidden packing inequality */ var copy; var aij; var ptr, e; var kase, ret, count = 0; var b; /* the row must be inequality constraint */ xassert(row.lb < row.ub); for (kase = 0; kase <= 1; kase++) { if (kase == 0) { /* process row upper bound */ if (row.ub == +DBL_MAX) continue; ptr = copy_form(row, +1.0); b = + row.ub; } else { /* process row lower bound */ if (row.lb == -DBL_MAX) continue; ptr = copy_form(row, -1.0); b = - row.lb; } /* now the inequality has the form "sum a[j] x[j] <= b" */ ret = hidden_packing(npp, ptr, b, function(v){b=v}); xassert(0 <= ret && ret <= 2); if (kase == 1 && ret == 1 || ret == 2) { /* the original inequality has been identified as hidden packing inequality */ count++; if (GLP_DEBUG){ xprintf("Original constraint:"); for (aij = row.ptr; aij != null; aij = aij.r_next) xprintf(" " + aij.val + " x" + aij.col.j); if (row.lb != -DBL_MAX) xprintf(", >= " + row.lb); if (row.ub != +DBL_MAX) xprintf(", <= " + row.ub); xprintf(""); xprintf("Equivalent packing inequality:"); for (e = ptr; e != null; e = e.next) xprintf(" " + (e.aj > 0.0 ? "+" : "-") + "x" + e.xj.j); xprintf(", <= " + b + ""); } if (row.lb == -DBL_MAX || row.ub == +DBL_MAX) { /* the original row is single-sided inequality; no copy is needed */ copy = null; } else { /* the original row is double-sided inequality; we need to create its copy for other bound before replacing it with the equivalent inequality */ copy = npp_add_row(npp); if (kase == 0) { /* the copy is for lower bound */ copy.lb = row.lb; copy.ub = +DBL_MAX; } else { /* the copy is for upper bound */ copy.lb = -DBL_MAX; copy.ub = row.ub; } /* copy original row coefficients */ for (aij = row.ptr; aij != null; aij = aij.r_next) npp_add_aij(copy, aij.col, aij.val); } /* replace the original inequality by equivalent one */ npp_erase_row(row); row.lb = -DBL_MAX; row.ub = b; for (e = ptr; e != null; e = e.next) npp_add_aij(row, e.xj, e.aj); /* continue processing lower bound for the copy */ if (copy != null) row = copy; } } return count; } function npp_implied_packing(row, which, var_, set_){ var ptr, e, i, k; var len = 0; var b, eps; /* build inequality (3) */ if (which == 0) { ptr = copy_form(row, -1.0); xassert(row.lb != -DBL_MAX); b = - row.lb; } else if (which == 1) { ptr = copy_form(row, +1.0); xassert(row.ub != +DBL_MAX); b = + row.ub; } /* remove non-binary variables to build relaxed inequality (5); compute its right-hand side b~ with formula (6) */ for (e = ptr; e != null; e = e.next) { if (!(e.xj.is_int && e.xj.lb == 0.0 && e.xj.ub == 1.0)) { /* x[j] is non-binary variable */ if (e.aj > 0.0) { if (e.xj.lb == -DBL_MAX) return len; b -= e.aj * e.xj.lb; } else /* e.aj < 0.0 */ { if (e.xj.ub == +DBL_MAX) return len; b -= e.aj * e.xj.ub; } /* a[j] = 0 means that variable x[j] is removed */ e.aj = 0.0; } } /* substitute x[j] = 1 - x~[j] to build knapsack inequality (8); compute its right-hand side beta with formula (11) */ for (e = ptr; e != null; e = e.next) if (e.aj < 0.0) b -= e.aj; /* if beta is close to zero, the knapsack inequality is either infeasible or forcing inequality; this must never happen, so we skip further analysis */ if (b < 1e-3) return len; /* build set P as well as sets Jp and Jn, and determine x[k] as explained above in comments to the routine */ eps = 1e-3 + 1e-6 * b; i = k = null; for (e = ptr; e != null; e = e.next) { /* note that alfa[j] = |a[j]| */ if (Math.abs(e.aj) > 0.5 * (b + eps)) { /* alfa[j] > (b + eps) / 2; include x[j] in set P, i.e. in set Jp or Jn */ var_[++len] = e.xj; set_[len] = (e.aj > 0.0 ? 0 : 1); /* alfa[i] = min alfa[j] over all j included in set P */ if (i == null || Math.abs(i.aj) > Math.abs(e.aj)) i = e; } else if (Math.abs(e.aj) >= 1e-3) { /* alfa[k] = max alfa[j] over all j not included in set P; we skip coefficient a[j] if it is close to zero to avoid numerically unreliable results */ if (k == null || Math.abs(k.aj) < Math.abs(e.aj)) k = e; } } /* if alfa[k] satisfies to condition (13) for all j in P, include x[k] in P */ if (i != null && k != null && Math.abs(i.aj) + Math.abs(k.aj) > b + eps) { var_[++len] = k.xj; set_[len] = (k.aj > 0.0 ? 0 : 1); } /* trivial packing inequality being redundant must never appear, so we just ignore it */ if (len < 2) len = 0; return len; } function npp_is_covering(npp, row){ /* test if constraint is covering inequality */ var col; var aij; var b; xassert(npp == npp); if (!(row.lb != -DBL_MAX && row.ub == +DBL_MAX)) return 0; b = 1; for (aij = row.ptr; aij != null; aij = aij.r_next) { col = aij.col; if (!(col.is_int && col.lb == 0.0 && col.ub == 1.0)) return 0; if (aij.val == +1.0){ } else if (aij.val == -1.0) b--; else return 0; } if (row.lb != b) return 0; return 1; } function hidden_covering(npp, ptr, b, callback) { /* process inequality constraint: sum a[j] x[j] >= b; 0 - specified row is NOT hidden covering inequality; 1 - specified row is covering inequality; 2 - specified row is hidden covering inequality. */ var e; var neg; var eps; xassert(npp == npp); /* a[j] must be non-zero, x[j] must be binary, for all j in J */ for (e = ptr; e != null; e = e.next) { xassert(e.aj != 0.0); xassert(e.xj.is_int); xassert(e.xj.lb == 0.0 && e.xj.ub == 1.0); } /* check if the specified inequality constraint already has the form of covering inequality */ neg = 0; /* neg is |Jn| */ for (e = ptr; e != null; e = e.next) { if (e.aj == +1.0){ } else if (e.aj == -1.0) neg++; else break; } if (e == null) { /* all coefficients a[j] are +1 or -1; check rhs b */ if (b == (1 - neg)) { /* it is covering inequality; no processing is needed */ return 1; } } /* substitute x[j] = 1 - x~[j] for all j in Jn to make all a[j] positive; the result is a~[j] = |a[j]| and new rhs b */ for (e = ptr; e != null; e = e.next) if (e.aj < 0) b -= e.aj; /* now a[j] > 0 for all j in J (actually |a[j]| are used) */ /* if b <= 0, skip processing--this case must not appear */ if (b < 1e-3) return 0; /* now a[j] > 0 for all j in J, and b > 0 */ /* the specified constraint is equivalent to covering inequality iff a[j] >= b for all j in J */ eps = 1e-9 + 1e-12 * Math.abs(b); for (e = ptr; e != null; e = e.next) if (Math.abs(e.aj) < b - eps) return 0; /* perform back substitution x~[j] = 1 - x[j] and construct the final equivalent covering inequality in generalized format */ b = 1.0; for (e = ptr; e != null; e = e.next) { if (e.aj > 0.0) e.aj = +1.0; else /* e.aj < 0.0 */{ e.aj = -1.0; b -= 1.0; } } callback(b); return 2; } function npp_hidden_covering(npp, row){ /* identify hidden covering inequality */ var copy; var aij; var ptr, e; var kase, ret, count = 0; var b; /* the row must be inequality constraint */ xassert(row.lb < row.ub); for (kase = 0; kase <= 1; kase++) { if (kase == 0) { /* process row lower bound */ if (row.lb == -DBL_MAX) continue; ptr = copy_form(row, +1.0); b = + row.lb; } else { /* process row upper bound */ if (row.ub == +DBL_MAX) continue; ptr = copy_form(row, -1.0); b = - row.ub; } /* now the inequality has the form "sum a[j] x[j] >= b" */ ret = hidden_covering(npp, ptr, b, function(v){b=v}); xassert(0 <= ret && ret <= 2); if (kase == 1 && ret == 1 || ret == 2) { /* the original inequality has been identified as hidden covering inequality */ count++; if (GLP_DEBUG){ xprintf("Original constraint:"); for (aij = row.ptr; aij != null; aij = aij.r_next) xprintf(" " + aij.val + " x" + aij.col.j); if (row.lb != -DBL_MAX) xprintf(", >= " + row.lb); if (row.ub != +DBL_MAX) xprintf(", <= " + row.ub); xprintf(""); xprintf("Equivalent covering inequality:"); for (e = ptr; e != null; e = e.next) xprintf(" " + (e.aj > 0.0 ? "+" : "-") + "x" + e.xj.j); xprintf(", >= " + b + ""); } if (row.lb == -DBL_MAX || row.ub == +DBL_MAX) { /* the original row is single-sided inequality; no copy is needed */ copy = null; } else { /* the original row is double-sided inequality; we need to create its copy for other bound before replacing it with the equivalent inequality */ copy = npp_add_row(npp); if (kase == 0) { /* the copy is for upper bound */ copy.lb = -DBL_MAX; copy.ub = row.ub; } else { /* the copy is for lower bound */ copy.lb = row.lb; copy.ub = +DBL_MAX; } /* copy original row coefficients */ for (aij = row.ptr; aij != null; aij = aij.r_next) npp_add_aij(copy, aij.col, aij.val); } /* replace the original inequality by equivalent one */ npp_erase_row(row); row.lb = b; row.ub = +DBL_MAX; for (e = ptr; e != null; e = e.next) npp_add_aij(row, e.xj, e.aj); /* continue processing upper bound for the copy */ if (copy != null) row = copy; } } return count; } function npp_is_partitioning(npp, row){ /* test if constraint is partitioning equality */ var col; var aij; var b; xassert(npp == npp); if (row.lb != row.ub) return 0; b = 1; for (aij = row.ptr; aij != null; aij = aij.r_next) { col = aij.col; if (!(col.is_int && col.lb == 0.0 && col.ub == 1.0)) return 0; if (aij.val == +1.0){ } else if (aij.val == -1.0) b--; else return 0; } if (row.lb != b) return 0; return 1; } function reduce_ineq_coef(npp, ptr, b, callback) { /* process inequality constraint: sum a[j] x[j] >= b */ /* returns: the number of coefficients reduced */ var e; var count = 0; var h, inf_t, new_a; xassert(npp == npp); /* compute h; see (15) */ h = 0.0; for (e = ptr; e != null; e = e.next) { if (e.aj > 0.0) { if (e.xj.lb == -DBL_MAX) return count; h += e.aj * e.xj.lb; } else /* e.aj < 0.0 */ { if (e.xj.ub == +DBL_MAX) return count; h += e.aj * e.xj.ub; } } /* perform reduction of coefficients at binary variables */ for (e = ptr; e != null; e = e.next) { /* skip non-binary variable */ if (!(e.xj.is_int && e.xj.lb == 0.0 && e.xj.ub == 1.0)) continue; if (e.aj > 0.0) { /* compute inf t[k]; see (14) */ inf_t = h; if (b - e.aj < inf_t && inf_t < b) { /* compute reduced coefficient a'[k]; see (7) */ new_a = b - inf_t; if (new_a >= +1e-3 && e.aj - new_a >= 0.01 * (1.0 + e.aj)) { /* accept a'[k] */ if (GLP_DEBUG){xprintf("+")} e.aj = new_a; count++; } } } else /* e.aj < 0.0 */ { /* compute inf t[k]; see (14) */ inf_t = h - e.aj; if (b < inf_t && inf_t < b - e.aj) { /* compute reduced coefficient a'[k]; see (11) */ new_a = e.aj + (inf_t - b); if (new_a <= -1e-3 && new_a - e.aj >= 0.01 * (1.0 - e.aj)) { /* accept a'[k] */ if (GLP_DEBUG){xprintf("-")} e.aj = new_a; /* update h; see (17) */ h += (inf_t - b); /* compute b'; see (9) */ b = inf_t; count++; } } } } callback(b); return count } function npp_reduce_ineq_coef(npp, row){ /* reduce inequality constraint coefficients */ var copy; var aij; var ptr, e; var kase, count = new Array(2); var b; /* the row must be inequality constraint */ xassert(row.lb < row.ub); count[0] = count[1] = 0; for (kase = 0; kase <= 1; kase++) { if (kase == 0) { /* process row lower bound */ if (row.lb == -DBL_MAX) continue; if (GLP_DEBUG){xprintf("L")} ptr = copy_form(row, +1.0); b = + row.lb; } else { /* process row upper bound */ if (row.ub == +DBL_MAX) continue; if (GLP_DEBUG){xprintf("U")} ptr = copy_form(row, -1.0); b = - row.ub; } /* now the inequality has the form "sum a[j] x[j] >= b" */ count[kase] = reduce_ineq_coef(npp, ptr, b, function(v){b=v}); if (count[kase] > 0) { /* the original inequality has been replaced by equivalent one with coefficients reduced */ if (row.lb == -DBL_MAX || row.ub == +DBL_MAX) { /* the original row is single-sided inequality; no copy is needed */ copy = null; } else { /* the original row is double-sided inequality; we need to create its copy for other bound before replacing it with the equivalent inequality */ if (GLP_DEBUG){xprintf("*")} copy = npp_add_row(npp); if (kase == 0) { /* the copy is for upper bound */ copy.lb = -DBL_MAX; copy.ub = row.ub; } else { /* the copy is for lower bound */ copy.lb = row.lb; copy.ub = +DBL_MAX; } /* copy original row coefficients */ for (aij = row.ptr; aij != null; aij = aij.r_next) npp_add_aij(copy, aij.col, aij.val); } /* replace the original inequality by equivalent one */ npp_erase_row(row); row.lb = b; row.ub = +DBL_MAX; for (e = ptr; e != null; e = e.next) npp_add_aij(row, e.xj, e.aj); /* continue processing upper bound for the copy */ if (copy != null) row = copy; } } return count[0] + count[1]; } function npp_clean_prob(npp){ /* perform initial LP/MIP processing */ var row, next_row; var col, next_col; var ret; xassert(npp == npp); /* process rows which originally are free */ for (row = npp.r_head; row != null; row = next_row) { next_row = row.next; if (row.lb == -DBL_MAX && row.ub == +DBL_MAX) { /* process free row */ if (GLP_DEBUG){xprintf("1")} npp_free_row(npp, row); /* row was deleted */ } } /* process rows which originally are double-sided inequalities */ for (row = npp.r_head; row != null; row = next_row) { next_row = row.next; if (row.lb != -DBL_MAX && row.ub != +DBL_MAX && row.lb < row.ub) { ret = npp_make_equality(npp, row); if (ret == 0){ } else if (ret == 1) { /* row was replaced by equality constraint */ if (GLP_DEBUG){xprintf("2")} } else xassert(ret != ret); } } /* process columns which are originally fixed */ for (col = npp.c_head; col != null; col = next_col) { next_col = col.next; if (col.lb == col.ub) { /* process fixed column */ if (GLP_DEBUG){xprintf("3")} npp_fixed_col(npp, col); /* column was deleted */ } } /* process columns which are originally double-bounded */ for (col = npp.c_head; col != null; col = next_col) { next_col = col.next; if (col.lb != -DBL_MAX && col.ub != +DBL_MAX && col.lb < col.ub) { ret = npp_make_fixed(npp, col); if (ret == 0){ } else if (ret == 1) { /* column was replaced by fixed column; process it */ if (GLP_DEBUG){xprintf("4")} npp_fixed_col(npp, col); /* column was deleted */ } } } } function npp_process_row(npp, row, hard){ /* perform basic row processing */ var col; var aij, next_aij, aaa; var ret; /* row must not be free */ xassert(!(row.lb == -DBL_MAX && row.ub == +DBL_MAX)); /* start processing row */ if (row.ptr == null) { /* empty row */ ret = npp_empty_row(npp, row); if (ret == 0) { /* row was deleted */ if (GLP_DEBUG){xprintf("A")} return 0; } else if (ret == 1) { /* primal infeasibility */ return GLP_ENOPFS; } else xassert(ret != ret); } if (row.ptr.r_next == null) { /* row singleton */ col = row.ptr.col; if (row.lb == row.ub) { /* equality constraint */ ret = npp_eq_singlet(npp, row); if (ret == 0) { /* column was fixed, row was deleted */ if (GLP_DEBUG){xprintf("B")} /* activate rows affected by column */ for (aij = col.ptr; aij != null; aij = aij.c_next) npp_activate_row(npp, aij.row); /* process fixed column */ npp_fixed_col(npp, col); /* column was deleted */ return 0; } else if (ret == 1 || ret == 2) { /* primal/integer infeasibility */ return GLP_ENOPFS; } else xassert(ret != ret); } else { /* inequality constraint */ ret = npp_ineq_singlet(npp, row); if (0 <= ret && ret <= 3) { /* row was deleted */ if (GLP_DEBUG){xprintf("C")} /* activate column, since its length was changed due to row deletion */ npp_activate_col(npp, col); if (ret >= 2) { /* column bounds changed significantly or column was fixed */ /* activate rows affected by column */ for (aij = col.ptr; aij != null; aij = aij.c_next) npp_activate_row(npp, aij.row); } if (ret == 3) { /* column was fixed; process it */ if (GLP_DEBUG){xprintf("D")} npp_fixed_col(npp, col); /* column was deleted */ } return 0; } else if (ret == 4) { /* primal infeasibility */ return GLP_ENOPFS; } else xassert(ret != ret); } } /* general row analysis */ ret = npp_analyze_row(npp, row); xassert(0x00 <= ret && ret <= 0xFF); if (ret == 0x33) { /* row bounds are inconsistent with column bounds */ return GLP_ENOPFS; } if ((ret & 0x0F) == 0x00) { /* row lower bound does not exist or redundant */ if (row.lb != -DBL_MAX) { /* remove redundant row lower bound */ if (GLP_DEBUG){xprintf("F")} npp_inactive_bound(npp, row, 0); } } else if ((ret & 0x0F) == 0x01) { /* row lower bound can be active */ /* see below */ } else if ((ret & 0x0F) == 0x02) { /* row lower bound is a forcing bound */ if (GLP_DEBUG){xprintf("G")} /* process forcing row */ if (npp_forcing_row(npp, row, 0) == 0) return fixup(); } else xassert(ret != ret); if ((ret & 0xF0) == 0x00) { /* row upper bound does not exist or redundant */ if (row.ub != +DBL_MAX) { /* remove redundant row upper bound */ if (GLP_DEBUG){xprintf("I")} npp_inactive_bound(npp, row, 1); } } else if ((ret & 0xF0) == 0x10) { /* row upper bound can be active */ /* see below */ } else if ((ret & 0xF0) == 0x20) { /* row upper bound is a forcing bound */ if (GLP_DEBUG) {xprintf("J")} /* process forcing row */ if (npp_forcing_row(npp, row, 1) == 0) return fixup(); } else xassert(ret != ret); if (row.lb == -DBL_MAX && row.ub == +DBL_MAX) { /* row became free due to redundant bounds removal */ if (GLP_DEBUG) {xprintf("K")} /* activate its columns, since their length will change due to row deletion */ for (aij = row.ptr; aij != null; aij = aij.r_next) npp_activate_col(npp, aij.col); /* process free row */ npp_free_row(npp, row); /* row was deleted */ return 0; } /* row lower and/or upper bounds can be active */ if (npp.sol == GLP_MIP && hard) { /* improve current column bounds (optional) */ if (npp_improve_bounds(npp, row, 1) < 0) return GLP_ENOPFS; } function fixup() { /* columns were fixed, row was made free */ for (aij = row.ptr; aij != null; aij = next_aij) { /* process column fixed by forcing row */ if (GLP_DEBUG){xprintf("H")} col = aij.col; next_aij = aij.r_next; /* activate rows affected by column */ for (aaa = col.ptr; aaa != null; aaa = aaa.c_next) npp_activate_row(npp, aaa.row); /* process fixed column */ npp_fixed_col(npp, col); /* column was deleted */ } /* process free row (which now is empty due to deletion of all its columns) */ npp_free_row(npp, row); /* row was deleted */ return 0; } return 0; } function npp_improve_bounds(npp, row, flag){ /* improve current column bounds */ var col; var aij, next_aij, aaa; var kase, ret, count = 0; var lb, ub; xassert(npp.sol == GLP_MIP); /* row must not be free */ xassert(!(row.lb == -DBL_MAX && row.ub == +DBL_MAX)); /* determine implied column bounds */ npp_implied_bounds(npp, row); /* and use these bounds to strengthen current column bounds */ for (aij = row.ptr; aij != null; aij = next_aij) { col = aij.col; next_aij = aij.r_next; for (kase = 0; kase <= 1; kase++) { /* save current column bounds */ lb = col.lb; ub = col.ub; if (kase == 0) { /* process implied column lower bound */ if (col.ll.ll == -DBL_MAX) continue; ret = npp_implied_lower(npp, col, col.ll.ll); } else { /* process implied column upper bound */ if (col.uu.uu == +DBL_MAX) continue; ret = npp_implied_upper(npp, col, col.uu.uu); } if (ret == 0 || ret == 1) { /* current column bounds did not change or changed, but not significantly; restore current column bounds */ col.lb = lb; col.ub = ub; } else if (ret == 2 || ret == 3) { /* current column bounds changed significantly or column was fixed */ if (GLP_DEBUG){xprintf("L")} count++; /* activate other rows affected by column, if required */ if (flag) { for (aaa = col.ptr; aaa != null; aaa = aaa.c_next) { if (aaa.row != row) npp_activate_row(npp, aaa.row); } } if (ret == 3) { /* process fixed column */ if (GLP_DEBUG){xprintf("M")} npp_fixed_col(npp, col); /* column was deleted */ break; /* for kase */ } } else if (ret == 4) { /* primal/integer infeasibility */ return -1; } else xassert(ret != ret); } } return count; } function npp_process_col(npp, col) { /* perform basic column processing */ var row; var aij; var ret; /* column must not be fixed */ xassert(col.lb < col.ub); /* start processing column */ if (col.ptr == null) { /* empty column */ ret = npp_empty_col(npp, col); if (ret == 0) { /* column was fixed and deleted */ if (GLP_DEBUG){xprintf("N")} return 0; } else if (ret == 1) { /* dual infeasibility */ return GLP_ENODFS; } else xassert(ret != ret); } if (col.ptr.c_next == null) { /* column singleton */ row = col.ptr.row; function slack(){ /* implied slack variable */ if (GLP_DEBUG) {xprintf("O")} npp_implied_slack(npp, col); /* column was deleted */ if (row.lb == -DBL_MAX && row.ub == +DBL_MAX) { /* row became free due to implied slack variable */ if (GLP_DEBUG){xprintf("P")} /* activate columns affected by row */ for (aij = row.ptr; aij != null; aij = aij.r_next) npp_activate_col(npp, aij.col); /* process free row */ npp_free_row(npp, row); /* row was deleted */ } else { /* row became inequality constraint; activate it since its length changed due to column deletion */ npp_activate_row(npp, row); } return 0; } if (row.lb == row.ub) { /* equality constraint */ if (!col.is_int) return slack(); } else { /* inequality constraint */ if (!col.is_int) { ret = npp_implied_free(npp, col); if (ret == 0) { /* implied free variable */ if (GLP_DEBUG){xprintf("Q")} /* column bounds were removed, row was replaced by equality constraint */ return slack(); } else if (ret == 1) { /* column is not implied free variable, because its lower and/or upper bounds can be active */ } else if (ret == 2) { /* dual infeasibility */ return GLP_ENODFS; } } } } /* column still exists */ return 0; } function npp_process_prob(npp, hard){ /* perform basic LP/MIP processing */ var row; var col; var processing, ret; /* perform initial LP/MIP processing */ npp_clean_prob(npp); /* activate all remaining rows and columns */ for (row = npp.r_head; row != null; row = row.next) row.temp = 1; for (col = npp.c_head; col != null; col = col.next) col.temp = 1; /* main processing loop */ processing = 1; while (processing) { processing = 0; /* process all active rows */ for (;;) { row = npp.r_head; if (row == null || !row.temp) break; npp_deactivate_row(npp, row); ret = npp_process_row(npp, row, hard); if (ret != 0) return done(); processing = 1; } /* process all active columns */ for (;;) { col = npp.c_head; if (col == null || !col.temp) break; npp_deactivate_col(npp, col); ret = npp_process_col(npp, col); if (ret != 0) return done(); processing = 1; } } if (npp.sol == GLP_MIP && !hard) { /* improve current column bounds (optional) */ for (row = npp.r_head; row != null; row = row.next) { if (npp_improve_bounds(npp, row, 0) < 0) { ret = GLP_ENOPFS; return done(); } } } /* all seems ok */ ret = 0; function done(){ xassert(ret == 0 || ret == GLP_ENOPFS || ret == GLP_ENODFS); if (GLP_DEBUG){xprintf("")} return ret; } return done(); } function npp_simplex(npp, parm){ /* process LP prior to applying primal/dual simplex method */ xassert(npp.sol == GLP_SOL); xassert(parm == parm); return npp_process_prob(npp, 0); } function npp_integer(npp, parm){ /* process MIP prior to applying branch-and-bound method */ var row, prev_row; var col; var aij; var count, ret; xassert(npp.sol == GLP_MIP); xassert(parm == parm); /*==============================================================*/ /* perform basic MIP processing */ ret = npp_process_prob(npp, 1); if (ret != 0) return ret; /*==============================================================*/ /* binarize problem, if required */ if (parm.binarize) npp_binarize_prob(npp); /*==============================================================*/ /* identify hidden packing inequalities */ count = 0; /* new rows will be added to the end of the row list, so we go from the end to beginning of the row list */ for (row = npp.r_tail; row != null; row = prev_row) { prev_row = row.prev; /* skip free row */ if (row.lb == -DBL_MAX && row.ub == +DBL_MAX) continue; /* skip equality constraint */ if (row.lb == row.ub) continue; /* skip row having less than two variables */ if (row.ptr == null || row.ptr.r_next == null) continue; /* skip row having non-binary variables */ for (aij = row.ptr; aij != null; aij = aij.r_next) { col = aij.col; if (!(col.is_int && col.lb == 0.0 && col.ub == 1.0)) break; } if (aij != null) continue; count += npp_hidden_packing(npp, row); } if (count > 0) xprintf(count + " hidden packing inequaliti(es) were detected"); /*==============================================================*/ /* identify hidden covering inequalities */ count = 0; /* new rows will be added to the end of the row list, so we go from the end to beginning of the row list */ for (row = npp.r_tail; row != null; row = prev_row) { prev_row = row.prev; /* skip free row */ if (row.lb == -DBL_MAX && row.ub == +DBL_MAX) continue; /* skip equality constraint */ if (row.lb == row.ub) continue; /* skip row having less than three variables */ if (row.ptr == null || row.ptr.r_next == null || row.ptr.r_next.r_next == null) continue; /* skip row having non-binary variables */ for (aij = row.ptr; aij != null; aij = aij.r_next) { col = aij.col; if (!(col.is_int && col.lb == 0.0 && col.ub == 1.0)) break; } if (aij != null) continue; count += npp_hidden_covering(npp, row); } if (count > 0) xprintf(count + " hidden covering inequaliti(es) were detected"); /*==============================================================*/ /* reduce inequality constraint coefficients */ count = 0; /* new rows will be added to the end of the row list, so we go from the end to beginning of the row list */ for (row = npp.r_tail; row != null; row = prev_row) { prev_row = row.prev; /* skip equality constraint */ if (row.lb == row.ub) continue; count += npp_reduce_ineq_coef(npp, row); } if (count > 0) xprintf(count + " constraint coefficient(s) were reduced"); /*==============================================================*/ //if (GLP_DEBUG){routine(npp)} /*==============================================================*/ /* all seems ok */ ret = 0; return ret; } function mod_diff(x, y) {return (x - y) & 0x7FFFFFFF} /* difference modulo 2^31 */ function flip_cycle(rand){ /* this is an auxiliary routine to do 55 more steps of the basic recurrence, at high speed, and to reset fptr */ var ii, jj; for (ii = 1, jj = 32; jj <= 55; ii++, jj++) rand.A[ii] = mod_diff(rand.A[ii], rand.A[jj]); for (jj = 1; ii <= 55; ii++, jj++) rand.A[ii] = mod_diff(rand.A[ii], rand.A[jj]); rand.fptr = 54; return rand.A[55]; } function rng_create_rand(){ var rand = {}; var i; rand.A = new Array(56); rand.A[0] = -1; for (i = 1; i <= 55; i++) rand.A[i] = 0; (rand.fptr) = 0; rng_init_rand(rand, 1); return rand; } function rng_init_rand(rand, seed){ var i; var prev = seed, next = 1; seed = prev = mod_diff(prev, 0); rand.A[55] = prev; for (i = 21; i; i = (i + 21) % 55) { rand.A[i] = next; next = mod_diff(prev, next); if (seed & 1) seed = 0x40000000 + (seed >> 1); else seed >>= 1; next = mod_diff(next, seed); prev = rand.A[i]; } flip_cycle(rand); flip_cycle(rand); flip_cycle(rand); flip_cycle(rand); flip_cycle(rand); } function rng_next_rand(rand){ return rand.A[rand.fptr] >= 0 ? rand.A[rand.fptr--] : flip_cycle(rand); } function rng_unif_rand(rand, m){ var two_to_the_31 = 0x80000000; var t = two_to_the_31 - (two_to_the_31 % m); var r; xassert(m > 0); do { r = rng_next_rand(rand); } while (t <= r); return r % m; } function rng_unif_01(rand){ var x = rng_next_rand(rand) / 2147483647.0; xassert(0.0 <= x && x <= 1.0); return x; } function rng_uniform(rand, a, b){ if (a >= b) xerror("rng_uniform: a = " + a + ", b = " + b + "; invalid range"); var x = rng_unif_01(rand); x = a * (1.0 - x) + b * x; xassert(a <= x && x <= b); return x; } var SCF_TBG = 1, /* Bartels-Golub elimination */ SCF_TGR = 2; /* Givens plane rotation */ /* return codes: */ var SCF_ESING = 1, /* singular matrix */ SCF_ELIMIT = 2; /* update limit reached */ var _GLPSCF_DEBUG = 0; var SCF_EPS = 1e-10; function scf_create_it(n_max){ if (_GLPSCF_DEBUG){ xprintf("scf_create_it: warning: debug mode enabled"); } if (!(1 <= n_max && n_max <= 32767)) xerror("scf_create_it: n_max = " + n_max + "; invalid parameter"); var scf = {}; scf.n_max = n_max; scf.n = 0; scf.f = new Float64Array(1 + n_max * n_max); scf.u = new Float64Array(1 + n_max * (n_max + 1) / 2); scf.p = new Int32Array(1 + n_max); scf.t_opt = SCF_TBG; scf.rank = 0; if (_GLPSCF_DEBUG) scf.c = new Float64Array(1 + n_max * n_max); else scf.c = null; scf.w = new Float64Array(1 + n_max); return scf; } function f_loc(scf, i, j){ var n_max = scf.n_max; var n = scf.n; xassert(1 <= i && i <= n); xassert(1 <= j && j <= n); return (i - 1) * n_max + j; } function u_loc(scf, i, j){ var n_max = scf.n_max; var n = scf.n; xassert(1 <= i && i <= n); xassert(i <= j && j <= n); return (i - 1) * n_max + j - i * (i - 1) / 2; } function bg_transform(scf, k, un){ var n = scf.n; var f = scf.f; var u = scf.u; var j, k1, kj, kk, n1, nj; var t; xassert(1 <= k && k <= n); /* main elimination loop */ for (; k < n; k++) { /* determine location of U[k,k] */ kk = u_loc(scf, k, k); /* determine location of F[k,1] */ k1 = f_loc(scf, k, 1); /* determine location of F[n,1] */ n1 = f_loc(scf, n, 1); /* if |U[k,k]| < |U[n,k]|, interchange k-th and n-th rows to provide |U[k,k]| >= |U[n,k]| */ if (Math.abs(u[kk]) < Math.abs(un[k])) { /* interchange k-th and n-th rows of matrix U */ for (j = k, kj = kk; j <= n; j++, kj++){ t = u[kj]; u[kj] = un[j]; un[j] = t; } /* interchange k-th and n-th rows of matrix F to keep the main equality F * C = U * P */ for (j = 1, kj = k1, nj = n1; j <= n; j++, kj++, nj++){ t = f[kj]; f[kj] = f[nj]; f[nj] = t; } } /* now |U[k,k]| >= |U[n,k]| */ /* if U[k,k] is too small in the magnitude, replace U[k,k] and U[n,k] by exact zero */ if (Math.abs(u[kk]) < SCF_EPS) u[kk] = un[k] = 0.0; /* if U[n,k] is already zero, elimination is not needed */ if (un[k] == 0.0) continue; /* compute gaussian multiplier t = U[n,k] / U[k,k] */ t = un[k] / u[kk]; /* apply gaussian elimination to nullify U[n,k] */ /* (n-th row of U) := (n-th row of U) - t * (k-th row of U) */ for (j = k+1, kj = kk+1; j <= n; j++, kj++) un[j] -= t * u[kj]; /* (n-th row of F) := (n-th row of F) - t * (k-th row of F) to keep the main equality F * C = U * P */ for (j = 1, kj = k1, nj = n1; j <= n; j++, kj++, nj++) f[nj] -= t * f[kj]; } /* if U[n,n] is too small in the magnitude, replace it by exact zero */ if (Math.abs(un[n]) < SCF_EPS) un[n] = 0.0; /* store U[n,n] in a proper location */ u[u_loc(scf, n, n)] = un[n]; } function givens(a, b, callback){ var t, c, s; if (b == 0.0){ c = 1.0; s = 0.0; } else if (Math.abs(a) <= Math.abs(b)){ t = - a / b; s = 1.0 / Math.sqrt(1.0 + t * t); c = s * t; } else{ t = - b / a; c = 1.0 / Math.sqrt(1.0 + t * t); s = c * t; } callback(c, s); } function gr_transform(scf, k, un){ var n = scf.n; var f = scf.f; var u = scf.u; var j, k1, kj, kk, n1, nj; xassert(1 <= k && k <= n); /* main elimination loop */ for (; k < n; k++) { /* determine location of U[k,k] */ kk = u_loc(scf, k, k); /* determine location of F[k,1] */ k1 = f_loc(scf, k, 1); /* determine location of F[n,1] */ n1 = f_loc(scf, n, 1); /* if both U[k,k] and U[n,k] are too small in the magnitude, replace them by exact zero */ if (Math.abs(u[kk]) < SCF_EPS && Math.abs(un[k]) < SCF_EPS) u[kk] = un[k] = 0.0; /* if U[n,k] is already zero, elimination is not needed */ if (un[k] == 0.0) continue; /* compute the parameters of Givens plane rotation */ givens(u[kk], un[k], function(c, s){ /* apply Givens rotation to k-th and n-th rows of matrix U */ for (j = k, kj = kk; j <= n; j++, kj++) { var ukj = u[kj], unj = un[j]; u[kj] = c * ukj - s * unj; un[j] = s * ukj + c * unj; } /* apply Givens rotation to k-th and n-th rows of matrix F to keep the main equality F * C = U * P */ for (j = 1, kj = k1, nj = n1; j <= n; j++, kj++, nj++) { var fkj = f[kj], fnj = f[nj]; f[kj] = c * fkj - s * fnj; f[nj] = s * fkj + c * fnj; } } ); } /* if U[n,n] is too small in the magnitude, replace it by exact zero */ if (Math.abs(un[n]) < SCF_EPS) un[n] = 0.0; /* store U[n,n] in a proper location */ u[u_loc(scf, n, n)] = un[n]; } function transform(scf, k, un){ switch (scf.t_opt){ case SCF_TBG: bg_transform(scf, k, un); break; case SCF_TGR: gr_transform(scf, k, un); break; default: xassert(scf != scf); } } function estimate_rank(scf){ var n_max = scf.n_max; var n = scf.n; var u = scf.u; var i, ii, inc, rank = 0; for (i = 1, ii = u_loc(scf, i, i), inc = n_max; i <= n; i++, ii += inc, inc--) if (u[ii] != 0.0) rank++; return rank; } if (_GLPSCF_DEBUG){ function check_error(scf, func){ var n = scf.n; var f = scf.f; var u = scf.u; var p = scf.p; var c = scf.c; var i, j, k; var d, dmax = 0.0, s, t; xassert(c != null); for (i = 1; i <= n; i++) { for (j = 1; j <= n; j++) { /* compute element (i,j) of product F * C */ s = 0.0; for (k = 1; k <= n; k++) s += f[f_loc(scf, i, k)] * c[f_loc(scf, k, j)]; /* compute element (i,j) of product U * P */ k = p[j]; t = (i <= k ? u[u_loc(scf, i, k)] : 0.0); /* compute the maximal relative error */ d = Math.abs(s - t) / (1.0 + Math.abs(t)); if (dmax < d) dmax = d; } } if (dmax > 1e-8) xprintf(func + ": dmax = " + dmax + "; relative error too large"); } } function scf_update_exp(scf, x, idx, y, idy, z){ var n_max = scf.n_max; var n = scf.n; var f = scf.f; var u = scf.u; var p = scf.p; if (_GLPSCF_DEBUG){var c = scf.c} var un = scf.w; var i, ij, in_, j, k, nj, ret = 0; var t; /* check if the factorization can be expanded */ if (n == n_max) { /* there is not enough room */ ret = SCF_ELIMIT; return ret; } /* increase the order of the factorization */ scf.n = ++n; /* fill new zero column of matrix F */ for (i = 1, in_ = f_loc(scf, i, n); i < n; i++, in_ += n_max) f[in_] = 0.0; /* fill new zero row of matrix F */ for (j = 1, nj = f_loc(scf, n, j); j < n; j++, nj++) f[nj] = 0.0; /* fill new unity diagonal element of matrix F */ f[f_loc(scf, n, n)] = 1.0; /* compute new column of matrix U, which is (old F) * x */ for (i = 1; i < n; i++) { /* u[i,n] := (i-th row of old F) * x */ t = 0.0; for (j = 1, ij = f_loc(scf, i, 1); j < n; j++, ij++) t += f[ij] * x[j+idx]; u[u_loc(scf, i, n)] = t; } /* compute new (spiked) row of matrix U, which is (old P) * y */ for (j = 1; j < n; j++) un[j] = y[p[j]+idy]; /* store new diagonal element of matrix U, which is z */ un[n] = z; /* expand matrix P */ p[n] = n; if (_GLPSCF_DEBUG){ /* expand matrix C */ /* fill its new column, which is x */ for (i = 1, in_ = f_loc(scf, i, n); i < n; i++, in_ += n_max) c[in_] = x[i+idx]; /* fill its new row, which is y */ for (j = 1, nj = f_loc(scf, n, j); j < n; j++, nj++) c[nj] = y[j+idy]; /* fill its new diagonal element, which is z */ c[f_loc(scf, n, n)] = z; } /* restore upper triangular structure of matrix U */ for (k = 1; k < n; k++) if (un[k] != 0.0) break; transform(scf, k, un); /* estimate the rank of matrices C and U */ scf.rank = estimate_rank(scf); if (scf.rank != n) ret = SCF_ESING; if (_GLPSCF_DEBUG){ /* check that the factorization is accurate enough */ check_error(scf, "scf_update_exp"); } return ret; } function solve(scf, x, idx){ var n = scf.n; var f = scf.f; var u = scf.u; var p = scf.p; var y = scf.w; var i, j, ij; var t; /* y := F * b */ for (i = 1; i <= n; i++) { /* y[i] = (i-th row of F) * b */ t = 0.0; for (j = 1, ij = f_loc(scf, i, 1); j <= n; j++, ij++) t += f[ij] * x[j+idx]; y[i] = t; } /* y := inv(U) * y */ for (i = n; i >= 1; i--) { t = y[i]; for (j = n, ij = u_loc(scf, i, n); j > i; j--, ij--) t -= u[ij] * y[j]; y[i] = t / u[ij]; } /* x := P' * y */ for (i = 1; i <= n; i++) x[p[i]+idx] = y[i]; } function tsolve(scf, x, idx){ var n = scf.n; var f = scf.f; var u = scf.u; var p = scf.p; var y = scf.w; var i, j, ij; var t; /* y := P * b */ for (i = 1; i <= n; i++) y[i] = x[p[i]+idx]; /* y := inv(U') * y */ for (i = 1; i <= n; i++) { /* compute y[i] */ ij = u_loc(scf, i, i); t = (y[i] /= u[ij]); /* substitute y[i] in other equations */ for (j = i+1, ij++; j <= n; j++, ij++) y[j] -= u[ij] * t; } /* x := F' * y (computed as linear combination of rows of F) */ for (j = 1; j <= n; j++) x[j+idx] = 0.0; for (i = 1; i <= n; i++) { t = y[i]; /* coefficient of linear combination */ for (j = 1, ij = f_loc(scf, i, 1); j <= n; j++, ij++) x[j+idx] += f[ij] * t; } } function scf_solve_it(scf, tr, x, idx){ if (scf.rank < scf.n) xerror("scf_solve_it: singular matrix"); if (!tr) solve(scf, x, idx); else tsolve(scf, x, idx); } function scf_reset_it(scf){ /* reset factorization for empty matrix C */ scf.n = scf.rank = 0; } var glp_scale_prob = exports["glp_scale_prob"] = function(lp, flags){ function min_row_aij(lp, i, scaled){ var aij; var min_aij, temp; xassert(1 <= i && i <= lp.m); min_aij = 1.0; for (aij = lp.row[i].ptr; aij != null; aij = aij.r_next) { temp = Math.abs(aij.val); if (scaled) temp *= (aij.row.rii * aij.col.sjj); if (aij.r_prev == null || min_aij > temp) min_aij = temp; } return min_aij; } function max_row_aij(lp, i, scaled){ var aij; var max_aij, temp; xassert(1 <= i && i <= lp.m); max_aij = 1.0; for (aij = lp.row[i].ptr; aij != null; aij = aij.r_next) { temp = Math.abs(aij.val); if (scaled) temp *= (aij.row.rii * aij.col.sjj); if (aij.r_prev == null || max_aij < temp) max_aij = temp; } return max_aij; } function min_col_aij(lp, j, scaled){ var aij; var min_aij, temp; xassert(1 <= j && j <= lp.n); min_aij = 1.0; for (aij = lp.col[j].ptr; aij != null; aij = aij.c_next) { temp = Math.abs(aij.val); if (scaled) temp *= (aij.row.rii * aij.col.sjj); if (aij.c_prev == null || min_aij > temp) min_aij = temp; } return min_aij; } function max_col_aij(lp, j, scaled){ var aij; var max_aij, temp; xassert(1 <= j && j <= lp.n); max_aij = 1.0; for (aij = lp.col[j].ptr; aij != null; aij = aij.c_next) { temp = Math.abs(aij.val); if (scaled) temp *= (aij.row.rii * aij.col.sjj); if (aij.c_prev == null || max_aij < temp) max_aij = temp; } return max_aij; } function min_mat_aij(lp, scaled){ var i; var min_aij, temp; min_aij = 1.0; for (i = 1; i <= lp.m; i++) { temp = min_row_aij(lp, i, scaled); if (i == 1 || min_aij > temp) min_aij = temp; } return min_aij; } function max_mat_aij(lp, scaled){ var i; var max_aij, temp; max_aij = 1.0; for (i = 1; i <= lp.m; i++) { temp = max_row_aij(lp, i, scaled); if (i == 1 || max_aij < temp) max_aij = temp; } return max_aij; } function eq_scaling(lp, flag){ var i, j, pass; var temp; xassert(flag == 0 || flag == 1); for (pass = 0; pass <= 1; pass++) { if (pass == flag) { /* scale rows */ for (i = 1; i <= lp.m; i++) { temp = max_row_aij(lp, i, 1); glp_set_rii(lp, i, glp_get_rii(lp, i) / temp); } } else { /* scale columns */ for (j = 1; j <= lp.n; j++) { temp = max_col_aij(lp, j, 1); glp_set_sjj(lp, j, glp_get_sjj(lp, j) / temp); } } } } function gm_scaling(lp, flag){ var i, j, pass; var temp; xassert(flag == 0 || flag == 1); for (pass = 0; pass <= 1; pass++) { if (pass == flag) { /* scale rows */ for (i = 1; i <= lp.m; i++) { temp = min_row_aij(lp, i, 1) * max_row_aij(lp, i, 1); glp_set_rii(lp, i, glp_get_rii(lp, i) / Math.sqrt(temp)); } } else { /* scale columns */ for (j = 1; j <= lp.n; j++) { temp = min_col_aij(lp, j, 1) * max_col_aij(lp, j, 1); glp_set_sjj(lp, j, glp_get_sjj(lp, j) / Math.sqrt(temp)); } } } } function max_row_ratio(lp){ var i; var ratio, temp; ratio = 1.0; for (i = 1; i <= lp.m; i++) { temp = max_row_aij(lp, i, 1) / min_row_aij(lp, i, 1); if (i == 1 || ratio < temp) ratio = temp; } return ratio; } function max_col_ratio(lp){ var j; var ratio, temp; ratio = 1.0; for (j = 1; j <= lp.n; j++) { temp = max_col_aij(lp, j, 1) / min_col_aij(lp, j, 1); if (j == 1 || ratio < temp) ratio = temp; } return ratio; } function gm_iterate(lp, it_max, tau){ var k, flag; var ratio = 0.0, r_old; /* if the scaling "quality" for rows is better than for columns, the rows are scaled first; otherwise, the columns are scaled first */ flag = (max_row_ratio(lp) > max_col_ratio(lp)); for (k = 1; k <= it_max; k++) { /* save the scaling "quality" from previous iteration */ r_old = ratio; /* determine the current scaling "quality" */ ratio = max_mat_aij(lp, 1) / min_mat_aij(lp, 1); /* if improvement is not enough, terminate scaling */ if (k > 1 && ratio > tau * r_old) break; /* otherwise, perform another iteration */ gm_scaling(lp, flag); } } function scale_prob(lp, flags){ function fmt(a, b, c, d){ return a + ": min|aij| = " + b + " max|aij| = " + c + " ratio = " + d + "" } var min_aij, max_aij, ratio; xprintf("Scaling..."); /* cancel the current scaling effect */ glp_unscale_prob(lp); /* report original scaling "quality" */ min_aij = min_mat_aij(lp, 1); max_aij = max_mat_aij(lp, 1); ratio = max_aij / min_aij; xprintf(fmt(" A", min_aij, max_aij, ratio)); /* check if the problem is well scaled */ if (min_aij >= 0.10 && max_aij <= 10.0) { xprintf("Problem data seem to be well scaled"); /* skip scaling, if required */ if (flags & GLP_SF_SKIP) return; } /* perform iterative geometric mean scaling, if required */ if (flags & GLP_SF_GM) { gm_iterate(lp, 15, 0.90); min_aij = min_mat_aij(lp, 1); max_aij = max_mat_aij(lp, 1); ratio = max_aij / min_aij; xprintf(fmt("GM", min_aij, max_aij, ratio)); } /* perform equilibration scaling, if required */ if (flags & GLP_SF_EQ) { eq_scaling(lp, max_row_ratio(lp) > max_col_ratio(lp)); min_aij = min_mat_aij(lp, 1); max_aij = max_mat_aij(lp, 1); ratio = max_aij / min_aij; xprintf(fmt("EQ", min_aij, max_aij, ratio)); } /* round scale factors to nearest power of two, if required */ if (flags & GLP_SF_2N) { var i, j; for (i = 1; i <= lp.m; i++) glp_set_rii(lp, i, round2n(glp_get_rii(lp, i))); for (j = 1; j <= lp.n; j++) glp_set_sjj(lp, j, round2n(glp_get_sjj(lp, j))); min_aij = min_mat_aij(lp, 1); max_aij = max_mat_aij(lp, 1); ratio = max_aij / min_aij; xprintf(fmt("2N", min_aij, max_aij, ratio)); } } if (flags & ~(GLP_SF_GM | GLP_SF_EQ | GLP_SF_2N | GLP_SF_SKIP | GLP_SF_AUTO)) xerror("glp_scale_prob: flags = " + flags + "; invalid scaling options"); if (flags & GLP_SF_AUTO) flags = (GLP_SF_GM | GLP_SF_EQ | GLP_SF_SKIP); scale_prob(lp, flags); }; function spx_primal(lp, parm){ var kappa = 0.10; function alloc_csa(lp){ var m = lp.m; var n = lp.n; var nnz = lp.nnz; var csa = {}; xassert(m > 0 && n > 0); csa.m = m; csa.n = n; csa.type = new Int8Array(1+m+n); csa.lb = new Float64Array(1+m+n); csa.ub = new Float64Array(1+m+n); csa.coef = new Float64Array(1+m+n); csa.obj = new Float64Array(1+n); csa.A_ptr = new Int32Array(1+n+1); csa.A_ind = new Int32Array(1+nnz); csa.A_val = new Float64Array(1+nnz); csa.head = new Int32Array(1+m+n); csa.stat = new Int8Array(1+n); csa.N_ptr = new Int32Array(1+m+1); csa.N_len = new Int32Array(1+m); csa.N_ind = null; /* will be allocated later */ csa.N_val = null; /* will be allocated later */ csa.bbar = new Float64Array(1+m); csa.cbar = new Float64Array(1+n); csa.refsp = new Int8Array(1+m+n); csa.gamma = new Float64Array(1+n); csa.tcol_ind = new Int32Array(1+m); csa.tcol_vec = new Float64Array(1+m); csa.trow_ind = new Int32Array(1+n); csa.trow_vec = new Float64Array(1+n); csa.work1 = new Float64Array(1+m); csa.work2 = new Float64Array(1+m); csa.work3 = new Float64Array(1+m); csa.work4 = new Float64Array(1+m); return csa; } function init_csa(csa, lp){ var m = csa.m; var n = csa.n; var type = csa.type; var lb = csa.lb; var ub = csa.ub; var coef = csa.coef; var obj = csa.obj; var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var stat = csa.stat; var refsp = csa.refsp; var gamma = csa.gamma; var i, j, k, loc; var cmax; var row, col; /* auxiliary variables */ for (i = 1; i <= m; i++) { row = lp.row[i]; type[i] = row.type; lb[i] = row.lb * row.rii; ub[i] = row.ub * row.rii; coef[i] = 0.0; } /* structural variables */ for (j = 1; j <= n; j++) { col = lp.col[j]; type[m+j] = col.type; lb[m+j] = col.lb / col.sjj; ub[m+j] = col.ub / col.sjj; coef[m+j] = col.coef * col.sjj; } /* original objective function */ obj[0] = lp.c0; xcopyArr(obj, 1, coef, m+1, n); /* factor used to scale original objective coefficients */ cmax = 0.0; for (j = 1; j <= n; j++) if (cmax < Math.abs(obj[j])) cmax = Math.abs(obj[j]); if (cmax == 0.0) cmax = 1.0; switch (lp.dir) { case GLP_MIN: csa.zeta = + 1.0 / cmax; break; case GLP_MAX: csa.zeta = - 1.0 / cmax; break; default: xassert(lp != lp); } if (Math.abs(csa.zeta) < 1.0) csa.zeta *= 1000.0; /* matrix A (by columns) */ loc = 1; for (j = 1; j <= n; j++) { A_ptr[j] = loc; for (var aij = lp.col[j].ptr; aij != null; aij = aij.c_next) { A_ind[loc] = aij.row.i; A_val[loc] = aij.row.rii * aij.val * aij.col.sjj; loc++; } } A_ptr[n+1] = loc; xassert(loc == lp.nnz+1); /* basis header */ xassert(lp.valid); xcopyArr(head, 1, lp.head, 1, m); k = 0; for (i = 1; i <= m; i++) { row = lp.row[i]; if (row.stat != GLP_BS) { k++; xassert(k <= n); head[m+k] = i; stat[k] = row.stat; } } for (j = 1; j <= n; j++) { col = lp.col[j]; if (col.stat != GLP_BS) { k++; xassert(k <= n); head[m+k] = m + j; stat[k] = col.stat; } } xassert(k == n); /* factorization of matrix B */ csa.valid = 1; lp.valid = 0; csa.bfd = lp.bfd; lp.bfd = null; /* matrix N (by rows) */ alloc_N(csa); build_N(csa); /* working parameters */ csa.phase = 0; csa.tm_beg = xtime(); csa.it_beg = csa.it_cnt = lp.it_cnt; csa.it_dpy = -1; /* reference space and steepest edge coefficients */ csa.refct = 0; xfillArr(refsp, 1, 0, m+n); for (j = 1; j <= n; j++) gamma[j] = 1.0; } function inv_col(csa, i, ind, val){ /* this auxiliary routine returns row indices and numeric values of non-zero elements of i-th column of the basis matrix */ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var k, len, ptr, t; if(GLP_DEBUG){xassert(1 <= i && i <= m)} k = head[i]; /* B[i] is k-th column of (I|-A) */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (k <= m) { /* B[i] is k-th column of submatrix I */ len = 1; ind[1] = k; val[1] = 1.0; } else { /* B[i] is (k-m)-th column of submatrix (-A) */ ptr = A_ptr[k-m]; len = A_ptr[k-m+1] - ptr; xcopyArr(ind, 1, A_ind, ptr, len); xcopyArr(val, 1, A_val, ptr, len); for (t = 1; t <= len; t++) val[t] = - val[t]; } return len; } function invert_B(csa){ var ret = bfd_factorize(csa.bfd, csa.m, null, inv_col, csa); csa.valid = (ret == 0); return ret; } function update_B(csa, i, k){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var val, ret; if (GLP_DEBUG){ xassert(1 <= i && i <= m); xassert(1 <= k && k <= m+n); } if (k <= m) { /* new i-th column of B is k-th column of I */ var ind = new Array(1+1); val = new Array(1+1); ind[1] = k; val[1] = 1.0; xassert(csa.valid); ret = bfd_update_it(csa.bfd, i, 0, 1, ind, 0, val); } else { /* new i-th column of B is (k-m)-th column of (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; val = csa.work1; var beg, end, ptr, len; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; len = 0; for (ptr = beg; ptr < end; ptr++) val[++len] = - A_val[ptr]; xassert(csa.valid); ret = bfd_update_it(csa.bfd, i, 0, len, A_ind, beg-1, val); } csa.valid = (ret == 0); return ret; } function error_ftran(csa, h, x, r){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var i, k, beg, end, ptr; var temp; /* compute the residual vector: r = h - B * x = h - B[1] * x[1] - ... - B[m] * x[m], where B[1], ..., B[m] are columns of matrix B */ xcopyArr(r, 1, h, 1, m); for (i = 1; i <= m; i++) { temp = x[i]; if (temp == 0.0) continue; k = head[i]; /* B[i] is k-th column of (I|-A) */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (k <= m) { /* B[i] is k-th column of submatrix I */ r[k] -= temp; } else { /* B[i] is (k-m)-th column of submatrix (-A) */ beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) r[A_ind[ptr]] += A_val[ptr] * temp; } } } function refine_ftran(csa, h, x){ var m = csa.m; var r = csa.work1; var d = csa.work1; var i; /* compute the residual vector r = h - B * x */ error_ftran(csa, h, x, r); /* compute the correction vector d = inv(B) * r */ xassert(csa.valid); bfd_ftran(csa.bfd, d); /* refine the solution vector (new x) = (old x) + d */ for (i = 1; i <= m; i++) x[i] += d[i]; } function error_btran(csa, h, x, r){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var i, k, beg, end, ptr; var temp; /* compute the residual vector r = b - B'* x */ for (i = 1; i <= m; i++) { /* r[i] := b[i] - (i-th column of B)'* x */ k = head[i]; /* B[i] is k-th column of (I|-A) */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} temp = h[i]; if (k <= m) { /* B[i] is k-th column of submatrix I */ temp -= x[k]; } else { /* B[i] is (k-m)-th column of submatrix (-A) */ beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) temp += A_val[ptr] * x[A_ind[ptr]]; } r[i] = temp; } } function refine_btran(csa, h, x){ var m = csa.m; var r = csa.work1; var d = csa.work1; var i; /* compute the residual vector r = h - B'* x */ error_btran(csa, h, x, r); /* compute the correction vector d = inv(B') * r */ xassert(csa.valid); bfd_btran(csa.bfd, d); /* refine the solution vector (new x) = (old x) + d */ for (i = 1; i <= m; i++) x[i] += d[i]; } function alloc_N(csa){ var m = csa.m; var n = csa.n; var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var N_ptr = csa.N_ptr; var N_len = csa.N_len; var i, j, beg, end, ptr; /* determine number of non-zeros in each row of the augmented constraint matrix (I|-A) */ for (i = 1; i <= m; i++) N_len[i] = 1; for (j = 1; j <= n; j++) { beg = A_ptr[j]; end = A_ptr[j+1]; for (ptr = beg; ptr < end; ptr++) N_len[A_ind[ptr]]++; } /* determine maximal row lengths of matrix N and set its row pointers */ N_ptr[1] = 1; for (i = 1; i <= m; i++) { /* row of matrix N cannot have more than n non-zeros */ if (N_len[i] > n) N_len[i] = n; N_ptr[i+1] = N_ptr[i] + N_len[i]; } /* now maximal number of non-zeros in matrix N is known */ csa.N_ind = new Int32Array(N_ptr[m+1]); csa.N_val = new Float64Array(N_ptr[m+1]); } function add_N_col(csa, j, k){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var N_ptr = csa.N_ptr; var N_len = csa.N_len; var N_ind = csa.N_ind; var N_val = csa.N_val; var pos; if (GLP_DEBUG){ xassert(1 <= j && j <= n); xassert(1 <= k && k <= m+n); } if (k <= m) { /* N[j] is k-th column of submatrix I */ pos = N_ptr[k] + (N_len[k]++); if (GLP_DEBUG){xassert(pos < N_ptr[k+1])} N_ind[pos] = j; N_val[pos] = 1.0; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var i, beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) { i = A_ind[ptr]; /* row number */ pos = N_ptr[i] + (N_len[i]++); if (GLP_DEBUG){xassert(pos < N_ptr[i+1])} N_ind[pos] = j; N_val[pos] = - A_val[ptr]; } } } function del_N_col(csa, j, k){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var N_ptr = csa.N_ptr; var N_len = csa.N_len; var N_ind = csa.N_ind; var N_val = csa.N_val; var pos, head, tail; if (GLP_DEBUG){ xassert(1 <= j && j <= n); xassert(1 <= k && k <= m+n); } if (k <= m) { /* N[j] is k-th column of submatrix I */ /* find element in k-th row of N */ head = N_ptr[k]; for (pos = head; N_ind[pos] != j; pos++){} /* nop */ /* and remove it from the row list */ tail = head + (--N_len[k]); if (GLP_DEBUG){xassert(pos <= tail)} N_ind[pos] = N_ind[tail]; N_val[pos] = N_val[tail]; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var i, beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) { i = A_ind[ptr]; /* row number */ /* find element in i-th row of N */ head = N_ptr[i]; for (pos = head; N_ind[pos] != j; pos++){} /* nop */ /* and remove it from the row list */ tail = head + (--N_len[i]); if (GLP_DEBUG){xassert(pos <= tail)} N_ind[pos] = N_ind[tail]; N_val[pos] = N_val[tail]; } } } function build_N(csa){ var m = csa.m; var n = csa.n; var head = csa.head; var stat = csa.stat; var N_len = csa.N_len; var j, k; /* N := empty matrix */ xfillArr(N_len, 1, 0, m); /* go through non-basic columns of matrix (I|-A) */ for (j = 1; j <= n; j++) { if (stat[j] != GLP_NS) { /* xN[j] is non-fixed; add j-th column to matrix N which is k-th column of matrix (I|-A) */ k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} add_N_col(csa, j, k); } } } function get_xN(csa, j){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var lb = csa.lb; var ub = csa.ub; var head = csa.head; var stat = csa.stat; var k; var xN; if (GLP_DEBUG){xassert(1 <= j && j <= n)} k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} switch (stat[j]) { case GLP_NL: /* x[k] is on its lower bound */ xN = lb[k]; break; case GLP_NU: /* x[k] is on its upper bound */ xN = ub[k]; break; case GLP_NF: /* x[k] is free non-basic variable */ xN = 0.0; break; case GLP_NS: /* x[k] is fixed non-basic variable */ xN = lb[k]; break; default: xassert(stat != stat); } return xN; } function eval_beta(csa, beta){ var m = csa.m; var n = csa.n; var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var h = csa.work2; var i, j, k, beg, end, ptr; var xN; /* compute the right-hand side vector: h := - N * xN = - N[1] * xN[1] - ... - N[n] * xN[n], where N[1], ..., N[n] are columns of matrix N */ for (i = 1; i <= m; i++) h[i] = 0.0; for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* determine current value of xN[j] */ xN = get_xN(csa, j); if (xN == 0.0) continue; if (k <= m) { /* N[j] is k-th column of submatrix I */ h[k] -= xN; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) h[A_ind[ptr]] += xN * A_val[ptr]; } } /* solve system B * beta = h */ xcopyArr(beta, 1, h, 1, m); xassert(csa.valid); bfd_ftran(csa.bfd, beta); /* and refine the solution */ refine_ftran(csa, h, beta); } function eval_pi(csa, pi){ var m = csa.m; var c = csa.coef; var head = csa.head; var cB = csa.work2; var i; /* construct the right-hand side vector cB */ for (i = 1; i <= m; i++) cB[i] = c[head[i]]; /* solve system B'* pi = cB */ xcopyArr(pi, 1, cB, 1, m); xassert(csa.valid); bfd_btran(csa.bfd, pi); /* and refine the solution */ refine_btran(csa, cB, pi); } function eval_cost(csa, pi, j){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var coef = csa.coef; var head = csa.head; var k; var dj; if (GLP_DEBUG){xassert(1 <= j && j <= n)} k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} dj = coef[k]; if (k <= m) { /* N[j] is k-th column of submatrix I */ dj -= pi[k]; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) dj += A_val[ptr] * pi[A_ind[ptr]]; } return dj; } function eval_bbar(csa) { eval_beta(csa, csa.bbar); } function eval_cbar(csa){ if (GLP_DEBUG){var m = csa.m} var n = csa.n; if (GLP_DEBUG){var head = csa.head} var cbar = csa.cbar; var pi = csa.work3; var j; if(GLP_DEBUG){var k} /* compute simplex multipliers */ eval_pi(csa, pi); /* compute and store reduced costs */ for (j = 1; j <= n; j++) { if (GLP_DEBUG){ k = head[m+j]; /* x[k] = xN[j] */ xassert(1 <= k && k <= m+n); } cbar[j] = eval_cost(csa, pi, j); } } function reset_refsp(csa){ var m = csa.m; var n = csa.n; var head = csa.head; var refsp = csa.refsp; var gamma = csa.gamma; var j, k; xassert(csa.refct == 0); csa.refct = 1000; xfillArr(refsp, 1, 0, m+n); for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ refsp[k] = 1; gamma[j] = 1.0; } } function eval_gamma(csa, j){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var head = csa.head; var refsp = csa.refsp; var alfa = csa.work3; var h = csa.work3; var i, k; var gamma; if (GLP_DEBUG){xassert(1 <= j && j <= n)} k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* construct the right-hand side vector h = - N[j] */ for (i = 1; i <= m; i++) h[i] = 0.0; if (k <= m) { /* N[j] is k-th column of submatrix I */ h[k] = -1.0; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) h[A_ind[ptr]] = A_val[ptr]; } /* solve system B * alfa = h */ xassert(csa.valid); bfd_ftran(csa.bfd, alfa); /* compute gamma */ gamma = (refsp[k] ? 1.0 : 0.0); for (i = 1; i <= m; i++) { k = head[i]; if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (refsp[k]) gamma += alfa[i] * alfa[i]; } return gamma; } function chuzc(csa, tol_dj){ var n = csa.n; var stat = csa.stat; var cbar = csa.cbar; var gamma = csa.gamma; var j, q; var dj, best, temp; /* nothing is chosen so far */ q = 0; best = 0.0; /* look through the list of non-basic variables */ for (j = 1; j <= n; j++) { dj = cbar[j]; switch (stat[j]) { case GLP_NL: /* xN[j] can increase */ if (dj >= - tol_dj) continue; break; case GLP_NU: /* xN[j] can decrease */ if (dj <= + tol_dj) continue; break; case GLP_NF: /* xN[j] can change in any direction */ if (- tol_dj <= dj && dj <= + tol_dj) continue; break; case GLP_NS: /* xN[j] cannot change at all */ continue; default: xassert(stat != stat); } /* xN[j] is eligible non-basic variable; choose one which has largest weighted reduced cost */ if (GLP_DEBUG){xassert(gamma[j] > 0.0)} temp = (dj * dj) / gamma[j]; if (best < temp){ q = j; best = temp; } } /* store the index of non-basic variable xN[q] chosen */ csa.q = q; } function eval_tcol(csa){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var head = csa.head; var q = csa.q; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var h = csa.tcol_vec; var i, k, nnz; if (GLP_DEBUG){xassert(1 <= q && q <= n)} k = head[m+q]; /* x[k] = xN[q] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* construct the right-hand side vector h = - N[q] */ for (i = 1; i <= m; i++) h[i] = 0.0; if (k <= m) { /* N[q] is k-th column of submatrix I */ h[k] = -1.0; } else { /* N[q] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) h[A_ind[ptr]] = A_val[ptr]; } /* solve system B * tcol = h */ xassert(csa.valid); bfd_ftran(csa.bfd, tcol_vec); /* construct sparse pattern of the pivot column */ nnz = 0; for (i = 1; i <= m; i++) { if (tcol_vec[i] != 0.0) tcol_ind[++nnz] = i; } csa.tcol_nnz = nnz; } function refine_tcol(csa){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var head = csa.head; var q = csa.q; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var h = csa.work3; var i, k, nnz; if (GLP_DEBUG){xassert(1 <= q && q <= n)} k = head[m+q]; /* x[k] = xN[q] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* construct the right-hand side vector h = - N[q] */ for (i = 1; i <= m; i++) h[i] = 0.0; if (k <= m) { /* N[q] is k-th column of submatrix I */ h[k] = -1.0; } else { /* N[q] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) h[A_ind[ptr]] = A_val[ptr]; } /* refine solution of B * tcol = h */ refine_ftran(csa, h, tcol_vec); /* construct sparse pattern of the pivot column */ nnz = 0; for (i = 1; i <= m; i++) { if (tcol_vec[i] != 0.0) tcol_ind[++nnz] = i; } csa.tcol_nnz = nnz; } function sort_tcol(csa, tol_piv){ if (GLP_DEBUG){var m = csa.m} var nnz = csa.tcol_nnz; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var i, num, pos; var big, eps, temp; /* compute infinity (maximum) norm of the column */ big = 0.0; for (pos = 1; pos <= nnz; pos++) { if (GLP_DEBUG){ i = tcol_ind[pos]; xassert(1 <= i && i <= m); } temp = Math.abs(tcol_vec[tcol_ind[pos]]); if (big < temp) big = temp; } csa.tcol_max = big; /* determine absolute pivot tolerance */ eps = tol_piv * (1.0 + 0.01 * big); /* move significant column components to front of the list */ for (num = 0; num < nnz; ) { i = tcol_ind[nnz]; if (Math.abs(tcol_vec[i]) < eps) nnz--; else { num++; tcol_ind[nnz] = tcol_ind[num]; tcol_ind[num] = i; } } csa.tcol_num = num; } function chuzr(csa, rtol){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var type = csa.type; var lb = csa.lb; var ub = csa.ub; var coef = csa.coef; var head = csa.head; var phase = csa.phase; var bbar = csa.bbar; var cbar = csa.cbar; var q = csa.q; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var tcol_num = csa.tcol_num; var i, i_stat, k, p, p_stat, pos; var alfa, big, delta, s, t, teta, tmax; if (GLP_DEBUG){xassert(1 <= q && q <= n)} /* s := - sign(d[q]), where d[q] is reduced cost of xN[q] */ if (GLP_DEBUG){xassert(cbar[q] != 0.0)} s = (cbar[q] > 0.0 ? -1.0 : +1.0); /*** FIRST PASS ***/ k = head[m+q]; /* x[k] = xN[q] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (type[k] == GLP_DB) { /* xN[q] has both lower and upper bounds */ p = -1; p_stat = 0; teta = ub[k] - lb[k]; big = 1.0; } else { /* xN[q] has no opposite bound */ p = 0; p_stat = 0; teta = DBL_MAX; big = 0.0; } /* walk through significant elements of the pivot column */ for (pos = 1; pos <= tcol_num; pos++) { i = tcol_ind[pos]; if (GLP_DEBUG){xassert(1 <= i && i <= m)} k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} alfa = s * tcol_vec[i]; if (GLP_DEBUG){xassert(alfa != 0.0)} /* xB[i] = ... + alfa * xN[q] + ..., and due to s we need to consider the only case when xN[q] is increasing */ if (alfa > 0.0) { /* xB[i] is increasing */ if (phase == 1 && coef[k] < 0.0) { /* xB[i] violates its lower bound, which plays the role of an upper bound on phase I */ delta = rtol * (1.0 + kappa * Math.abs(lb[k])); t = ((lb[k] + delta) - bbar[i]) / alfa; i_stat = GLP_NL; } else if (phase == 1 && coef[k] > 0.0) { /* xB[i] violates its upper bound, which plays the role of an lower bound on phase I */ continue; } else if (type[k] == GLP_UP || type[k] == GLP_DB || type[k] == GLP_FX) { /* xB[i] is within its bounds and has an upper bound */ delta = rtol * (1.0 + kappa * Math.abs(ub[k])); t = ((ub[k] + delta) - bbar[i]) / alfa; i_stat = GLP_NU; } else { /* xB[i] is within its bounds and has no upper bound */ continue; } } else { /* xB[i] is decreasing */ if (phase == 1 && coef[k] > 0.0) { /* xB[i] violates its upper bound, which plays the role of an lower bound on phase I */ delta = rtol * (1.0 + kappa * Math.abs(ub[k])); t = ((ub[k] - delta) - bbar[i]) / alfa; i_stat = GLP_NU; } else if (phase == 1 && coef[k] < 0.0) { /* xB[i] violates its lower bound, which plays the role of an upper bound on phase I */ continue; } else if (type[k] == GLP_LO || type[k] == GLP_DB || type[k] == GLP_FX) { /* xB[i] is within its bounds and has an lower bound */ delta = rtol * (1.0 + kappa * Math.abs(lb[k])); t = ((lb[k] - delta) - bbar[i]) / alfa; i_stat = GLP_NL; } else { /* xB[i] is within its bounds and has no lower bound */ continue; } } /* t is a change of xN[q], on which xB[i] reaches its bound (possibly relaxed); since the basic solution is assumed to be primal feasible (or pseudo feasible on phase I), t has to be non-negative by definition; however, it may happen that xB[i] slightly (i.e. within a tolerance) violates its bound, that leads to negative t; in the latter case, if xB[i] is chosen, negative t means that xN[q] changes in wrong direction; if pivot alfa[i,q] is close to zero, even small bound violation of xB[i] may lead to a large change of xN[q] in wrong direction; let, for example, xB[i] >= 0 and in the current basis its value be -5e-9; let also xN[q] be on its zero bound and should increase; from the ratio test rule it follows that the pivot alfa[i,q] < 0; however, if alfa[i,q] is, say, -1e-9, the change of xN[q] in wrong direction is 5e-9 / (-1e-9) = -5, and using it for updating values of other basic variables will give absolutely wrong results; therefore, if t is negative, we should replace it by exact zero assuming that xB[i] is exactly on its bound, and the violation appears due to round-off errors */ if (t < 0.0) t = 0.0; /* apply minimal ratio test */ if (teta > t || teta == t && big < Math.abs(alfa)){ p = i; p_stat = i_stat; teta = t; big = Math.abs(alfa); } } /* the second pass is skipped in the following cases: */ /* if the standard ratio test is used */ if (rtol == 0.0) return done(); /* if xN[q] reaches its opposite bound or if no basic variable has been chosen on the first pass */ if (p <= 0) return done(); /* if xB[p] is a blocking variable, i.e. if it prevents xN[q] from any change */ if (teta == 0.0) return done(); /*** SECOND PASS ***/ /* here tmax is a maximal change of xN[q], on which the solution remains primal feasible (or pseudo feasible on phase I) within a tolerance */ tmax = teta; /* nothing is chosen so far */ p = 0; p_stat = 0; teta = DBL_MAX; big = 0.0; /* walk through significant elements of the pivot column */ for (pos = 1; pos <= tcol_num; pos++) { i = tcol_ind[pos]; if (GLP_DEBUG){xassert(1 <= i && i <= m)} k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} alfa = s * tcol_vec[i]; if (GLP_DEBUG){xassert(alfa != 0.0)} /* xB[i] = ... + alfa * xN[q] + ..., and due to s we need to consider the only case when xN[q] is increasing */ if (alfa > 0.0) { /* xB[i] is increasing */ if (phase == 1 && coef[k] < 0.0) { /* xB[i] violates its lower bound, which plays the role of an upper bound on phase I */ t = (lb[k] - bbar[i]) / alfa; i_stat = GLP_NL; } else if (phase == 1 && coef[k] > 0.0) { /* xB[i] violates its upper bound, which plays the role of an lower bound on phase I */ continue; } else if (type[k] == GLP_UP || type[k] == GLP_DB || type[k] == GLP_FX) { /* xB[i] is within its bounds and has an upper bound */ t = (ub[k] - bbar[i]) / alfa; i_stat = GLP_NU; } else { /* xB[i] is within its bounds and has no upper bound */ continue; } } else { /* xB[i] is decreasing */ if (phase == 1 && coef[k] > 0.0) { /* xB[i] violates its upper bound, which plays the role of an lower bound on phase I */ t = (ub[k] - bbar[i]) / alfa; i_stat = GLP_NU; } else if (phase == 1 && coef[k] < 0.0) { /* xB[i] violates its lower bound, which plays the role of an upper bound on phase I */ continue; } else if (type[k] == GLP_LO || type[k] == GLP_DB || type[k] == GLP_FX) { /* xB[i] is within its bounds and has an lower bound */ t = (lb[k] - bbar[i]) / alfa; i_stat = GLP_NL; } else { /* xB[i] is within its bounds and has no lower bound */ continue; } } /* (see comments for the first pass) */ if (t < 0.0) t = 0.0; /* t is a change of xN[q], on which xB[i] reaches its bound; if t <= tmax, all basic variables can violate their bounds only within relaxation tolerance delta; we can use this freedom and choose basic variable having largest influence coefficient to avoid possible numeric instability */ if (t <= tmax && big < Math.abs(alfa)){ p = i; p_stat = i_stat; teta = t; big = Math.abs(alfa); } } /* something must be chosen on the second pass */ xassert(p != 0); function done(){ /* store the index and status of basic variable xB[p] chosen */ csa.p = p; if (p > 0 && type[head[p]] == GLP_FX) csa.p_stat = GLP_NS; else csa.p_stat = p_stat; /* store corresponding change of non-basic variable xN[q] */ if (GLP_DEBUG){xassert(teta >= 0.0)} csa.teta = s * teta; } done(); } function eval_rho(csa, rho){ var m = csa.m; var p = csa.p; var i; if (GLP_DEBUG){xassert(1 <= p && p <= m)} /* construct the right-hand side vector rho[p] */ for (i = 1; i <= m; i++) rho[i] = 0.0; rho[p] = 1.0; /* solve system B'* rho = rho[p] */ xassert(csa.valid); bfd_btran(csa.bfd, rho); } function refine_rho(csa, rho){ var m = csa.m; var p = csa.p; var e = csa.work3; var i; if (GLP_DEBUG){xassert(1 <= p && p <= m)} /* construct the right-hand side vector e[p] */ for (i = 1; i <= m; i++) e[i] = 0.0; e[p] = 1.0; /* refine solution of B'* rho = e[p] */ refine_btran(csa, e, rho); } function eval_trow(csa, rho){ var m = csa.m; var n = csa.n; if (GLP_DEBUG){var stat = csa.stat} var N_ptr = csa.N_ptr; var N_len = csa.N_len; var N_ind = csa.N_ind; var N_val = csa.N_val; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var i, j, beg, end, ptr, nnz; var temp; /* clear the pivot row */ for (j = 1; j <= n; j++) trow_vec[j] = 0.0; /* compute the pivot row as a linear combination of rows of the matrix N: trow = - rho[1] * N'[1] - ... - rho[m] * N'[m] */ for (i = 1; i <= m; i++) { temp = rho[i]; if (temp == 0.0) continue; /* trow := trow - rho[i] * N'[i] */ beg = N_ptr[i]; end = beg + N_len[i]; for (ptr = beg; ptr < end; ptr++) { if (GLP_DEBUG){ j = N_ind[ptr]; xassert(1 <= j && j <= n); xassert(stat[j] != GLP_NS); } trow_vec[N_ind[ptr]] -= temp * N_val[ptr]; } } /* construct sparse pattern of the pivot row */ nnz = 0; for (j = 1; j <= n; j++) { if (trow_vec[j] != 0.0) trow_ind[++nnz] = j; } csa.trow_nnz = nnz; } function update_bbar(csa){ if (GLP_DEBUG){ var m = csa.m; var n = csa.n; } var bbar = csa.bbar; var q = csa.q; var tcol_nnz = csa.tcol_nnz; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var p = csa.p; var teta = csa.teta; var i, pos; if (GLP_DEBUG){ xassert(1 <= q && q <= n); xassert(p < 0 || 1 <= p && p <= m); } /* if xN[q] leaves the basis, compute its value in the adjacent basis, where it will replace xB[p] */ if (p > 0) bbar[p] = get_xN(csa, q) + teta; /* update values of other basic variables (except xB[p], because it will be replaced by xN[q]) */ if (teta == 0.0) return; for (pos = 1; pos <= tcol_nnz; pos++) { i = tcol_ind[pos]; /* skip xB[p] */ if (i == p) continue; /* (change of xB[i]) = alfa[i,q] * (change of xN[q]) */ bbar[i] += tcol_vec[i] * teta; } } function reeval_cost(csa){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var coef = csa.coef; var head = csa.head; var q = csa.q; var tcol_nnz = csa.tcol_nnz; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var i, pos; var dq; if (GLP_DEBUG){xassert(1 <= q && q <= n)} dq = coef[head[m+q]]; for (pos = 1; pos <= tcol_nnz; pos++) { i = tcol_ind[pos]; if (GLP_DEBUG){xassert(1 <= i && i <= m)} dq += coef[head[i]] * tcol_vec[i]; } return dq; } function update_cbar(csa){ if (GLP_DEBUG){var n = csa.n} var cbar = csa.cbar; var q = csa.q; var trow_nnz = csa.trow_nnz; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var j, pos; var new_dq; if (GLP_DEBUG){xassert(1 <= q && q <= n)} /* compute reduced cost of xB[p] in the adjacent basis, where it will replace xN[q] */ if (GLP_DEBUG){xassert(trow_vec[q] != 0.0)} new_dq = (cbar[q] /= trow_vec[q]); /* update reduced costs of other non-basic variables (except xN[q], because it will be replaced by xB[p]) */ for (pos = 1; pos <= trow_nnz; pos++) { j = trow_ind[pos]; /* skip xN[q] */ if (j == q) continue; cbar[j] -= trow_vec[j] * new_dq; } } function update_gamma(csa){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var type = csa.type; var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var refsp = csa.refsp; var gamma = csa.gamma; var q = csa.q; var tcol_nnz = csa.tcol_nnz; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var p = csa.p; var trow_nnz = csa.trow_nnz; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var u = csa.work3; var i, j, k, pos, beg, end, ptr; var gamma_q, delta_q, pivot, s, t, t1, t2; if (GLP_DEBUG){ xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); } /* the basis changes, so decrease the count */ xassert(csa.refct > 0); csa.refct--; /* recompute gamma[q] for the current basis more accurately and compute auxiliary vector u */ gamma_q = delta_q = (refsp[head[m+q]] ? 1.0 : 0.0); for (i = 1; i <= m; i++) u[i] = 0.0; for (pos = 1; pos <= tcol_nnz; pos++) { i = tcol_ind[pos]; if (refsp[head[i]]) { u[i] = t = tcol_vec[i]; gamma_q += t * t; } else u[i] = 0.0; } xassert(csa.valid); bfd_btran(csa.bfd, u); /* update gamma[k] for other non-basic variables (except fixed variables and xN[q], because it will be replaced by xB[p]) */ pivot = trow_vec[q]; if (GLP_DEBUG){xassert(pivot != 0.0)} for (pos = 1; pos <= trow_nnz; pos++) { j = trow_ind[pos]; /* skip xN[q] */ if (j == q) continue; /* compute t */ t = trow_vec[j] / pivot; /* compute inner product s = N'[j] * u */ k = head[m+j]; /* x[k] = xN[j] */ if (k <= m) s = u[k]; else { s = 0.0; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) s -= A_val[ptr] * u[A_ind[ptr]]; } /* compute gamma[k] for the adjacent basis */ t1 = gamma[j] + t * t * gamma_q + 2.0 * t * s; t2 = (refsp[k] ? 1.0 : 0.0) + delta_q * t * t; gamma[j] = (t1 >= t2 ? t1 : t2); if (gamma[j] < DBL_EPSILON) gamma[j] = DBL_EPSILON; } /* compute gamma[q] for the adjacent basis */ if (type[head[p]] == GLP_FX) gamma[q] = 1.0; else { gamma[q] = gamma_q / (pivot * pivot); if (gamma[q] < DBL_EPSILON) gamma[q] = DBL_EPSILON; } } function err_in_bbar(csa){ var m = csa.m; var bbar = csa.bbar; var i; var e, emax, beta; beta = new Float64Array(1+m); eval_beta(csa, beta); emax = 0.0; for (i = 1; i <= m; i++) { e = Math.abs(beta[i] - bbar[i]) / (1.0 + Math.abs(beta[i])); if (emax < e) emax = e; } return emax; } function err_in_cbar(csa){ var m = csa.m; var n = csa.n; var stat = csa.stat; var cbar = csa.cbar; var j; var e, emax, cost, pi; pi = new Float64Array(1+m); eval_pi(csa, pi); emax = 0.0; for (j = 1; j <= n; j++) { if (stat[j] == GLP_NS) continue; cost = eval_cost(csa, pi, j); e = Math.abs(cost - cbar[j]) / (1.0 + Math.abs(cost)); if (emax < e) emax = e; } return emax; } function err_in_gamma(csa){ var n = csa.n; var stat = csa.stat; var gamma = csa.gamma; var j; var e, emax, temp; emax = 0.0; for (j = 1; j <= n; j++) { if (stat[j] == GLP_NS) { xassert(gamma[j] == 1.0); continue; } temp = eval_gamma(csa, j); e = Math.abs(temp - gamma[j]) / (1.0 + Math.abs(temp)); if (emax < e) emax = e; } return emax; } function change_basis(csa){ var m = csa.m; if (GLP_DEBUG){ var n = csa.n; var type = csa.type; } var head = csa.head; var stat = csa.stat; var q = csa.q; var p = csa.p; var p_stat = csa.p_stat; var k; if (GLP_DEBUG){xassert(1 <= q && q <= n)} if (p < 0) { /* xN[q] goes to its opposite bound */ if (GLP_DEBUG){ k = head[m+q]; /* x[k] = xN[q] */ xassert(1 <= k && k <= m+n); xassert(type[k] == GLP_DB); } switch (stat[q]) { case GLP_NL: /* xN[q] increases */ stat[q] = GLP_NU; break; case GLP_NU: /* xN[q] decreases */ stat[q] = GLP_NL; break; default: xassert(stat != stat); } } else { /* xB[p] leaves the basis, xN[q] enters the basis */ if (GLP_DEBUG){ xassert(1 <= p && p <= m); k = head[p]; /* x[k] = xB[p] */ switch (p_stat) { case GLP_NL: /* xB[p] goes to its lower bound */ xassert(type[k] == GLP_LO || type[k] == GLP_DB); break; case GLP_NU: /* xB[p] goes to its upper bound */ xassert(type[k] == GLP_UP || type[k] == GLP_DB); break; case GLP_NS: /* xB[p] goes to its fixed value */ xassert(type[k] == GLP_NS); break; default: xassert(p_stat != p_stat); } } /* xB[p] <. xN[q] */ k = head[p]; head[p] = head[m+q]; head[m+q] = k; stat[q] = p_stat; } } function set_aux_obj(csa, tol_bnd){ var m = csa.m; var n = csa.n; var type = csa.type; var lb = csa.lb; var ub = csa.ub; var coef = csa.coef; var head = csa.head; var bbar = csa.bbar; var i, k, cnt = 0; var eps; /* use a bit more restrictive tolerance */ tol_bnd *= 0.90; /* clear all objective coefficients */ for (k = 1; k <= m+n; k++) coef[k] = 0.0; /* walk through the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (type[k] == GLP_LO || type[k] == GLP_DB || type[k] == GLP_FX) { /* x[k] has lower bound */ eps = tol_bnd * (1.0 + kappa * Math.abs(lb[k])); if (bbar[i] < lb[k] - eps) { /* and violates it */ coef[k] = -1.0; cnt++; } } if (type[k] == GLP_UP || type[k] == GLP_DB || type[k] == GLP_FX) { /* x[k] has upper bound */ eps = tol_bnd * (1.0 + kappa * Math.abs(ub[k])); if (bbar[i] > ub[k] + eps) { /* and violates it */ coef[k] = +1.0; cnt++; } } } return cnt; } function set_orig_obj(csa){ var m = csa.m; var n = csa.n; var coef = csa.coef; var obj = csa.obj; var zeta = csa.zeta; var i, j; for (i = 1; i <= m; i++) coef[i] = 0.0; for (j = 1; j <= n; j++) coef[m+j] = zeta * obj[j]; } function check_stab(csa, tol_bnd){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var type = csa.type; var lb = csa.lb; var ub = csa.ub; var coef = csa.coef; var head = csa.head; var phase = csa.phase; var bbar = csa.bbar; var i, k; var eps; /* walk through the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (phase == 1 && coef[k] < 0.0) { /* x[k] must not be greater than its lower bound */ if (GLP_DEBUG){ xassert(type[k] == GLP_LO || type[k] == GLP_DB || type[k] == GLP_FX); } eps = tol_bnd * (1.0 + kappa * Math.abs(lb[k])); if (bbar[i] > lb[k] + eps) return 1; } else if (phase == 1 && coef[k] > 0.0) { /* x[k] must not be less than its upper bound */ if (GLP_DEBUG){ xassert(type[k] == GLP_UP || type[k] == GLP_DB || type[k] == GLP_FX); } eps = tol_bnd * (1.0 + kappa * Math.abs(ub[k])); if (bbar[i] < ub[k] - eps) return 1; } else { /* either phase = 1 and coef[k] = 0, or phase = 2 */ if (type[k] == GLP_LO || type[k] == GLP_DB || type[k] == GLP_FX) { /* x[k] must not be less than its lower bound */ eps = tol_bnd * (1.0 + kappa * Math.abs(lb[k])); if (bbar[i] < lb[k] - eps) return 1; } if (type[k] == GLP_UP || type[k] == GLP_DB || type[k] == GLP_FX) { /* x[k] must not be greater then its upper bound */ eps = tol_bnd * (1.0 + kappa * Math.abs(ub[k])); if (bbar[i] > ub[k] + eps) return 1; } } } /* basic solution is primal feasible within a tolerance */ return 0; } function check_feas(csa, tol_bnd){ var m = csa.m; if (GLP_DEBUG){ var n = csa.n; var type = csa.type; } var lb = csa.lb; var ub = csa.ub; var coef = csa.coef; var head = csa.head; var bbar = csa.bbar; var i, k; var eps; xassert(csa.phase == 1); /* walk through the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (coef[k] < 0.0) { /* check if x[k] still violates its lower bound */ if (GLP_DEBUG){ xassert(type[k] == GLP_LO || type[k] == GLP_DB || type[k] == GLP_FX); } eps = tol_bnd * (1.0 + kappa * Math.abs(lb[k])); if (bbar[i] < lb[k] - eps) return 1; } else if (coef[k] > 0.0) { /* check if x[k] still violates its upper bound */ if (GLP_DEBUG){ xassert(type[k] == GLP_UP || type[k] == GLP_DB || type[k] == GLP_FX); } eps = tol_bnd * (1.0 + kappa * Math.abs(ub[k])); if (bbar[i] > ub[k] + eps) return 1; } } /* basic solution is primal feasible within a tolerance */ return 0; } function eval_obj(csa){ var m = csa.m; var n = csa.n; var obj = csa.obj; var head = csa.head; var bbar = csa.bbar; var i, j, k; var sum; sum = obj[0]; /* walk through the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (k > m) sum += obj[k-m] * bbar[i]; } /* walk through the list of non-basic variables */ for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (k > m) sum += obj[k-m] * get_xN(csa, j); } return sum; } function display(csa, parm, spec){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var type = csa.type; var lb = csa.lb; var ub = csa.ub; var phase = csa.phase; var head = csa.head; var bbar = csa.bbar; var i, k, cnt; var sum; if (parm.msg_lev < GLP_MSG_ON) return; if (parm.out_dly > 0 && 1000.0 * xdifftime(xtime(), csa.tm_beg) < parm.out_dly) return; if (csa.it_cnt == csa.it_dpy) return; if (!spec && csa.it_cnt % parm.out_frq != 0) return; /* compute the sum of primal infeasibilities and determine the number of basic fixed variables */ sum = 0.0; cnt = 0; for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (type[k] == GLP_LO || type[k] == GLP_DB || type[k] == GLP_FX) { /* x[k] has lower bound */ if (bbar[i] < lb[k]) sum += (lb[k] - bbar[i]); } if (type[k] == GLP_UP || type[k] == GLP_DB || type[k] == GLP_FX) { /* x[k] has upper bound */ if (bbar[i] > ub[k]) sum += (bbar[i] - ub[k]); } if (type[k] == GLP_FX) cnt++; } xprintf((phase == 1 ? ' ' : '*') + csa.it_cnt + ": obj = " + eval_obj(csa) + " infeas = " + sum + " (" + cnt + ")"); csa.it_dpy = csa.it_cnt; } function store_sol(csa, lp, p_stat, d_stat, ray){ var m = csa.m; var n = csa.n; var zeta = csa.zeta; var head = csa.head; var stat = csa.stat; var bbar = csa.bbar; var cbar = csa.cbar; var i, j, k; var row, col; if (GLP_DEBUG){ xassert(lp.m == m); xassert(lp.n == n); /* basis factorization */ xassert(!lp.valid && lp.bfd == null); xassert(csa.valid && csa.bfd != null); } lp.valid = 1; csa.valid = 0; lp.bfd = csa.bfd; csa.bfd = null; xcopyArr(lp.head, 1, head, 1, m); /* basic solution status */ lp.pbs_stat = p_stat; lp.dbs_stat = d_stat; /* objective function value */ lp.obj_val = eval_obj(csa); /* simplex iteration count */ lp.it_cnt = csa.it_cnt; /* unbounded ray */ lp.some = ray; /* basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (k <= m) { row = lp.row[k]; row.stat = GLP_BS; row.bind = i; row.prim = bbar[i] / row.rii; row.dual = 0.0; } else { col = lp.col[k-m]; col.stat = GLP_BS; col.bind = i; col.prim = bbar[i] * col.sjj; col.dual = 0.0; } } /* non-basic variables */ for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (k <= m) { row = lp.row[k]; row.stat = stat[j]; row.bind = 0; switch (stat[j]) { case GLP_NL: row.prim = row.lb; break; case GLP_NU: row.prim = row.ub; break; case GLP_NF: row.prim = 0.0; break; case GLP_NS: row.prim = row.lb; break; default: xassert(stat != stat); } row.dual = (cbar[j] * row.rii) / zeta; } else { col = lp.col[k-m]; col.stat = stat[j]; col.bind = 0; switch (stat[j]) { case GLP_NL: col.prim = col.lb; break; case GLP_NU: col.prim = col.ub; break; case GLP_NF: col.prim = 0.0; break; case GLP_NS: col.prim = col.lb; break; default: xassert(stat != stat); } col.dual = (cbar[j] / col.sjj) / zeta; } } } var csa; var binv_st = 2; /* status of basis matrix factorization: 0 - invalid; 1 - just computed; 2 - updated */ var bbar_st = 0; /* status of primal values of basic variables: 0 - invalid; 1 - just computed; 2 - updated */ var cbar_st = 0; /* status of reduced costs of non-basic variables: 0 - invalid; 1 - just computed; 2 - updated */ var rigorous = 0; /* rigorous mode flag; this flag is used to enable iterative refinement on computing pivot rows and columns of the simplex table */ var check = 0; var p_stat, d_stat, ret; /* allocate and initialize the common storage area */ csa = alloc_csa(lp); init_csa(csa, lp); if (parm.msg_lev >= GLP_MSG_DBG) xprintf("Objective scale factor = " + csa.zeta + ""); while (true){ /* main loop starts here */ /* compute factorization of the basis matrix */ if (binv_st == 0) { ret = invert_B(csa); if (ret != 0) { if (parm.msg_lev >= GLP_MSG_ERR) { xprintf("Error: unable to factorize the basis matrix (" + ret + ")"); xprintf("Sorry, basis recovery procedure not implemented yet"); } xassert(!lp.valid && lp.bfd == null); lp.bfd = csa.bfd; csa.bfd = null; lp.pbs_stat = lp.dbs_stat = GLP_UNDEF; lp.obj_val = 0.0; lp.it_cnt = csa.it_cnt; lp.some = 0; ret = GLP_EFAIL; return ret; } csa.valid = 1; binv_st = 1; /* just computed */ /* invalidate basic solution components */ bbar_st = cbar_st = 0; } /* compute primal values of basic variables */ if (bbar_st == 0) { eval_bbar(csa); bbar_st = 1; /* just computed */ /* determine the search phase, if not determined yet */ if (csa.phase == 0) { if (set_aux_obj(csa, parm.tol_bnd) > 0) { /* current basic solution is primal infeasible */ /* start to minimize the sum of infeasibilities */ csa.phase = 1; } else { /* current basic solution is primal feasible */ /* start to minimize the original objective function */ set_orig_obj(csa); csa.phase = 2; } xassert(check_stab(csa, parm.tol_bnd) == 0); /* working objective coefficients have been changed, so invalidate reduced costs */ cbar_st = 0; display(csa, parm, 1); } /* make sure that the current basic solution remains primal feasible (or pseudo feasible on phase I) */ if (check_stab(csa, parm.tol_bnd)) { /* there are excessive bound violations due to round-off errors */ if (parm.msg_lev >= GLP_MSG_ERR) xprintf("Warning: numerical instability (primal simplex, phase " + (csa.phase == 1 ? "I" : "II") + ")"); /* restart the search */ csa.phase = 0; binv_st = 0; rigorous = 5; continue; } } xassert(csa.phase == 1 || csa.phase == 2); /* on phase I we do not need to wait until the current basic solution becomes dual feasible; it is sufficient to make sure that no basic variable violates its bounds */ if (csa.phase == 1 && !check_feas(csa, parm.tol_bnd)) { /* the current basis is primal feasible; switch to phase II */ csa.phase = 2; set_orig_obj(csa); cbar_st = 0; display(csa, parm, 1); } /* compute reduced costs of non-basic variables */ if (cbar_st == 0) { eval_cbar(csa); cbar_st = 1; /* just computed */ } /* redefine the reference space, if required */ switch (parm.pricing) { case GLP_PT_STD: break; case GLP_PT_PSE: if (csa.refct == 0) reset_refsp(csa); break; default: xassert(parm != parm); } /* at this point the basis factorization and all basic solution components are valid */ xassert(binv_st && bbar_st && cbar_st); /* check accuracy of current basic solution components (only for debugging) */ if (check) { var e_bbar = err_in_bbar(csa); var e_cbar = err_in_cbar(csa); var e_gamma = (parm.pricing == GLP_PT_PSE ? err_in_gamma(csa) : 0.0); xprintf("e_bbar = " + e_bbar + "; e_cbar = " + e_cbar + "; e_gamma = " + e_gamma + ""); xassert(e_bbar <= 1e-5 && e_cbar <= 1e-5 && e_gamma <= 1e-3); } /* check if the iteration limit has been exhausted */ if (parm.it_lim < INT_MAX && csa.it_cnt - csa.it_beg >= parm.it_lim) { if (bbar_st != 1 || csa.phase == 2 && cbar_st != 1) { if (bbar_st != 1) bbar_st = 0; if (csa.phase == 2 && cbar_st != 1) cbar_st = 0; continue; } display(csa, parm, 1); if (parm.msg_lev >= GLP_MSG_ALL) xprintf("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED"); switch (csa.phase) { case 1: p_stat = GLP_INFEAS; set_orig_obj(csa); eval_cbar(csa); break; case 2: p_stat = GLP_FEAS; break; default: xassert(csa != csa); } chuzc(csa, parm.tol_dj); d_stat = (csa.q == 0 ? GLP_FEAS : GLP_INFEAS); store_sol(csa, lp, p_stat, d_stat, 0); ret = GLP_EITLIM; return ret; } /* check if the time limit has been exhausted */ if (parm.tm_lim < INT_MAX && 1000.0 * xdifftime(xtime(), csa.tm_beg) >= parm.tm_lim) { if (bbar_st != 1 || csa.phase == 2 && cbar_st != 1) { if (bbar_st != 1) bbar_st = 0; if (csa.phase == 2 && cbar_st != 1) cbar_st = 0; continue; } display(csa, parm, 1); if (parm.msg_lev >= GLP_MSG_ALL) xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED"); switch (csa.phase) { case 1: p_stat = GLP_INFEAS; set_orig_obj(csa); eval_cbar(csa); break; case 2: p_stat = GLP_FEAS; break; default: xassert(csa != csa); } chuzc(csa, parm.tol_dj); d_stat = (csa.q == 0 ? GLP_FEAS : GLP_INFEAS); store_sol(csa, lp, p_stat, d_stat, 0); ret = GLP_ETMLIM; return ret; } /* display the search progress */ display(csa, parm, 0); /* choose non-basic variable xN[q] */ chuzc(csa, parm.tol_dj); if (csa.q == 0) { if (bbar_st != 1 || cbar_st != 1) { if (bbar_st != 1) bbar_st = 0; if (cbar_st != 1) cbar_st = 0; continue; } display(csa, parm, 1); switch (csa.phase) { case 1: if (parm.msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO FEASIBLE SOLUTION"); p_stat = GLP_NOFEAS; set_orig_obj(csa); eval_cbar(csa); chuzc(csa, parm.tol_dj); d_stat = (csa.q == 0 ? GLP_FEAS : GLP_INFEAS); break; case 2: if (parm.msg_lev >= GLP_MSG_ALL) xprintf("OPTIMAL SOLUTION FOUND"); p_stat = d_stat = GLP_FEAS; break; default: xassert(csa != csa); } store_sol(csa, lp, p_stat, d_stat, 0); ret = 0; return ret; } /* compute pivot column of the simplex table */ eval_tcol(csa); if (rigorous) refine_tcol(csa); sort_tcol(csa, parm.tol_piv); /* check accuracy of the reduced cost of xN[q] */ { var d1 = csa.cbar[csa.q]; /* less accurate */ var d2 = reeval_cost(csa); /* more accurate */ xassert(d1 != 0.0); if (Math.abs(d1 - d2) > 1e-5 * (1.0 + Math.abs(d2)) || !(d1 < 0.0 && d2 < 0.0 || d1 > 0.0 && d2 > 0.0)) { if (parm.msg_lev >= GLP_MSG_DBG) xprintf("d1 = " + d1 + "; d2 = " + d2 + ""); if (cbar_st != 1 || !rigorous) { if (cbar_st != 1) cbar_st = 0; rigorous = 5; continue; } } /* replace cbar[q] by more accurate value keeping its sign */ if (d1 > 0.0) csa.cbar[csa.q] = (d2 > 0.0 ? d2 : +DBL_EPSILON); else csa.cbar[csa.q] = (d2 < 0.0 ? d2 : -DBL_EPSILON); } /* choose basic variable xB[p] */ switch (parm.r_test) { case GLP_RT_STD: chuzr(csa, 0.0); break; case GLP_RT_HAR: chuzr(csa, 0.30 * parm.tol_bnd); break; default: xassert(parm != parm); } if (csa.p == 0) { if (bbar_st != 1 || cbar_st != 1 || !rigorous) { if (bbar_st != 1) bbar_st = 0; if (cbar_st != 1) cbar_st = 0; rigorous = 1; continue; } display(csa, parm, 1); switch (csa.phase) { case 1: if (parm.msg_lev >= GLP_MSG_ERR) xprintf("Error: unable to choose basic variable on phase I"); xassert(!lp.valid && lp.bfd == null); lp.bfd = csa.bfd; csa.bfd = null; lp.pbs_stat = lp.dbs_stat = GLP_UNDEF; lp.obj_val = 0.0; lp.it_cnt = csa.it_cnt; lp.some = 0; ret = GLP_EFAIL; break; case 2: if (parm.msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS UNBOUNDED SOLUTION"); store_sol(csa, lp, GLP_FEAS, GLP_NOFEAS, csa.head[csa.m+csa.q]); ret = 0; break; default: xassert(csa != csa); } return ret; } /* check if the pivot element is acceptable */ if (csa.p > 0) { var piv = csa.tcol_vec[csa.p]; var eps = 1e-5 * (1.0 + 0.01 * csa.tcol_max); if (Math.abs(piv) < eps) { if (parm.msg_lev >= GLP_MSG_DBG) xprintf("piv = " + piv + "; eps = " + eps + ""); if (!rigorous) { rigorous = 5; continue; } } } /* now xN[q] and xB[p] have been chosen anyhow */ /* compute pivot row of the simplex table */ if (csa.p > 0) { var rho = csa.work4; eval_rho(csa, rho); if (rigorous) refine_rho(csa, rho); eval_trow(csa, rho); } /* accuracy check based on the pivot element */ if (csa.p > 0) { var piv1 = csa.tcol_vec[csa.p]; /* more accurate */ var piv2 = csa.trow_vec[csa.q]; /* less accurate */ xassert(piv1 != 0.0); if (Math.abs(piv1 - piv2) > 1e-8 * (1.0 + Math.abs(piv1)) || !(piv1 > 0.0 && piv2 > 0.0 || piv1 < 0.0 && piv2 < 0.0)) { if (parm.msg_lev >= GLP_MSG_DBG) xprintf("piv1 = " + piv1 + "; piv2 = " + piv2 + ""); if (binv_st != 1 || !rigorous) { if (binv_st != 1) binv_st = 0; rigorous = 5; continue; } /* use more accurate version in the pivot row */ if (csa.trow_vec[csa.q] == 0.0) { csa.trow_nnz++; xassert(csa.trow_nnz <= csa.n); csa.trow_ind[csa.trow_nnz] = csa.q; } csa.trow_vec[csa.q] = piv1; } } /* update primal values of basic variables */ update_bbar(csa); bbar_st = 2; /* updated */ /* update reduced costs of non-basic variables */ if (csa.p > 0) { update_cbar(csa); cbar_st = 2; /* updated */ /* on phase I objective coefficient of xB[p] in the adjacent basis becomes zero */ if (csa.phase == 1) { var k = csa.head[csa.p]; /* x[k] = xB[p] . xN[q] */ csa.cbar[csa.q] -= csa.coef[k]; csa.coef[k] = 0.0; } } /* update steepest edge coefficients */ if (csa.p > 0) { switch (parm.pricing) { case GLP_PT_STD: break; case GLP_PT_PSE: if (csa.refct > 0) update_gamma(csa); break; default: xassert(parm != parm); } } /* update factorization of the basis matrix */ if (csa.p > 0) { ret = update_B(csa, csa.p, csa.head[csa.m+csa.q]); if (ret == 0) binv_st = 2; /* updated */ else { csa.valid = 0; binv_st = 0; /* invalid */ } } /* update matrix N */ if (csa.p > 0) { del_N_col(csa, csa.q, csa.head[csa.m+csa.q]); if (csa.type[csa.head[csa.p]] != GLP_FX) add_N_col(csa, csa.q, csa.head[csa.p]); } /* change the basis header */ change_basis(csa); /* iteration complete */ csa.it_cnt++; if (rigorous > 0) rigorous--; continue; } /* return to the calling program */ //return ret; } function spx_dual(lp, parm){ var kappa = 0.10; function alloc_csa(lp){ var m = lp.m; var n = lp.n; var nnz = lp.nnz; var csa = {}; xassert(m > 0 && n > 0); csa.m = m; csa.n = n; csa.type = new Int8Array(1+m+n); csa.lb = new Float64Array(1+m+n); csa.ub = new Float64Array(1+m+n); csa.coef = new Float64Array(1+m+n); csa.orig_type = new Int8Array(1+m+n); csa.orig_lb = new Float64Array(1+m+n); csa.orig_ub = new Float64Array(1+m+n); csa.obj = new Float64Array(1+n); csa.A_ptr = new Int32Array(1+n+1); csa.A_ind = new Int32Array(1+nnz); csa.A_val = new Float64Array(1+nnz); csa.AT_ptr = new Int32Array(1+m+1); csa.AT_ind = new Int32Array(1+nnz); csa.AT_val = new Float64Array(1+nnz); csa.head = new Int32Array(1+m+n); csa.bind = new Int32Array(1+m+n); csa.stat = new Int8Array(1+n); csa.bbar = new Float64Array(1+m); csa.cbar = new Float64Array(1+n); csa.refsp = new Int8Array(1+m+n); csa.gamma = new Float64Array(1+m); csa.trow_ind = new Int32Array(1+n); csa.trow_vec = new Float64Array(1+n); csa.tcol_ind = new Int32Array(1+m); csa.tcol_vec = new Float64Array(1+m); csa.work1 = new Float64Array(1+m); csa.work2 = new Float64Array(1+m); csa.work3 = new Float64Array(1+m); csa.work4 = new Float64Array(1+m); return csa; } this["chrome_workaround_1"] = function(csa, lp){ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var n = csa.n; var aij, loc, j; /* matrix A (by columns) */ loc = 1; for (j = 1; j <= n; j++) { A_ptr[j] = loc; for (aij = lp.col[j].ptr; aij != null; aij = aij.c_next) { A_ind[loc] = aij.row.i; A_val[loc] = aij.row.rii * aij.val * aij.col.sjj; loc++; } } A_ptr[n+1] = loc; xassert(loc-1 == lp.nnz); }; this["chrome_workaround_2"] = function(csa, lp){ var loc, i, aij; var AT_ptr = csa.AT_ptr; var AT_ind = csa.AT_ind; var AT_val = csa.AT_val; var m = csa.m; /* matrix A (by rows) */ loc = 1; for (i = 1; i <= m; i++) { AT_ptr[i] = loc; for (aij = lp.row[i].ptr; aij != null; aij = aij.r_next) { AT_ind[loc] = aij.col.j; AT_val[loc] = aij.row.rii * aij.val * aij.col.sjj; loc++; } } AT_ptr[m+1] = loc; xassert(loc-1 == lp.nnz); }; function init_csa(csa, lp){ var m = csa.m; var n = csa.n; var type = csa.type; var lb = csa.lb; var ub = csa.ub; var coef = csa.coef; var orig_type = csa.orig_type; var orig_lb = csa.orig_lb; var orig_ub = csa.orig_ub; var obj = csa.obj; var head = csa.head; var bind = csa.bind; var stat = csa.stat; var refsp = csa.refsp; var gamma = csa.gamma; var i, j, k, loc; var cmax, aij, row, col; /* auxiliary variables */ for (i = 1; i <= m; i++) { row = lp.row[i]; type[i] = row.type; lb[i] = row.lb * row.rii; ub[i] = row.ub * row.rii; coef[i] = 0.0; } /* structural variables */ for (j = 1; j <= n; j++) { col = lp.col[j]; type[m+j] = col.type; lb[m+j] = col.lb / col.sjj; ub[m+j] = col.ub / col.sjj; coef[m+j] = col.coef * col.sjj; } /* original bounds of variables */ xcopyArr(orig_type, 1, type, 1, m+n); xcopyArr(orig_lb, 1, lb, 1, m+n); xcopyArr(orig_ub, 1, ub, 1, m+n); /* original objective function */ obj[0] = lp.c0; xcopyArr(obj, 1, coef, m+1, n); /* factor used to scale original objective coefficients */ cmax = 0.0; for (j = 1; j <= n; j++) if (cmax < Math.abs(obj[j])) cmax = Math.abs(obj[j]); if (cmax == 0.0) cmax = 1.0; switch (lp.dir) { case GLP_MIN: csa.zeta = + 1.0 / cmax; break; case GLP_MAX: csa.zeta = - 1.0 / cmax; break; default: xassert(lp != lp); } if (Math.abs(csa.zeta) < 1.0) csa.zeta *= 1000.0; /* scale working objective coefficients */ for (j = 1; j <= n; j++) coef[m+j] *= csa.zeta; chrome_workaround_1(csa, lp); chrome_workaround_2(csa, lp); /* basis header */ xassert(lp.valid); xcopyArr(head, 1, lp.head, 1, m); k = 0; for (i = 1; i <= m; i++) { row = lp.row[i]; if (row.stat != GLP_BS) { k++; xassert(k <= n); head[m+k] = i; stat[k] = row.stat; } } for (j = 1; j <= n; j++) { col = lp.col[j]; if (col.stat != GLP_BS) { k++; xassert(k <= n); head[m+k] = m + j; stat[k] = col.stat; } } xassert(k == n); for (k = 1; k <= m+n; k++) bind[head[k]] = k; /* factorization of matrix B */ csa.valid = 1; lp.valid = 0; csa.bfd = lp.bfd; lp.bfd = null; /* working parameters */ csa.phase = 0; csa.tm_beg = xtime(); csa.it_beg = csa.it_cnt = lp.it_cnt; csa.it_dpy = -1; /* reference space and steepest edge coefficients */ csa.refct = 0; xfillArr(refsp, 1, 0, m+n); for (i = 1; i <= m; i++) gamma[i] = 1.0; } function inv_col(csa, i, ind, val){ /* this auxiliary routine returns row indices and numeric values of non-zero elements of i-th column of the basis matrix */ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var k, len, ptr, t; if (GLP_DEBUG){xassert(1 <= i && i <= m)} k = head[i]; /* B[i] is k-th column of (I|-A) */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (k <= m) { /* B[i] is k-th column of submatrix I */ len = 1; ind[1] = k; val[1] = 1.0; } else { /* B[i] is (k-m)-th column of submatrix (-A) */ ptr = A_ptr[k-m]; len = A_ptr[k-m+1] - ptr; xcopyArr(ind, 1, A_ind, ptr, len); xcopyArr(val, 1, A_val, ptr, len); for (t = 1; t <= len; t++) val[t] = - val[t]; } return len; } function invert_B(csa){ var ret = bfd_factorize(csa.bfd, csa.m, null, inv_col, csa); csa.valid = (ret == 0); return ret; } function update_B(csa, i, k) { var m = csa.m; if (GLP_DEBUG){var n = csa.n} var ret, val; if (GLP_DEBUG){ xassert(1 <= i && i <= m); xassert(1 <= k && k <= m+n); } if (k <= m) { /* new i-th column of B is k-th column of I */ var ind = new Array(1+1); val = new Array(1+1); ind[1] = k; val[1] = 1.0; xassert(csa.valid); ret = bfd_update_it(csa.bfd, i, 0, 1, ind, 0, val); } else { /* new i-th column of B is (k-m)-th column of (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; val = csa.work1; var beg, end, ptr, len; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; len = 0; for (ptr = beg; ptr < end; ptr++) val[++len] = - A_val[ptr]; xassert(csa.valid); ret = bfd_update_it(csa.bfd, i, 0, len, A_ind, beg-1, val); } csa.valid = (ret == 0); return ret; } function error_ftran(csa, h, x, r){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var i, k, beg, end, ptr; var temp; /* compute the residual vector: r = h - B * x = h - B[1] * x[1] - ... - B[m] * x[m], where B[1], ..., B[m] are columns of matrix B */ xcopyArr(r, 1, h, 1, m); for (i = 1; i <= m; i++) { temp = x[i]; if (temp == 0.0) continue; k = head[i]; /* B[i] is k-th column of (I|-A) */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (k <= m) { /* B[i] is k-th column of submatrix I */ r[k] -= temp; } else { /* B[i] is (k-m)-th column of submatrix (-A) */ beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) r[A_ind[ptr]] += A_val[ptr] * temp; } } } function refine_ftran(csa, h, x){ var m = csa.m; var r = csa.work1; var d = csa.work1; var i; /* compute the residual vector r = h - B * x */ error_ftran(csa, h, x, r); /* compute the correction vector d = inv(B) * r */ xassert(csa.valid); bfd_ftran(csa.bfd, d); /* refine the solution vector (new x) = (old x) + d */ for (i = 1; i <= m; i++) x[i] += d[i]; } function error_btran(csa, h, x, r){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var i, k, beg, end, ptr; var temp; /* compute the residual vector r = b - B'* x */ for (i = 1; i <= m; i++) { /* r[i] := b[i] - (i-th column of B)'* x */ k = head[i]; /* B[i] is k-th column of (I|-A) */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} temp = h[i]; if (k <= m) { /* B[i] is k-th column of submatrix I */ temp -= x[k]; } else { /* B[i] is (k-m)-th column of submatrix (-A) */ beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) temp += A_val[ptr] * x[A_ind[ptr]]; } r[i] = temp; } } function refine_btran(csa, h, x){ var m = csa.m; var r = csa.work1; var d = csa.work1; var i; /* compute the residual vector r = h - B'* x */ error_btran(csa, h, x, r); /* compute the correction vector d = inv(B') * r */ xassert(csa.valid); bfd_btran(csa.bfd, d); /* refine the solution vector (new x) = (old x) + d */ for (i = 1; i <= m; i++) x[i] += d[i]; } function get_xN(csa, j){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var lb = csa.lb; var ub = csa.ub; var head = csa.head; var stat = csa.stat; var k; var xN; if (GLP_DEBUG){xassert(1 <= j && j <= n)} k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} switch (stat[j]) { case GLP_NL: /* x[k] is on its lower bound */ xN = lb[k]; break; case GLP_NU: /* x[k] is on its upper bound */ xN = ub[k]; break; case GLP_NF: /* x[k] is free non-basic variable */ xN = 0.0; break; case GLP_NS: /* x[k] is fixed non-basic variable */ xN = lb[k]; break; default: xassert(stat != stat); } return xN; } function eval_beta(csa, beta){ var m = csa.m; var n = csa.n; var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var h = csa.work2; var i, j, k, beg, end, ptr; var xN; /* compute the right-hand side vector: h := - N * xN = - N[1] * xN[1] - ... - N[n] * xN[n], where N[1], ..., N[n] are columns of matrix N */ for (i = 1; i <= m; i++) h[i] = 0.0; for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* determine current value of xN[j] */ xN = get_xN(csa, j); if (xN == 0.0) continue; if (k <= m) { /* N[j] is k-th column of submatrix I */ h[k] -= xN; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) h[A_ind[ptr]] += xN * A_val[ptr]; } } /* solve system B * beta = h */ xcopyArr(beta, 1, h, 1, m); xassert(csa.valid); bfd_ftran(csa.bfd, beta); /* and refine the solution */ refine_ftran(csa, h, beta); } function eval_pi(csa, pi){ var m = csa.m; var c = csa.coef; var head = csa.head; var cB = csa.work2; var i; /* construct the right-hand side vector cB */ for (i = 1; i <= m; i++) cB[i] = c[head[i]]; /* solve system B'* pi = cB */ xcopyArr(pi, 1, cB, 1, m); xassert(csa.valid); bfd_btran(csa.bfd, pi); /* and refine the solution */ refine_btran(csa, cB, pi); } function eval_cost(csa, pi, j){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var coef = csa.coef; var head = csa.head; var k; var dj; if (GLP_DEBUG){xassert(1 <= j && j <= n)} k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} dj = coef[k]; if (k <= m) { /* N[j] is k-th column of submatrix I */ dj -= pi[k]; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) dj += A_val[ptr] * pi[A_ind[ptr]]; } return dj; } function eval_bbar(csa){ eval_beta(csa, csa.bbar); } function eval_cbar(csa){ if (GLP_DEBUG){var m = csa.m} var n = csa.n; if (GLP_DEBUG){var head = csa.head} var cbar = csa.cbar; var pi = csa.work3; var j; if (GLP_DEBUG){var k} /* compute simplex multipliers */ eval_pi(csa, pi); /* compute and store reduced costs */ for (j = 1; j <= n; j++) { if (GLP_DEBUG){ k = head[m+j]; /* x[k] = xN[j] */ xassert(1 <= k && k <= m+n); } cbar[j] = eval_cost(csa, pi, j); } } function reset_refsp(csa){ var m = csa.m; var n = csa.n; var head = csa.head; var refsp = csa.refsp; var gamma = csa.gamma; var i, k; xassert(csa.refct == 0); csa.refct = 1000; xfillArr(refsp, 1, 0, m+n); for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ refsp[k] = 1; gamma[i] = 1.0; } } function eval_gamma(csa, gamma){ var m = csa.m; var n = csa.n; var type = csa.type; var head = csa.head; var refsp = csa.refsp; var alfa = csa.work3; var h = csa.work3; var i, j, k; /* gamma[i] := eta[i] (or 1, if xB[i] is free) */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} if (type[k] == GLP_FR) gamma[i] = 1.0; else gamma[i] = (refsp[k] ? 1.0 : 0.0); } /* compute columns of the current simplex table */ for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* skip column, if xN[j] is not in C */ if (!refsp[k]) continue; if (GLP_DEBUG){ /* set C must not contain fixed variables */ xassert(type[k] != GLP_FX); } /* construct the right-hand side vector h = - N[j] */ for (i = 1; i <= m; i++) h[i] = 0.0; if (k <= m) { /* N[j] is k-th column of submatrix I */ h[k] = -1.0; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) h[A_ind[ptr]] = A_val[ptr]; } /* solve system B * alfa = h */ xassert(csa.valid); bfd_ftran(csa.bfd, alfa); /* gamma[i] := gamma[i] + alfa[i,j]^2 */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (type[k] != GLP_FR) gamma[i] += alfa[i] * alfa[i]; } } } function chuzr(csa, tol_bnd){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var type = csa.type; var lb = csa.lb; var ub = csa.ub; var head = csa.head; var bbar = csa.bbar; var gamma = csa.gamma; var i, k, p; var delta, best, eps, ri, temp; /* nothing is chosen so far */ p = 0; delta = 0.0; best = 0.0; /* look through the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* determine bound violation ri[i] */ ri = 0.0; if (type[k] == GLP_LO || type[k] == GLP_DB || type[k] == GLP_FX) { /* xB[i] has lower bound */ eps = tol_bnd * (1.0 + kappa * Math.abs(lb[k])); if (bbar[i] < lb[k] - eps) { /* and significantly violates it */ ri = lb[k] - bbar[i]; } } if (type[k] == GLP_UP || type[k] == GLP_DB || type[k] == GLP_FX) { /* xB[i] has upper bound */ eps = tol_bnd * (1.0 + kappa * Math.abs(ub[k])); if (bbar[i] > ub[k] + eps) { /* and significantly violates it */ ri = ub[k] - bbar[i]; } } /* if xB[i] is not eligible, skip it */ if (ri == 0.0) continue; /* xB[i] is eligible basic variable; choose one with largest weighted bound violation */ if (GLP_DEBUG){xassert(gamma[i] >= 0.0)} temp = gamma[i]; if (temp < DBL_EPSILON) temp = DBL_EPSILON; temp = (ri * ri) / temp; if (best < temp){ p = i; delta = ri; best = temp; } } /* store the index of basic variable xB[p] chosen and its change in the adjacent basis */ csa.p = p; csa.delta = delta; } function eval_rho(csa, e){ var m = csa.m; var p = csa.p; var i; if (GLP_DEBUG){xassert(1 <= p && p <= m)} /* construct the right-hand side vector e[p] */ for (i = 1; i <= m; i++) e[i] = 0.0; e[p] = 1.0; /* solve system B'* rho = e[p] */ xassert(csa.valid); bfd_btran(csa.bfd, rho); } function refine_rho(csa, rho){ var m = csa.m; var p = csa.p; var e = csa.work3; var i; if (GLP_DEBUG){xassert(1 <= p && p <= m)} /* construct the right-hand side vector e[p] */ for (i = 1; i <= m; i++) e[i] = 0.0; e[p] = 1.0; /* refine solution of B'* rho = e[p] */ refine_btran(csa, e, rho); } function eval_trow1(csa, rho){ var m = csa.m; var n = csa.n; var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var head = csa.head; var stat = csa.stat; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var j, k, beg, end, ptr, nnz; var temp; /* compute the pivot row as inner products of columns of the matrix N and vector rho: trow[j] = - rho * N[j] */ nnz = 0; for (j = 1; j <= n; j++) { if (stat[j] == GLP_NS) { /* xN[j] is fixed */ trow_vec[j] = 0.0; continue; } k = head[m+j]; /* x[k] = xN[j] */ if (k <= m) { /* N[j] is k-th column of submatrix I */ temp = - rho[k]; } else { /* N[j] is (k-m)-th column of submatrix (-A) */ beg = A_ptr[k-m]; end = A_ptr[k-m+1]; temp = 0.0; for (ptr = beg; ptr < end; ptr++) temp += rho[A_ind[ptr]] * A_val[ptr]; } if (temp != 0.0) trow_ind[++nnz] = j; trow_vec[j] = temp; } csa.trow_nnz = nnz; } function eval_trow2(csa, rho){ var m = csa.m; var n = csa.n; var AT_ptr = csa.AT_ptr; var AT_ind = csa.AT_ind; var AT_val = csa.AT_val; var bind = csa.bind; var stat = csa.stat; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var i, j, beg, end, ptr, nnz; var temp; /* clear the pivot row */ for (j = 1; j <= n; j++) trow_vec[j] = 0.0; /* compute the pivot row as a linear combination of rows of the matrix N: trow = - rho[1] * N'[1] - ... - rho[m] * N'[m] */ for (i = 1; i <= m; i++) { temp = rho[i]; if (temp == 0.0) continue; /* trow := trow - rho[i] * N'[i] */ j = bind[i] - m; /* x[i] = xN[j] */ if (j >= 1 && stat[j] != GLP_NS) trow_vec[j] -= temp; beg = AT_ptr[i]; end = AT_ptr[i+1]; for (ptr = beg; ptr < end; ptr++) { j = bind[m + AT_ind[ptr]] - m; /* x[k] = xN[j] */ if (j >= 1 && stat[j] != GLP_NS) trow_vec[j] += temp * AT_val[ptr]; } } /* construct sparse pattern of the pivot row */ nnz = 0; for (j = 1; j <= n; j++) { if (trow_vec[j] != 0.0) trow_ind[++nnz] = j; } csa.trow_nnz = nnz; } function eval_trow(csa, rho){ var m = csa.m; var i, nnz; var dens; /* determine the density of the vector rho */ nnz = 0; for (i = 1; i <= m; i++) if (rho[i] != 0.0) nnz++; dens = nnz / m; if (dens >= 0.20) { /* rho is relatively dense */ eval_trow1(csa, rho); } else { /* rho is relatively sparse */ eval_trow2(csa, rho); } } function sort_trow(csa, tol_piv){ if (GLP_DEBUG){ var n = csa.n; var stat = csa.stat; } var nnz = csa.trow_nnz; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var j, num, pos; var big, eps, temp; /* compute infinity (maximum) norm of the row */ big = 0.0; for (pos = 1; pos <= nnz; pos++) { if (GLP_DEBUG){ j = trow_ind[pos]; xassert(1 <= j && j <= n); xassert(stat[j] != GLP_NS); } temp = Math.abs(trow_vec[trow_ind[pos]]); if (big < temp) big = temp; } csa.trow_max = big; /* determine absolute pivot tolerance */ eps = tol_piv * (1.0 + 0.01 * big); /* move significant row components to the front of the list */ for (num = 0; num < nnz; ) { j = trow_ind[nnz]; if (Math.abs(trow_vec[j]) < eps) nnz--; else { num++; trow_ind[nnz] = trow_ind[num]; trow_ind[num] = j; } } csa.trow_num = num; } function chuzc(csa, rtol){ if (GLP_DEBUG){ var m = csa.m; var n = csa.n; } var stat = csa.stat; var cbar = csa.cbar; if (GLP_DEBUG){ var p = csa.p; } var delta = csa.delta; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var trow_num = csa.trow_num; var j, pos, q; var alfa, big, s, t, teta, tmax; if (GLP_DEBUG){xassert(1 <= p && p <= m)} /* delta > 0 means that xB[p] violates its lower bound and goes to it in the adjacent basis, so lambdaB[p] is increasing from its lower zero bound; delta < 0 means that xB[p] violates its upper bound and goes to it in the adjacent basis, so lambdaB[p] is decreasing from its upper zero bound */ if (GLP_DEBUG){xassert(delta != 0.0)} /* s := sign(delta) */ s = (delta > 0.0 ? +1.0 : -1.0); /*** FIRST PASS ***/ /* nothing is chosen so far */ q = 0; teta = DBL_MAX; big = 0.0; /* walk through significant elements of the pivot row */ for (pos = 1; pos <= trow_num; pos++) { j = trow_ind[pos]; if (GLP_DEBUG){xassert(1 <= j && j <= n)} alfa = s * trow_vec[j]; if (GLP_DEBUG){xassert(alfa != 0.0)} /* lambdaN[j] = ... - alfa * lambdaB[p] - ..., and due to s we need to consider only increasing lambdaB[p] */ if (alfa > 0.0) { /* lambdaN[j] is decreasing */ if (stat[j] == GLP_NL || stat[j] == GLP_NF) { /* lambdaN[j] has zero lower bound */ t = (cbar[j] + rtol) / alfa; } else { /* lambdaN[j] has no lower bound */ continue; } } else { /* lambdaN[j] is increasing */ if (stat[j] == GLP_NU || stat[j] == GLP_NF) { /* lambdaN[j] has zero upper bound */ t = (cbar[j] - rtol) / alfa; } else { /* lambdaN[j] has no upper bound */ continue; } } /* t is a change of lambdaB[p], on which lambdaN[j] reaches its zero bound (possibly relaxed); since the basic solution is assumed to be dual feasible, t has to be non-negative by definition; however, it may happen that lambdaN[j] slightly (i.e. within a tolerance) violates its zero bound, that leads to negative t; in the latter case, if xN[j] is chosen, negative t means that lambdaB[p] changes in wrong direction that may cause wrong results on updating reduced costs; thus, if t is negative, we should replace it by exact zero assuming that lambdaN[j] is exactly on its zero bound, and violation appears due to round-off errors */ if (t < 0.0) t = 0.0; /* apply minimal ratio test */ if (teta > t || teta == t && big < Math.abs(alfa)){ q = j; teta = t; big = Math.abs(alfa); } } /* the second pass is skipped in the following cases: */ /* if the standard ratio test is used */ if (rtol == 0.0) return done(); /* if no non-basic variable has been chosen on the first pass */ if (q == 0) return done(); /* if lambdaN[q] prevents lambdaB[p] from any change */ if (teta == 0.0) return done(); /*** SECOND PASS ***/ /* here tmax is a maximal change of lambdaB[p], on which the solution remains dual feasible within a tolerance */ tmax = teta; /* nothing is chosen so far */ q = 0; teta = DBL_MAX; big = 0.0; /* walk through significant elements of the pivot row */ for (pos = 1; pos <= trow_num; pos++) { j = trow_ind[pos]; if (GLP_DEBUG){xassert(1 <= j && j <= n)} alfa = s * trow_vec[j]; if (GLP_DEBUG){xassert(alfa != 0.0)} /* lambdaN[j] = ... - alfa * lambdaB[p] - ..., and due to s we need to consider only increasing lambdaB[p] */ if (alfa > 0.0) { /* lambdaN[j] is decreasing */ if (stat[j] == GLP_NL || stat[j] == GLP_NF) { /* lambdaN[j] has zero lower bound */ t = cbar[j] / alfa; } else { /* lambdaN[j] has no lower bound */ continue; } } else { /* lambdaN[j] is increasing */ if (stat[j] == GLP_NU || stat[j] == GLP_NF) { /* lambdaN[j] has zero upper bound */ t = cbar[j] / alfa; } else { /* lambdaN[j] has no upper bound */ continue; } } /* (see comments for the first pass) */ if (t < 0.0) t = 0.0; /* t is a change of lambdaB[p], on which lambdaN[j] reaches its zero (lower or upper) bound; if t <= tmax, all reduced costs can violate their zero bounds only within relaxation tolerance rtol, so we can choose non-basic variable having largest influence coefficient to avoid possible numerical instability */ if (t <= tmax && big < Math.abs(alfa)){ q = j; teta = t; big = Math.abs(alfa); } } /* something must be chosen on the second pass */ xassert(q != 0); function done(){ /* store the index of non-basic variable xN[q] chosen */ csa.q = q; /* store reduced cost of xN[q] in the adjacent basis */ csa.new_dq = s * teta; } done(); } function eval_tcol(csa){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var head = csa.head; var q = csa.q; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var h = csa.tcol_vec; var i, k, nnz; if (GLP_DEBUG){xassert(1 <= q && q <= n)} k = head[m+q]; /* x[k] = xN[q] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* construct the right-hand side vector h = - N[q] */ for (i = 1; i <= m; i++) h[i] = 0.0; if (k <= m) { /* N[q] is k-th column of submatrix I */ h[k] = -1.0; } else { /* N[q] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) h[A_ind[ptr]] = A_val[ptr]; } /* solve system B * tcol = h */ xassert(csa.valid); bfd_ftran(csa.bfd, tcol_vec); /* construct sparse pattern of the pivot column */ nnz = 0; for (i = 1; i <= m; i++) { if (tcol_vec[i] != 0.0) tcol_ind[++nnz] = i; } csa.tcol_nnz = nnz; } function refine_tcol(csa){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var head = csa.head; var q = csa.q; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var h = csa.work3; var i, k, nnz; if (GLP_DEBUG){xassert(1 <= q && q <= n)} k = head[m+q]; /* x[k] = xN[q] */ if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* construct the right-hand side vector h = - N[q] */ for (i = 1; i <= m; i++) h[i] = 0.0; if (k <= m) { /* N[q] is k-th column of submatrix I */ h[k] = -1.0; } else { /* N[q] is (k-m)-th column of submatrix (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) h[A_ind[ptr]] = A_val[ptr]; } /* refine solution of B * tcol = h */ refine_ftran(csa, h, tcol_vec); /* construct sparse pattern of the pivot column */ nnz = 0; for (i = 1; i <= m; i++) { if (tcol_vec[i] != 0.0) tcol_ind[++nnz] = i; } csa.tcol_nnz = nnz; } function update_cbar(csa){ if (GLP_DEBUG){var n = csa.n} var cbar = csa.cbar; var trow_nnz = csa.trow_nnz; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var q = csa.q; var new_dq = csa.new_dq; var j, pos; if (GLP_DEBUG){xassert(1 <= q && q <= n)} /* set new reduced cost of xN[q] */ cbar[q] = new_dq; /* update reduced costs of other non-basic variables */ if (new_dq == 0.0) return; for (pos = 1; pos <= trow_nnz; pos++) { j = trow_ind[pos]; if (GLP_DEBUG){xassert(1 <= j && j <= n)} if (j != q) cbar[j] -= trow_vec[j] * new_dq; } } function update_bbar(csa){ if (GLP_DEBUG){ var m = csa.m; var n = csa.n; } var bbar = csa.bbar; var p = csa.p; var delta = csa.delta; var q = csa.q; var tcol_nnz = csa.tcol_nnz; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var i, pos; var teta; if (GLP_DEBUG){ xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); /* determine the change of xN[q] in the adjacent basis */ xassert(tcol_vec[p] != 0.0); } teta = delta / tcol_vec[p]; /* set new primal value of xN[q] */ bbar[p] = get_xN(csa, q) + teta; /* update primal values of other basic variables */ if (teta == 0.0) return; for (pos = 1; pos <= tcol_nnz; pos++) { i = tcol_ind[pos]; if (GLP_DEBUG){xassert(1 <= i && i <= m)} if (i != p) bbar[i] += tcol_vec[i] * teta; } } function update_gamma(csa){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var type = csa.type; var head = csa.head; var refsp = csa.refsp; var gamma = csa.gamma; var p = csa.p; var trow_nnz = csa.trow_nnz; var trow_ind = csa.trow_ind; var trow_vec = csa.trow_vec; var q = csa.q; var tcol_nnz = csa.tcol_nnz; var tcol_ind = csa.tcol_ind; var tcol_vec = csa.tcol_vec; var u = csa.work3; var i, j, k,pos; var gamma_p, eta_p, pivot, t, t1, t2; if (GLP_DEBUG){ xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); } /* the basis changes, so decrease the count */ xassert(csa.refct > 0); csa.refct--; /* recompute gamma[p] for the current basis more accurately and compute auxiliary vector u */ if (GLP_DEBUG){xassert(type[head[p]] != GLP_FR)} gamma_p = eta_p = (refsp[head[p]] ? 1.0 : 0.0); for (i = 1; i <= m; i++) u[i] = 0.0; for (pos = 1; pos <= trow_nnz; pos++) { j = trow_ind[pos]; if (GLP_DEBUG){xassert(1 <= j && j <= n)} k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG){ xassert(1 <= k && k <= m+n); xassert(type[k] != GLP_FX); } if (!refsp[k]) continue; t = trow_vec[j]; gamma_p += t * t; /* u := u + N[j] * delta[j] * trow[j] */ if (k <= m) { /* N[k] = k-j stolbec submatrix I */ u[k] += t; } else { /* N[k] = k-m-k stolbec (-A) */ var A_ptr = csa.A_ptr; var A_ind = csa.A_ind; var A_val = csa.A_val; var beg, end, ptr; beg = A_ptr[k-m]; end = A_ptr[k-m+1]; for (ptr = beg; ptr < end; ptr++) u[A_ind[ptr]] -= t * A_val[ptr]; } } xassert(csa.valid); bfd_ftran(csa.bfd, u); /* update gamma[i] for other basic variables (except xB[p] and free variables) */ pivot = tcol_vec[p]; if (GLP_DEBUG){xassert(pivot != 0.0)} for (pos = 1; pos <= tcol_nnz; pos++) { i = tcol_ind[pos]; if (GLP_DEBUG){xassert(1 <= i && i <= m)} k = head[i]; if (GLP_DEBUG){xassert(1 <= k && k <= m+n)} /* skip xB[p] */ if (i == p) continue; /* skip free basic variable */ if (type[head[i]] == GLP_FR) { if (GLP_DEBUG){xassert(gamma[i] == 1.0)} continue; } /* compute gamma[i] for the adjacent basis */ t = tcol_vec[i] / pivot; t1 = gamma[i] + t * t * gamma_p + 2.0 * t * u[i]; t2 = (refsp[k] ? 1.0 : 0.0) + eta_p * t * t; gamma[i] = (t1 >= t2 ? t1 : t2); /* (though gamma[i] can be exact zero, because the reference space does not include non-basic fixed variables) */ if (gamma[i] < DBL_EPSILON) gamma[i] = DBL_EPSILON; } /* compute gamma[p] for the adjacent basis */ if (type[head[m+q]] == GLP_FR) gamma[p] = 1.0; else { gamma[p] = gamma_p / (pivot * pivot); if (gamma[p] < DBL_EPSILON) gamma[p] = DBL_EPSILON; } /* if xB[p], which becomes xN[q] in the adjacent basis, is fixed and belongs to the reference space, remove it from there, and change all gamma's appropriately */ k = head[p]; if (type[k] == GLP_FX && refsp[k]) { refsp[k] = 0; for (pos = 1; pos <= tcol_nnz; pos++) { i = tcol_ind[pos]; if (i == p) { if (type[head[m+q]] == GLP_FR) continue; t = 1.0 / tcol_vec[p]; } else { if (type[head[i]] == GLP_FR) continue; t = tcol_vec[i] / tcol_vec[p]; } gamma[i] -= t * t; if (gamma[i] < DBL_EPSILON) gamma[i] = DBL_EPSILON; } } } function err_in_bbar(csa){ var m = csa.m; var bbar = csa.bbar; var i; var e, emax; var beta = new Float64Array(1+m); eval_beta(csa, beta); emax = 0.0; for (i = 1; i <= m; i++) { e = Math.abs(beta[i] - bbar[i]) / (1.0 + Math.abs(beta[i])); if (emax < e) emax = e; } return emax; } /*********************************************************************** * err_in_cbar - compute maximal relative error in dual solution * * This routine returns maximal relative error: * * max |cost[j] - cbar[j]| / (1 + |cost[j]|), * * where cost and cbar are, respectively, directly computed and the * current (updated) reduced costs of non-basic non-fixed variables. * * NOTE: The routine is intended only for debugginig purposes. */ function err_in_cbar(csa){ var m = csa.m; var n = csa.n; var stat = csa.stat; var cbar = csa.cbar; var j; var e, emax, cost; var pi = new Float64Array(1+m); eval_pi(csa, pi); emax = 0.0; for (j = 1; j <= n; j++) { if (stat[j] == GLP_NS) continue; cost = eval_cost(csa, pi, j); e = Math.abs(cost - cbar[j]) / (1.0 + Math.abs(cost)); if (emax < e) emax = e; } return emax; } function err_in_gamma(csa){ var m = csa.m; var type = csa.type; var head = csa.head; var gamma = csa.gamma; var exact = csa.work4; var i; var e, emax, temp; eval_gamma(csa, exact); emax = 0.0; for (i = 1; i <= m; i++) { if (type[head[i]] == GLP_FR) { xassert(gamma[i] == 1.0); xassert(exact[i] == 1.0); continue; } temp = exact[i]; e = Math.abs(temp - gamma[i]) / (1.0 + Math.abs(temp)); if (emax < e) emax = e; } return emax; } function change_basis(csa){ var m = csa.m; if (GLP_DEBUG){var n = csa.n} var type = csa.type; var head = csa.head; var bind = csa.bind; var stat = csa.stat; var p = csa.p; var delta = csa.delta; var q = csa.q; var k; /* xB[p] leaves the basis, xN[q] enters the basis */ if (GLP_DEBUG){ xassert(1 <= p && p <= m); xassert(1 <= q && q <= n); } /* xB[p] <. xN[q] */ k = head[p]; head[p] = head[m+q]; head[m+q] = k; bind[head[p]] = p; bind[head[m+q]] = m + q; if (type[k] == GLP_FX) stat[q] = GLP_NS; else if (delta > 0.0) { if (GLP_DEBUG){ xassert(type[k] == GLP_LO || type[k] == GLP_DB) } stat[q] = GLP_NL; } else /* delta < 0.0 */ { if (GLP_DEBUG) xassert(type[k] == GLP_UP || type[k] == GLP_DB); stat[q] = GLP_NU; } } function check_feas(csa, tol_dj){ var m = csa.m; var n = csa.n; var orig_type = csa.orig_type; var head = csa.head; var cbar = csa.cbar; var j, k; for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG) xassert(1 <= k && k <= m+n); if (cbar[j] < - tol_dj) if (orig_type[k] == GLP_LO || orig_type[k] == GLP_FR) return 1; if (cbar[j] > + tol_dj) if (orig_type[k] == GLP_UP || orig_type[k] == GLP_FR) return 1; } return 0; } function set_aux_bnds(csa){ var m = csa.m; var n = csa.n; var type = csa.type; var lb = csa.lb; var ub = csa.ub; var orig_type = csa.orig_type; var head = csa.head; var stat = csa.stat; var cbar = csa.cbar; var j, k; for (k = 1; k <= m+n; k++) { switch (orig_type[k]) { case GLP_FR: /* to force free variables to enter the basis */ type[k] = GLP_DB; lb[k] = -1e3; ub[k] = +1e3; break; case GLP_LO: type[k] = GLP_DB; lb[k] = 0.0; ub[k] = +1.0; break; case GLP_UP: type[k] = GLP_DB; lb[k] = -1.0; ub[k] = 0.0; break; case GLP_DB: case GLP_FX: type[k] = GLP_FX; lb[k] = ub[k] = 0.0; break; default: xassert(orig_type != orig_type); } } for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG) xassert(1 <= k && k <= m+n); if (type[k] == GLP_FX) stat[j] = GLP_NS; else if (cbar[j] >= 0.0) stat[j] = GLP_NL; else stat[j] = GLP_NU; } } function set_orig_bnds(csa){ var m = csa.m; var n = csa.n; var type = csa.type; var lb = csa.lb; var ub = csa.ub; var orig_type = csa.orig_type; var orig_lb = csa.orig_lb; var orig_ub = csa.orig_ub; var head = csa.head; var stat = csa.stat; var cbar = csa.cbar; var j, k; xcopyArr(type, 1, orig_type, 1, m+n); xcopyArr(lb, 1, orig_lb, 1, m+n); xcopyArr(ub, 1, orig_ub, 1, m+n); for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG) xassert(1 <= k && k <= m+n); switch (type[k]) { case GLP_FR: stat[j] = GLP_NF; break; case GLP_LO: stat[j] = GLP_NL; break; case GLP_UP: stat[j] = GLP_NU; break; case GLP_DB: if (cbar[j] >= +DBL_EPSILON) stat[j] = GLP_NL; else if (cbar[j] <= -DBL_EPSILON) stat[j] = GLP_NU; else if (Math.abs(lb[k]) <= Math.abs(ub[k])) stat[j] = GLP_NL; else stat[j] = GLP_NU; break; case GLP_FX: stat[j] = GLP_NS; break; default: xassert(type != type); } } } function check_stab(csa, tol_dj){ var n = csa.n; var stat = csa.stat; var cbar = csa.cbar; var j; for (j = 1; j <= n; j++) { if (cbar[j] < - tol_dj) if (stat[j] == GLP_NL || stat[j] == GLP_NF) return 1; if (cbar[j] > + tol_dj) if (stat[j] == GLP_NU || stat[j] == GLP_NF) return 1; } return 0; } function eval_obj(csa){ var m = csa.m; var n = csa.n; var obj = csa.obj; var head = csa.head; var bbar = csa.bbar; var i, j, k; var sum; sum = obj[0]; /* walk through the list of basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG) xassert(1 <= k && k <= m+n); if (k > m) sum += obj[k-m] * bbar[i]; } /* walk through the list of non-basic variables */ for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG) xassert(1 <= k && k <= m+n); if (k > m) sum += obj[k-m] * get_xN(csa, j); } return sum; } function display(csa, parm, spec){ var m = csa.m; var n = csa.n; var coef = csa.coef; var orig_type = csa.orig_type; var head = csa.head; var stat = csa.stat; var phase = csa.phase; var bbar = csa.bbar; var cbar = csa.cbar; var i, j, cnt; var sum; if (parm.msg_lev < GLP_MSG_ON) return; if (parm.out_dly > 0 && 1000.0 * xdifftime(xtime(), csa.tm_beg) < parm.out_dly) return; if (csa.it_cnt == csa.it_dpy) return; if (!spec && csa.it_cnt % parm.out_frq != 0) return; /* compute the sum of dual infeasibilities */ sum = 0.0; if (phase == 1) { for (i = 1; i <= m; i++) sum -= coef[head[i]] * bbar[i]; for (j = 1; j <= n; j++) sum -= coef[head[m+j]] * get_xN(csa, j); } else { for (j = 1; j <= n; j++) { if (cbar[j] < 0.0) if (stat[j] == GLP_NL || stat[j] == GLP_NF) sum -= cbar[j]; if (cbar[j] > 0.0) if (stat[j] == GLP_NU || stat[j] == GLP_NF) sum += cbar[j]; } } /* determine the number of basic fixed variables */ cnt = 0; for (i = 1; i <= m; i++) if (orig_type[head[i]] == GLP_FX) cnt++; if (csa.phase == 1) xprintf(" " + csa.it_cnt + ": infeas = " + sum + " (" + cnt + ")"); else xprintf("|" + csa.it_cnt + ": obj = " + eval_obj(csa) + " infeas = " + sum + " (" + cnt + ")"); csa.it_dpy = csa.it_cnt; } function store_sol(csa, lp, p_stat, d_stat, ray){ var m = csa.m; var n = csa.n; var zeta = csa.zeta; var head = csa.head; var stat = csa.stat; var bbar = csa.bbar; var cbar = csa.cbar; var i, j, k; var col, row; if (GLP_DEBUG){ xassert(lp.m == m); xassert(lp.n == n); /* basis factorization */ xassert(!lp.valid && lp.bfd == null); xassert(csa.valid && csa.bfd != null); } lp.valid = 1; csa.valid = 0; lp.bfd = csa.bfd; csa.bfd = null; xcopyArr(lp.head, 1, head, 1, m); /* basic solution status */ lp.pbs_stat = p_stat; lp.dbs_stat = d_stat; /* objective function value */ lp.obj_val = eval_obj(csa); /* simplex iteration count */ lp.it_cnt = csa.it_cnt; /* unbounded ray */ lp.some = ray; /* basic variables */ for (i = 1; i <= m; i++) { k = head[i]; /* x[k] = xB[i] */ if (GLP_DEBUG) xassert(1 <= k && k <= m+n); if (k <= m) { row = lp.row[k]; row.stat = GLP_BS; row.bind = i; row.prim = bbar[i] / row.rii; row.dual = 0.0; } else { col = lp.col[k-m]; col.stat = GLP_BS; col.bind = i; col.prim = bbar[i] * col.sjj; col.dual = 0.0; } } /* non-basic variables */ for (j = 1; j <= n; j++) { k = head[m+j]; /* x[k] = xN[j] */ if (GLP_DEBUG) xassert(1 <= k && k <= m+n); if (k <= m) { row = lp.row[k]; row.stat = stat[j]; row.bind = 0; switch (stat[j]) { case GLP_NL: row.prim = row.lb; break; case GLP_NU: row.prim = row.ub; break; case GLP_NF: row.prim = 0.0; break; case GLP_NS: row.prim = row.lb; break; default: xassert(stat != stat); } row.dual = (cbar[j] * row.rii) / zeta; } else { col = lp.col[k-m]; col.stat = stat[j]; col.bind = 0; switch (stat[j]) { case GLP_NL: col.prim = col.lb; break; case GLP_NU: col.prim = col.ub; break; case GLP_NF: col.prim = 0.0; break; case GLP_NS: col.prim = col.lb; break; default: xassert(stat != stat); } col.dual = (cbar[j] / col.sjj) / zeta; } } } var csa; var binv_st = 2; /* status of basis matrix factorization: 0 - invalid; 1 - just computed; 2 - updated */ var bbar_st = 0; /* status of primal values of basic variables: 0 - invalid; 1 - just computed; 2 - updated */ var cbar_st = 0; /* status of reduced costs of non-basic variables: 0 - invalid; 1 - just computed; 2 - updated */ var rigorous = 0; /* rigorous mode flag; this flag is used to enable iterative refinement on computing pivot rows and columns of the simplex table */ var check = 0; var p_stat, d_stat, ret; /* allocate and initialize the common storage area */ csa = alloc_csa(lp); init_csa(csa, lp); if (parm.msg_lev >= GLP_MSG_DBG) xprintf("Objective scale factor = " + csa.zeta + ""); while (true){ /* main loop starts here */ /* compute factorization of the basis matrix */ if (binv_st == 0) { ret = invert_B(csa); if (ret != 0) { if (parm.msg_lev >= GLP_MSG_ERR) { xprintf("Error: unable to factorize the basis matrix (" + ret + ")"); xprintf("Sorry, basis recovery procedure not implemented yet"); } xassert(!lp.valid && lp.bfd == null); lp.bfd = csa.bfd; csa.bfd = null; lp.pbs_stat = lp.dbs_stat = GLP_UNDEF; lp.obj_val = 0.0; lp.it_cnt = csa.it_cnt; lp.some = 0; ret = GLP_EFAIL; return ret; } csa.valid = 1; binv_st = 1; /* just computed */ /* invalidate basic solution components */ bbar_st = cbar_st = 0; } /* compute reduced costs of non-basic variables */ if (cbar_st == 0) { eval_cbar(csa); cbar_st = 1; /* just computed */ /* determine the search phase, if not determined yet */ if (csa.phase == 0) { if (check_feas(csa, 0.90 * parm.tol_dj) != 0) { /* current basic solution is dual infeasible */ /* start searching for dual feasible solution */ csa.phase = 1; set_aux_bnds(csa); } else { /* current basic solution is dual feasible */ /* start searching for optimal solution */ csa.phase = 2; set_orig_bnds(csa); } xassert(check_stab(csa, parm.tol_dj) == 0); /* some non-basic double-bounded variables might become fixed (on phase I) or vice versa (on phase II) */ csa.refct = 0; /* bounds of non-basic variables have been changed, so invalidate primal values */ bbar_st = 0; } /* make sure that the current basic solution remains dual feasible */ if (check_stab(csa, parm.tol_dj) != 0) { if (parm.msg_lev >= GLP_MSG_ERR) xprintf("Warning: numerical instability (dual simplex, phase " + (csa.phase == 1 ? "I" : "II") + ")"); if (parm.meth == GLP_DUALP) { store_sol(csa, lp, GLP_UNDEF, GLP_UNDEF, 0); ret = GLP_EFAIL; return ret; } /* restart the search */ csa.phase = 0; binv_st = 0; rigorous = 5; continue; } } xassert(csa.phase == 1 || csa.phase == 2); /* on phase I we do not need to wait until the current basic solution becomes primal feasible; it is sufficient to make sure that all reduced costs have correct signs */ if (csa.phase == 1 && check_feas(csa, parm.tol_dj) == 0) { /* the current basis is dual feasible; switch to phase II */ display(csa, parm, 1); csa.phase = 2; if (cbar_st != 1) { eval_cbar(csa); cbar_st = 1; } set_orig_bnds(csa); csa.refct = 0; bbar_st = 0; } /* compute primal values of basic variables */ if (bbar_st == 0) { eval_bbar(csa); if (csa.phase == 2) csa.bbar[0] = eval_obj(csa); bbar_st = 1; /* just computed */ } /* redefine the reference space, if required */ switch (parm.pricing) { case GLP_PT_STD: break; case GLP_PT_PSE: if (csa.refct == 0) reset_refsp(csa); break; default: xassert(parm != parm); } /* at this point the basis factorization and all basic solution components are valid */ xassert(binv_st && bbar_st && cbar_st); /* check accuracy of current basic solution components (only for debugging) */ if (check) { var e_bbar = err_in_bbar(csa); var e_cbar = err_in_cbar(csa); var e_gamma = (parm.pricing == GLP_PT_PSE ? err_in_gamma(csa) : 0.0); xprintf("e_bbar = " + e_bbar + "; e_cbar = " + e_cbar + "; e_gamma = " + e_gamma + ""); xassert(e_bbar <= 1e-5 && e_cbar <= 1e-5 && e_gamma <= 1e-3); } /* if the objective has to be maximized, check if it has reached its lower limit */ if (csa.phase == 2 && csa.zeta < 0.0 && parm.obj_ll > -DBL_MAX && csa.bbar[0] <= parm.obj_ll) { if (bbar_st != 1 || cbar_st != 1) { if (bbar_st != 1) bbar_st = 0; if (cbar_st != 1) cbar_st = 0; continue; } display(csa, parm, 1); if (parm.msg_lev >= GLP_MSG_ALL) xprintf("OBJECTIVE LOWER LIMIT REACHED; SEARCH TERMINATED" ); store_sol(csa, lp, GLP_INFEAS, GLP_FEAS, 0); ret = GLP_EOBJLL; return ret; } /* if the objective has to be minimized, check if it has reached its upper limit */ if (csa.phase == 2 && csa.zeta > 0.0 && parm.obj_ul < +DBL_MAX && csa.bbar[0] >= parm.obj_ul) { if (bbar_st != 1 || cbar_st != 1) { if (bbar_st != 1) bbar_st = 0; if (cbar_st != 1) cbar_st = 0; continue; } display(csa, parm, 1); if (parm.msg_lev >= GLP_MSG_ALL) xprintf("OBJECTIVE UPPER LIMIT REACHED; SEARCH TERMINATED" ); store_sol(csa, lp, GLP_INFEAS, GLP_FEAS, 0); ret = GLP_EOBJUL; return ret; } /* check if the iteration limit has been exhausted */ if (parm.it_lim < INT_MAX && csa.it_cnt - csa.it_beg >= parm.it_lim) { if (csa.phase == 2 && bbar_st != 1 || cbar_st != 1) { if (csa.phase == 2 && bbar_st != 1) bbar_st = 0; if (cbar_st != 1) cbar_st = 0; continue; } display(csa, parm, 1); if (parm.msg_lev >= GLP_MSG_ALL) xprintf("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED"); switch (csa.phase) { case 1: d_stat = GLP_INFEAS; set_orig_bnds(csa); eval_bbar(csa); break; case 2: d_stat = GLP_FEAS; break; default: xassert(csa != csa); } store_sol(csa, lp, GLP_INFEAS, d_stat, 0); ret = GLP_EITLIM; return ret; } /* check if the time limit has been exhausted */ if (parm.tm_lim < INT_MAX && 1000.0 * xdifftime(xtime(), csa.tm_beg) >= parm.tm_lim) { if (csa.phase == 2 && bbar_st != 1 || cbar_st != 1) { if (csa.phase == 2 && bbar_st != 1) bbar_st = 0; if (cbar_st != 1) cbar_st = 0; continue; } display(csa, parm, 1); if (parm.msg_lev >= GLP_MSG_ALL) xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED"); switch (csa.phase) { case 1: d_stat = GLP_INFEAS; set_orig_bnds(csa); eval_bbar(csa); break; case 2: d_stat = GLP_FEAS; break; default: xassert(csa != csa); } store_sol(csa, lp, GLP_INFEAS, d_stat, 0); ret = GLP_ETMLIM; return ret; } /* display the search progress */ display(csa, parm, 0); /* choose basic variable xB[p] */ chuzr(csa, parm.tol_bnd); if (csa.p == 0) { if (bbar_st != 1 || cbar_st != 1) { if (bbar_st != 1) bbar_st = 0; if (cbar_st != 1) cbar_st = 0; continue; } display(csa, parm, 1); switch (csa.phase) { case 1: if (parm.msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO DUAL FEASIBLE SOLUTION"); set_orig_bnds(csa); eval_bbar(csa); p_stat = GLP_INFEAS; d_stat = GLP_NOFEAS; break; case 2: if (parm.msg_lev >= GLP_MSG_ALL) xprintf("OPTIMAL SOLUTION FOUND"); p_stat = d_stat = GLP_FEAS; break; default: xassert(csa != csa); } store_sol(csa, lp, p_stat, d_stat, 0); ret = 0; return ret; } /* compute pivot row of the simplex table */ { var rho = csa.work4; eval_rho(csa, rho); if (rigorous) refine_rho(csa, rho); eval_trow(csa, rho); sort_trow(csa, parm.tol_bnd); } /* choose non-basic variable xN[q] */ switch (parm.r_test) { case GLP_RT_STD: chuzc(csa, 0.0); break; case GLP_RT_HAR: chuzc(csa, 0.30 * parm.tol_dj); break; default: xassert(parm != parm); } if (csa.q == 0) { if (bbar_st != 1 || cbar_st != 1 || !rigorous) { if (bbar_st != 1) bbar_st = 0; if (cbar_st != 1) cbar_st = 0; rigorous = 1; continue; } display(csa, parm, 1); switch (csa.phase) { case 1: if (parm.msg_lev >= GLP_MSG_ERR) xprintf("Error: unable to choose basic variable on phase I"); xassert(!lp.valid && lp.bfd == null); lp.bfd = csa.bfd; csa.bfd = null; lp.pbs_stat = lp.dbs_stat = GLP_UNDEF; lp.obj_val = 0.0; lp.it_cnt = csa.it_cnt; lp.some = 0; ret = GLP_EFAIL; break; case 2: if (parm.msg_lev >= GLP_MSG_ALL) xprintf("PROBLEM HAS NO FEASIBLE SOLUTION"); store_sol(csa, lp, GLP_NOFEAS, GLP_FEAS, csa.head[csa.p]); ret = 0; break; default: xassert(csa != csa); } return ret; } /* check if the pivot element is acceptable */ { var piv = csa.trow_vec[csa.q]; var eps = 1e-5 * (1.0 + 0.01 * csa.trow_max); if (Math.abs(piv) < eps) { if (parm.msg_lev >= GLP_MSG_DBG) xprintf("piv = " + piv + "; eps = " + eps + ""); if (!rigorous) { rigorous = 5; continue; } } } /* now xN[q] and xB[p] have been chosen anyhow */ /* compute pivot column of the simplex table */ eval_tcol(csa); if (rigorous) refine_tcol(csa); /* accuracy check based on the pivot element */ { var piv1 = csa.tcol_vec[csa.p]; /* more accurate */ var piv2 = csa.trow_vec[csa.q]; /* less accurate */ xassert(piv1 != 0.0); if (Math.abs(piv1 - piv2) > 1e-8 * (1.0 + Math.abs(piv1)) || !(piv1 > 0.0 && piv2 > 0.0 || piv1 < 0.0 && piv2 < 0.0)) { if (parm.msg_lev >= GLP_MSG_DBG) xprintf("piv1 = " + piv1 + "; piv2 = " + piv2 + ""); if (binv_st != 1 || !rigorous) { if (binv_st != 1) binv_st = 0; rigorous = 5; continue; } /* (not a good idea; should be revised later) */ if (csa.tcol_vec[csa.p] == 0.0) { csa.tcol_nnz++; xassert(csa.tcol_nnz <= csa.m); csa.tcol_ind[csa.tcol_nnz] = csa.p; } csa.tcol_vec[csa.p] = piv2; } } /* update primal values of basic variables */ update_bbar(csa); if (csa.phase == 2) csa.bbar[0] += (csa.cbar[csa.q] / csa.zeta) * (csa.delta / csa.tcol_vec[csa.p]); bbar_st = 2; /* updated */ /* update reduced costs of non-basic variables */ update_cbar(csa); cbar_st = 2; /* updated */ /* update steepest edge coefficients */ switch (parm.pricing) { case GLP_PT_STD: break; case GLP_PT_PSE: if (csa.refct > 0) update_gamma(csa); break; default: xassert(parm != parm); } /* update factorization of the basis matrix */ ret = update_B(csa, csa.p, csa.head[csa.m+csa.q]); if (ret == 0) binv_st = 2; /* updated */ else { csa.valid = 0; binv_st = 0; /* invalid */ } /* change the basis header */ change_basis(csa); /* iteration complete */ csa.it_cnt++; if (rigorous > 0) rigorous--; } } }(typeof exports === 'object' && exports || this));