{*******************************************}
{ TClusteringTool (Series Clustering)       }
{ Copyright (c) 2012-2020 by Steema Software}
{*******************************************}
unit TeeClusteringTool;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  {$IFNDEF FMX}
  Windows,
  {$ENDIF}
  {$ENDIF}

  SysUtils, Classes,  
  
  {$IFDEF D17}
  System.UIConsts,
  {$ENDIF}

  {$IFDEF FMX}
  System.UITypes, FMX.Types,

  {$IFDEF D19}
  FMX.Graphics,
  {$ENDIF}

  {$ELSE}

  {$IFDEF D16}
  System.UITypes,
  {$ENDIF}

  Graphics,
  {$ENDIF}

  {$IFDEF D9}
  Types,
  {$ENDIF}

  {$IFDEF FMX}
  FMXTee.Canvas, FMXTee.Engine, FMXTee.Functions.Clustering
  {$ELSE}
  TeCanvas, TeEngine, TeeClustering
  {$ENDIF}
  ;

type
  {$IFDEF FMX}
  TPointFloat=TPoint;
  {$ENDIF}
  
  TXYZData=record
    X,Y,Z : TChartValue;
    Index : Integer;
  end;

  TClusterStats=record
    CoVariance   : Double;
    Correlation  : Double;
    SumOfSquares : Double;
  end;

  TDistanceMethod=(dmEuclidean, dmSquaredEuclidean, dmManhattan, dmMinkowski,
                   dmSorensen, dmChebyshev);

  TClusteringMethod=(cmKMeans, cmHierarchical, cmQT);

  TClusteringTool=class(TTeeCustomToolSeries)
  private
    FBoundings   : Boolean;
    FCenters     : TSeriesPointer;
    FCentroids   : TSeriesPointer;
    FColorEach   : Boolean;

    FMethod      : TClusteringMethod;
    Provider     : TClusterProvider;
    FTransp      : TTeeTransparency;

    FHierarchical : THierarchicalClustering;
    FKMeans       : TKMeansClustering;
    FQTClustering : TQTClustering;

    procedure Colorize(const ACluster:TCluster);
    function GetDistance: TDistanceMethod;
    function GetLambda: Single;
    function GetLinkage: TLinkageMethod;
    procedure ResetColors;
    procedure SetBoundings(const Value: Boolean);
    procedure SetCenters(const Value: TSeriesPointer);
    procedure SetCentroids(const Value: TSeriesPointer);
    procedure SetColorEach(const Value: Boolean);
    procedure SetDistance(const Value: TDistanceMethod);
    procedure SetLambda(const Value: Single);
    procedure SetLinkage(const Value: TLinkageMethod);
    procedure SetMethod(const Value: TClusteringMethod);
    procedure SetTransp(const Value: TTeeTransparency);
  protected
    Procedure ChartEvent(AEvent:TChartToolEvent); override;
    class Function GetEditorClass:String; override;
    procedure SetSeries(const Value: TChartSeries); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    procedure Clear;
    function Clusters:TCluster;
    function Data(const ACluster:TCluster):TXYZData;
    class Function Description:String; override;
    function Execute:TCluster;

    function GetClusterCenter(const ACluster:TCluster):TPointFloat;
    function GetHullCentroid(const ACluster:TCluster):TPointFloat;
    procedure GetClusterPoints(const ACluster:TCluster; out Points:TPointArray);
    function GetStats(const ACluster:TCluster):TClusterStats;
    class Function LongDescription:String; override;

  published
    property ColorEach:Boolean read FColorEach write SetColorEach default True;
    property Distance:TDistanceMethod read GetDistance write SetDistance default dmEuclidean;
    property Linkage:TLinkageMethod read GetLinkage write SetLinkage default lmNone;
    property Method: TClusteringMethod read FMethod write SetMethod default cmKMeans;
    property MinkowskiLambda:Single read GetLambda write SetLambda;

    property Hierarchical : THierarchicalClustering read FHierarchical;
    property KMeans       : TKMeansClustering read FKMeans;
    property QTClustering : TQTClustering read FQTClustering;

    property Centers:TSeriesPointer read FCenters write SetCenters;
    property Centroids:TSeriesPointer read FCentroids write SetCentroids;
    property ShowBounds:Boolean read FBoundings write SetBoundings default True;
    property Transparency:TTeeTransparency read FTransp write SetTransp default 75;
  end;

  TFloatPointArray=Array of TFloatPoint;

