[_CDMiwok_01_]<cedarcommon2.0>QPSolve>QPTestImpl.mesa!1

QPTestImpl.mesa

Ken Shoemake, March 25, 1990 0:31 am PST

DIRECTORY

Commander, Convert, EditedStream, IO, QPSolve, RealFns, Rope

;

QPTestImpl: CEDAR PROGRAM

IMPORTS Commander, Convert, EditedStream, IO, QPSolve, RealFns

EXPORTS

~ BEGIN

OPEN QPSolve;

Procedures

QPTestCmd: Commander.CommandProc ~ {

ENABLE {

Convert.Error, EditedStream.Rubout => GOTO Done;

};

gapWidth: REAL ← 1.0;

skipWidth: REAL ← 7.0;

firstColWidth: REAL;

secondColWidth: REAL;

spanningWidth: REAL;

VarList: TYPE ~ LIST OF INT;

EqnList: TYPE ~ LIST OF VarList;

eqnlist: EqnList ← LIST[

LIST[1, 2, -7], LIST[3, 4, -8], LIST[5, 6, -9], LIST[10, 11, -12], LIST[2, 3, 4, 5, -13],

LIST[1, 2, 3, 4, 5, 6, -12], LIST[1, -2], LIST[3, -4], LIST[5, -6], LIST[10, -11] ];

penalty: REAL ← 1.0e6;

n: NAT ~ 14;

m: NAT ~ 10;

nFR: NAT ← n;

eqs: Matrix ← NewMatrix[m, n];

lin: RVector ← NEW[RVectorRep[n]];

bounds: RVector ← NEW[RVectorRep[n]];

vars: RVector ← NEW[RVectorRep[n]];

iVar: IVector ← NEW[IVectorRep[n]];

cost: REAL ← 0.0;

eqk: INT;

FindVar: PROC [k: NAT] RETURNS [NAT]

~ {FOR i: NAT IN [0..n) DO IF iVar[i]=k THEN RETURN[i] ENDLOOP; RETURN[n]};

FixVar: PROC [kV: NAT]

~ {

k: NAT ← FindVar[kV];

FOR i: NAT IN (k..nFR) DO iVar[i-1] ← iVar[i] ENDLOOP;

nFR ← nFR - 1; iVar[nFR] ← kV; vars[kV] ← bounds[kV];

};

IO.PutF[cmd.out, "Type two column widths and spanning width. Quit with [DEL]\n"];

firstColWidth ← IO.GetReal[cmd.in];

secondColWidth ← IO.GetReal[cmd.in];

spanningWidth ← IO.GetReal[cmd.in];

eqs.m ← m; eqs[0].n ← lin.n ← bounds.n ← vars.n ← iVar.n ← n;

FOR i: NAT IN [0..n) DO iVar[i] ← i ENDLOOP;

FOR i: NAT IN [0..n) DO lin[i] ← 0.0 ENDLOOP; lin[0] ← penalty;

FOR i: NAT IN [0..n) DO FOR j: NAT IN [0..m) DO eqs[j][i] ← 0.0 ENDLOOP ENDLOOP;

<< Here all the constraint equations are set up. >>

eqk ← 0;

FOR elist: EqnList ← eqnlist, elist.rest WHILE elist # NIL DO

FOR vlist: VarList ← elist.first, vlist.rest WHILE vlist # NIL DO

eqs[eqk][ABS[vlist.first]] ← IF vlist.first < 0 THEN -1.0 ELSE 1.0;

ENDLOOP;

eqk ← eqk+1;

ENDLOOP;

FOR i: NAT IN [0..n) DO bounds[i] ← 0.0 ENDLOOP;

bounds[8] ← gapWidth;

bounds[13] ← skipWidth;

bounds[7] ← firstColWidth;

bounds[9] ← secondColWidth;

bounds[12] ← spanningWidth;

FOR i: NAT IN [1..n) DO vars[i] ← bounds[i]+1.0 ENDLOOP;

FixVar[9]; FixVar[12]; FixVar[7];

vars[0] ← 0.0;

FOR j: NAT IN [0..m) DO

FOR i: NAT IN [1..n) DO eqs[j][0] ← eqs[j][0] + eqs[j][i]*vars[i] ENDLOOP;

vars[0] ← vars[0] + eqs[j][0] * eqs[j][0];

ENDLOOP;

vars[0] ← RealFns.SqRt[vars[0]];

FOR j: NAT IN [0..m) DO eqs[j][0] ← -eqs[j][0] / vars[0] ENDLOOP;

IO.PutF[cmd.out, "\n^ = "];

FOR i: NAT IN [0..n) DO

IO.PutF[cmd.out, " %2d %s", IO.int[iVar[i]], IO.rope[IF i = nFR-1 THEN "/" ELSE " "]];

ENDLOOP;

IO.PutF[cmd.out, "\ns = "];

FOR i: NAT IN [0..n) DO

IO.PutF[cmd.out, " %4.1f", IO.real[bounds[i]]];

ENDLOOP;

IO.PutF[cmd.out, "\nx = "];

FOR i: NAT IN [0..n) DO

IO.PutF[cmd.out, " %4.1f", IO.real[vars[i]]];

ENDLOOP;

IO.PutF[cmd.out, "\nA ="];

FOR j: NAT IN [0..m) DO

FOR i: NAT IN [0..n) DO

IO.PutF[cmd.out, " %4.1f", IO.real[eqs[j][i]]];

ENDLOOP;

IO.PutF[cmd.out, "\n "];

ENDLOOP;

IO.PutF[cmd.out, "\nTesting...\n"];

nFR ← QPSolve[lin, eqs, bounds, vars, iVar, nFR];

FOR i: NAT IN [0..n) DO cost ← cost + vars[i]*(vars[i] + lin[i]) ENDLOOP;

IO.PutF[cmd.out, "Solution(?): %9.4f\n", IO.real[cost]];

FOR i: NAT IN [0..n) DO

IO.PutF[cmd.out, "x[%2d] = %9.4f\n", IO.int[i], IO.real[vars[i]]];

ENDLOOP;

EXITS

Done => NULL;

};

