teeboxplot.pas

Delphi TeeChartPro.6.01的源代码

{**********************************************}
{   TCustomBoxSeries                           }
{     TBoxSeries                               }
{     THorizBoxSeries                          }
{                                              }
{   Copyright (c) 2000-2003 by                 }
{   Marjan Slatinek and David Berneda          }
{**********************************************}
unit TeeBoxPlot;
{$I TeeDefs.inc}

interface

Uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes, SysUtils,
     {$IFDEF CLX}
     QGraphics,
     {$ELSE}
     Graphics,
     {$ENDIF}
     Chart, Series, TeEngine, TeCanvas;

type
   TCustomBoxSeries=class(TPointSeries)
   private
     FExtrOut       : TSeriesPointer;
     FMedianPen     : TChartPen;
     FMildOut       : TSeriesPointer;
     FPosition      : Double;
     FWhiskerLength : Double;
     FWhiskerPen    : TChartPen;
     IVertical      : Boolean;

     FUseCustomValues: boolean;
     FMedian: double;
     FQuartile1: double;
     FQuartile3: double;
     FInnerFence1: double;
     FInnerFence3: double;
     FOuterFence1: double;
     FOuterFence3: double;
     FAdjacentPoint1: integer;
     FAdjacentPoint3: integer;
     Function GetBox:TSeriesPointer;
     procedure SetExtrOut(Value: TSeriesPointer);
     procedure SetMedianPen(Value: TChartPen);
     procedure SetMildOut(Value: TSeriesPointer);
     procedure SetPosition(Const Value: Double);
     procedure SetWhiskerLength(Const Value: Double);
     procedure SetWhiskerPen(Value: TChartPen);
     procedure SetUseCustomValues(const Value: boolean);
     procedure SetMedian(const Value: double);
     procedure SetQuartile1(const Value: double);
     procedure SetQuartile3(const Value: double);
     procedure SetInnerFence1(const Value: double);
     procedure SetInnerFence3(const Value: double);
     procedure SetOuterFence1(const Value: double);
     procedure SetOuterFence3(const Value: double);
     procedure SetAdjacentPoint1(const Value: integer);
     procedure SetAdjacentPoint3(const Value: integer);
   protected
     procedure DoBeforeDrawValues; override;
     procedure DrawAllValues; override;
     procedure DrawValue(ValueIndex: Integer); override;
     class Function GetEditorClass:String; override;
     function  GetSampleValues: TChartValueList; virtual;
     procedure PrepareForGallery(IsEnabled:Boolean); override;
     procedure SetParentChart(Const Value: TCustomAxisPanel); override;
     procedure SetSampleValues(Value: TChartValueList); virtual;
   public
     Constructor Create(AOwner: TComponent); override;
     Destructor Destroy; override;
     Procedure Assign(Source:TPersistent); override;

     procedure AddSampleValues(NumValues:Integer); override;
     property Box:TSeriesPointer read GetBox;
     { MS : Added to support custom values }
     property Median: double read FMedian write SetMedian;
     property Quartile1: double read FQuartile1 write SetQuartile1;
     property Quartile3: double read FQuartile3 write SetQuartile3;
     property InnerFence1: double read FInnerFence1 write SetInnerFence1;
     property InnerFence3: double read FInnerFence3 write SetInnerFence3;
     property OuterFence1: double read FOuterFence1 write SetOuterFence1;
     property OuterFence3: double read FOuterFence3 write SetOuterFence3;
     property AdjacentPoint1 : integer read FAdjacentPoint1 write SetAdjacentPoint1;
     property AdjacentPoint3 : integer read FAdjacentPoint3 write SetAdjacentPoint3;
   published
     property ExtrOut       : TSeriesPointer read FExtrOut write SetExtrOut;
     property MedianPen     : TChartPen read FMedianPen write SetMedianPen;
     property MildOut       : TSeriesPointer read FMildOut write SetMildOut;
     property Position      : Double read FPosition write SetPosition;
     property SampleValues  : TChartValueList read GetSampleValues write SetSampleValues;
     property WhiskerLength : Double read FWhiskerLength write SetWhiskerLength;
     property WhiskerPen    : TChartPen read FWhiskerPen write SetWhiskerPen;
     property UseCustomValues : boolean read FUseCustomValues write SetUseCustomValues default false;
   end;

   { Vertical Box Series }
   TBoxSeries=class(TCustomBoxSeries)
   public
     Function MaxXValue:Double; override;
     Function MinXValue:Double; override;
   end;

   { Horizontal Box Series }
   THorizBoxSeries=class(TCustomBoxSeries)
   public
     Constructor Create(AOwner:TComponent); override;
     Function MaxYValue:Double; override;
     Function MinYValue:Double; override;
   end;

implementation

Uses TeeProCo;