function BoundingEllipse(const P:TPointArray; var Center,Radius:TPointFloat; var RotationAngle:Double):Boolean;

implementation

uses
  Math,
  {$IFDEF FMX}
  FMXTee.Procs, FMXTee.Chart, FMXTee.ProConstants
  {$ELSE}
  TeeProcs, Chart, TeeProCo
  {$ENDIF}
  ;

type
  TCalcDistanceFunc=function(const A,B:TXYZData):Single;

  TSeriesProvider=class(TClusterProvider)
  private
    FDistance : TDistanceMethod;
    FLambda   : Single;
    FSeries   : TChartSeries;

    ILambda   : Single;
    Source    : Array of TXYZData;

    SeriesZ   : Boolean;

    InternalDistance : TCalcDistanceFunc;

    procedure CheckDistanceFunction;
    procedure FillData;
    procedure FreeSource;
    procedure SetSeries(const Value: TChartSeries);
    procedure SetDistance(const Value: TDistanceMethod);
  protected
    function CalcDistanceData(const A,B:TXYZData):Single; overload;
    function CalcDistanceData(const A,B:Integer):Single; override;
    function CalcDistanceData(const A,B:TCluster):Single; override;
    function CalcDistanceData(const A:Integer; const B:TCluster):Single; override;
    function CloneData(const AData:Pointer):Pointer; override;
    function GetData(const Index:Integer):Pointer; override;
    procedure RecalcValues(const ACluster:TCluster); override;
    function SourceCount:Integer; override;
  public
    Constructor Create;
    Destructor Destroy; override;

    procedure GetClusterPoints(ACluster:TCluster; out Points:TPointArray);

    property Distance:TDistanceMethod read FDistance write SetDistance;
    property Series:TChartSeries read FSeries write SetSeries;
  end;

{ TSeriesProvider }

function TSeriesProvider.GetData(const Index: Integer): Pointer;
begin
  result:=@Source[Index];
end;

Destructor TSeriesProvider.Destroy;
begin
  FreeSource;
  inherited;
end;

procedure TSeriesProvider.FreeSource;
begin
  Source:=nil;
end;

function DistEuclidean(const A,B:TXYZData):Single;
begin
  result:=TeeHypot(A.X-B.X,A.Y-B.Y);
end;

function DistEuclideanZ(const A,B:TXYZData):Single;
begin
  result:=TeeHypot(TeeHypot(A.X-B.X,A.Y-B.Y),A.Z-B.Z);
end;

function DistSqrEuclidean(const A,B:TXYZData):Single;
begin
  result:=Sqr(A.X-B.X)+Sqr(A.Y-B.Y);
end;

function DistSqrEuclideanZ(const A,B:TXYZData):Single;
begin
  result:=Sqr(A.X-B.X)+Sqr(A.Y-B.Y)+Sqr(A.Y-B.Z);
end;

function DistManhattan(const A,B:TXYZData):Single;
begin
  result:=Abs(B.X-A.X)+Abs(B.Y-A.Y);
end;

function DistManhattanZ(const A,B:TXYZData):Single;
begin
  result:=Abs(B.X-A.X)+Abs(B.Y-A.Y)+Abs(B.Z-A.Z);
end;

function DistSorensen(const A,B:TXYZData):Single;
begin
  result:=(B.X+A.X)+(B.Y+A.Y);

  if result<>0 then
     result:=(Abs(B.X-A.X)+Abs(B.Y-A.Y)) / result;
end;

