////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Histogram 1D, 2D, 3D class.                                                //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20120601 - Creation & test Ok.                                             //
// 20230529 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_th123; // Histogram 1D,2D,3D

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$ASSERTIONS ON}

{$WARN 5023 off : Unit "$1" not used in $2}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, variants,
 _crw_alloc, _crw_str, _crw_fio, _crw_fifo, _crw_fpu, _crw_rtc;

 {
 *******************************************************************************
 Purpose:
 ********
  Histogram 1D,2D,3D class.
  Uses to fill one,two,three dimension histograms or spectrums, for example,
  in area of spectrometry,particle and nuclear physics measurements.
 Description:
  Create         - Create 1D, 2D or 3D histogram:
   1D: Create('Name','Title',Nx,Ax,Bx);                    Nx bins over X axis, (Ax <= X < Bx) range
   2D: Create('Name','Title',Nx,Ax,Bx,Ny,Ay,By);           Ny bins over Y axis, (Ay <= Y < By) range
   3D: Create('Name','Title',Nx,Ax,Bx,Ny,Ax,By,Nz,Az,Bz);  Nz bins over Z axis, (Az <= X < Bz) range
  Name           - Name of histogram.
  Title          - Title string (reserved for future).
  Dimension      - 1,2,3 for 1D,2D,3D histograms.
  ElemSize       - Element size, bytes (4=SINGLE,8=DOUBLE).
  NBins          - Total number of bins (flat array for all dimensions):
   1D: NBins=(NBinsX+2)
   2D: NBins=(NBinsX+2)*(NBinsY+2)
   3D: NBins=(NBinsX+2)*(NBinsY+2)*(NBinsZ+2)
  NBinsX         - X axis number of bins (1D,2D,3D)
  NBinsY         - Y axis number of bins (2D,3D), zero for 1D
  NBinsZ         - Z axis number of bins (3D), zero for 1D,2D
  XMin,XMax      - X axis range (1D,2D,3D)
  YMin,YMax      - Y axis range (2D,3D), zero for 1D
  ZMin,ZMax      - Z axis range (3D), zero for 1D,2D
  BinContent[i]  - Content of bin[i], with flat bin index i=0..NBins-1
   1D: BinContent[IndexToBin(ix)]       bin index = ix
   2D: BinContent[IndexToBin(ix,iy)]    bin index = ix+(NBinsX+2)*iy
   3D: BinContent[IndexToBin(ix,iy,iz)] bin index = ix+(NNinsX+2)*(iy+(NBinsY+2)*iz)
       ix=0        - X underflow,  (X < XMin)
       ix=1..NBinX - X normal bin, (Xmin+(i-1)*(XMax-XMin)/NBinsX <= X < XMin+i*(XMax-XMin)/NBinsX)
       ix=NBinsX+1 - X overflow,   (X >= XMax) or (X = NAN)
       iy, iz      - similar to ix (change X to Y or Z)
  FindBin        - Find bin index to fill by (X,Y,Z) values:
   1D: FindBin(aX)
   2D: FindBin(aX,aY)
   3D: FindBin(aX,aY,aZ)
  AxisToBin(..) - Find flat bin index corresponded to X,Y,Z axis indexes
   1D: AxisToBin(ix)       return ix,                               ix=0..NBinX+1
   2D: AxisToBin(ix,iy)    retorn ix+(NBinsX+2)*iy,                 iy=0..NBinsY+1 
   3D: AxisToBin(ix,iy,iz) return ix+(NBinsX+2)*(iy+(NBinsY+2)*iz), iz=0..NBinsZ+1
  BinToAxis(..) - Convert flat bin index to axis indexes (ix,iy,iz)
  Fill(..,n)    - Fill histogtram, i.e. increment bin by n: IncBinContent(FindBin(..),n)
   1D: Fill(aX,n)
   2D: Fill(aX,aY,n)
   3D: Fill(aX,aY,aZ,n)
  UserNotes     - Any user defined text for comments.
  TimeStamp     - For file date & time stamp.
  LinkTags[i]   - Any user data specified by user, i=0..15
  GetSPDText    - Get spectr as SPD text (1D only!).
  SaveToFileSPD - Save this text to SPD.
  CreateClone   - Create a copy of the histogram.
  CreateSlice   - Create a 1D or 2D slice of the histogram.
 Example:
 ********
  h1:=NewH123D('h1','Demo-1D',100,0,10);
  h2:=NewH123D('h2','Demo-2D',100,0,10,100,10,20);
  h3:=NewH123D('h3','Demo-3D',100,0,10,100,10,20,1024,0,100);
  while GetData(x,y,z) do begin
   h1.Fill(x);
   h2.Fill(x,y);
   h3.Fill(x,y,z);
  end;
  ...
 *******************************************************************************
 }
