<<>> <> <> <> <<>> DIRECTORY Commander, Convert, EditedStream, IO, QPSolve, RealFns, Rope ; QPTestImpl: CEDAR PROGRAM IMPORTS Commander, Convert, EditedStream, IO, QPSolve, RealFns EXPORTS ~ BEGIN OPEN QPSolve; <<>> <> QPTestCmd: Commander.CommandProc ~ { ENABLE { Convert.Error, EditedStream.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.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; 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;