function DistSorensenZ(const A,B:TXYZData):Single;
begin
  result:=(B.X+A.X)+(B.Y+A.Y)+(B.Z+A.Z);

  if result<>0 then
     result:=(Abs(B.X-A.X)+Abs(B.Y-A.Y)+Abs(B.Z-A.Z)) / result;
end;

function DistChebyshev(const A,B:TXYZData):Single;
begin
  result:=Max(Abs(B.X-A.X),Abs(B.Y-A.Y));
end;

function DistChebyshevZ(const A,B:TXYZData):Single;
begin
  result:=Max(Max(Abs(B.X-A.X),Abs(B.Y-A.Y)),Abs(B.Z-A.Z));
end;

function TSeriesProvider.CalcDistanceData(const A,B:TXYZData):Single;
begin
  if FDistance=dmMinkowski then
     if SeriesZ then
        result:=Power(Power(Abs(B.X-A.X), FLambda)+
                      Power(Abs(B.Y-A.Y), FLambda)+
                      Power(Abs(B.Z-A.Z), FLambda),
                      ILambda)
     else
        result:=Power(Power(Abs(B.X-A.X), FLambda)+
                      Power(Abs(B.Y-A.Y), FLambda),
                      ILambda)
  else
    result:=InternalDistance(A,B);
end;

function TSeriesProvider.CalcDistanceData(const A,B:Integer):Single;
begin
  result:=CalcDistanceData(Source[A],Source[B]);
end;

function TSeriesProvider.CalcDistanceData(const A, B: TCluster): Single;
begin
  result:=CalcDistanceData(TXYZData(A.Data^), TXYZData(B.Data^));
end;

function TSeriesProvider.CalcDistanceData(const A: Integer; const B: TCluster): Single;
begin
  result:=CalcDistanceData(Source[A], TXYZData(B.Data^));
end;

procedure TSeriesProvider.CheckDistanceFunction;
begin
  case FDistance of
       dmEuclidean: if SeriesZ then InternalDistance:=DistEuclideanZ
                               else InternalDistance:=DistEuclidean;
dmSquaredEuclidean: if SeriesZ then InternalDistance:=DistSqrEuclideanZ
                               else InternalDistance:=DistSqrEuclidean;
       dmManhattan: if SeriesZ then InternalDistance:=DistManhattanZ
                               else InternalDistance:=DistManhattan;
        dmSorensen: if SeriesZ then InternalDistance:=DistSorensenZ
                               else InternalDistance:=DistSorensen;
  else              if SeriesZ then InternalDistance:=DistChebyshevZ
                               else InternalDistance:=DistChebyshev;
  end;
end;

procedure TSeriesProvider.FillData;
var t : Integer;
    xValue,
    yValue,
    zValue : TChartValues;
begin
  xValue:=FSeries.XValues.Value;
  yValue:=FSeries.YValues.Value;

  SeriesZ:=(FSeries.ValuesList.Count>2);

  if SeriesZ then
     zValue:=FSeries.ValuesList[2].Value
  else
     zValue:=nil;

  CheckDistanceFunction;

  FreeSource;

  SetLength(Source, FSeries.Count);

  for t:=0 to FSeries.Count-1 do
  begin
    //GetMem(Source[t], SizeOf(TXYZData));

    with TXYZData(Source[t]) do
    begin
      X:=xValue[t];
      Y:=yValue[t];

      if SeriesZ then
         Z:=zValue[t]
      else
         Z:=0;

      Index:=t;
    end;
  end;
end;

function TSeriesProvider.CloneData(const AData:Pointer):Pointer;
begin
  GetMem(result, SizeOf(TXYZData));

  if Assigned(AData) then
  begin
    TXYZData(result^):=TXYZData(AData^);
    TXYZData(result^).Index:=-1;
  end
  else
  with TXYZData(result^) do
  begin
    X:=0;
    Y:=0;
    Z:=0;
    Index:=-1;
  end;
end;