Start Code

Commander.Register["QPTest", QPTestCmd, "Test QPSolve routine."];

END..

Action: PROC ~ {

VarList: TYPE ~ LIST OF INT;

EqnList: TYPE ~ LIST OF VarList;

eqnlist: EqnList ← LIST[

LIST[1, 2, -7], LIST[3, 4, -8], LIST[5, 6, -9], LIST[10, 11, 12], LIST[2, 3, 4, 5, -13],

LIST[1, 2, 3, 4, 5, 6, -12], LIST[1, -2], LIST[3, -4], LIST[5, -6], LIST[10, -11] ];

penalty: REAL ← 1.0e10;

n: NAT ~ 14;

m: NAT ~ 10;

eqs: Matrix ← NewMatrix[m, n];

lin: RVector ← NEW[RVectorRep[n]];

bounds: RVector ← NEW[RVectorRep[n]];

init: RVector ← NEW[RVectorRep[n]];

iVar: IVector ← NEW[IVectorRep[n]];

soln: RVector;

cost: REAL ← 0.0;

eqk: INT;

gapWidth: REAL ← 1.0;

skipWidth: REAL ← 7.0;

firstColWidth: REAL ← 5.0;

secondColWidth: REAL ← 5.0;

headingWidth: REAL ← 12.0;

IO.PutF[cmd.out, "Type widths for two columns and spanning head. Quit with [DEL]\n"];

firstColWidth ← IO.GetReal[cmd.in];

secondColWidth ← IO.GetReal[cmd.in];

headingWidth ← IO.GetReal[cmd.in];

eqs.m ← m; eqs[0].n ← lin.n ← bounds.n ← init.n ← iVar.n ← n;

FOR i: NAT IN [0..n) DO lin[i] ← 0.0 ENDLOOP; lin[0] ← penalty;

FOR i: NAT IN [0..n) DO FOR j: NAT IN [0..m) DO eqs[j][i] ← 0.0 ENDLOOP ENDLOOP;

<< Here all the constraint equations are set up. >>

eqk ← 0;

FOR elist: EqnList ← eqnlist, elist.rest WHILE elist # NIL DO

FOR vlist: VarList ← elist.first, vlist.rest WHILE vlist # NIL DO

eqs[eqk][ABS[vlist.first]] ← IF vlist.first < 0 THEN -1.0 ELSE 1.0;

ENDLOOP;

eqk ← eqk+1;

ENDLOOP;

FOR i: NAT IN [0..n) DO bounds[i] ← 0.0 ENDLOOP;

FOR i: NAT IN [1..n) DO init[i] ← bounds[i]+1.0 ENDLOOP;

init[8] ← bounds[8] ← gapWidth;

init[13] ← bounds[13] ← skipWidth;

init[7] ← bounds[7] ← firstColWidth;

init[9] ← bounds[9] ← secondColWidth;

init[12] ← bounds[12] ← headingWidth;

init[0] ← 0.0;

init[8] ← MAX[gapWidth,
skipWidth-(firstColWidth+secondColWidth)/2,
headingWidth-(firstColWidth+secondColWidth)];

init[12] ← MAX[headingWidth, init[8]+(firstColWidth+secondColWidth)];

init[1] ← init[2] ← firstColWidth/2;

init[5] ← init[6] ← secondColWidth/2;

init[3] ← init[4] ← init[8]/2;

init[10] ← init[11] ← init[12]/2;

init[13] ← init[2]+init[8]+init[5];

FOR j: NAT IN [0..m) DO

FOR i: NAT IN [1..n) DO eqs[j][0] ← eqs[j][0] + eqs[j][i]*init[i] ENDLOOP;

init[0] ← init[0] + eqs[j][0] * eqs[j][0];

ENDLOOP;

init[0] ← RealFns.SqRt[init[0]];

FOR j: NAT IN [0..m) DO eqs[j][0] ← -eqs[j][0] / init[0] ENDLOOP;

FOR i: NAT IN [0..n) DO iVar[i] ← i ENDLOOP;

iVar[13] ← 7; iVar[7] ← 13; iVar[12] ← 9; iVar[11] ← 12; iVar[9] ← 11;

IO.PutF[cmd.out, "Testing...\n"];

soln ← QPSolve[lin, eqs, bounds, init, iVar, n-2];

FOR i: NAT IN [0..n) DO cost ← cost + soln[iVar[i]]*(soln[iVar[i]] + lin[i]) ENDLOOP;

IO.PutF[cmd.out, "Solution(?): %9.4f\n", IO.real[cost]];

FOR i: NAT IN [0..n) DO

IO.PutF[cmd.out, "x[%2d] = %9.4f\n", IO.int[iVar[i]], IO.real[soln[iVar[i]]]];

ENDLOOP;

};