type
 EH123D = class(Exception);
 TH123D = class(TLatch)
 private
  myName        : LongString;
  myTitle       : LongString;
  myNameX       : LongString;
  myNameY       : LongString;
  myNameZ       : LongString;
  myNBins       : LongInt;
  myNBinsX      : LongInt;
  myNBinsY      : LongInt;
  myNBinsZ      : LongInt;
  myDimension   : LongInt;
  myElemSize    : LongInt;
  myBuffer      : Pointer;
  myXMin        : Double;
  myXMax        : Double;
  myYMin        : Double;
  myYMax        : Double;
  myZMin        : Double;
  myZMax        : Double;
  myUserNotes   : LongString;
  myTimeStamp   : Double;
  myLinkTags    : array[0..15] of Variant;
  function  GetName:LongString;
  function  GetTitle:LongString;
  function  GetNameX:LongString;
  procedure SetNameX(const aNameX:LongString);
  function  GetNameY:LongString;
  procedure SetNameY(const aNameY:LongString);
  function  GetNameZ:LongString;
  procedure SetNameZ(const aNameZ:LongString);
  function  GetNBins:LongInt;
  function  GetNBinsX:LongInt;
  function  GetNBinsY:LongInt;
  function  GetNBinsZ:LongInt;
  function  GetDimension:LongInt;
  function  GetXMin:Double;
  function  GetXMax:Double;
  function  GetYMin:Double;
  function  GetYMax:Double;
  function  GetZMin:Double;
  function  GetZMax:Double;
  function  GetElemSize:LongInt;
  function  GetUserNotes:LongString;
  procedure SetUserNotes(const aUserNotes:LongString);
  function  GetTimeStamp:Double;
  procedure SetTimeStamp(aTimeStamp:Double);
  function  GetLinkTags(aIndex:LongInt):Variant;
  procedure SetLinkTags(aIndex:LongInt; const aValue:Variant);
 protected
  function    CheckOk:Boolean; override;
 public
  constructor Create(const aName     : LongString;
                     const aTitle    : LongString;
                           aNBinsX   : LongInt;
                           aXMin     : Double;
                           aXMax     : Double;
                           aNBinsY   : LongInt = 0;
                           aYMin     : Double  = 0;
                           aYMax     : Double  = 0;
                           aNBinsZ   : LongInt = 0;
                           aZMin     : Double  = 0;
                           aZMax     : Double  = 0;
                           aElemSize : LongInt = SizeOf(Double));
  destructor  Destroy; override;
 public
  procedure Clear;
  function  FindBin(aX:Double):LongInt; overload;
  function  FindBin(aX,aY:Double):LongInt; overload;
  function  FindBin(aX,aY,aZ:Double):LongInt; overload;
  function  AxisToBin(aIx:LongInt):LongInt; overload;
  function  AxisToBin(aIx,aIy:LongInt):LongInt; overload;
  function  AxisToBin(aIx,aIy,aIz:LongInt):LongInt; overload;
  function  BinToAxis(aBin:LongInt; var aIx:LongInt):Boolean; overload;
  function  BinToAxis(aBin:LongInt; var aIx,aIy:LongInt):Boolean; overload;
  function  BinToAxis(aBin:LongInt; var aIx,aIy,aIz:LongInt):Boolean; overload;
  function  Fill(aX:Double; aInc:Double):LongInt; overload;
  function  Fill(aX,aY:Double; aInc:Double):LongInt; overload;
  function  Fill(aX,aY,aZ:Double; aInc:Double):LongInt; overload;
  function  IncBinContent(aBin:LongInt; aInc:Double=1):Double;
  procedure SetBinContent(aBin:LongInt; aContent:Double);
  function  GetBinContent(aBin:LongInt):Double;
  function  GetBinWidthX(aBin:LongInt):Double;
  function  GetBinWidthY(aBin:LongInt):Double;
  function  GetBinWidthZ(aBin:LongInt):Double;
  function  GetBinCenterX(aBin:LongInt):Double;
  function  GetBinCenterY(aBin:LongInt):Double;
  function  GetBinCenterZ(aBin:LongInt):Double;
  function  GetBinLowEdgeX(aBin:LongInt):Double;
  function  GetBinLowEdgeY(aBin:LongInt):Double;
  function  GetBinLowEdgeZ(aBin:LongInt):Double;
  function  GetSumm(aBin1:LongInt=0; aBin2:LongInt=MaxInt; aPower:LongInt=1):Double;
  function  GetEntries:Double;
  function  GetSpdText(aText:TStringList):TStringList;
  function  SaveToFileSpd(const aFileName:LongString):Boolean;
  function  SaveToFileHst(const aFileName:LongString):Boolean;
  function  CreateClone:TH123D;
  function  CreateSlice(aIx:LongInt=-1;aIy:LongInt=-1;aIz:LongInt=-1):TH123D;
 public
  property  Name                     : LongString  read GetName;
  property  Title                    : LongString  read GetTitle;
  property  NameX                    : LongString  read GetNameX write SetNameX;
  property  NameY                    : LongString  read GetNameY write SetNameY;
  property  NameZ                    : LongString  read GetNameZ write SetNameZ;
  property  Dimension                : LongInt     read GetDimension;
  property  NBins                    : LongInt     read GetNBins;
  property  BinContent[aBin:LongInt] : Double      read GetBinContent write SetBinContent; Default;
  property  NBinsX                   : LongInt     read GetNBinsX;
  property  NBinsY                   : LongInt     read GetNBinsY;
  property  NBinsZ                   : LongInt     read GetNBinsZ;
  property  XMin                     : Double      read GetXMin;
  property  XMax                     : Double      read GetXMax;
  property  YMin                     : Double      read GetYMin;
  property  YMax                     : Double      read GetYMax;
  property  ZMin                     : Double      read GetZMin;
  property  ZMax                     : Double      read GetZMax;
  property  ElemSize                 : LongInt     read GetElemSize;
  property  Entries                  : Double      read GetEntries;
  property  UserNotes                : LongString  read GetUserNotes write SetUserNotes;
  property  TimeStamp                : Double      read GetTimeStamp write SetTimeStamp;
  property  LinkTags[aIndex:LongInt] : Variant     read GetLinkTags  write SetLinkTags;
 end;

function  NewH123D(const aName     : LongString;
                   const aTitle    : LongString;
                         aNBinsX   : LongInt;
                         aXMin     : Double;
                         aXMax     : Double;
                         aNBinsY   : LongInt = 0;
                         aYMin     : Double  = 0;
                         aYMax     : Double  = 0;
                         aNBinsZ   : LongInt = 0;
                         aZMin     : Double  = 0;
                         aZMax     : Double  = 0;
                         aElemSize : LongInt = SizeOf(Double)) : TH123D;
procedure Kill(var TheObject:TH123D); overload;

type
 TStatSummXY = class(TMasterObject)
 private
  myEntries : Extended;
  mySummX   : Extended;
  mySummY   : Extended;
  mySummXX  : Extended;
  mySummXY  : Extended;
  mySummYY  : Extended;
  myMinX    : Extended;
  myMaxX    : Extended;
  myMinY    : Extended;
  myMaxY    : Extended;
 public
  constructor Create;
  destructor  Destroy; override;
 public
  function  Entries:Extended;
  function  MinX:Extended;      function  MinY:Extended;      // Minimal X & Y
  function  MaxX:Extended;      function  MaxY:Extended;      // Maximal X & Y
  function  SummX:Extended;     function  SummY:Extended;     // 1st order summ's
  function  SummXX:Extended;    function  SummYY:Extended;    // 2nd order summ's
  function  SummXY:Extended;                                  // & cross summ
  function  MeanX:Extended;     function  MeanY:Extended;     // Mean value
  function  MeanXX:Extended;    function  MeanYY:Extended;    // Mean square
  function  MeanXY:Extended;    function  CovXY:Extended;     // Covariation
  function  DispX:Extended;     function  DispY:Extended;     // Dispersions
  function  SigmaX:Extended;    function  SigmaY:Extended;    // X & Y sigma's
  function  LineC0:Extended;    function  LineC1:Extended;    // Line Y(X)=C0+C1*X
  function  LineDisp:Extended;  function  LineSigma:Extended; // Line residial dispersion & sigma
  function  LineCorr:Extended;                                // Line pair corellation -1..1
  procedure Add(aX:Double); overload;
  procedure Add(aX,aY:Double); overload;
  procedure Print(const Prefix:LongString='');
  procedure Clear;
 end;

function NewStatSummXY:TStatSummXY;
procedure Kill(var TheObject:TStatSummXY); overload;

const
 Th123UsesOwnBugReport:Boolean=false;

procedure Test_Benchmark_TH123D;

implementation

procedure BugReport(const E:Exception; const O:TObject; const Location:LongString='');
const ExeName:String[63]='';
begin
 if not Th123UsesOwnBugReport then begin
  _crw_alloc.BugReport(E,O,Location);
  Exit;
 end;
 if Length(ExeName)=0 then ExeName:=SysUtils.ExtractFileName(ParamStr(0));
 if Assigned(E) then
 if Length(Location)=0 
 then Echo(Format('@OnException=%s,%s (in %s)',[E.ClassName,E.Message,ExeName]))
 else Echo(Format('@OnException=%s,%s (in %s, %s)',[E.ClassName,E.Message,ExeName,Location]));
end;

 ////////////////////////
 // TH123D implementation
 ////////////////////////

constructor TH123D.Create(const aName     : LongString;
                          const aTitle    : LongString;
                                aNBinsX   : LongInt;
                                aXMin     : Double;
                                aXMax     : Double;
                                aNBinsY   : LongInt;
                                aYMin     : Double;
                                aYMax     : Double;
                                aNBinsZ   : LongInt;
                                aZMin     : Double;
                                aZMax     : Double;
                                aElemSize : LongInt);