// New Cluster "center" calculated as simple average:
procedure TSeriesProvider.RecalcValues(const ACluster:TCluster);
var t, tmpL : Integer;
    tmpD : Pointer;
begin
  with ACluster do
  begin
    tmpL:=Count;

    with TXYZData(Data^) do
    if tmpL>0 then
    begin
      for t:=0 to tmpL-1 do
      begin
        tmpD:=Item[t].Data;
        X:=X+TXYZData(tmpD^).X;
        Y:=Y+TXYZData(tmpD^).Y;
        Z:=Z+TXYZData(tmpD^).Z;
      end;

      X:=X/tmpL;
      Y:=Y/tmpL;
      Z:=Z/tmpL;
    end
    else
    begin
      X:=0;
      Y:=0;
      Z:=0;
    end;
  end;
end;

function BoundingEllipse(const P:TPointArray; var Center,Radius:TPointFloat; var RotationAngle:Double):Boolean;
var tmp,
    A,B,
    t,tt : Integer;
    tmpMax,
    tmpDist : Single;
begin
  // Find longest axis
  tmp:=Length(P);

  tmpMax:=0;

  A:=-1;
  B:=-1;

  for t:=0 to tmp-1 do
  begin
    for tt:=t+1 to tmp-1 do
    begin
      tmpDist:=TeeHypot({$IFDEF FPC}1.0*{$ENDIF}P[t].X-P[tt].X, P[t].Y-P[tt].Y);

      if tmpDist>tmpMax then
      begin
        tmpMax:=tmpDist;
        A:=t;
        B:=tt;
      end;
    end;
  end;

  if A<>-1 then
  begin
    result:=True;

    Center.X:=(P[A].X+P[B].X)*0.5;
    Center.Y:=(P[A].Y+P[B].Y)*0.5;

    Radius.X:=TeeHypot(P[A].X-Center.X, P[A].Y-Center.Y);
    Radius.Y:=Radius.X*0.5;

    RotationAngle:=180-ArcTan2(P[B].Y-P[A].Y, P[B].X-P[A].X)*180.0/PI;
  end
  else
    result:=False;
end;

function TSeriesProvider.SourceCount:Integer;
begin
  if Assigned(FSeries) then
  begin
    result:=FSeries.Count;

    if Length(Source)<>result then
       FillData;
  end
  else
     result:=0;
end;

procedure TSeriesProvider.SetSeries(const Value: TChartSeries);
begin
  if FSeries<>Value then
  begin
    FSeries:=Value;

    if Assigned(FSeries) then
       FillData;
  end;
end;

constructor TSeriesProvider.Create;
begin
  inherited Create;
  InternalDistance:=DistEuclidean;
end;

procedure TSeriesProvider.SetDistance(const Value: TDistanceMethod);
begin
  FDistance := Value;
  CheckDistanceFunction;
end;

procedure TSeriesProvider.GetClusterPoints(ACluster: TCluster; out Points: TPointArray);

  procedure AddData(const AData:TXYZData);
  var tmp : Integer;
  begin
    if AData.Index<>-1 then
    begin
      tmp:=Length(Points);
      SetLength(Points, tmp+1);
      Points[tmp]:=TeePoint(Series.CalcXPos(AData.Index),
                            Series.CalcYPos(AData.Index));
    end;
  end;

var t : Integer;
begin
  if Assigned(ACluster) then
  with ACluster do
  begin
    if Assigned(Data) then
       AddData(TXYZData(Data^));

    for t:=0 to Count-1 do
        GetClusterPoints(Items[t], Points);
  end;
end;

{ TClusteringTool }

Constructor TClusteringTool.Create(AOwner: TComponent);

  function NewPointer(const AColor:TColor):TSeriesPointer;
  begin
    result:=TSeriesPointer.Create(nil);

    with result do
    begin
      Visible:=False;
      Color:=AColor;
      Pen.Hide;
      Size:=4;
      Style:=psCircle;
    end;
  end;