Action: PROC ~ {

n: NAT ~ 4;

m: NAT ~ 1;

eqs: Matrix ← NewMatrix[m, n];

lin: RVector ← NEW[RVectorRep[n]];

bounds: RVector ← NEW[RVectorRep[n]];

init: RVector ← NEW[RVectorRep[n]];

iVar: IVector ← NEW[IVectorRep[n]];

soln: RVector;

eqs.m ← m; eqs[0].n ← lin.n ← bounds.n ← init.n ← iVar.n ← n;

FOR i: NAT IN [0..n) DO lin[i] ← 0.0 ENDLOOP;

FOR i: NAT IN [0..n) DO FOR j: NAT IN [0..m) DO eqs[j][i] ← 0.0 ENDLOOP ENDLOOP;

eqs[0][1] ← 1.0; eqs[0][2] ← -1.0;

FOR i: NAT IN [0..n) DO bounds[i] ← i ENDLOOP;

bounds[anInt] ← aReal;

FOR i: NAT IN [0..n) DO init[i] ← bounds[i]+1.0 ENDLOOP;

init[1] ← init[2] ← MAX[init[1], init[2]];

FOR i: NAT IN [0..n) DO iVar[i] ← i ENDLOOP;

IO.PutF[cmd.out, "Testing...\n"];

soln ← QPSolve[lin, eqs, bounds, init, iVar, n];

IO.PutF[cmd.out, "Solution(?):\n"];

FOR i: NAT IN [0..n) DO

IO.PutF[cmd.out, "x[%d] = %16.13e\n", IO.int[iVar[i]], IO.real[soln[iVar[i]]]];

ENDLOOP;

};

