MODULE PZRefineCands EXPORTS Main;

(* Refines a list of candidate matchings, using DP on coded curvature chains.  *)

IMPORT ParseParams, FileRd, FileWr, TextWr, Wr, Fmt, CPUTime;
IMPORT Process, OSError, Thread, Stdio;
IMPORT PZSymbolChain, PZCandidate;
IMPORT PZMatch;  
 
FROM Stdio IMPORT stderr;
 
<* FATAL Wr.Failure, Thread.Alerted, OSError.E *>

TYPE
  Options = RECORD
      inName: TEXT;             (* Input candidate file name. *)
      chainPrefix: TEXT;        (* Invariant chain file name prefix. *)
      band: CARDINAL;           (* Nominal band width (lambda) for file names. *)
      outName: TEXT;            (* Output candidate file (without ".???"). *)
      maxShift: LONGREAL;       (* Max shift to try in alignment. *)
      maxDist: LONGREAL;        (* Clip letter distances to this maximum. *)
      cutDist: LONGREAL;        (* Max avg curvature distance for accepting cand. *)
      minLength: LONGREAL;      (* Minimum length of matching segments. *)
      shrinkFactor: LONGREAL;   (* Corner broadening factor. *)
      extraLength: LONGREAL;    (* Extra length to add at each candidate end. *)
      maxCurveCands: CARDINAL;  (* Max candidates per curve. *)
      maxPairCands: CARDINAL;   (* Max candidates per curve pair. *)
      dontReverse: BOOLEAN;     (* TRUE omits inversion of second chain. *)
    END;

PROCEDURE Main() =
  BEGIN
    WITH 
      o = GetOptions(),
      cData = PZCandidate.Read(FileRd.Open(o.inName & ".can")),
      oldCand = cData.c^,
      lambda = cData.lambda,
      curves = PZCandidate.GetCurves(oldCand)^,
      ch = PZSymbolChain.ReadAll(
        o.chainPrefix, o.band, ".cvc",
        sel := curves, headerOnly := FALSE
      )^,
      minLength = o.minLength - o.shrinkFactor * 2.0d0 * lambda,
      newCand = RefineCandidates(oldCand, ch,
        maxShift := o.maxShift,
        maxDist := o.maxDist,
        cutDist := o.cutDist, 
        minLength := minLength, 
        extraLength := o.extraLength, 
        maxCurveCands := o.maxCurveCands, 
        maxPairCands := o.maxPairCands, 
        dontReverse := o.dontReverse
      )^,
      wr = FileWr.Open(o.outName & ".can")
    DO
      PZCandidate.Write(wr, cData.cmt & RefineComments(o), newCand, lambda);
    END;
  END Main;          

      
PROCEDURE GetOptions(): Options =
  VAR o: Options;
  BEGIN
    WITH
      pp = NEW(ParseParams.T).init(stderr)
    DO
      TRY
        pp.getKeyword("-inName");
        o.inName := pp.getNext();
        
        pp.getKeyword("-chainPrefix");
        o.chainPrefix := pp.getNext();
        
        pp.getKeyword("-band");
        o.band := pp.getNextInt();
        
        pp.getKeyword("-outName");
        o.outName := pp.getNext();
        
        pp.getKeyword("-minLength");
        o.minLength := pp.getNextLongReal();
        
        pp.getKeyword("-shrinkFactor");
        o.shrinkFactor := pp.getNextLongReal(0.0d0, 5.0d0);
        
        pp.getKeyword("-extraLength");
        o.extraLength := pp.getNextLongReal(0.0d0);
        
        pp.getKeyword("-maxShift");
        o.maxShift := pp.getNextLongReal();
        
        pp.getKeyword("-maxDist");
        o.maxDist := pp.getNextLongReal(0.0d0);
        
        pp.getKeyword("-cutDist");
        o.cutDist := pp.getNextLongReal(0.0d0);
        
        IF pp.keywordPresent("-maxCurveCands") THEN
          o.maxCurveCands := pp.getNextInt(1)
        ELSE
          o.maxCurveCands := LAST(CARDINAL)
        END;
                         
        IF pp.keywordPresent("-maxPairCands") THEN
          o.maxPairCands := pp.getNextInt(1, o.maxCurveCands)
        ELSE
          o.maxPairCands := LAST(CARDINAL)
        END;
                         
        o.dontReverse := pp.keywordPresent("-dontReverse");
        
        pp.finish();                                       
      EXCEPT                                                            
      | ParseParams.Error =>                                              
          Wr.PutText(stderr, "Usage: PZRefineCands \\\n");
          Wr.PutText(stderr, "  -inName NAME \\\n");
          Wr.PutText(stderr, "  -chainPrefix NAME \\\n");
          Wr.PutText(stderr, "  -band NUMBER \\\n");
          Wr.PutText(stderr, "  -outName NAME \\\n");
          Wr.PutText(stderr, "  -minLength NUMBER -shrinkFactor NUMBER \\\n");
          Wr.PutText(stderr, "  -extraLength NUMBER \\\n");
          Wr.PutText(stderr, "  -maxShift NUMBER \\\n");
          Wr.PutText(stderr, "  -maxDist  NUMBER \\\n");
          Wr.PutText(stderr, "  -cutDist NUMBER \\\n");
          Wr.PutText(stderr, "  [ -maxCurveCands NUMBER ] \\\n");
          Wr.PutText(stderr, "  [ -maxPairCands NUMBER ] \\\n");
          Wr.PutText(stderr, "  [ -dontReverse ]\n");
        Process.Exit(1);
      END;
    END;
    RETURN o
  END GetOptions;