begin
  inherited;

  Provider:=TSeriesProvider.Create;

  FColorEach:=True;
  FBoundings:=True;
  FTransp:=75;

  FCenters:=NewPointer({$IFDEF FMX}claRed{$ELSE}clRed{$ENDIF});
  FCentroids:=NewPointer({$IFDEF FMX}claLime{$ELSE}clLime{$ENDIF});

  Brush.Color:={$IFDEF FMX}claWhite{$ELSE}clWhite{$ENDIF};

  MinkowskiLambda:=3;

  FHierarchical:=THierarchicalClustering.Create(Provider);
  FKMeans:=TKMeansClustering.Create(Provider);
  FQTClustering:=TQTClustering.Create(Provider);
end;

Destructor TClusteringTool.Destroy;
begin
  FQTClustering.Free;
  FKMeans.Free;
  FHierarchical.Free;

  Provider.Free;

  FCentroids.Free;
  FCenters.Free;
  
  inherited;
end;

function TClusteringTool.Data(const ACluster: TCluster): TXYZData;
begin
  result:=TXYZData(ACluster.Data^);
end;

procedure TClusteringTool.GetClusterPoints(const ACluster:TCluster; out Points: TPointArray);
begin
  TSeriesProvider(Provider).GetClusterPoints(ACluster,Points);
end;

function TClusteringTool.GetHullCentroid(const ACluster:TCluster):TPointFloat;
var tmp : TPointArray;
begin
  GetClusterPoints(ACluster, tmp);
  TTeeCanvas.ConvexHull(tmp);
  result:=PolygonCentroid(tmp);
  tmp:=nil;
end;

type
  TProviderAccess=class(TClusterProvider);

function TClusteringTool.GetStats(const ACluster:TCluster):TClusterStats;
var SumX   : Double;
    SumXY  : Double;
    SumY   : Double;
    SumX2  : Double;
    SumY2  : Double;
    ICount : Integer;
    CentroidCluster : TCluster;
    Centroid : TXYZData;

  procedure Process(const ACluster:TCluster);
  var t : Integer;
      x : TChartValue;
      y : TChartValue;
  begin
    with ACluster do
    if Count=0 then
    begin
      x:=TXYZData(Data^).X;
      y:=TXYZData(Data^).Y;

      SumXY:=SumXY+x*y;
      SumX2:=SumX2+Sqr(x);
      SumY2:=SumY2+Sqr(y);

      SumX:=SumX+x;
      SumY:=SumY+y;

      result.SumOfSquares:=result.SumOfSquares+
              Sqr(TProviderAccess(Provider).CalcDistanceData(CentroidCluster,ACluster));

      Inc(ICount);
    end
    else
    for t:=0 to Count-1 do
        Process(Items[t]);
  end;

var tmpDenominator : Double;
    tmpP           : TPointFloat;
begin
  if ACluster.Count>0 then
  begin
    ICount:=0;

    SumX:=0;
    SumY:=0;

    SumX2:=0;
    SumY2:=0;
    SumXY:=0;

    result.SumOfSquares:=0;

    tmpP:=GetHullCentroid(ACluster);

    CentroidCluster:=TCluster.Create;
    CentroidCluster.Data:=@Centroid;

    Centroid.X:=tmpP.x;
    Centroid.Y:=tmpP.y;
    Centroid.Z:=0;

    Process(ACluster);

    CentroidCluster.Free;
    
    result.CoVariance:=SumXY - (SumX*SumY/ICount);

    tmpDenominator:=(SumX2 - SumX*SumX/ICount) * (SumY2 - SumY*SumY/ICount);

    if tmpDenominator<=0 then
       result.Correlation:=1
    else
       result.Correlation:=result.CoVariance/Sqrt(tmpDenominator);
  end
  else
  begin
    result.CoVariance:=0;
    result.Correlation:=0;
    result.SumOfSquares:=0;
  end;
end;

function TClusteringTool.GetDistance: TDistanceMethod;
begin
  result:=TSeriesProvider(Provider).FDistance;