var Errors:LongInt; BufSize:Int64;
const MaxBufSize = 1 shl 30; // 1GB
begin
 inherited Create;
 Errors:=0;
 myDimension:=0;
 myUserNotes:='';
 myName:=Trim(aName);
 myTitle:=Trim(aTitle);
 myElemSize:=aElemSize;
 myNBinsX:=Max(0,aNBinsX); myXMin:=aXMin; myXMax:=aXMax;
 myNBinsY:=Max(0,aNBinsY); myYMin:=aYMin; myYMax:=aYMax;
 myNBinsZ:=Max(0,aNBinsZ); myZMin:=aZMin; myZMax:=aZMax;
 if myNBinsX>0 then Inc(myDimension);
 if myNBinsY>0 then Inc(myDimension);
 if myNBinsZ>0 then Inc(myDimension);
 if not(myDimension in [1,2,3]) then Inc(Errors);
 if not(myElemSize in [SizeOf(Single),SizeOf(Double)]) then Inc(Errors);
 myNBins:=1;
 if myDimension>0 then begin
  if not(myNBinsX>0) then Inc(Errors);
  if not(myXMin<myXMax) then Inc(Errors);
  myNBins:=myNBins*(myNBinsX+2);
  myNameX:='X';
 end;
 if myDimension>1 then begin
  if not(myNBinsY>0) then Inc(Errors);
  if not(myYMin<myYMax) then Inc(Errors);
  myNBins:=myNBins*(myNBinsY+2);
  myNameY:='Y';
 end;
 if myDimension>2 then begin
  if not(myNBinsZ>0) then Inc(Errors);
  if not(myZMin<myZMax) then Inc(Errors);
  myNBins:=myNBins*(myNBinsZ+2);
  myNameZ:='Z';
 end;
 BufSize:=myNBins; BufSize:=BufSize*myElemSize;
 if(BufSize<1) or (BufSize>MaxBufSize) then Inc(Errors);
 if Errors=0 then myBuffer:=Allocate(BufSize) else myBuffer:=nil;
 if not Assigned(myBuffer) then begin
  myDimension:=0;
  myNBins:=0;
  myNBinsX:=0;
  myNBinsY:=0;
  myNBinsZ:=0;
  myNameX:='';
  myNameY:='';
  myNameZ:='';
 end;
end;

destructor TH123D.Destroy;
var i:Integer;
begin
 try
  Lock;
  try
   Finalize(myName);
   Finalize(myTitle);
   Finalize(myUserNotes);
   Deallocate(Pointer(myBuffer));
   for i:=Low(myLinkTags) to High(myLinkTags) do VarClear(myLinkTags[i]);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Destroy');
 end;
 inherited Destroy;
end;

function TH123D.CheckOk:Boolean;
begin
 Result:=Assigned(myBuffer);
end;

function TH123D.GetName:LongString;
begin
 if Assigned(Self)
 then Result:=myName
 else Result:='';
end;

function TH123D.GetTitle:LongString;
begin
 if Assigned(Self)
 then Result:=myTitle
 else Result:='';
end;

function TH123D.GetNameX:LongString;
begin
 if Assigned(Self)
 then Result:=myNameX
 else Result:='';
end;

procedure TH123D.SetNameX(const aNameX:LongString);
begin
 if Assigned(Self) then myNameX:=Trim(aNameX);
end;

function TH123D.GetNameY:LongString;
begin
 if Assigned(Self)
 then Result:=myNameY
 else Result:='';
end;

procedure TH123D.SetNameY(const aNameY:LongString);
begin
 if Assigned(Self) then myNameY:=Trim(aNameY);
end;

function TH123D.GetNameZ:LongString;
begin
 if Assigned(Self)
 then Result:=myNameZ
 else Result:='';
end;

procedure TH123D.SetNameZ(const aNameZ:LongString);
begin
 if Assigned(Self) then myNameZ:=Trim(aNameZ);
end;

function TH123D.GetUserNotes:LongString;
begin
 if Assigned(Self)
 then Result:=myUserNotes
 else Result:='';
end;

procedure TH123D.SetUserNotes(const aUserNotes:LongString);
begin
 if Assigned(Self) then myUserNotes:=aUserNotes;
end;

function TH123D.GetDimension:LongInt;
begin
 if Assigned(Self)
 then Result:=myDimension
 else Result:=0;
end;

function TH123D.GetNBins:LongInt;
begin
 if Assigned(Self)
 then Result:=myNBins
 else Result:=0;
end;

function TH123D.GetNBinsX:LongInt;
begin
 if Assigned(Self)
 then Result:=myNBinsX
 else Result:=0;
end;

function TH123D.GetNBinsY:LongInt;
begin
 if Assigned(Self)
 then Result:=myNBinsY
 else Result:=0;
end;

function TH123D.GetNBinsZ:LongInt;
begin
 if Assigned(Self)
 then Result:=myNBinsZ
 else Result:=0;
end;

function TH123D.GetXMin:Double;
begin
 if Assigned(Self)
 then Result:=myXMin
 else Result:=0;
end;

function TH123D.GetXMax:Double;
begin
 if Assigned(Self)
 then Result:=myXMax
 else Result:=0;
end;

function TH123D.GetYMin:Double;
begin
 if Assigned(Self)
 then Result:=myYMin
 else Result:=0;
end;

function TH123D.GetYMax:Double;
begin
 if Assigned(Self)
 then Result:=myYMax
 else Result:=0;
end;

function TH123D.GetZMin:Double;
begin
 if Assigned(Self)
 then Result:=myZMin
 else Result:=0;
end;

function TH123D.GetZMax:Double;
begin
 if Assigned(Self)
 then Result:=myZMax
 else Result:=0;
end;

function TH123D.GetElemSize:LongInt;
begin
 if Assigned(Self)
 then Result:=myElemSize
 else Result:=0;
end;

function TH123D.GetTimeStamp:Double;
begin
 if Assigned(Self)
 then Result:=myTimeStamp
 else Result:=0;
end;

procedure TH123D.SetTimeStamp(aTimeStamp:Double);
begin
 if Assigned(Self) then myTimeStamp:=aTimeStamp;
end;

function TH123D.GetLinkTags(aIndex:LongInt):Variant;
begin
 if Assigned(Self) and (aIndex>=Low(myLinkTags)) and (aIndex<=High(myLinkTags))
 then Result:=myLinkTags[aIndex]
 else Result:=Unassigned;
end;

procedure TH123D.SetLinkTags(aIndex:LongInt; const aValue:Variant);
begin
 if Assigned(Self) and (aIndex>=Low(myLinkTags)) and (aIndex<=High(myLinkTags))
 then myLinkTags[aIndex]:=aValue;
end;

procedure TH123D.Clear;
begin
 if Assigned(Self) then
 if Assigned(myBuffer) then
 try
  Lock;
  try
   ZeroMemory(myBuffer,AllocSize(myBuffer));
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Clear');
 end;
end;

function TH123D.FindBin(aX:Double):LongInt;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=1 then begin
  if aX<myXMin then {Inc(Result,0)} else
  if not(aX<myXMax) then Inc(Result,myNBinsX+1) else
  Inc(Result,1+Trunc(myNBinsX*(aX-myXMin)/(myXMax-myXMin)));
  Assert((Result>=0) and (Result<myNBins),'TH123D.FindBin1D');
 end;
end;

function TH123D.FindBin(aX,aY:Double):LongInt;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=2 then begin
  if aY<myYMin then {Inc(Result,0)} else
  if not(aY<myYMax) then Inc(Result,myNBinsY+1) else
  Inc(Result,1+Trunc(myNBinsY*(aY-myYMin)/(myYMax-myYMin)));
  Result:=Result*(myNBinsX+2);
  if aX<myXMin then {Inc(Result,0)} else
  if not(aX<myXMax) then Inc(Result,myNBinsX+1) else
  Inc(Result,1+Trunc(myNBinsX*(aX-myXMin)/(myXMax-myXMin)));
  Assert((Result>=0) and (Result<myNBins),'TH123D.FindBin2D');
 end;
