DIRECTORY
Commander, Convert, IO, QPSolve, RealFns, Rope
;

QPTestImpl: CEDAR PROGRAM
IMPORTS Commander, Convert, IO, QPSolve, RealFns
EXPORTS
~ BEGIN
OPEN QPSolve;
QPTestCmd: Commander.CommandProc ~ {
ENABLE {
Convert.Error, IO.Rubout => GOTO Done;
};

DO
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;
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;
ENDLOOP;
EXITS
Done => NULL;
};

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;
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;
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;
};

DO
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;
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;
ENDLOOP;

Τ
QPTestImpl.mesa
Copyright Σ 1990, 1992 by Xerox Corporation.  All rights reserved.
Ken Shoemake, March 25, 1990 0:31 am PST
Jules Bloomenthal July 2, 1992 11:14 am PDT


Procedures
<< Here all the constraint equations are set up. >>
Start Code
<< Here all the constraint equations are set up. >>
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];
<< Here all the constraint equations are set up. >>
Κψ•NewlineDelimiter

–
"cedarcode" style™™Jšœ
Οe
œ7™BJ™(J™+J™—
codeš
Οk	˜	K˜.K˜
—K˜šΠnx
œžœ
ž˜Kšžœžœ˜0Kš
ž˜—Kšœž˜Kšžœ	˜
J™š
Οx
™
šΟn	œ˜$šžœ˜Kšœžœžœ˜&K˜—K˜š
ž˜Kšœ
žœ˜Kšœžœ˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜K˜Kš	œ	žœžœ
žœ
žœ
˜Kšœ	žœžœ
žœ	˜ šœžœ
˜Kš
žœžœžœžœžœ˜YKš
žœžœ	žœ	žœ	žœ˜T—Kšœ	žœ	˜K˜Kšœžœ˜Kšœžœ˜Kšœžœ˜
K˜Kšœžœ˜"Kšœžœ˜%Kšœžœ˜#Kšœžœ˜#Kšœžœ˜Kšœžœ
˜	K˜š
‘œžœžœžœžœ
˜$Kšœžœžœ
žœžœ
žœžœ
žœžœžœ˜K—š‘œžœžœ
˜Kš
œ˜Kšœžœ˜Kš
žœžœ
žœ
žœžœ
˜6K˜7K˜—K˜KšžœS˜UKšœžœ˜#Kšœžœ˜$Kšœžœ˜#K˜K˜=Kš
žœžœ
žœžœ
žœ
˜,Kš
žœžœ
žœžœžœ˜@Kšžœžœ
žœžœ
žœžœ
žœžœžœ
žœ
˜QJ™3K˜šžœ&žœ	žœ
ž˜=šžœ*žœ	žœ
ž˜AKš	œ	žœžœžœžœ˜CKšžœ
˜—K˜Kšžœ
˜—Kš
žœžœ
žœžœžœ
˜0K˜K˜K˜K˜K˜Kš
žœžœ
žœžœžœ
˜8K˜#K˜šžœžœ
žœž˜Kš
žœžœ
žœžœ+žœ
˜JK˜*Kšžœ
˜—K˜ Kš
žœžœ
žœžœ"žœ
˜AKšžœ˜šžœžœ
žœž˜Kšžœžœžœžœžœžœ˜VKšžœ
˜—Kšžœ˜šžœžœ
žœž˜Kšžœžœ˜0Kšžœ
˜—Kšžœ˜šžœžœ
žœž˜Kšžœžœ˜.Kšžœ
˜—Kšžœ˜šžœžœ
žœž˜šžœžœ
žœž˜Kšžœžœ˜0Kšžœ
˜—Kšžœ˜Kšžœ
˜—Kšžœ$˜&K˜1Kš
žœžœ
žœžœ*žœ
˜IKšžœ(žœ
˜9šžœžœ
žœž˜Kšžœ#žœ	žœ˜BKšžœ
˜—Kšžœ
˜—š
ž˜Kšœžœ
˜
—K˜—K˜—š
 
™
Kš
œA˜AK˜—Kšžœ˜K˜š‘œžœ˜Kš	œ	žœžœ
žœ
žœ
˜Kšœ	žœžœ
žœ	˜ šœžœ
˜Kš
žœžœžœžœžœ˜XKš
žœžœ	žœ	žœ	žœ˜T—Kšœ	žœ
˜Kšœžœ˜Kšœžœ˜K˜Kšœžœ˜"Kšœžœ˜%Kšœžœ˜#Kšœžœ˜#Kš
œ˜Kšœžœ˜Kšœžœ
˜	Kšœ
žœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜K˜KšžœT˜VKšœžœ˜#Kšœžœ˜$Kšœžœ˜"K˜K˜=Kš
žœžœ
žœžœžœ˜@Kšžœžœ
žœžœ
žœžœ
žœžœžœ
žœ
˜QJ™3K˜šžœ&žœ	žœ
ž˜=šžœ*žœ	žœ
ž˜AKš	œ	žœžœžœžœ˜CKšžœ
˜—K˜Kšžœ
˜—Kš
žœžœ
žœžœžœ
˜0Kš
žœžœ
žœžœžœ
˜8K˜K˜"K˜$K˜%K˜%K˜Jšœžœl™zJšœžœ7™EJš
œ$™$Jš
œ%™%Jš
œ™Jš
œ!™!J™#šžœžœ
žœž˜Kš
žœžœ
žœžœ+žœ
˜JK˜*Kšžœ
˜—K˜ Kš
žœžœ
žœžœ"žœ
˜AKš
žœžœ
žœžœ
žœ
˜,K˜GKšžœ˜!K˜2Kš
žœžœ
žœžœ6žœ
˜UKšžœ'žœ
˜8šžœžœ
žœž˜Kšžœ#žœžœ˜NKšžœ
˜—K˜—š‘œžœ˜Kšœžœ˜Kšœžœ˜K˜Kšœžœ˜"Kšœžœ˜%Kšœžœ˜#Kšœžœ˜#Kš
œ˜K˜=Kš
žœžœ
žœžœžœ
˜-Kšžœžœ
žœžœ
žœžœ
žœžœžœ
žœ
˜QK˜#Kš
žœžœ
žœžœžœ
˜.K˜Kš
žœžœ
žœžœžœ
˜8Kšœžœ˜*Kš
žœžœ
žœžœ
žœ
˜,Kšžœ˜!K˜0Kšžœ!˜#šžœžœ
žœž˜Kšžœ$žœžœ˜OKšžœ
˜—K˜—K˜š
ž˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜K˜Kš	œ	žœžœ
žœ
žœ
˜Kšœ	žœžœ
žœ	˜ Kšœžœ
žœžœ	˜5Kšœ	žœ	˜K˜Kšœžœ˜Kšœžœ˜K˜Kšœžœ˜"Kšœžœ˜%Kšœžœ˜#Kšœžœ˜#Kš
œ˜Kšœžœ˜Kšœžœ
˜	K˜KšžœL˜NKšœžœ˜#Kšœžœ˜$Kšœžœ˜K˜K˜=Kš
žœžœ
žœžœžœ˜@Kšžœžœ
žœžœ
žœžœ
žœžœžœ
žœ
˜QJ™3K˜šžœ&žœ	žœ
ž˜=šžœ*žœ	žœ
ž˜AKš	œ	žœžœžœžœ˜CKšžœ
˜—K˜Kšžœ
˜—Kš
žœžœ
žœžœžœ
˜0K˜K˜Kš
žœžœ
žœžœžœ
˜8K˜ K˜šžœžœ
žœž˜Kš
žœžœ
žœžœ+žœ
˜JK˜*Kšžœ
˜—K˜ Kš
žœžœ
žœžœ"žœ
˜AKš
žœžœ
žœžœ
žœ
˜,Kšžœ˜!K˜2Kš
žœžœ
žœžœ<žœ
˜[Kšžœ'žœ
˜8šžœžœ
žœž˜Kšžœ#žœžœ˜NKšžœ
˜—Kšžœ
˜K˜——…—!f12