[_CDCSL_93-16_]<1>Cedar>release>QPSolve>QPTestImpl.mesa

QPTestImpl.mesa

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

Jules Bloomenthal July 2, 1992 11:14 am PDT

DIRECTORY

Commander, Convert, IO, QPSolve, RealFns, Rope

;

QPTestImpl: CEDAR PROGRAM

IMPORTS Commander, Convert, IO, QPSolve, RealFns

EXPORTS

~ BEGIN

OPEN QPSolve;

Procedures

QPTestCmd: Commander.CommandProc ~ {

ENABLE {

Convert.Error, IO.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.PutRope[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.PutRope[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.PutRope[cmd.out, "\ns = "];

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

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

ENDLOOP;

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

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

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

ENDLOOP;

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

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

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

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

ENDLOOP;

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

ENDLOOP;

IO.PutRope[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.PutF1[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;