unit CalDatau;

interface
uses
  SysUtils,
  ULRecTyp, ULObju, Fileu,
  UlanType, UlanGlob,
  ULPRType, ULPRObju, ULCType, ULCObju,
  UCFType, UCFObju, UCFRType, UCFRObju,
  UCPType, UCPObju, UCPRType, UCPRObju,
  UCPLType, UCPLObju,
  DataFileu, FMath, Fitteru;

type
  TCalData = class(TDataFile)
  private
    FULC: TULCObj; { composed calibration branch }
    FULC_UCF: TUCFObj;
    FULC_UCP: TUCPObj;
    function GetULC: TULCObj;
    function GetULC_UCF: TUCFObj;
    function GetULC_UCP: TUCPObj;
    function GetActiveUCPR: TUCPRObj;
  protected
    procedure ULFFree;override;
    function GetFileExt: string; override;
    {v0.67}
    function HasData: boolean; override;
    procedure DiscardData; override;
    function GetTemplateExt: string; override;
    {/v0.67}
    procedure SetDefDir(const ADir: string);
    function GetDefDir: string;

  public
    procedure ComposePeaks(ACurveFitType: TCurveFitType; AResponseBase: TResponseBase; AOriginUse: TOriginUse);
    class function Fit(AUCPR: TUCPRObj; var AFitter: TFitter): boolean;
    function FitActiveUCPR(var AFitter: TFitter): boolean;
    { Calculate p.Amount from info in c, multiplying at the end by f }
    class procedure PeakAmountCalculate(p: TULPRObj; c: TUCPRObj; f: TFactor);
    class function GetY(c: TUCPRObj; x: Float): Float;

    procedure FileAdd(const AFileName: string);

    property ULC: TULCObj read GetULC;
    property ULC_UCF: TUCFObj read GetULC_UCF;
    property ULC_UCP: TUCPObj read GetULC_UCP;
    property ActiveUCPR: TUCPRObj read GetActiveUCPR;
    property DefDir: string read GetDefDir write SetDefDir;
  end;


implementation
uses
  Spectrum;
{TCalData.}
{v0.64}
function TCalData.GetULC: TULCObj;
begin
  if (FULC = nil) then
    FULC := TULCObj(ULF.FindOrAdd(ULCID, ''));
  Result := FULC;
end;

function TCalData.GetULC_UCF: TUCFObj;
begin
  if FULC_UCF = nil then
    FULC_UCF := TUCFObj(ULC.FindOrAdd(UCFID, ''));
  Result := FULC_UCF;
end;

function TCalData.GetULC_UCP: TUCPObj;
begin
  if FULC_UCP = nil then
    FULC_UCP := TUCPObj(ULC.FindOrAdd(UCPID, ''));
  Result := FULC_UCP;
end;
{/v0.64}

function CreateOrOpenCalFile(AFileName: string; var ACalData: TCalData): boolean;
var
  d: TCalData;
  fn: string;
begin
  ACalData := nil;
  if (AFileName = '') or (not FileExists(AFileName)) then begin
    //fn := AddBackSlash(TemplateDir) + pvUlanDefaultTemplate;
    //if not FileExists(fn) then
    //  fn := AddBackSlash(TemplateDir) + pvPasiveDefaultTemplate;
    fn := AFileName;
    d := TCalData.Create(fn, omCreate);
  end else begin
    fn := AFileName;
    d := TCalData.Create(fn, omRead);
  end;
  //d := TAcqData.Create(fn, omRead);
  try
    {
    if d.ULI.Duration <> 0 then begin
      ul := NewUserViewLimit;
      d.ULVL.MinX := ul.Min.X;
      d.ULVL.MinY := ul.Min.Y;
      d.ULVL.MaxX := d.ULI.Duration / 60; //min
      d.ULVL.MaxY := ul.Max.Y;
    end;
    }
    if AFileName <> '' then begin
      d.SaveTo(AFileName);
    end;
  except
    d.Free;
  end;
  ACalData := d;
  Result := true;
end;

procedure TCalData.ComposePeaks(ACurveFitType: TCurveFitType; AResponseBase: TResponseBase; AOriginUse: TOriginUse);
var
  i, j: integer;

  oucfr: TULObj;
  ucfr: TUCFRObj absolute oucfr;

  oucpr: TULObj;
  ucpr: TUCPRObj absolute oucpr;

  op: TULObj;
  p: TULPRObj absolute op;

  ucpl: TUCPLObj;

  f: TAcqData;
  w: single;
  fcount: integer;
  respindex: integer;
