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