PROCEDURE RefineCandidates(
    READONLY cand: PZCandidate.List;
    READONLY ch: ARRAY OF PZSymbolChain.ReadData; 
    maxShift: LONGREAL;         (* Max shift to try alignment using PD ?? *)        
    maxDist: LONGREAL;          (* Clip letter distances to this maximum. *)
    cutDist: LONGREAL;          (* Max mismatch to retain candidate *)
    minLength: LONGREAL;        (* Min required length of matched segments *)
    extraLength: LONGREAL;      (* Extra length to consider at both ends *)
    maxCurveCands: CARDINAL;    (* Max candidates per curve *)
    maxPairCands: CARDINAL;     (* Max candidates per curve pair *)
    dontReverse: BOOLEAN;       (* TRUE to supress reversal+complement of 2nd chain *)
  ) : REF PZCandidate.List =
  VAR 
    n: CARDINAL := 0;    (* Refined candidate count *)
    match: REF PZMatch.T;
    mismatch: LONGREAL;
    nMatched: CARDINAL;
    length: LONGREAL;
    c : REF PZCandidate.List;
    mia, mfa, mib, mfb: CARDINAL;  (* match endpoints relative to extracted pieces *)
    XYCost: REF PZMatch.CostMatrix := NIL;
  BEGIN 
    WITH
      nCands = NUMBER(cand),
      reverse = NOT dontReverse,
      start = CPUTime.Now()
    DO
      (* Wr.PutText(stderr, "minLength = " &  Fmt.LongReal(minLength) & "\n"); *) 
      Wr.PutText(stderr, "candidates before refine loop = " & Fmt.Int(nCands) & "\n"); 
      c := NEW(REF PZCandidate.List, nCands);
      FOR i := 0 TO nCands-1 DO 
        WITH 
          s = cand[i],
          
          sa = s.int[0],
          cha = ch[sa.k],
          ma = NUMBER(cha.c^),
          aStep = cha.length / FLOAT(ma, LONGREAL),
          aExtra = CEILING(extraLength / aStep),
          rna = (sa.fin - sa.ini) MOD ma + 1,
          na = MIN(rna + 2*aExtra, ma),
          aStretch = (na - rna) DIV 2,
          ia = (sa.ini - aStretch) MOD ma,
          ca = PZSymbolChain.Trim(cha.c^, ia, na)^,
          
          sb = s.int[1],
          chb = ch[sb.k],
          mb = NUMBER(chb.c^),
          bStep = chb.length / FLOAT(mb, LONGREAL),
          bExtra = CEILING(extraLength / bStep),
          rnb = (sb.fin - sb.ini) MOD mb + 1,
          nb = MIN(rnb + 2*bExtra, mb),
          bStretch = (nb - rnb) DIV 2,
          ib = (sb.ini - bStretch) MOD mb,
          cb = PZSymbolChain.Trim(chb.c^, ib, nb)^,
          
          step = 0.5d0 * (aStep + bStep),
          minChainSteps = MAX(0, FLOOR((2.0d0 * minLength)/step))
        DO 
          IF na > 0 AND nb > 0  THEN 
            <* ASSERT NUMBER(ca)>0 *>
            <* ASSERT NUMBER(cb)>0 *>
            (* Wr.PutText(stderr, "minChainSteps = " &  Fmt.Int(minChainSteps) & "\n"); *)
            IF reverse THEN
              PZSymbolChain.ReverseAndComplement(cb)
            END;
            ComputeCurvChainMismatch(
              ca, cb, 
              maxShift:= maxShift,
              maxDist := maxDist, 
              cutDist := cutDist,
              minChainSteps := minChainSteps,
              step := step,
              (*OUT*) 
              mismatch := mismatch,
              length := length,
              nMatched := nMatched,
              match := match,
              (*WORK*) 
              XYCost := XYCost
            );
            IF reverse THEN
              PZSymbolChain.ReverseAndComplement(cb)
            END;
            (* Wr.PutText(stderr, "mismatch = " &  Fmt.LongReal(mismatch) & "\n"); *)
            IF mismatch <= 0.0d0
            AND length > minLength THEN 
              WITH
                r = c[n],
                ra = r.int[0],
                rb = r.int[1],
                nm = NUMBER(match^)
              DO
                mia := match[0,0]; 
                mfa := match[nm-1,0];
                IF reverse THEN
                  mib := nb - 1 - match[nm-1,1]; 
                  mfb := nb - 1 - match[0,1];
                ELSE
                  mib := match[0,1]; 
                  mfb := match[nm-1,1];
                END;
                r.mismatch := mismatch;
                r.length := length;
                r.matched := FLOAT(nMatched, LONGREAL) * step;
                ra.ini := (ia+mia) MOD ma;
                ra.fin := (ia+mfa) MOD ma;
                <* ASSERT ra.ini # ra.fin *>
                ra.k := sa.k;
                rb.ini := (ib+mib) MOD mb;
                rb.fin := (ib+mfb) MOD mb;
                <* ASSERT rb.ini # rb.fin *>
                rb.k := sb.k;
              END;
              INC(n);
            END;
          END;
        END;
        IF (i MOD 80 = 0) THEN Wr.PutText(stderr, "\n") END;
        Wr.PutText(stderr, ".");
      END;
      Wr.PutText(stderr, "\n");
      WITH t = CPUTime.Now() - start DO
        Wr.PutText(stderr, "time for RefineCandidates = " & FLR(t,0,1) & " sec\n")
      END;
      Wr.PutText(stderr, "candidates before Sort and Prune = " & Fmt.Int(n) & "\n"); 
      PZCandidate.Sort(SUBARRAY(c^, 0, n), PZCandidate.LexBetter);
      PZCandidate.Prune(c^, n, maxCurveCands, maxPairCands);
      PZCandidate.Sort(SUBARRAY(c^, 0, n), PZCandidate.AbsBetter);
      Wr.PutText(stderr, "candidates after  Sort and Prune = " & Fmt.Int(n) & "\n"); 
      WITH ct = NEW(REF PZCandidate.List, n) DO
        ct^ := SUBARRAY(c^,0,n);
        RETURN ct
      END;
    END
  END RefineCandidates;
 
 