firstColWidth: REAL;

secondColWidth: REAL;

spanWidth: REAL;

VarList: TYPE ~ LIST OF INT;

EqnList: TYPE ~ LIST OF VarList;

eqnlist: EqnList ← LIST[LIST[1, 2, -3], LIST[1, -2]];

penalty: REAL ← 1.0e6;

n: NAT ~ 4;

m: NAT ~ 2;

eqs: Matrix ← NewMatrix[m, n];

lin: RVector ← NEW[RVectorRep[n]];

bounds: RVector ← NEW[RVectorRep[n]];

init: RVector ← NEW[RVectorRep[n]];

iVar: IVector ← NEW[IVectorRep[n]];

soln: RVector;

cost: REAL ← 0.0;

eqk: INT;

IO.PutF[cmd.out, "Type two column widths and span width. Quit with [DEL]\n"];

firstColWidth ← IO.GetReal[cmd.in];

secondColWidth ← IO.GetReal[cmd.in];

spanWidth ← IO.GetReal[cmd.in];

eqs.m ← m; eqs[0].n ← lin.n ← bounds.n ← init.n ← iVar.n ← n;

FOR i: NAT IN [0..n) DO lin[i] ← 0.0 ENDLOOP; lin[0] ← penalty;

FOR i: NAT IN [0..n) DO FOR j: NAT IN [0..m) DO eqs[j][i] ← 0.0 ENDLOOP ENDLOOP;

<< Here all the constraint equations are set up. >>

eqk ← 0;

FOR elist: EqnList ← eqnlist, elist.rest WHILE elist # NIL DO

FOR vlist: VarList ← elist.first, vlist.rest WHILE vlist # NIL DO

eqs[eqk][ABS[vlist.first]] ← IF vlist.first < 0 THEN -1.0 ELSE 1.0;

ENDLOOP;

eqk ← eqk+1;

ENDLOOP;

FOR i: NAT IN [0..n) DO bounds[i] ← 0.0 ENDLOOP;

bounds[1] ← firstColWidth;

bounds[2] ← secondColWidth;

FOR i: NAT IN [1..n) DO init[i] ← bounds[i]+1.0 ENDLOOP;

init[3] ← bounds[3] ← spanWidth;

init[0] ← 0.0;

FOR j: NAT IN [0..m) DO

FOR i: NAT IN [1..n) DO eqs[j][0] ← eqs[j][0] + eqs[j][i]*init[i] ENDLOOP;

init[0] ← init[0] + eqs[j][0] * eqs[j][0];

ENDLOOP;

init[0] ← RealFns.SqRt[init[0]];

FOR j: NAT IN [0..m) DO eqs[j][0] ← -eqs[j][0] / init[0] ENDLOOP;

FOR i: NAT IN [0..n) DO iVar[i] ← i ENDLOOP;

IO.PutF[cmd.out, "Testing...\n"];

soln ← QPSolve[lin, eqs, bounds, init, iVar, nFR];

FOR i: NAT IN [0..n) DO cost ← cost + soln[iVar[i]]*(soln[iVar[i]] + lin[iVar[i]]) ENDLOOP;

IO.PutF[cmd.out, "Solution(?): %9.4f\n", IO.real[cost]];

FOR i: NAT IN [0..n) DO

IO.PutF[cmd.out, "x[%2d] = %9.4f\n", IO.int[iVar[i]], IO.real[soln[iVar[i]]]];

ENDLOOP;