end;

function TClusteringTool.GetLambda: Single;
begin
  result:=TSeriesProvider(Provider).FLambda;
end;

procedure TClusteringTool.SetDistance(const Value: TDistanceMethod);
begin
  TSeriesProvider(Provider).Distance:=Value;
end;

procedure TClusteringTool.SetLambda(const Value: Single);
begin
  if Value=0 then
     raise Exception.Create('Minkowski Lambda cannot be zero');

  with TSeriesProvider(Provider) do
  begin
    FLambda:=Value;
    ILambda:=1/FLambda;
  end;
end;

function TClusteringTool.Execute: TCluster;
begin
  TSeriesProvider(Provider).Series:=Series;

  case FMethod of
    cmKMeans: result:=KMeans.Execute;
    cmHierarchical: result:=Hierarchical.Execute;
  else
    result:=QTClustering.Execute;
  end;

  if ColorEach then
     Colorize(Clusters);
end;

procedure TClusteringTool.ResetColors;
var t : Integer;
begin
  if Assigned(Series) then
  for t:=0 to Series.Count-1 do
      Series.ValueColor[t]:=clTeeColor;
end;

procedure TClusteringTool.Colorize(const ACluster:TCluster);

  procedure ColorizeCluster(ACluster:TCluster; AColor:TColor);
  var t : Integer;
  begin
    with Data(ACluster) do
    if Index>-1 then
       Series.ValueColor[Index]:=AColor;

    for t:=0 to ACluster.Count-1 do
        ColorizeCluster(ACluster[t],AColor)
  end;

var t : Integer;
begin
  ResetColors;

  for t:=0 to ACluster.Count-1 do
      ColorizeCluster(ACluster[t], ParentChart.GetDefaultColor(t));
end;

function TClusteringTool.GetLinkage: TLinkageMethod;
begin
  result:=KMeans.Linkage;
end;

procedure TClusteringTool.SetLinkage(const Value: TLinkageMethod);
begin
  KMeans.Linkage:=Value;
  Hierarchical.Linkage:=KMeans.Linkage;
  QTClustering.Linkage:=KMeans.Linkage;
end;

function TClusteringTool.GetClusterCenter(const ACluster: TCluster): TPointFloat;
begin
  with Data(ACluster) do
  begin
    result.X:=TSeriesProvider(Provider).FSeries.CalcXPosValue(X);
    result.Y:=TSeriesProvider(Provider).FSeries.CalcYPosValue(Y);
  end;
end;

class function TClusteringTool.GetEditorClass: String;
begin
  result:='TClusteringToolEditor';
end;

type
  TPointerAccess=class(TSeriesPointer);
  
