<<>> <> <> <> <> DIRECTORY Args, Commander, Controls, Draw2d, G3dFunction, G3dTool, Imager, IO, Real, RealFns, Rope, ViewerOps; G3dMinimizeCmdImpl: CEDAR PROGRAM IMPORTS Args, Controls, Draw2d, G3dFunction, G3dTool, Imager, IO, Real, RealFns, ViewerOps ~ BEGIN <> ROPE: TYPE ~ Rope.ROPE; Control: TYPE ~ Controls.Control; FunctionProc: TYPE ~ G3dFunction.FunctionProc; MinimizeInfo: TYPE ~ REF MinimizeInfoRec; MinimizeInfoRec: TYPE ~ RECORD [ -- params needed to perform (and graph) a minimization t0, t1: Control, -- t range func: FunctionProc, -- function to minimize logslope: Control, alpha: Control, slopefac: Control, certainfac: Control, logeps: Control, v0, v1: Control, -- vertical range for graph vref: Control ]; <> Minimize: Commander.CommandProc ~ { t0A, t1A, v0A, v1A, vrefA, maxslopeA, alphaA, slopefacA, accelfacA, certainfacA, epsilonA: Args.Arg; [t0A, t1A, v0A, v1A, vrefA, maxslopeA, alphaA, slopefacA, accelfacA, certainfacA, epsilonA] ¬ Args.ArgsGet[cmd, "-t%rr-v%rr-vref%r-maxslope%r-alpha%r-slopefac%r-accelfac%r-certainfac%r-epsilon%r" ! Args.Error => {msg ¬ reason; GOTO ArgsErr}]; { NewControl: PROC [name: ROPE, min, max: REAL, arg: Args.Arg, default: REAL] RETURNS [Control] ~ { RETURN[Controls.NewControl[ name: name, type: hSlider, clientData: m, -- backpointer from each control to top level min: min, max: max, init: IF arg.ok THEN arg.real ELSE default, proc: UpdateControl]]; }; <> m: MinimizeInfo ¬ NEW[MinimizeInfoRec]; m­ ¬ [ t0: NewControl["t0", -1500., 1500., t0A, 0.], t1: NewControl["t1", -1500., 1500., t1A, 360.], v0: NewControl["v0", -5., -1., v0A, -2.], v1: NewControl["v1", 1., 5., v1A, 1.], vref: NewControl["vref", -1., 1., vrefA, 0.], func: TestFunc, logslope: NewControl["maxslope", -10., 10., maxslopeA, RealFns.Log[10., 3.1416/180.]], alpha: NewControl["alpha", 0., 1., alphaA, .35], slopefac: NewControl["slopefac", 0., 2., slopefacA, .5], certainfac: NewControl["certainfac", 0., 2., certainfacA, 1.], logeps: NewControl["epsilon", -10., 0., epsilonA, -4.] ]; <> [] ¬ Controls.OuterViewer[ name: "Minimize", graphicsHeight: 400, drawProc: RedrawGraph, typescriptHeight: 18, clientData: m, controls: LIST[m.t0, m.t1, m.v0, m.v1, m.logslope, m.alpha, m.slopefac, m.certainfac, m.logeps] ]; }; EXITS ArgsErr => RETURN[$Failure, msg]; }; TestFunc: G3dFunction.FunctionProc ~ {RETURN[RealFns.SinDeg[t]]}; UpdateControl: Controls.ControlProc ~ { <> IF control.mouse.state = up THEN ViewerOps.PaintViewer[viewer: control.outerData.graphics, hint: client, clearClient: TRUE, whatChanged: control.whatChanged]; }; <> <> <> <> <<};>> <<>> RedrawGraph: Controls.DrawProc ~ { <> UserToScreenX: PROC [x: REAL] RETURNS [i: INT16] ~ {i ¬ Real.Round[sx0+mx*(x-ux0)]}; UserToScreenY: PROC [y: REAL] RETURNS [i: INT16] ~ {i ¬ Real.Round[sy0+my*(y-uy0)]}; ScreenToUserX: PROC [sx: INTEGER] RETURNS [REAL] ~ {RETURN[ux0+(sx-sx0)/mx]}; ScreenToUserY: PROC [sy: INTEGER] RETURNS [REAL] ~ {RETURN[uy0+(sy-sy0)/my]}; Line: G3dFunction.LineProc ~ { sx0: INTEGER ¬ UserToScreenX[x0]; sy0: INTEGER ¬ UserToScreenY[y0]; sx1: INTEGER ¬ UserToScreenX[x1]; sy1: INTEGER ¬ UserToScreenY[y1]; Imager.MaskRectangle[context, [sx0, sy0, sx1-sx0+1, sy1-sy0+1]]; Imager.MaskRectangle[context, [sx0-1, sy0-1, 3, 3]]; Imager.MaskRectangle[context, [sx1-1, sy1-1, 3, 3]]; }; m: MinimizeInfo ~ NARROW[clientData]; ux0: REAL ¬ m.t0.value; ux1: REAL ¬ m.t1.value; uy0: REAL ¬ m.v0.value; uy1: REAL ¬ m.v1.value; uyref: REAL ¬ m.vref.value; sx0: INTEGER ¬ 32; -- screen left margin sy0: INTEGER ¬ 17; -- screen bottom margin sx1: INTEGER ¬ viewer.cw-sx0; sy1: INTEGER ¬ viewer.ch-sy0; mx: REAL ¬ (sx1-sx0)/(ux1-ux0); my: REAL ¬ (sy1-sy0)/(uy1-uy0); dx: REAL ¬ (ux1-ux0)/RealFns.Power[2.0, Real.Floor[RealFns.Log[2.0, (sx1-sx0)/40.0]]]; dy: REAL ¬ (uy1-uy0)/Real.Floor[(sy1-sy0)/30.]; tick: INTEGER ~ 5; Imager.MaskRectangle[context, [sx0, UserToScreenY[uyref], sx1-sx0+1, 1]]; -- ref. line Imager.MaskRectangle[context, [sx0, sy0, sx1-sx0+1, 1]]; -- line along bottom Imager.MaskRectangle[context, [sx0, sy1, sx1-sx0+1, 1]]; -- line along top Imager.MaskRectangle[context, [sx0, sy0, 1, sy1-sy0+1]]; -- line along left Imager.MaskRectangle[context, [sx1, sy0, 1, sy1-sy0+1]]; -- line along right FOR y: REAL ¬ uy0, y+dy WHILE y < uy1+.5*dy DO -- left edge ticks sy: INTEGER ~ UserToScreenY[y]; Imager.MaskRectangle[context, [sx0-tick, sy, tick, 1]]; Draw2d.Label[context, [3, sy], IO.PutFR1["%3.2f", IO.real[y]]]; ENDLOOP; FOR x: REAL ¬ ux0, x+dx WHILE x < ux1+.5*dx DO -- bottom edge ticks sx: INTEGER ~ UserToScreenX[x]; Imager.MaskRectangle[context, [sx, sy0-tick, 1, tick]]; Draw2d.Label[context, [sx-sx0/2, 3], IO.PutFR1["%5.1f", IO.real[x]]]; ENDLOOP; FOR sx: INTEGER IN [sx0..sx1] DO y: REAL ~ m.func[ScreenToUserX[sx]]; Imager.MaskRectangle[context, [sx, UserToScreenY[y], 1, 1]]; ENDLOOP; [] ¬ G3dFunction.MinimizeFunction[ function: m.func, t0: m.t0.value, t1: m.t1.value, logSlope: m.logslope.value, alpha: m.alpha.value, slopeFac: m.slopefac.value, certainFac: m.certainfac.value, logEps: m.logeps.value, lineProc: Line, report: NARROW[viewer.parent.data, Controls.OuterData].typescript.out]; }; <> usage: ROPE ¬ "minimize [options] options include: -t set interval over which minimum is found -x vertical axis to graph [-2 1] -maxslope max slope of function [.02] -slopefac [1.] -alphafac [.35] -certainfac [1.] -epsilon [1e-4] "; G3dTool.Register["Minimize", Minimize, usage]; END. .. Interval: TYPE ~ REF IntervalRec; IntervalRec: TYPE ~ RECORD [ -- information about an interval, used in min search tree depth: NAT ¬ 0, -- depth within tree parent: Interval ¬ NIL, -- parent interval prev, next: Interval ¬ NIL, -- prev and next in linked list of active leaves l, r: Interval ¬ NIL, -- ptrs to left and right child intervals, if any lt, rt: REAL, -- t at left and right ends of interval lval, rval: REAL, -- values at left and right ends of interval estval: REAL -- estimated minimum value over this interval ]; NthDeriv: PROC [n: Interval, order: NAT] RETURNS [REAL] ~ { k: INTEGER ¬ 1; sum: REAL ¬ 0.; FOR i: NAT IN [0..order/2) DO IF n = NIL THEN RETURN[slop]; n ¬ PrevSibling[n]; ENDLOOP; FOR i: NAT IN [0..order] DO IF n = NIL THEN RETURN[slop]; sum ¬ sum+k*n.lval; n ¬ NextSibling[n]; k ¬ k*(i-order)/(i+1); -- e.g. order=4 generates k= 1, -4, 6, -4, 1 ENDLOOP; RETURN[sum]; }; EstimateMinVal: PROC [n: Interval] RETURNS [REAL] ~ { <> val: REAL ¬ 0.; fact: NAT ¬ 1; FOR order: NAT IN [0..maxOrder] DO val ¬ val+NthDeriv[n, order]/fact; IF order>0 THEN fact ¬ fact*order; ENDLOOP; RETURN[?? MIN[n.lval, n.rval]-slack*(fudge*(n.rt-n.lt)+ABS[n.lval-n.rval]);]; }; SillyNthDeriv: PROC [n: Interval, order: NAT] RETURNS [REAL] ~ { IF order = 0 THEN RETURN[n.lval]; IF order MOD 2 = 0 THEN RETURN[NthDeriv[n, order-1]]-NthDeriv[PrevSibling[n], order-1]] ELSE RETURN[NthDeriv[NextSibling[n], order-1]-NthDeriv[n, order-1]]; }; PoorEstimateMinVal: PROC [n: Interval] RETURNS [REAL] ~ { <> RETURN[MIN[n.lval, n.rval]-slack*(fudge*(n.rt-n.lt)+ABS[n.lval-n.rval])]; };