PROCEDURE ComputeCurvChainMismatch(
    READONLY a, b: PZSymbolChain.T;
    maxShift: LONGREAL; 
    maxDist: LONGREAL;
    cutDist: LONGREAL;
    step: LONGREAL;
    minChainSteps: CARDINAL;
    VAR (*OUT*) mismatch : LONGREAL;
    VAR (*OUT*) length: LONGREAL;
    VAR (*OUT*) nMatched: CARDINAL;
    VAR (*OUT*) match: REF PZMatch.T;
    VAR (*WORK*) XYCost: REF PZMatch.CostMatrix;
  ) =
  VAR xCenter, yCenter: CARDINAL;
      minAvgDist: REF ARRAY OF LONGREAL;
  BEGIN
    WITH
      NA = NUMBER(a),
      NB = NUMBER(b),
      ac = (NA-1) DIV 2,
      bc = (NB-1) DIV 2
    DO
      IF minChainSteps <= (NA-1)+(NB-1) THEN
        PZSymbolChain.OutMatch(
          a, b,
          loc := FLOAT(ac + bc, LONGREAL),
          align := FLOAT(ac - bc, LONGREAL),
          maxShift := maxShift,
          maxDist := maxDist,
          cutDist := cutDist,
          step := step,
          minChainSteps := minChainSteps,
          (*OUT*) mismatch := mismatch,
          (*OUT*) nMatched := nMatched,
          (*OUT*) match := match,
          (*OUT*) xCenter := xCenter,
          (*OUT*) yCenter := yCenter,
          (*OUT*) minAvgDist := minAvgDist,
          (*WORK*) XYCost := XYCost
        );
        WITH
          nm = NUMBER(match^),
          La = match[nm-1,0] - match[0,0],
          Lb = match[nm-1,1] - match[0,1]
        DO
          length := step * FLOAT(La + Lb, LONGREAL)/2.0d0
        END;
      ELSE
        mismatch := LAST(LONGREAL);
        length := 0.0d0;
        nMatched := 0;
        match := NEW(REF PZMatch.T, 1);
        match[0] := PZMatch.Pair{ac,bc}
      END
    END
  END ComputeCurvChainMismatch;
 
 
PROCEDURE RefineComments(READONLY o: Options):TEXT=
  BEGIN 
    WITH 
      wr = NEW(TextWr.T).init()
    DO 
      Wr.PutText(wr, "PZRefineCands: \n"); 
      Wr.PutText(wr, "  inName:      " & o.inName & "\n"); 
      Wr.PutText(wr, "  chainPrefix: " & o.chainPrefix     & "\n");
      Wr.PutText(wr, "  band:        " & Fmt.Int(o.band) & "\n");
      Wr.PutText(wr, "  outName:     " & o.outName & "\n"); 
      RETURN(TextWr.ToText(wr))
    END (* DO *);
  END RefineComments;

PROCEDURE FLR(x: LONGREAL; w, d: CARDINAL): TEXT =
  BEGIN
    RETURN Fmt.Pad(Fmt.LongReal(x, prec := d, style := Fmt.Style.Fix), w)
  END FLR;

BEGIN
  Main()
END PZRefineCands.