begin
  ULC_UCP.DoChangeLock;
  try
    ULC_UCP.Clear;
    fcount := 0;
    for i := 0 to ULC_UCF.ChildCount - 1 do begin
      oucfr := ULC_UCF.Childs[i];
      if not (oucfr is TUCFRObj) then
        continue;
      // ulctype ucptype ucprtype ucftype ucfrtype ulprtype ulrectyp
      f := TAcqData.Create(ExpandFileName(DefDir + ucfr.FileName), omRead);
      try
        inc(fcount);
        w := ucfr.Weight;
        if w = 0 then
          w := 1;
        for j := 0 to f.ULP.ChildCount - 1 do begin
          op := f.ULP.Childs[j];
          if not (op is TULPRObj) then
            continue;
          if p.PeakName = '' then
            continue;
          if not ULC_UCP.HasChildWithFieldUsrValue('PeakName', p.PeakName, oucpr) then begin
            oucpr := ULC_UCP.Add(UCPRID);//ulobju
            ucpr.PeakName := p.PeakName;
            ucpr.DataName := p.DataName;
            ucpr.CurveFitType := ACurveFitType;
            ucpr.ResponseBase := AResponseBase;
            ucpr.OriginUse := AOriginUse;
          end;

          ucpr.FromFileCount := ucpr.FromFileCount + 1;
          ucpr.WeightSum := ucpr.WeightSum + w;
          ucpr.Response := ucpr.Response + p.Response * w;
          ucpr.X := ucpr.X + p.X * w;

          ucpl := TUCPLObj(ucpr.Add(UCPLID));
          if ucpr.ResponseBase = rbHeight then begin
            ucpl.Response := p.Height;
          end else begin
            ucpl.Response := p.AreaSize;
          end;
          ucpl.Amount := p.Amount;
          ucpl.Weight := w;

        end;
      finally
        f.Free;
      end;
    end;
    i := 0;
    respindex := -1;
    while i < ULC_UCP.ChildCount do begin
      oucpr := ULC_UCP.Childs[i];
      if not (oucpr is TUCPRObj) then
        continue;
      if ULC.PeakFindKind = pfkAND then begin
        if ucpr.FromFileCount < fcount then begin
          ucpr.Free;
          continue;
        end;
      end;
      ucpr.Response := ucpr.Response / ucpr.WeightSum;
      ucpr.X := ucpr.X / ucpr.WeightSum;

      ucpr.SortByFieldName('Response');

      inc(i);
    end;
  finally
    ULC_UCP.DoChangeUnlock;
  end;
end;

(*procedure TCalData.ComposePeaksByAverage;
// ucprtype ulanrecs.lst
  { scan all selected files for named peaks,
    create compoused peaks from them using switch:
      - intersection (only peaks present in all files)
      - union (all peaks found in any file)

    for each composed peak compute weighted average using Weight field:
      response := response[i] * weight[i] / sum of weights
      x := x[i] * weight[i] / sum of weights
  }
var
  i, j: integer;

  oucfr: TULObj;
  ucfr: TUCFRObj absolute oucfr;

  oucpr: TULObj;
  ucpr: TUCPRObj absolute oucpr;

  op: TULObj;
  p: TULPRObj absolute op;

  f: TAcqData;
  w: single;
  fcount: integer;
//
begin
  ULC_UCP.Clear;
  fcount := 0;
  for i := 0 to ULC_UCF.ChildCount - 1 do begin
    oucfr := ULC_UCF.Childs[i];
    if not (oucfr is TUCFRObj) then
      continue;
    // ulctype ucptype ucprtype ucftype ucfrtype ulprtype ulrectyp
    f := TAcqData.Create(ExpandFileName(DefDir + ucfr.FileName), omRead);
    try
      inc(fcount);
      w := ucfr.Weight;
      if w = 0 then
        w := 1;
      for j := 0 to f.ULP.ChildCount - 1 do begin
        op := f.ULP.Childs[j];
        if not (op is TULPRObj) then
          continue;
        if not ULC_UCP.HasChildWithFieldUsrValue('PeakName', p.PeakName, oucpr) then begin
          oucpr := ULC_UCP.Add(UCPRID);
          ucpr.PeakName := p.PeakName;
          ucpr.DataName := p.DataName;
        end;

        ucpr.FromFileCount := ucpr.FromFileCount + 1;
        ucpr.WeightSum := ucpr.WeightSum + w;
        ucpr.Response := ucpr.Response + p.Response * w;
        ucpr.X := ucpr.X + p.X * w;
      end;
    finally
      f.Free;
    end;
  end;
  i := 0;
  while i < ULC_UCP.ChildCount do begin
    oucpr := ULC_UCP.Childs[i];
    if not (oucpr is TUCPRObj) then
      continue;
    if ULC.PeakFindKind = pfkAND then begin
      if ucpr.FromFileCount < fcount then begin
        ucpr.Free;
        continue;
      end;
    end;
    ucpr.Response := ucpr.Response / ucpr.WeightSum;
    ucpr.X := ucpr.X / ucpr.WeightSum;
    inc(i);
  end;
end;

procedure TCalData.ComposePeaks(ACurveFitType: TCurveFitType);
begin
  if ACurveFitType = cfNone then
    ComposePeaksByAverage
  else
    ComposePeaksMultiLevel(ACurveFitType);
end;
*)