procedure TClusteringTool.ChartEvent(AEvent: TChartToolEvent);
type
  TMinMax=record
    Min,
    Max : Single;
  end;

  procedure GetMinMax(const ACluster:TCluster; var AX,AY,AZ:TMinMax);
  var t : Integer;
  begin
    if ACluster.Count=0 then
    with Data(ACluster) do
    begin
      if X<AX.Min then AX.Min:=X else
      if X>AX.Max then AX.Max:=X;

      if Y<AY.Min then AY.Min:=Y else
      if Y>AY.Max then AY.Max:=Y;

      if Z<AZ.Min then AZ.Min:=Z else
      if Z>AZ.Max then AZ.Max:=Z;
    end
    else
      for t:=0 to ACluster.Count-1 do
          GetMinMax(ACluster[t],AX,AY,AZ);
  end;

  function Rect2DFromRectZ(const ARect:TRect; Z:Integer):TRect;
  var p : TFourPoints;
  begin
    p[0]:=ParentChart.Canvas.Calculate3DPosition(ARect.TopLeft,Z);
    p[1]:=ParentChart.Canvas.Calculate3DPosition(ARect.Right, ARect.Top,Z);
    p[2]:=ParentChart.Canvas.Calculate3DPosition(ARect.BottomRight,Z);
    p[3]:=ParentChart.Canvas.Calculate3DPosition(ARect.Left, ARect.Bottom,Z);
    result:=PolygonBounds(p);
  end;

  procedure Draw3D(const ACluster:TCluster);

    procedure DrawShape(const X,Y,Z:Integer; const APointer:TSeriesPointer);
    begin
      APointer.PrepareCanvas(ParentChart.Canvas,APointer.Color);
      TPointerAccess(APointer).Z:=Z;
      APointer.Draw(X,Y);
    end;

  var P : TPoint;
      Left,Top,
      Right,Bottom,
      Z0,Z1,
      tmp : Integer;
      X,Y,Z : TMinMax;
      PP : TFourPoints;
      tmpBlend : TTeeBlend;
  begin
    if FCenters.Visible then
    begin
      with Data(ACluster) do
      begin
        P.X:=TSeriesProvider(Provider).FSeries.CalcXPosValue(X);
        P.Y:=TSeriesProvider(Provider).FSeries.CalcYPosValue(Y);
        tmp:=ParentChart.Axes.Depth.CalcPosValue(Z);

        DrawShape({$IFDEF FMX}Round{$ENDIF}(P.X),
                  {$IFDEF FMX}Round{$ENDIF}(P.Y),tmp,FCenters);
      end;
    end;

    if FBoundings or FCentroids.Visible then
    begin
      X.Min:=MaxSingle; X.Max:=MinSingle;
      Y.Min:=MaxSingle; Y.Max:=MinSingle;
      Z.Min:=MaxSingle; Z.Max:=MinSingle;

      GetMinMax(ACluster,X,Y,Z);

      Left:=TSeriesProvider(Provider).FSeries.CalcXPosValue(X.Min);
      Right:=TSeriesProvider(Provider).FSeries.CalcXPosValue(X.Max);
      Bottom:=TSeriesProvider(Provider).FSeries.CalcYPosValue(Y.Min);
      Top:=TSeriesProvider(Provider).FSeries.CalcYPosValue(Y.Max);
      Z0:=ParentChart.Axes.Depth.CalcPosValue(Z.Min);
      Z1:=ParentChart.Axes.Depth.CalcPosValue(Z.Max);

      with ParentChart.Canvas do
      begin
        PP[0]:=Calculate3DPosition(Left, Top, Z0);
        PP[1]:=Calculate3DPosition(Left, Top, Z1);
        PP[2]:=Calculate3DPosition(Left, Bottom, Z1);
        PP[3]:=Calculate3DPosition(Left, Bottom, Z0);
      end;

      if FBoundings then
      begin
        ParentChart.Canvas.AssignVisiblePen(Self.Pen);
        ParentChart.Canvas.AssignBrush(Self.Brush);

        if ParentChart.Canvas.SupportsAlpha then
           tmpBlend:=ParentChart.Canvas.BeginBlending(TeeZeroRect, FTransp)
        else
           tmpBlend:=ParentChart.Canvas.BeginBlending(RectFromPolygon(PP,4), FTransp);

        ParentChart.Canvas.Cube(Left,Right,Top,Bottom,Z0,Z1);

        ParentChart.Canvas.EndBlending(tmpBlend);
      end;

      if FCentroids.Visible then
         DrawShape((Left+Right) div 2, (Top+Bottom) div 2, (Z0+Z1) div 2, FCentroids);
    end;
  end;

  procedure Draw2D(const ACluster:TCluster);

    procedure DrawShape(const P:TPointFloat; const APointer:TSeriesPointer);
    begin
      APointer.PrepareCanvas(ParentChart.Canvas, APointer.Color);
      APointer.Draw(Round(P.X), Round(P.Y));
    end;

  var tmpB : TPointArray;
      tmpP : TPointFloat;
      tmpR : TRect;
      tmpBlend : TTeeBlend;
  begin
    if FCenters.Visible then
       DrawShape(GetClusterCenter(ACluster), FCenters);

    if FCentroids.Visible or FBoundings then
    begin
      tmpB:=nil;

      GetClusterPoints(ACluster, tmpB);
      ParentChart.Canvas.ConvexHull(tmpB);
    end;

    if FCentroids.Visible then
    begin
      tmpP:=PolygonCentroid(tmpB);
      DrawShape(tmpP,FCentroids);
    end;

    if FBoundings then
    begin
      ParentChart.Canvas.AssignVisiblePen(Self.Pen);
      ParentChart.Canvas.AssignBrush(Self.Brush);

      if ParentChart.Canvas.SupportsAlpha then
         tmpBlend:=ParentChart.Canvas.BeginBlending(TeeZeroRect, FTransp)
      else
      begin
        tmpR:=PolygonBounds(tmpB);
        tmpBlend:=ParentChart.Canvas.BeginBlending(Rect2DFromRectZ(tmpR,0), FTransp);
      end;

      ParentChart.Canvas.PolygonWithZ(tmpB,0);
      ParentChart.Canvas.EndBlending(tmpBlend);
    end;

    tmpB:=nil;
  end;

