The minimum is " . format(-$a[0][0]) . "." : "
The maximum is " . format($a[0][0]) . ".";
$str .= ($prog == 1) ? "
\nPrimal solution: " : "
\nDual solution: ";
for ($j = 1; $j < $n; $j++) $str .= "0 ";
$str .= ($prog == 1) ? "
\nDual solution: " : "
\nPrimal solution: ";
for ($i = 1; $i < $m; $i++) $str .= "0 ";
$str .= "
\n";
}
else
{
$str .= "
The linear programme cannot be solved.
\n";
}
}
}
}
}
}
/* Initialise variables, put normalised rows into new matrix and determine trivial redundant constraints if any */
$phase1 = false;
if ($red)
{
$cb = 0;
$cn = 0;
$mbv = array();
$mbv = array_fill(0, $m + $n - 1, true);
$b = $a;
for ($i = 1; $i < $m; $i++)
{
$max = $sca = 0;
for ($j = 1; $j < $n; $j++)
{
$abs = abs($b[$i][$j]);
if ($abs > $max) $max = $abs;
}
$max = ($max == 0) ? 1 : 1 / $max;
$b[$i][0] *= $max;
for ($j = 1; $j < $n; $j++)
{
$b[$i][$j] *= $max;
$sca += $b[$i][$j] * $b[$i][$j];
}
$sca = ($sca > 0) ? 1 / sqrt($sca) : 1;
for ($j = 0; $j < $n; $j++) $b[$i][$j] *= $sca;
$f[$i] = $b[$i][0] >= 0;
if ($f[$i])
{
for ($j = 1; $j < $n && $b[$i][$j] <= 0; $j++);
$f[$i] = $j == $n;
}
}
/* Compare rows and compute upper and lower limits to remove further redundant rows if possible */
if ($m > 2)
{
for ($i = 1; $i < $m; $i++)
{
$hsi = $b[$i][0];
$hgi = $hsi > 0;
$hli = $hsi < 0;
$hge = $hsi >= 0;
$hle = $hsi <= 0;
$heq = $hsi == 0;
for ($k = $i + 1; !$f[$i] && $k < $m; $k++)
{
if (!$f[$k])
{
$lsi = $b[$k][0];
if ($hle && $lsi >= 0) $l = $i; else if ($hge && $lsi <= 0) $l = $k; else $l = 0;
$h = ($l == $i) ? $k : $i;
if ($l != 0)
{
$llim = 0;
$ulim = INFINITY;
}
else
{
$l = $k;
if ($hgi)
{
$llim = 0;
$ulim = $hsi / $lsi;
}
else
{
$llim = $hsi / $lsi;
$ulim = INFINITY;
}
}
$one = true;
for ($j = 1; $one && $j < $n; $j++)
{
$hco = $b[$h][$j];
$lco = $b[$l][$j];
$hgo = $hco > 0;
$hlo = $hco < 0;
$lgo = $lco > 0;
$llo = $lco < 0;
if ($hgo && $lgo || $hlo && $llo)
{
$hco /= $lco;
if ($lgo && $llim < $hco) $llim = $hco; elseif ($llo && $ulim > $hco) $ulim = $hco;
if ($llim > $ulim + EPSILON) $one = false;
}
else
{
if ($hgo && $lco <= 0) $one = false; elseif ($hco >= 0 && $llo) $one = false;
}
}
$f[$h] = $one;
/* Alter probable redundant row if necessary and compute again */
if (!$one && ($hgi && $lsi > 0 || $hli && $lsi < 0 || $heq && $lsi == 0))
{
$llim = ($hli) ? $lsi / $hsi : 0;
$ulim = ($hgi) ? $lsi / $hsi : INFINITY;
$one = true;
for ($j = 1; $one && $j < $n; $j++)
{
$hco = $b[$h][$j];
$lco = $b[$l][$j];
$hgo = $hco > 0;
$hlo = $hco < 0;
$lgo = $lco > 0;
$llo = $lco < 0;
if ($hgo && $lgo || $hlo && $llo)
{
$lco /= $hco;
if ($hgo && $llim < $lco) $llim = $lco; elseif ($hlo && $ulim > $lco) $ulim = $lco;
if ($llim > $ulim + EPSILON) $one = false;
}
else
{
if ($hlo && $lco >= 0) $one = false; elseif ($hco <= 0 && $lgo) $one = false;
}
}
$f[$l] = $one;
}
}
}
}
}
/* Output redundant rows if any and remove them from the initial matrix */
$q = 0;
for ($i = 1; $i < $m; $i++) if ($f[$i]) $g[$q++] = $i;
if ($q > 0)
{
$str .= ($q == 1) ? "
The following row is" : "
The following rows are";
$str .= " redundant:
\n" . '
' . "\n";
for ($i = 0; $i < $q; $i++)
{
$str .= "";
for ($j = 0; $j < $n; $j++) $str .= "" . $a[$g[$i]][$j] . " | ";
$str .= "
\n";
}
$str .= "
\n";
$q = 1;
for ($i = 1; $i < $m; $i++)
{
if (!$f[$i])
{
for ($j = 0; $j < $n; $j++) $a[$q][$j] = $a[$i][$j];
$q++;
}
}
$m = $q;
}
$b = $a;
}
if ($solve)
{
/* Check whether linear programme is limited */
$limit = true;
for ($j = 1; $j < $n && $limit; $j++)
{
if ($a[0][$j] > 0)
{
for ($i = 1; $i < $m && $a[$i][$j] < 0; $i++);
$limit = $i < $m;
}
}
if ($limit && $m > 1)
{
/* Initialise variables and determine smallest negative value of the right side if any */
$min = $perts = $steps = 0;
for ($i = 1; $i < $m; $i++)
{
$ele = $a[$i][0];
if ($ele < $min)
{
$k = $i;
$min = $ele;
}
}
if ($min < 0)
{
/* Phase I: Add slack variable in the last column, save objective function and make tableau valid by pivot step */
$phase1 = true;
if ($output) tableau($a, $k, 0, $m, $n, $bv, $nbv, $opt, false, $prog, "", $str);
/* Normalise and scale if demanded */
if ($nor1 || $nor2)
{
if ($output) $str .= "
The 1st normalisation will be executed.
\n";
normalise($a, $n1, $i, $j, $m, $n);
}
if ($scal)
{
if ($output) $str .= "
The scaling will be executed.
\n";
scale($a, $e, $i, $j, $m, $n);
if ($nor1 && $nor2)
{
if ($output) $str .= "
The 2nd normalisation will be executed.
\n";
normalise($a, $n2, $i, $j, $m, $n);
}
}
for ($i = 1; $i < $m; $i++) $a[$i][$n] = -1;
$c = $a[0];
$mem = $c[0];
$a[0] = array_fill(0, $n, 0);
$a[0][$n] = -1;
$nbv[$n] = $bv[$k];
$bv[$k] = $c[0] = 0;
$none = true;
for ($j = 1; $j < $n; $j++) $none &= $c[$j] == 0;
$l = $n++;
$steps++;
if ($output)
{
tableau($a, $k, $l, $m, $n, $bv, $nbv, $opt, true, $prog, "
Phase I:
\n", $str);
$str .= "
The pivot is a[$k][" . ($l + 1) . "] = -1.
\n";
}
transform($a, $bv, $mbv, $cb, $cn, $i, $j, $k, $l, $m, $n, $red, $solve, null, 0);
if ($solve)
{
/* Loop, check feasibility and collect results */
$l = loop($a, $m, $n, $bv, $nbv, $mbv, $cb, $cn, $output, $red, $opt, $perts, $prog, $steps, $str, $solve, $rule, false);
if ($solve)
{
if ($a[0][0] != 0)
{
$solve = false; // infeasible
tableau($a, 0, 0, $m, $n, $bv, $nbv, $opt, true, $prog, "", $str);
$str .= "
The linear programme cannot be solved.
\n";
numbers($perts, $steps, '', $str);
}
else
{
tableau($a, $k, $l, $m, $n, $bv, $nbv, $opt, false, $prog, "", $str);
if ($nbv[$l] != 0)
{
/* Move slack variable from the base variables to the last column of the non-base variables and drop last column */
for ($l = $n - 1; $l > 0 && $a[$k][$l] == 0; $l--);
$bv[$k] = $nbv[$l];
$nbv[$l] = 0;
$steps++;
transform($a, $bv, $mbv, $cb, $cn, $i, $j, $k, $l, $m, $n, $red, $solve, null, 0);
if ($output) tableau($a, $k, $l, $m, $n, $bv, $nbv, $opt, true, $prog, "
The pivot is a[$k][" . ($l + 1) . "] = " . format(1 / $a[$k][$l]) . ".
\n", $str);
}
if ($solve)
{
$phase1 = false;
$n--;
if ($nbv[$l] == 0 && $l < $n)
{
/* Replace column in tableau with slack variable by last column and drop the latter */
for ($i = 1; $i < $m; $i++) $a[$i][$l] = $a[$i][$n];
$nbv[$l] = $nbv[$n];
}
$a[0][0] = $mem;
if ($none)
{
/* All coefficients of the objective function are zero */
$l = 0;
tableau($a, $k, $l, $m, $n, $bv, $nbv, $opt, false, $prog, "
End of phase I:
\n", $str);
results($a, $e, $n1, $n2, $m, $n, $bv, $nbv, $mbv, $cb, $cn, $red, $opt, $perts, $prog, $steps, $str, $solve, $nor1, $scal, $nor2, $rule);
$solve = false;
}
else
{
/* Translate objective function into new variables */
for ($j = 1; $j < $n; $j++)
{
$l = $nbv[$j];
$a[0][$j] = ($l < $n) ? $c[$l] : 0;
}
for ($i = 1; $i < $m; $i++)
{
$l = $bv[$i];
if ($l < $n)
{
$obj = -$c[$l];
for ($j = 0; $j < $n; $j++) $a[0][$j] += $obj * $a[$i][$j];
}
}
for ($j = 0; $j < $n; $j++) if (abs($a[0][$j]) < EPSILON) $a[0][$j] = 0;
if ($red) redundant($a, $bv, $mbv, $cb, $cn, $m, $n);
if ($output) $str .= "
End of phase I:
\n";
}
}
else
{
$str .= "
The boundary of computation was transcended.
\n";
numbers($perts, $steps, '', $str);
}
}
}
else
{
numbers($perts, $steps, '', $str);
}
}
else
{
$str .= "
The boundary of computation was transcended.
\n";
numbers($perts, $steps, '', $str);
}
}
else
{
if ($output) tableau($a, 0, 0, $m, $n, $bv, $nbv, $opt, true, $prog, "", $str);
/* Normalise and scale if demanded */
if ($nor1 || $nor2)
{
if ($output) $str .= "
The 1st normalisation will be executed.
\n";
normalise($a, $n1, $i, $j, $m, $n);
}
if ($scal)
{
if ($output) $str .= "
The scaling will be executed.
\n";
scale($a, $e, $i, $j, $m, $n);
if ($nor1 && $nor2)
{
if ($output) $str .= "
The 2nd normalisation will be executed.
\n";
normalise($a, $n2, $i, $j, $m, $n);
}
}
}
/* Phase II: Loop, check whether the linear programme is limited and collect further results */
if ($solve)
{
$phase1 = false;
for ($j = 1; $j < $n && $a[0][$j] <= 0; $j++);
if ($j < $n)
{
if ($min < 0)
{
if ($output)
{
numbers($perts, $steps, '', $str);
$str .= "
Phase II:
\n";
}
$allp = $perts;
$alls = $steps;
$perts = $steps = 0;
}
loop($a, $m, $n, $bv, $nbv, $mbv, $cb, $cn, $output, $red, $opt, $perts, $prog, $steps, $str, $solve, $rule, false);
if ($solve)
{
/* Check whether linear programme is limited */
for ($j = 1; $j < $n && $a[0][$j] <= 0; $j++);
if ($j < $n)
{
tableau($a, 0, $j, $m, $n, $bv, $nbv, $opt, true, $prog, "", $str);
$j++;
$solve = false;
$str .= "
The linear programme is unlimited in column $j.
\n";
numbers($perts, $steps, '', $str);
}
else
{
tableau($a, 0, 0, $m, $n, $bv, $nbv, $opt, false, $prog, "", $str);
results($a, $e, $n1, $n2, $m, $n, $bv, $nbv, $mbv, $cb, $cn, $red, $opt, $perts, $prog, $steps, $str, $solve, $nor1, $scal, $nor2, $rule);
}
}
else
{
numbers($perts, $steps, '', $str);
}
if ($min < 0) numbers($allp + $perts, $alls + $steps, ' in total', $str);
}
else
{
tableau($a, 0, 0, $m, $n, $bv, $nbv, $opt, false, $prog, "", $str);
results($a, $e, $n1, $n2, $m, $n, $bv, $nbv, $mbv, $cb, $cn, $red, $opt, $perts, $prog, $steps, $str, $solve, $nor1, $scal, $nor2, $rule);
}
}
}
else
{
if ($limit)
{
tableau($a, 0, 0, $m, $n, $bv, $nbv, $opt, true, $prog, "", $str);
if ($prog == 1) $str .= ($opt == 1) ? "
The maximum is " . format(-$a[0][0]) . "." : "
The minimum is " . format($a[0][0]) . ".";
else $str .= ($opt == 1) ? "
The minimum is " . format(-$a[0][0]) . "." : "
The maximum is " . format($a[0][0]) . ".";
$str .= ($prog == 1) ? "
\nPrimale Lösung: " : "
\nDuale Lösung: ";
for ($j = 1; $j < $n; $j++) $str .= "0 ";
$str .= ($prog == 1) ? "
\nDual solution: Does not exist.
\nThere are no further primal solutions.
\n"
: "
\nPrimal solution: Does not exist.
\nThere are no further dual solutions.
\n";
}
else
{
tableau($a, 0, $j - 1, $m, $n, $bv, $nbv, $opt, true, $prog, "", $str);
$str .= "
The linear programme is unlimited in column $j.
\n";
}
}
}
if ($red)
{
/* Output redundant rows resp. nonnegativity conditions */
if ($phase1) $n--;
if ($cb > 0)
{
$too = ($q > 0) ? " also" : "";
$str .= ($cb == 1) ? "
The following row is" : "
The following rows are";
$str .= "$too redundant:
\n" . '
' . "\n";
for ($i = 1; $i < $m; $i++)
{
if (!$mbv[$i + $n - 1])
{
$str .= "";
for ($j = 0; $j < $n; $j++) $str .= "" . $b[$i][$j] . " | ";
$str .= "
\n";
}
}
$str .= "
\n";
}
if (!$mbv[0])
{
$cn--;
$mbv[0] = true;
}
if ($cn > 0)
{
$str .= ($cn == 1) ? "
The following variable doesn't" : "
The following variables don't";
$str .= " need a nonnegativity condition:
\n";
for ($j = 1; $j < $n; $j++) if (!$mbv[$j]) $str .= $j + " ";
$str .= "
\n";
}
}
}
$str .= "
© 2018 by Boris Haase
\n";
$str .= 'top
' . "\n\n";
/* Output */
echo $str;
?>