procedure TCalData.ULFFree;
begin
  FULC := nil;
    FULC_UCP := nil;
    FULC_UCF := nil;
  inherited;
end;

function TCalData.GetFileExt: string;
begin
  Result := ULCExt;
end;

function TCalData.HasData: boolean;
begin
  Result := true;
end;

procedure TCalData.DiscardData;
begin
end;

function TCalData.GetTemplateExt: string;
begin
  Result := FileExt;
end;

function TCalData.GetActiveUCPR: TUCPRObj;
var o: TULObj;
begin
  o := FULC_UCP.ActiveChild;
  if o.RecID = UCPRID then
    Result := TUCPRObj(o)
  else
    Result := nil;
end;

class function TCalData.Fit(AUCPR: TUCPRObj; var AFitter: TFitter): boolean;
var
  i: integer;
  ucpl: TUCPLObj;
begin
  Result := false;
  if AUCPR = nil then
    exit;
  AFitter := Fitter(AUCPR.CurveFitType);
  AFitter.PointCount := AUCPR.ChildCount;
  AFitter.OriginUse := AUCPR.OriginUse;
  for i := 0 to AUCPR.ChildCount - 1 do begin
    ucpl := TUCPLObj(AUCPR.Childs[i]);
    AFitter.PointAdd(ucpl.Response, ucpl.Amount); // last PointAdd invokes AFitter.CalcParam
  end;

  { copy f curve function parameters to calibration peak record }
  if AFitter.BCount > 0 then // fitteru
    AUCPR.Param1 := AFitter.B[0]
  else
    AUCPR.Param1 := 0;
  if AFitter.BCount > 1 then
    AUCPR.Param2 := AFitter.B[1]
  else
    AUCPR.Param2 := 0;
  if AFitter.BCount > 2 then
    AUCPR.Param3 := AFitter.B[2]
  else
    AUCPR.Param3 := 0;
  if AFitter.BCount > 3 then
    AUCPR.Param4 := AFitter.B[3]
  else
    AUCPR.Param4 := 0;
  {/}

  Result := true;
end;

function TCalData.FitActiveUCPR(var AFitter: TFitter): boolean;
begin
  Result := Fit(ActiveUCPR, AFitter);
end;

class function TCalData.GetY(c: TUCPRObj; x: Float): Float;
var
  fi: TFitter;
begin
  case c.CurveFitType of //ulantype
    // cfNone
    cfPointToPoint: begin
      if Fit(c, fi) then begin
        Result := fi.Func(x)
      end;
    end;
    cfLinear: begin
      Result := c.Param1 + c.Param2 * x;
    end;
    cfQuadratic: begin
      Result := c.Param1 + c.Param2 * x + c.Param3 * x * x;
    end;
    cfCubic: begin
      Result := c.Param1 + c.Param2 * x + c.Param3 * x * x + c.Param4 * x * x  * x;
    end;
  else
    Result := 0;
  end;
end;

{ Calculate p.Amount from info in c, multiplying at the end by f }
class procedure TCalData.PeakAmountCalculate(p: TULPRObj; c: TUCPRObj; f: TFactor);
var
  v: Float;
begin
  if p.UsrPeakCoef = 0 then
    p.UsrPeakCoef := 1;
  if f = 0 then
    f := 1;
  p.Amount := 0;
  if c.CurveFitType = cfNone then begin
    p.Response := c.Response;
    if p.Response <> 0 then
      p.Amount := (p.AreaSize / p.Response) * p.UsrPeakCoef * f;
  end else begin
    if c.ResponseBase = rbHeight then
      v := p.Height
    else
      v := p.AreaSize;
    p.Amount := GetY(c, v) * p.UsrPeakCoef * f;
    { ucprtype
    if Fit(c, fi) then begin
      if c.ResponseBase = rbHeight then
        v := p.Height
      else
        v := p.AreaSize;
      p.Amount := fi.Func(v) * p.UsrPeakCoef * f;
    end; }
  end;
end;

procedure TCalData.FileAdd(const AFileName: string);
var
  f: TUCFRObj;
  fn: string;
begin
  f := TUCFRObj(ULC_UCF.Add(UCFRID));
  if ExtractFilePath(AFileName) = '' then
    fn := DefDir + AFileName
  else
    fn := AFileName;
  f.FileName := ExtractRelativePath(DefDir, fn);
end;

procedure TCalData.SetDefDir(const ADir: string);
begin
  ULC_UCF.DefDir := SysUtils.IncludeTrailingPathDelimiter(ADir);
end;

function TCalData.GetDefDir: string;
begin
  Result := ULC_UCF.DefDir;
end;

{/TCalData.}

end.