end;

function TH123D.FindBin(aX,aY,aZ:Double):LongInt;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=3 then begin
  if aZ<myZMin then {Inc(Result,0)} else
  if not(aZ<myZMax) then Inc(Result,myNBinsZ+1) else
  Inc(Result,1+Trunc(myNBinsZ*(aZ-myZMin)/(myZMax-myZMin)));
  Result:=Result*(myNBinsY+2);
  if aY<myYMin then {Inc(Result,0)} else
  if not(aY<myYMax) then Inc(Result,myNBinsY+1) else
  Inc(Result,1+Trunc(myNBinsY*(aY-myYMin)/(myYMax-myYMin)));
  Result:=Result*(myNBinsX+2);
  if aX<myXMin then {Inc(Result,0)} else
  if not(aX<myXMax) then Inc(Result,myNBinsX+1) else
  Inc(Result,1+Trunc(myNBinsX*(aX-myXMin)/(myXMax-myXMin)));
  Assert((Result>=0) and (Result<myNBins),'TH123D.FindBin3D');
 end;
end;

function TH123D.AxisToBin(aIx:LongInt):LongInt;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=1 then begin
  if aIx<1 then {Inc(Result,0)} else
  if aIx>myNBinsX then Inc(Result,myNBinsX+1) else
  Inc(Result,aIx);
  Assert((Result>=0) and (Result<myNBins),'TH123D.AxisToBin1D');
 end;
end;

function TH123D.AxisToBin(aIx,aIy:LongInt):LongInt;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=2 then begin
  if aIy<1 then {Inc(Result,0)} else
  if aIy>myNBinsY then Inc(Result,myNBinsY+1) else
  Inc(Result,aIy);
  Result:=Result*(myNBinsX+2);
  if aIx<1 then {Inc(Result,0)} else
  if aIx>myNBinsX then Inc(Result,myNBinsX+1) else
  Inc(Result,aIx);
  Assert((Result>=0) and (Result<myNBins),'TH123D.AxisToBin2D');
 end;
end;

function TH123D.AxisToBin(aIx,aIy,aIz:LongInt):LongInt;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=3 then begin
  if aIz<1 then {Inc(Result,0)} else
  if aIz>myNBinsZ then Inc(Result,myNBinsZ+1) else
  Inc(Result,aIz);
  Result:=Result*(myNBinsY+2);
  if aIy<1 then {Inc(Result,0)} else
  if aIy>myNBinsY then Inc(Result,myNBinsY+1) else
  Inc(Result,aIy);
  Result:=Result*(myNBinsX+2);
  if aIx<1 then {Inc(Result,0)} else
  if aIx>myNBinsX then Inc(Result,myNBinsX+1) else
  Inc(Result,aIx);
  Assert((Result>=0) and (Result<myNBins),'TH123D.FindBin3D');
 end;
end;

function DivMod(Divident,Divisor:LongInt; var Reminder:LongInt):LongInt;
begin
 Result:=Divident div Divisor;
 Reminder:=Divident mod Divisor;
end;

function TH123D.BinToAxis(aBin:LongInt; var aIx:LongInt):Boolean;
begin
 aIx:=0;
 Result:=False;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=1 then begin
  Result:=(aBin>=0) and (aBin<myNBins);
  if Result then DivMod(aBin,myNBinsX+2,aIx);
  Assert((aIx>=0) and (aIx<=myNBinsX+1),'TH123D.BinToAxis1D');
 end;
end;

function TH123D.BinToAxis(aBin:LongInt; var aIx,aIy:LongInt):Boolean;
begin
 aIx:=0;
 aIy:=0;
 Result:=False;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=2 then begin
  Result:=(aBin>=0) and (aBin<myNBins);
  if Result then DivMod(DivMod(aBin,myNBinsX+2,aIx),myNBinsY+2,aIy);
  Assert((aIx>=0) and (aIx<=myNBinsX+1),'TH123D.BinToAxis2D');
  Assert((aIy>=0) and (aIy<=myNBinsY+1),'TH123D.BinToAxis2D');
 end;
end;

function TH123D.BinToAxis(aBin:LongInt; var aIx,aIy,aIz:LongInt):Boolean;
begin
 aIx:=0;
 aIy:=0;
 aIz:=0;
 Result:=False;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if myDimension=3 then begin
  Result:=(aBin>=0) and (aBin<myNBins);
  if Result then DivMod(DivMod(DivMod(aBin,myNBinsX+2,aIx),myNBinsY+2,aIy),myNBinsZ+2,aIz);
  Assert((aIx>=0) and (aIx<=myNBinsX+1),'TH123D.BinToAxis3D');
  Assert((aIy>=0) and (aIy<=myNBinsY+1),'TH123D.BinToAxis3D');
  Assert((aIz>=0) and (aIz<=myNBinsZ+1),'TH123D.BinToAxis3D');
 end;
end;

function TH123D.Fill(aX:Double; aInc:Double):LongInt;
begin
 Result:=FindBin(aX);
 IncBinContent(Result,aInc);
end;

function TH123D.Fill(aX,aY:Double; aInc:Double):LongInt;
begin
 Result:=FindBin(aX,aY);
 IncBinContent(Result,aInc);
end;

function TH123D.Fill(aX,aY,aZ:Double; aInc:Double):LongInt;
begin
 Result:=FindBin(aX,aY,aZ);
 IncBinContent(Result,aInc);
end;

function TH123D.IncBinContent(aBin:LongInt; aInc:Double):Double;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if (aBin>=0) and (aBin<myNBins) then
 try
  Lock;
  try
   case myElemSize of
    SizeOf(Single): begin
                     PSingleArray(myBuffer)[aBin]:=PSingleArray(myBuffer)[aBin]+aInc;
                     Result:=PSingleArray(myBuffer)[aBin];
                    end;
    SizeOf(Double): begin
                     PDoubleArray(myBuffer)[aBin]:=PDoubleArray(myBuffer)[aBin]+aInc;
                     Result:=PDoubleArray(myBuffer)[aBin];
                    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'IncBinContent');
 end;
end;

procedure TH123D.SetBinContent(aBin:LongInt; aContent:Double);
begin
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if (aBin>=0) and (aBin<myNBins) then
 try
  Lock;
  try
   case myElemSize of
    SizeOf(Single): PSingleArray(myBuffer)[aBin]:=aContent;
    SizeOf(Double): PDoubleArray(myBuffer)[aBin]:=aContent;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetBinContent');
 end;
end;

function TH123D.GetBinContent(aBin:LongInt):Double;
begin
 Result:=0;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if (aBin>=0) and (aBin<myNBins) then
 try
  Lock;
  try
   case myElemSize of
    SizeOf(Single): Result:=PSingleArray(myBuffer)[aBin];
    SizeOf(Double): Result:=PDoubleArray(myBuffer)[aBin];
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetBinContent');
 end;
end;

function TH123D.GetBinWidthX(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>0)
 then Result:=(myXMax-myXMin)/myNBinsX
 else Result:=0;
end;

function TH123D.GetBinWidthY(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>1)
 then Result:=(myYMax-myYMin)/myNBinsY
 else Result:=0;
end;

function TH123D.GetBinWidthZ(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>2)
 then Result:=(myZMax-myZMin)/myNBinsZ
 else Result:=0;
end;

function TH123D.GetBinCenterX(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>0)
 then Result:=myXMin+(aBin-0.5)*((myXMax-myXMin)/myNBinsX)
 else Result:=0;
end;