var t : Integer;
    tmpClusters : TCluster;
begin
  if AEvent=cteAfterDraw then
  begin
    tmpClusters:=Clusters;

    for t:=0 to tmpClusters.Count-1 do
    if not TBaseClustering.IsUndefined(tmpClusters[t]) then
    begin
      if TSeriesProvider(Provider).SeriesZ then
         Draw3D(tmpClusters[t])
      else
         Draw2D(tmpClusters[t]);
    end;
  end;

  inherited;
end;

function TClusteringTool.Clusters: TCluster;
begin
  case FMethod of
    cmKMeans: result:=KMeans.Clusters;
    cmHierarchical: result:=Hierarchical.Clusters;
  else
    result:=QTClustering.Clusters;
  end;
end;

procedure TClusteringTool.SetMethod(const Value: TClusteringMethod);
begin
  if FMethod<>Value then
  begin
    FMethod:=Value;

    if FColorEach then
       Colorize(Clusters);

    if FBoundings or FCenters.Visible or FCentroids.Visible then
       Repaint;
  end;
end;

procedure TClusteringTool.SetBoundings(const Value: Boolean);
begin
  SetBooleanProperty(FBoundings,Value);
end;

procedure TClusteringTool.SetCenters(const Value: TSeriesPointer);
begin
  FCenters.Assign(Value);
  Repaint;
end;

procedure TClusteringTool.SetCentroids(const Value: TSeriesPointer);
begin
  FCentroids.Assign(Value);
  Repaint;
end;

procedure TClusteringTool.SetColorEach(const Value: Boolean);
begin
  if FColorEach<>Value then
  begin
    FColorEach:=Value;

    if FColorEach then
       Colorize(Clusters)
    else
       ResetColors;
  end;
end;

procedure TClusteringTool.SetSeries(const Value: TChartSeries);
var tmp : Boolean;
begin
  tmp:=Series=Value;

  inherited;

  if not tmp then
     Clear;

  FCenters.ParentChart:=ParentChart;
  FCentroids.ParentChart:=ParentChart;
  
  TSeriesProvider(Provider).Series:=Series;
end;

procedure TClusteringTool.Clear;
begin
  Hierarchical.Clusters.Clear;
  KMeans.Clusters.Clear;
  QTClustering.Clusters.Clear;

  TSeriesProvider(Provider).FreeSource;
end;

procedure TClusteringTool.SetTransp(const Value: TTeeTransparency);
begin
  if FTransp<>Value then
  begin
    FTransp:=Value;
    Repaint;
  end;
end;

class function TClusteringTool.Description: String;
begin
  result:=TeeMsg_ClusteringTool;
end;

class function TClusteringTool.LongDescription: String;
begin
  result:= TeeMsg_ClusteringDesc;
end;

initialization
  RegisterTeeTools([TClusteringTool]);
finalization
  UnRegisterTeeTools([TClusteringTool]);
end.