{ TCustomBoxSeries }
Constructor TCustomBoxSeries.Create(AOwner: TComponent);
begin
  inherited;
  AllowSinglePoint:=False;
  CalcVisiblePoints:=False;
  XValues.Name:='';
  YValues.Name:='Samples';   { <- do not translate }
  Marks.Visible:=False;
  Marks.Callout.Length:=0;
  FUseCustomValues := false; { MS : added to support custom values }

  FWhiskerLength:=1.5;
  FMildOut:=TSeriesPointer.Create(Self);
  FMildOut.Style:=psCircle;
  FExtrOut:=TSeriesPointer.Create(Self);
  FExtrOut.Style:=psStar;

  With Pointer do
  begin
    Draw3D:=False;
    Pen.Width:=1;
    VertSize:=15;
    HorizSize:=15;
    Brush.Color:=clWhite;
  end;

  FWhiskerPen:=CreateChartPen;

  FMedianPen:=CreateChartPen;
  FMedianPen.Width:=1;
  FMedianPen.Style:=psDot;

  IVertical:=True;
end;

Destructor TCustomBoxSeries.Destroy;
begin
  FMedianPen.Free;
  FWhiskerPen.Free;
  FreeAndNil(FExtrOut);
  FreeAndNil(FMildOut);
  inherited;
end;

procedure TCustomBoxSeries.SetWhiskerLength(Const Value: Double);
begin
  SetDoubleProperty(FWhiskerLength,Value);
end;

function TCustomBoxSeries.GetSampleValues;
begin
  result:=MandatoryValueList;
end;

procedure TCustomBoxSeries.SetSampleValues(Value: TChartValueList);
begin
  if IVertical then YValues:=Value else XValues:=Value;
end;

procedure TCustomBoxSeries.SetPosition(Const Value: Double);
begin
  SetDoubleProperty(FPosition,Value);
end;

procedure TCustomBoxSeries.SetWhiskerPen(Value: TChartPen);
begin
  FWhiskerPen.Assign(Value);
end;

procedure TCustomBoxSeries.SetMedianPen(Value: TChartPen);
begin
  FMedianPen.Assign(Value);
end;

procedure TCustomBoxSeries.SetMildOut(Value: TSeriesPointer);
begin
  FMildOut.Assign(Value);
end;

procedure TCustomBoxSeries.SetExtrOut(Value: TSeriesPointer);
begin
  FExtrOut.Assign(Value);
end;

procedure TCustomBoxSeries.DoBeforeDrawValues; { 5.02 - new calculation algorithm }
var N       : Integer;
    i       : Integer;
    FIqr    : Double;
    FMed    : Integer;
    InvN    : Double;

    { Calculate 1st and 3rd quartile }
    function Percentile(Const P: double): double;
    var QQ,
        OldQQ,
        U      : Double;
    begin
     i := 0;
     QQ := 0.0;
     OldQQ := 0.0;
     while QQ < P do
     begin
      OldQQ := QQ;
      QQ := (0.5+i)*InvN;
      Inc(i);
     end;
     U := (P-OldQQ)/(QQ-OldQQ);
     Result := SampleValues[i-2] + (SampleValues[i-1]-SampleValues[i-2])*U;
  end;

begin
  inherited;
  { if custom values are used, or there are no points, skip the recalculation }
  if (Not FUseCustomValues) and (SampleValues.Count>0) then
  begin
     N:=SampleValues.Count;
     InvN := 1.0/N;
     { calculate median }
     FMed := N div 2;
     if Odd(N) then FMedian := SampleValues[FMed]
     else FMedian := 0.5* (SampleValues[FMed-1] + SampleValues[FMed]);

     { calculate Q1 and Q3 }
     FQuartile1 := Percentile(0.25);
     FQuartile3 := Percentile(0.75);

     { calculate IQR }
     FIqr:=FQuartile3-FQuartile1;
     FInnerFence1:=FQuartile1-FWhiskerLength*FIqr;
     FInnerFence3:=FQuartile3+FWhiskerLength*FIqr;

     { find adjacent points }
     for i := 0 to N-1 do if FInnerFence1<=SampleValues.Value[i] then Break;
     FAdjacentPoint1:=i;

     for i := FMed to N-1 do if FInnerFence3<=SampleValues.Value[i] then Break;
     FAdjacentPoint3 := i-1;

     { calculate outer fences }
     FOuterFence1:=FQuartile1-2*FWhiskerLength*FIqr;
     FOuterFence3:=FQuartile3+2*FWhiskerLength*FIqr;
  end;
end;

type TPointerAccess=class(TSeriesPointer);

procedure TCustomBoxSeries.DrawValue(ValueIndex:Integer);
var tmpColor : TColor;
    tmpVal   : Double;
    tmp      : TSeriesPointer;
begin
  tmpVal:=SampleValues.Value[ValueIndex];

  { inside inner fences - no point }
  if (tmpVal>=FInnerFence1) and (tmpVal<=FInnerFence3) then tmp:=nil
  { mild outlined points }
  else
  if ((tmpVal>=FInnerFence3) and (tmpVal<=FOuterFence3)) or ((tmpVal<=FInnerFence1) and (tmpVal>=FOuterFence1)) then
     tmp:=FMildOut
  else
    { extreme outlined points }