function TH123D.GetBinCenterY(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>1)
 then Result:=myYMin+(aBin-0.5)*((myYMax-myYMin)/myNBinsY)
 else Result:=0;
end;

function TH123D.GetBinCenterZ(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>2)
 then Result:=myZMin+(aBin-0.5)*((myZMax-myZMin)/myNBinsZ)
 else Result:=0;
end;

function TH123D.GetBinLowEdgeX(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>0)
 then Result:=myXMin+(aBin-1)*((myXMax-myXMin)/myNBinsX)
 else Result:=0;
end;

function TH123D.GetBinLowEdgeY(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>1)
 then Result:=myYMin+(aBin-1)*((myYMax-myYMin)/myNBinsY)
 else Result:=0;
end;

function TH123D.GetBinLowEdgeZ(aBin:LongInt):Double;
begin
 if Assigned(Self) and (myDimension>2)
 then Result:=myZMin+(aBin-1)*((myZMax-myZMin)/myNBinsZ)
 else Result:=0;
end;

function TH123D.GetSumm(aBin1:LongInt=0; aBin2:LongInt=MaxInt; aPower:LongInt=1):Double;
var aBin:LongInt; Item:Double;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   for aBin:=Max(0,aBin1) to Min(myNBins-1,aBin2) do begin
    case myElemSize of
     SizeOf(Single): Item:=PSingleArray(myBuffer)[aBin];
     SizeOf(Double): Item:=PDoubleArray(myBuffer)[aBin];
     else Item:=0;
    end;
    case aPower of
     0:Result:=Result+1;
     1:Result:=Result+Item;
     2:Result:=Result+Item*Item;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetSumm');
 end;
end;

function TH123D.GetEntries:Double;
begin
 Result:=GetSumm(0,MaxInt,1);
end;


function TH123D.CreateClone:TH123D;
var i:LongInt;
begin
 Result:=Nil;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 try
  Lock;
  try
   Result:=NewH123D(Name,Title,NBinsX,XMin,XMax,NBinsY,YMin,YMax,NBinsZ,ZMin,ZMax,ElemSize);
   for i:=0 to NBins-1 do Result.SetBinContent(i,GetBinContent(i));
   Result.UserNotes:=UserNotes;
   Result.TimeStamp:=TimeStamp;
   Result.NameX:=NameX;
   Result.NameY:=NameY;
   Result.NameZ:=NameZ;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Clone');
 end;
end;

