MODULE DownMinimizer;

IMPORT LRN, Minimizer; 
FROM Minimizer IMPORT 
  Point, Gradient, Length, Value, EvalProc, CheckProc;

IMPORT Wr, Fmt, Thread;
FROM Stdio IMPORT stderr;

REVEAL
  T = Public BRANDED OBJECT
      alpha: LONGREAL := 1.53478225382648941d0;
      beta: LONGREAL := 0.5d0;
      setSizeCalled: BOOLEAN := FALSE;
      NC: CARDINAL;       (* Number of client variables *)
      (* Work areas for "minimize": *)
      xn: REF Point;      (* Probe point *)
      fxn: REF Value;     (* Its function value *)
      dfxn: REF Gradient; (* Its gradient *)
    OVERRIDES
      name := Name;
      setAlphaBeta := SetAlphaBeta;
      setSize := SetSize;
      minimize := Minimize;
      needsGradient := NeedsGradient;
    END;
    
PROCEDURE Name(m: T): TEXT =
  BEGIN
    RETURN "DownMinimizer("
     & "alpha = " & Fmt.LongReal(m.alpha)
     & ", beta = " & Fmt.LongReal(m.beta)
     & ")"
  END  Name;

PROCEDURE SetAlphaBeta(m: T; alpha, beta: LONGREAL): T =
  BEGIN
    <* ASSERT alpha > 1.0d0 *>
    <* ASSERT beta < 1.0d0 AND beta > 0.0d0 *>
    m.alpha := alpha;
    m.beta := beta;
    RETURN m
  END SetAlphaBeta;
    
PROCEDURE SetSize(m: T; n: CARDINAL): Minimizer.T =
  BEGIN
    m.setSizeCalled := TRUE;
    m.NC := n;
    m.xn := NEW(REF Point, m.NC);
    m.fxn := NEW(REF Value); 
    m.dfxn := NEW(REF Gradient, m.NC);
    RETURN m
  END SetSize;

PROCEDURE NeedsGradient(<*UNUSED*> m: T): BOOLEAN =
  BEGIN
    RETURN TRUE   
  END NeedsGradient;

PROCEDURE Minimize(
    m: T;
    eval: EvalProc;
    VAR x: Point;
    VAR fx: Value;
    VAR dfx: Gradient;
    dist: Length;
    tol: Length;
    check: CheckProc;
  ) =
  VAR step: LONGREAL := dist;       (* Current step size *)
  BEGIN
    IF check # NIL THEN
      IF check(x, fx, dfx) THEN RETURN END
    END;
    <* ASSERT m.setSizeCalled *>
    WITH 
      debug = m.debug,
      alpha = m.alpha,
      beta = m.beta,
      NC = m.NC,
      xn = m.xn^,
      fxn = m.fxn^,
      dfxn = m.dfxn^,
      minStep = tol,   (* Min step that can still be reduced *)
      maxStep = dist   (* Max step that can still be increased *)
    DO
      <* ASSERT NUMBER(x) = NC *>
      
      IF debug THEN 
        WITH gNorm = LRN.Norm(dfx) DO
          Debug("initial state:", LRN.T{});
          Debug("  fx, gNorm, step  = ", LRN.T{fx, gNorm, step}); 
          Debug("  x  = ", x); 
          Debug("  dfx  = ", dfx);
          PrintNewLine();
        END
      END;

      (* "x", "fx", and "dfx" contain the best minimum seen so far. *)
      LOOP
        (* Compute new probe point: *)
        WITH 
          gNorm = LRN.Norm(dfx),
          s = step/gNorm
        DO
          FOR i := 0 TO NC-1 DO xn[i] := x[i] - s * dfx[i] END
        END;
        IF eval(xn, fxn, dfxn) THEN RETURN END; 

        IF debug THEN 
          WITH gnNorm = LRN.Norm(dfxn) DO
            Debug("state:", LRN.T{}); 
            Debug("  fxn, gNorm, step = ", LRN.T{fxn, gnNorm, step}); 
            Debug("  xn = ", xn); 
            Debug("  dfxn = ", dfxn);
          END
        END;

        (* Decide what to do: *)
        IF fxn <= fx THEN
          (* Advance and increase step size: *)
          x := xn; fx := fxn; dfx := dfxn;
          IF check # NIL THEN
            IF check(x, fx, dfx) THEN RETURN END
          END;
          IF step < maxStep THEN step := step * alpha END;
          IF debug THEN Debug("  accepted", LRN.T{}) END;
        ELSIF step <= tol THEN
          (* Give up: *)
          IF debug THEN Debug("  rejected and stopped", LRN.T{}) END;
          RETURN
        ELSE
          (* Reduce step size and retry: *)
          IF debug THEN Debug("  rejected", LRN.T{}) END;
          IF step > minStep THEN step := step * beta END;
        END;
        IF debug THEN PrintNewLine() END;
      END
    END
  END  Minimize;
  
PROCEDURE Debug(msg: TEXT; READONLY x: LRN.T) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(stderr, "DownMinimizer ");
    Wr.PutText(stderr, msg);
    FOR i := 0 TO LAST(x) DO
      Wr.PutText(stderr, Fmt.Pad(Fmt.LongReal(x[i], Fmt.Style.Sci, 6), 15))
    END;
    Wr.PutText(stderr, "\n")
  END Debug;

PROCEDURE PrintNewLine () =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    Wr.PutText(stderr, "\n");
  END PrintNewLine;

BEGIN
END DownMinimizer.