{$PUSH}
{$WARNINGS OFF}
function TH123D.CreateSlice(aIx:LongInt=-1;aIy:LongInt=-1;aIz:LongInt=-1):TH123D;
var map,sbin,rbin:LongInt;
begin
 Result:=Nil;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 try
  Lock;
  try
   map:=0;
   if (aIx>=0) and (aIx<=NBinsX+1) then Inc(map,1);
   if (aIy>=0) and (aIy<=NBinsY+1) then Inc(map,2);
   if (aIz>=0) and (aIz<=NBinsZ+1) then Inc(map,4);
   // 1D
   if Dimension=1 then begin
    if map=0 then Result:=CreateClone;
   end;
   // 2D
   if Dimension=2 then begin
    if map=0 then Result:=CreateClone;
    // Fixed aIx
    if map=1 then begin
     Result:=NewH123D(Name,Title,NBinsY,YMin,YMax);
     for aIy:=0 to NBinsY+1 do begin
      sbin:=AxisToBin(aIx,aIy);
      rbin:=Result.AxisToBin(aIy);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(aIx,1);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=X,%d,%g,%g',
       [aIx,GetBinLowEdgeX(sbin),GetBinLowEdgeX(sbin)+GetBinWidthX(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameY;
    end;
    // Fixed aIy
    if map=2 then begin
     Result:=NewH123D(Name,Title,NBinsX,XMin,XMax);
     for aIx:=0 to NBinsX+1 do begin
      sbin:=AxisToBin(aIx,aIy);
      rbin:=Result.AxisToBin(aIx);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(1,aIy);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=Y,%d,%g,%g',
       [aIy,GetBinLowEdgeY(sbin),GetBinLowEdgeY(sbin)+GetBinWidthY(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameX;
    end;
   end;
   // 3D
   if Dimension=3 then begin
    if map=0 then Result:=CreateClone;
    // Fixed aIx
    if map=1 then begin
     Result:=NewH123D(Name,Title,NBinsY,YMin,YMax,NBinsZ,ZMin,ZMax);
     for aIy:=0 to NBinsY+1 do
     for aIz:=0 to NBinsZ+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIy,aIz);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(aIx,1,1);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=X,%d,%g,%g',
       [aIx,GetBinLowEdgeX(sbin),GetBinLowEdgeX(sbin)+GetBinWidthX(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameY;
     Result.NameY:=NameZ;
    end;
    // Fixed aIy
    if map=2 then begin
     Result:=NewH123D(Name,Title,NBinsX,XMin,XMax,NBinsZ,ZMin,ZMax);
     for aIx:=0 to NBinsX+1 do
     for aIz:=0 to NBinsZ+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIx,aIz);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(1,aIy,1);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=Y,%d,%g,%g',
       [aIy,GetBinLowEdgeY(sbin),GetBinLowEdgeY(sbin)+GetBinWidthY(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameX;
     Result.NameY:=NameZ;
    end;
    // Fixed aIz
    if map=4 then begin
     Result:=NewH123D(Name,Title,NBinsX,XMin,XMax,NBinsY,YMin,YMax);
     for aIx:=0 to NBinsX+1 do
     for aIy:=0 to NBinsY+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIx,aIy);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(1,1,aIz);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=Z,%d,%g,%g',
       [aIz,GetBinLowEdgeZ(sbin),GetBinLowEdgeZ(sbin)+GetBinWidthZ(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameX;
     Result.NameY:=NameY;
    end;
    // Fixed aIx,aIy
    if map=3 then begin
     Result:=NewH123D(Name,Title,NBinsZ,ZMin,ZMax);
     for aIz:=0 to NBinsZ+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIz);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(aIx,aIy,1);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=XY,%d,%g,%g,%d,%g,%g',
       [aIx,GetBinLowEdgeX(sbin),GetBinLowEdgeX(sbin)+GetBinWidthX(sbin),
        aIy,GetBinLowEdgeY(sbin),GetBinLowEdgeY(sbin)+GetBinWidthY(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameZ;
    end;
    // Fixed aIx,aIz
    if map=5 then begin
     Result:=NewH123D(Name,Title,NBinsY,YMin,YMax);
     for aIy:=0 to NBinsY+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIy);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(aIx,1,aIz);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=XZ,%d,%g,%g,%d,%g,%g',
       [aIx,GetBinLowEdgeX(sbin),GetBinLowEdgeX(sbin)+GetBinWidthX(sbin),
        aIz,GetBinLowEdgeZ(sbin),GetBinLowEdgeZ(sbin)+GetBinWidthZ(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameY;
    end;
    // Fixed aIy,aIz
    if map=6 then begin
     Result:=NewH123D(Name,Title,NBinsX,XMin,XMax);
     for aIx:=0 to NBinsX+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIx);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(1,aIy,aIz);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=YZ,%d,%g,%g,%d,%g,%g',
       [aIy,GetBinLowEdgeY(sbin),GetBinLowEdgeY(sbin)+GetBinWidthY(sbin),
        aIz,GetBinLowEdgeZ(sbin),GetBinLowEdgeZ(sbin)+GetBinWidthZ(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameX;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'CreateSlice');
 end;
end;
{$WARNINGS ON}
{$POP}

(*
function TH123D.CreateSlice2(aIax:LongInt=1;aIbx:LongInt=0;
                             aIay:LongInt=1;aIby:LongInt=0;
                             aIaz:LongInt=1;aIbz:LongInt=0):TH123D;
var map,sbin,rbin:LongInt; sum:Double;
begin
 Result:=nil;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 try
  Lock;
  try
   map:=0;
   aIax:=Max(0,aIax); aIbx:=Min(NBinsX+1,aIbx); if (aIbx>=aIax) then Inc(map,1);
   aIay:=Max(0,aIay); aIby:=Min(NBinsY+1,aIby); if (aIby>=aIay) then Inc(map,2);
   aIaz:=Max(0,aIaz); aIbz:=Min(NBinsZ+1,aIbz); if (aIbz>=aIaz) then Inc(map,4);
   // 1D
   if Dimension=1 then begin
    if map=0 then Result:=CreateClone;
   end;
   // 2D
   if Dimension=2 then begin
    if map=0 then Result:=CreateClone;
    if map=1 then begin // Fixed aIx
     Result:=NewH123D(Name,Title,NBinsY,YMin,YMax);
     for aIy:=0 to NBinsY+1 do begin
      sbin:=AxisToBin(aIx,aIy);
      rbin:=Result.AxisToBin(aIy);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(aIx,1);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=X,%d,%g,%g',
       [aIx,GetBinLowEdgeX(sbin),GetBinLowEdgeX(sbin)+GetBinWidthX(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameY;
    end;
    if map=2 then begin // Fixed aIy
     Result:=NewH123D(Name,Title,NBinsX,XMin,XMax);
     for aIx:=0 to NBinsX+1 do begin
      sbin:=AxisToBin(aIx,aIy);
      rbin:=Result.AxisToBin(aIx);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(1,aIy);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=Y,%d,%g,%g',
       [aIy,GetBinLowEdgeY(sbin),GetBinLowEdgeY(sbin)+GetBinWidthY(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameX;
    end;
   end;
   // 3D
   if Dimension=3 then begin
    if map=0 then Result:=CreateClone;
    if map=1 then begin // Fixed aIx
     Result:=NewH123D(Name,Title,NBinsY,YMin,YMax,NBinsZ,ZMin,ZMax);
     for aIy:=0 to NBinsY+1 do
     for aIz:=0 to NBinsZ+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIy,aIz);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(aIx,1,1);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=X,%d,%g,%g',
       [aIx,GetBinLowEdgeX(sbin),GetBinLowEdgeX(sbin)+GetBinWidthX(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameY;
     Result.NameY:=NameZ;
    end;
    if map=2 then begin // Fixed aIy
     Result:=NewH123D(Name,Title,NBinsX,XMin,XMax,NBinsZ,ZMin,ZMax);
     for aIx:=0 to NBinsX+1 do
     for aIz:=0 to NBinsZ+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIx,aIz);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(1,aIy,1);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=Y,%d,%g,%g',
       [aIy,GetBinLowEdgeY(sbin),GetBinLowEdgeY(sbin)+GetBinWidthY(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameX;
     Result.NameY:=NameZ;
    end;
    if map=4 then begin // Fixed aIz
     Result:=NewH123D(Name,Title,NBinsX,XMin,XMax,NBinsY,YMin,YMax);
     for aIx:=0 to NBinsX+1 do
     for aIy:=0 to NBinsY+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIx,aIy);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(1,1,aIz);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=Z,%d,%g,%g',
       [aIz,GetBinLowEdgeZ(sbin),GetBinLowEdgeZ(sbin)+GetBinWidthZ(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameX;
     Result.NameY:=NameY;
    end;
    if map=3 then begin // Fixed aIx,aIy
     Result:=NewH123D(Name,Title,NBinsZ,ZMin,ZMax);
     for aIz:=0 to NBinsZ+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIz);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(aIx,aIy,1);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=XY,%d,%g,%g, %d, %g, %g',
       [aIx,GetBinLowEdgeX(sbin),GetBinLowEdgeX(sbin)+GetBinWidthX(sbin),
        aIy,GetBinLowEdgeY(sbin),GetBinLowEdgeY(sbin)+GetBinWidthY(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameZ;
    end;
    if map=5 then begin // Fixed aIx,aIz
     Result:=NewH123D(Name,Title,NBinsY,YMin,YMax);
     for aIy:=0 to NBinsY+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIy);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(aIx,1,aIz);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=XZ,%d,%g,%g, %d, %g, %g',
       [aIx,GetBinLowEdgeX(sbin),GetBinLowEdgeX(sbin)+GetBinWidthX(sbin),
        aIz,GetBinLowEdgeZ(sbin),GetBinLowEdgeZ(sbin)+GetBinWidthZ(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameY;
    end;
    if map=6 then begin // Fixed aIy,aIz
     Result:=NewH123D(Name,Title,NBinsX,XMin,XMax);
     for aIx:=0 to NBinsX+1 do begin
      sbin:=AxisToBin(aIx,aIy,aIz);
      rbin:=Result.AxisToBin(aIx);
      Result.SetBinContent(rbin,GetBinContent(sbin));
     end;
     sbin:=AxisToBin(1,aIy,aIz);
     Result.UserNotes:=Trim(UserNotes)+EOL+
      Format('ExtractedSlice=YZ,%d,%g,%g, %d, %g, %g',
       [aIy,GetBinLowEdgeY(sbin),GetBinLowEdgeY(sbin)+GetBinWidthY(sbin),
        aIz,GetBinLowEdgeZ(sbin),GetBinLowEdgeZ(sbin)+GetBinWidthZ(sbin)]);
     Result.TimeStamp:=TimeStamp;
     Result.NameX:=NameX;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'CreateSlice');
 end;
end;
*)

function TH123D.GetSpdText(aText:TStringList):TStringList;
var i:LongInt; aNote:TStringList; con:Double;
begin
 Result:=aText;
 if Assigned(Self) then
 if (myDimension=1) then
 if Assigned(Result) then
 if Assigned(myBuffer) then
 try
  aNote:=TStringList.Create;
  Lock;
  try
   aText.Add(Format('[%s-%s calibration]',['Chan',NameX]));
   aText.Add(Format('FitMethod = %s',['Polynom']));
   aText.Add(Format('TransformX = %s',['Line']));
   aText.Add(Format('TransformY = %s',['Line']));
   aText.Add(Format('Center = %d',[0]));
   aText.Add(Format('Power = %d',[1]));
   aText.Add(Format('Scale = %d',[1]));
   aText.Add(Format('Bounds = %d %d',[0,NBinsX]));
   aText.Add(Format('Data %10s %10s %10s',['Chan',NameX,'Weight']));
   aText.Add(Format('     %10d %10g %10d',[1,XMin,1]));
   aText.Add(Format('     %10d %10g %10d',[NBinsX+1,XMax,1]));
   aText.Add(Format('End Data',[]));
   aText.Add(Format('Notice Text',[]));
   aText.Add(Format('TimeStamp=%g',[TimeStamp]));
   aText.Add(Format('End Notice Text',[]));
   if Length(UserNotes)>0 then begin
    aNote.Text:=UserNotes;
    Result.Add('[SpectrNote]');
    Result.AddStrings(aNote);
   end;
   Result.Add('[SpectrData]');
   for i:=0 to NBinsX+1 do begin
    con:=GetBinContent(AxisToBin(i));
    if con<>0 then Result.Add(Format('%d %g',[i,con]));
   end;
  finally
   Unlock;
   Kill(aNote);
  end;
 except
  on E:Exception do BugReport(E,Self,'AddBinContent');
 end;
end;

function TH123D.SaveToFileSpd(const aFileName:LongString):Boolean;
var aText:TStringList;
begin
 Result:=False;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if Length(Trim(aFileName))>0 then
 try
  aText:=nil;
  try
   aText:=GetSpdText(TStringList.Create);
   aText.SaveToFile(ExpandFileName(Trim(aFileName)));
   Result:=True;
  finally
   Kill(aText);
  end;
 except
  on E:Exception do BugReport(E,Self,'AddBinContent');
 end;
end;

function TH123D.SaveToFileHst(const aFileName:LongString):Boolean;
var FText:Text; FBuff:Pointer; i:Integer;
const FBuffSize=1024*1024*16;
begin
 Result:=False;
 if Assigned(Self) then
 if Assigned(myBuffer) then
 if Length(Trim(aFileName))>0 then
 try
  FBuff:=nil;
  System.Assign(FText,Trim(aFileName));
  try
   FBuff:=Allocate(FBuffSize);
   System.SetTextBuf(FText,FBuff^,FBuffSize);
   System.Rewrite(FText);
   Writeln(FText,'[',ClassName,']');
   Writeln(FText,'Name=',Name);
   Writeln(FText,'Title=',Title);
   Writeln(FText,Format('TimeStamp=%g',[TimeStamp]));
   Writeln(FText,Format('Dimension=%d',[Dimension]));
   Writeln(FText,Format('NBins=%d',[NBins]));
   if Dimension>0 then begin
    Writeln(FText,Format('NBinsX=%d',[NBinsX]));
    Writeln(FText,Format('XMin=%g',[XMin]));
    Writeln(FText,Format('XMax=%g',[XMax]));
   end;
   if Dimension>1 then begin
    Writeln(FText,Format('NBinsY=%d',[NBinsY]));
    Writeln(FText,Format('YMin=%g',[YMin]));
    Writeln(FText,Format('YMax=%g',[YMax]));
   end;
   if Dimension>2 then begin
    Writeln(FText,Format('NBinsZ=%d',[NBinsZ]));
    Writeln(FText,Format('ZMin=%g',[ZMin]));
    Writeln(FText,Format('ZMax=%g',[ZMax]));
   end;
   Writeln(FText,'[BinsContent]');
   for i:=0 to NBins-1 do if GetBinContent(i)>0 then Writeln(FText,Format('%d %g',[i,GetBinContent(i)]));
   Writeln(FText,'[UserNotes]',EOL,UserNotes);
   Result:=True;
  finally
   System.Close(FText);
   Deallocate(FBuff);
  end;
 except
  on E:Exception do BugReport(E,Self,'AddBinContent');
 end;
end;

function  NewH123D(const aName     : LongString;
                   const aTitle    : LongString;
                         aNBinsX   : LongInt;
                         aXMin     : Double;
                         aXMax     : Double;
                         aNBinsY   : LongInt;
                         aYMin     : Double;
                         aYMax     : Double;
                         aNBinsZ   : LongInt;
                         aZMin     : Double;
                         aZMax     : Double;
                         aElemSize : LongInt) : TH123D;
begin
 Result:=nil;
 try
  Result:=TH123D.Create(aName,aTitle,aNBinsX,aXMin,aXMax,aNBinsY,aYMin,aYMax,aNBinsZ,aZMin,aZMax,aElemSize);
  if not Result.Ok then EH123D.Create(Format('Could no create histogram %s',[aName]));
 except
  on E:Exception do BugReport(E,nil,'NewTH123D');
 end;
end;

procedure Kill(var TheObject:TH123D); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 ///////////////////////////////
 // TStatSummator implementation
 ///////////////////////////////
constructor TStatSummXY.Create;
begin
 inherited Create;
 Clear;
end;

destructor TStatSummXY.Destroy;
begin
 inherited Destroy;
end;

function TStatSummXY.Entries:Extended;
begin
 if Assigned(Self)
 then Result:=myEntries
 else Result:=0;
end;

function TStatSummXY.MinX:Extended;
begin
 if Assigned(Self)
 then Result:=myMinX
 else Result:=0;
end;

function TStatSummXY.MinY:Extended;
begin
 if Assigned(Self)
 then Result:=myMinY
 else Result:=0;
end;

function TStatSummXY.MaxX:Extended;
begin
 if Assigned(Self)
 then Result:=myMaxX
 else Result:=0;
end;

function TStatSummXY.MaxY:Extended;
begin
 if Assigned(Self)
 then Result:=myMaxY
 else Result:=0;
end;

function TStatSummXY.SummX:Extended;
begin
 if Assigned(Self)
 then Result:=mySummX
 else Result:=0;
end;

function TStatSummXY.SummY:Extended;
begin
 if Assigned(Self)
 then Result:=mySummY
 else Result:=0;
end;

function TStatSummXY.SummXX:Extended;
begin
 if Assigned(Self)
 then Result:=mySummXX
 else Result:=0;
end;

function TStatSummXY.SummYY:Extended;
begin
 if Assigned(Self)
 then Result:=mySummYY
 else Result:=0;
end;

function TStatSummXY.SummXY:Extended;
begin
 if Assigned(Self)
 then Result:=mySummXY
 else Result:=0;
end;

function TStatSummXY.MeanX:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=mySummX/myEntries
 else Result:=0;
end;

function TStatSummXY.MeanY:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=mySummY/myEntries
 else Result:=0;
end;

function TStatSummXY.MeanXX:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=mySummXX/myEntries
 else Result:=0;
end;

function TStatSummXY.MeanYY:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=mySummYY/myEntries
 else Result:=0;
end;

function TStatSummXY.MeanXY:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=mySummXY/myEntries
 else Result:=0;
end;

function TStatSummXY.CovXY:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=MeanXY-MeanX*MeanY
 else Result:=0;
end;

function TStatSummXY.DispX:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=MeanXX-Sqr(MeanX)
 else Result:=0;
end;

function TStatSummXY.DispY:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=MeanYY-Sqr(MeanY)
 else Result:=0;
end;

function TStatSummXY.SigmaX:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=Sqrt(DispX)
 else Result:=0;
end;

function TStatSummXY.SigmaY:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=Sqrt(DispY)
 else Result:=0;
end;

function TStatSummXY.LineC0:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=MeanY-LineC1*MeanX
 else Result:=0;
end;

function TStatSummXY.LineC1:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=CovXY/DispX
 else Result:=0;
end;

function TStatSummXY.LineDisp:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=MeanYY-(LineC1*MeanXY+LineC0*MeanY)
 else Result:=0;
end;

function TStatSummXY.LineSigma:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=Sqrt(LineDisp)
 else Result:=0;
end;

function TStatSummXY.LineCorr:Extended;
begin
 if Assigned(Self) and (myEntries>0)
 then Result:=CovXY/(SigmaX*SigmaY)
 else Result:=0;
end;

procedure TStatSummXY.Add(aX:Double);
begin
 if Assigned(Self) then
 if not IsInf(aX) then
 if not IsNan(aX) then begin
  if myEntries=0 then begin
   myMinX:=aX;
   myMaxX:=aX;
  end else begin
   if myMinX>aX then myMinX:=aX;
   if myMaxX<aX then myMaxX:=aX;
  end;
  myEntries:=myEntries+1;
  mySummX:=mySummX+aX;
  mySummXX:=mySummXX+aX*aX;
 end;
end;

procedure TStatSummXY.Add(aX,aY:Double);
begin
 if Assigned(Self) then
 if not IsInf(aX) then
 if not IsInf(aY) then
 if not IsNan(aX) then
 if not IsNan(aY) then begin
  if myEntries=0 then begin
   myMinX:=aX; myMaxX:=aX;
   myMinY:=aY; myMaxY:=aY;
  end else begin
   if myMinX>aX then myMinX:=aX; if myMaxX<aX then myMaxX:=aX;
   if myMinY>aY then myMinY:=aY; if myMaxY<aY then myMaxY:=aY;
  end;
  myEntries:=myEntries+1;
  mySummX:=mySummX+aX;
  mySummY:=mySummY+aY;
  mySummXX:=mySummXX+aX*aX;
  mySummYY:=mySummYY+aY*aY;
  mySummXY:=mySummXY+aX*aY;
 end;
end;

procedure TStatSummXY.Clear;
begin
 if Assigned(Self) then begin
  myEntries:=0;
  myMinX:=0;
  myMaxX:=0;
  myMinY:=0;
  myMaxY:=0;
  mySummX:=0;
  mySummY:=0;
  mySummXX:=0;
  mySummYY:=0;
  mySummXY:=0;
 end;
end;

procedure TStatSummXY.Print(const Prefix:LongString);
begin
 if Assigned(Self) then begin
  Echo(Format('%sEntries:    %g',[Prefix,Entries]));
  Echo(Format('%sMin X,Y     %20g, %20g',[Prefix,MinX,MinY]));
  Echo(Format('%sMax X,Y     %20g, %20g',[Prefix,MaxX,MaxY]));
  Echo(Format('%sSumm X,Y:   %20g, %20g',[Prefix,SummX,SummY]));
  Echo(Format('%sSumm XX,YY: %20g, %20g, %20g',[Prefix,SummXX,SummYY,SummXY]));
  Echo(Format('%sMean X,Y:   %20g, %20g',[Prefix,MeanX,MeanY]));
  Echo(Format('%sSigma X,Y:  %20g, %20g',[Prefix,SigmaX,SigmaY]));
  Echo(Format('%sMean XX,YY: %20g, %20g, %20g',[Prefix,MeanXX,MeanYY,MeanXY]));
  Echo(Format('%sDisp X,Y:   %20g, %20g, %20g',[Prefix,DispX,DispY,CovXY]));
  Echo(Format('%sLine A,B,R: %20g, %20g, %20g',[Prefix,LineC0,LineC1,LineCorr]));
  Echo(Format('%sDisp,Sigma: %20g, %20g',[Prefix,LineDisp,LineSigma]));
 end;
end;

function NewStatSummXY:TStatSummXY;
begin
 Result:=TStatSummXY.Create;
end;

procedure Kill(var TheObject:TStatSummXY); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;
 
 /////////////////////////
 // Testing and benchmarks
 /////////////////////////
procedure Test_Benchmark_TH123D;
var Summ:TStatSummXY; errors,i,ix,iy,iz,l,m,N:Integer; h:TH123D;
begin
 h:=nil;
 Summ:=nil;
 try
  try
   Echo('TStatSummXY test:');
   Summ:=NewStatSummXY;
   ix:=0; iy:=0; iz:=0;
   N:=1000; Echo('1)Gauss,X,Y, no corellation');
   for i:=0 to N-1 do Summ.Add(RandG(0,1),RandG(0,1));
   Summ.Print('  ');Summ.Clear;
   N:=1000; Echo('2)Gauss,X=20+1.5*Y, no corellation');
   for i:=0 to N-1 do Summ.Add(i,20+1.5*i+RandG(0,0.1));
   Summ.Print('  ');Summ.Clear;
   N:=1000; Echo('3)Gauss,X=20-1.5*Y, no corellation');
   for i:=0 to N-1 do Summ.Add(i,20-1.5*i+RandG(0,0.1));
   Summ.Print;Summ.Clear;
   errors:=0;
   Echo('TH123D test 1D:');
   h:=NewH123D('h1','Test-1D',5,0,10);
   Echo(Format('%s, %s, %d, %d, %d, %d, %d',[h.Name,h.Title,h.Dimension,h.NBins,h.NBinsX,h.NBinsY,h.NBinsZ]));
   m:=1;
   for i:=0 to h.NBins-1 do begin
    if not h.BinToAxis(i,ix) then inc(errors);
    if i<>h.AxisToBin(ix) then inc(errors);
    l:=h.fill(h.XMin+(ix-0.5)*(h.XMax-h.XMin)/h.NBinsX,m);
    if i<>l then inc(errors);
    if h.GetBinContent(l)<>m then inc(errors);
    Echo(Format('%d, %d, %d, %d, %d, %g',[errors,i,ix,l,m,h.GetBinContent(l)]));
    inc(m);
   end;
   Echo(Format('%d error(s), %g entries',[errors,h.Entries]));
   Kill(h);
   Echo('TH123D test 2D:');
   h:=NewH123D('h1','Test-1D',5,0,5,6,0,6);
   Echo(Format('%s, %s, %d, %d, %d, %d, %d',[h.Name,h.Title,h.Dimension,h.NBins,h.NBinsX,h.NBinsY,h.NBinsZ]));
   m:=1;
   for i:=0 to h.NBins-1 do begin
    if not h.BinToAxis(i,ix,iy) then inc(errors);
    if i<>h.AxisToBin(ix,iy) then inc(errors);
    l:=h.fill(h.XMin+(ix-0.5)*(h.XMax-h.XMin)/h.NBinsX,
              h.YMin+(iy-0.5)*(h.YMax-h.YMin)/h.NBinsY,m);
    if i<>l then inc(errors);
    if h.GetBinContent(l)<>m then inc(errors);
    Echo(Format('%d, %d, %d, %d, %d, %d, %g',[errors,i,ix,iy,l,m,h.GetBinContent(l)]));
    inc(m);
   end;
   Echo(Format('%d error(s), %g entries',[errors,h.Entries]));
   Kill(h);
   Echo('TH123D test 3D:');
   h:=NewH123D('h1','Test-1D',5,0,5, 6,1,7, 7,2,9);
   Echo(Format('%s, %s, %d, %d, %d, %d, %d',[h.Name,h.Title,h.Dimension,h.NBins,h.NBinsX,h.NBinsY,h.NBinsZ]));
   m:=1;
   for i:=0 to h.NBins-1 do begin
    if not h.BinToAxis(i,ix,iy,iz) then inc(errors);
    if i<>h.AxisToBin(ix,iy,iz) then inc(errors);
    l:=h.fill(h.XMin+(ix-0.5)*(h.XMax-h.XMin)/h.NBinsX,
              h.YMin+(iy-0.5)*(h.YMax-h.YMin)/h.NBinsY,
              h.ZMin+(iz-0.5)*(h.ZMax-h.ZMin)/h.NBinsZ,
              m);
    if i<>l then inc(errors);
    if h.GetBinContent(l)<>m then inc(errors);
    Echo(Format('%d, %d, %d, %d, %d, %d, %d, %g',[errors,i,ix,iy,iz,l,m,h.GetBinContent(l)]));
    inc(m);
   end;
   Echo(Format('%d error(s), %g entries',[errors,h.Entries]));
   Kill(h);
  finally
   Kill(Summ);
   Kill(h);
  end;
 except
  on E:Exception do BugReport(E,nil,'Test_Benchmark_TH123D');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_th123;
begin
end;

procedure Free_crw_th123;
begin
end;

initialization

 Init_crw_th123;

finalization

 Free_crw_th123;

end.

//////////////
// END OF FILE
//////////////

