teedownsampling.pas

TeeChart 7.0 With Source在Delphi 7.0中的安装

{*********************************************}
{  TDownSamplingFunction                      }
{  Copyright (c) 2004-2005 by Steema Software }
{  With permission from Mr. Nils Haeck        }
{*********************************************}
unit TeeDownSampling;
{$I TeeDefs.inc}

{ Implementation of the famous Douglas-Peucker simplification
  algorithm.

  This file contains a 3D floating point implementation, for spatial
  polylines, as well as a 2D integer implementation for use with
  Windows GDI.

  Loosely based on C code from SoftSurfer (www.softsurfer.com)
  http://geometryalgorithms.com/Archive/algorithm_0205/algorithm_0205.htm

  References:
  David Douglas & Thomas Peucker, "Algorithms for the reduction of the number of
  points required to represent a digitized line or its caricature", The Canadian
  Cartographer 10(2), 112-122  (1973)

  Delphi code by Nils Haeck (c) 2003 Simdesign (www.simdesign.nl)
  http://www.simdesign.nl/components/douglaspeucker.html

  ****************************************************************
  The contents of this file are subject to the Mozilla Public
  License Version 1.1 (the "License"); you may not use this file
  except in compliance with the License. You may obtain a copy of
  the License at:
  http://www.mozilla.org/MPL/

  Software distributed under the License is distributed on an
  "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  implied. See the License for the specific language governing
  rights and limitations under the License.
}

interface

uses
  {$IFNDEF LINUX}
  Windows,
  {$ENDIF}
  Classes, TeEngine;

type
  // Float point 3D
  TPointFloat2D = packed record
    X: TChartValue;
    Y: TChartValue;
  end;

  TDownSampleMethod=(dsDouglas, dsMax, dsMin, dsMinMax, dsAverage);

  TDownSamplingFunction=class(TTeeFunction)
  private
    FDownSampleMethod: TDownSampleMethod;
    FTolerance: TChartValue;
    procedure SetDownSampleMethod(const Value: TDownSampleMethod);
    procedure SetTolerance(Value:TChartValue);
  public
    { Reduced size. Reduction factor is then Source.Count/ReducedSize}
    ReducedSize : Integer;
    Constructor Create(AOwner: TComponent); override;
    procedure AddPoints(Source:TChartSeries); override;
  published
    { Different downsample methods}
    property DownSampleMethod : TDownSampleMethod read FDownSampleMethod write SetDownSampleMethod default dsDouglas;
    { Tolerance, expressed in real chart values}
    property Tolerance:TChartValue read FTolerance write SetTolerance;
  end;

function GroupDownSample( const Tol: TChartValue;
                          const X,Y: TChartValues; N: Integer;
                          Method: TDownSampleMethod;
                          var RX, RY: TChartValues): Integer;

implementation

uses Math, Chart, TeeProCo, TeeConst;

function VecMin2D(const x1,y1,x2,y2: TChartValue): TPointFloat2D;
// Result = (x1,y1) - (x2,y2)
begin
  Result.X := x1 - x2;
  Result.Y := y1 - y2;
end;

function DotProd2D(const x1,y1,x2,y2:TChartValue): TChartValue;
// Dotproduct = (x1,y1)*(x2,y2)
begin
  Result := x1*x2 + y1*y2;
end;

function DistSquared2D(const x1,y1,x2,y2: TChartValue): TChartValue;
// Square of the distance from (x1,y1) to (x2,y2)
var v : TPointFloat2D;
begin
  v  := VecMin2D(x1,y1,x2,y2);
  result := Sqr(v.x)+Sqr(v.y);
end;

procedure Simplify2D(const Tol2: TChartValue; const X,Y: TChartValues;
  var Marker: array of boolean; j, k: integer);
// Simplify polyline in X,Y between j and k. Marker[] will be set to True
// for each point that must be included
var
  i, MaxI: integer; // Index at maximum value
  MaxD2: TChartValue;    // Maximum value squared
  CU, CW, B: TChartValue;
  DV2: TChartValue;
  P0, P1, PB, U, W: TPointFloat2D;
begin
  // Is there anything to simplify?
  if k <= j + 1 then exit;

  P0.X := X[j];
  P0.Y := Y[j];

  P1.X := X[k];
  P1.Y := Y[k];
  U  := VecMin2D(P1.X,p1.Y, P0.X, P0.Y); // Segment vector
  CU := DotProd2D(U.X, U.Y, U.X, U.Y); // Segment length squared
  MaxD2 := 0;
  MaxI  := 0;

  // Loop through points and detect the one furthest away
  for i := j + 1 to k - 1 do
  begin
    W  := VecMin2D(X[i],Y[i], P0.X, P0.Y);
    CW := DotProd2D(W.X,W.Y, U.X, U.Y);

    // Distance of point Orig[i] from segment
    if CW <= 0 then
    begin
      // Before segment
      DV2 := DistSquared2D(X[i], Y[i], P0.X, P0.X)
    end
    else
    begin
      if CW > CU then
      begin
        // Past segment
        DV2 := DistSquared2D(X[i], Y[i], P1.X, P1.Y);
      end
      else
      begin
        // Fraction of the segment
        try
          B := CW / CU;
        except
          B := 0; // in case CU = 0
        end;

        PB.X := P0.X + B * U.X;
        PB.Y := P0.Y + B * U.Y;
        DV2 := DistSquared2D(X[i], Y[i], PB.X, PB.Y);
      end;
    end;

    // test with current max distance squared
    if DV2 > MaxD2 then
    begin
      // Orig[i] is a new max vertex
      MaxI  := i;
      MaxD2 := DV2;
    end;
  end;

  // If the furthest point is outside tolerance we must split
  if MaxD2 > Tol2 then
  begin // error is worse than the tolerance

    // split the polyline at the farthest vertex from S
    Marker[MaxI] := True;  // mark Orig[maxi] for the simplified polyline

    // recursively simplify the two subpolylines at Orig[maxi]
    Simplify2D(Tol2, X,Y, Marker, j, MaxI); // polyline Orig[j] to Orig[maxi]
    Simplify2D(Tol2, X,Y, Marker, MaxI, k); // polyline Orig[maxi] to Orig[k]
  end;
end;

{ PolySimplify2D:
  Approximates the polyline with 2D integer vertices in Orig, with a simplified
  version that will be returned in Simple. The maximum deviation from the
  original line is given in Tol.
  Input:  Tol      = approximation tolerance
          X,Y   = polyline array of vertex points
  Output: rX,rY = simplified polyline vertices. This array must initially
                     have the same length as X,Y
  Return: the number of points in rX or rY
}
function PolySimplify2D(const Tol: TChartValue; const X,Y: TChartValues; N: Integer;
                        var RX,RY: Array of TChartValue): integer;
var
  i      : Integer;
  Marker : Array of Boolean;
  Tol2   : TChartValue;
begin
  result := 0;

  if Length(X) < 2 then
     Exit;

  Tol2 := Sqr(Tol);

  // Create a marker array
  SetLength(Marker, N);

  // Include first and last point
  Marker[0]     := True;
  Marker[N - 1] := True;

  // Exclude intermediate for now
  for i := 1 to N - 2 do
      Marker[i] := False;

  // Simplify
  Simplify2D(Tol2, X,Y, Marker, 0, N - 1);

  // Copy to resulting list
  for i := 0 to N - 1 do
  if Marker[i] then
  begin
    RX[result] := X[i];
    RY[result] := Y[i];
    Inc(result);
  end;
end;

function GroupDownSample(const Tol: TChartValue; const X,Y: TChartValues;
                               N: Integer; Method: TDownSampleMethod;
                               var RX, RY: TChartValues): Integer;
var tmpSum : TChartValue;
    tmpMax,tmpMin: TChartValue;
    i,j: Integer;
begin
  result := 0;

  if Method = dsDouglas then
     result := PolySimplify2D(Tol,X,Y,N,rX,rY)
  else
  begin
    i := 0;

    while i<N do
    begin
      j := i;
      tmpSum := Y[i];
      tmpMax := Y[i];
      tmpMin := Y[i];

      while Abs(X[j+1]-X[i])<Tol do
      begin
        Inc(j);
        tmpSum := tmpSum + Y[j];
        if Y[j] > tmpMax then tmpMax := Y[j];
        if Y[j] < tmpMin then tmpMin := Y[j];
      end;

      if Method <> dsMinMax then
      begin
        rX[result] := (X[j] + X[i])*0.5; // x is average of group

        case Method of
          dsAverage : rY[result] := tmpSum/(j-i+1);
          dsMax : rY[result] := tmpMax;
          dsMin : rY[result] := tmpMin;
        end;

        Inc(result);
      end
      else
      if result<High(rX)-1 then // safeguard in case somebody tries to do this on very short array
      begin
        rX[result] := X[i];
        rX[result+1] := X[j];
        rY[result] := tmpMin;
        rY[result+1] := tmpMax;

        Inc(result,2);
      end;

      i := j+1;
    end;
  end;
end;

{ TDownSamplingFunction }

procedure TDownSamplingFunction.AddPoints(Source: TChartSeries);
var
  rX,rY : TChartValues;
  t     : Integer;
begin
  if Source.Count>0 then
  begin
    with ParentSeries do
    begin
      Clear;

      if YMandatory=Source.YMandatory then  // 7.0
      begin
        NotMandatoryValueList.Order:=loAscending;
        MandatoryValueList.Order:=loNone;
        CalcVisiblePoints:=True;
      end
      else
      begin
        NotMandatoryValueList.Order:=loNone;
        MandatoryValueList.Order:=loAscending;
        CalcVisiblePoints:=False;
      end;
    end;

    // step 1 : setup result arrays
    SetLength(rX,Source.Count);
    SetLength(rY,Source.Count);

    try
      // step 2 : do downsample
      with Source do
        ReducedSize := GroupDownSample(FTolerance,XValues.Value,YValues.Value,
                                       Count,FDownSampleMethod,rX,rY);

      // step 3 : populate target series with results
      for t := 0 to ReducedSize-1 do
          ParentSeries.AddXY(rX[t],rY[t]);

    finally
      // cleanup memory
      rX:=nil;
      rY:=nil;
    end;
  end;
end;

Constructor TDownSamplingFunction.Create(AOwner: TComponent);
begin
  inherited;
  CanUsePeriod:=False;
  SingleSource:=True;
  FTolerance := 1.0;
  InternalSetPeriod(1);
end;

procedure TDownSamplingFunction.SetDownSampleMethod(const Value: TDownSampleMethod);
begin
  if FDownSampleMethod<>Value then
  begin
    FDownSampleMethod := Value;
    Recalculate;
  end;
end;

procedure TDownSamplingFunction.SetTolerance(Value:TChartValue);
begin
  Value:=Max(0.0,Value);

  if FTolerance<>Value then
  begin
    FTolerance := Value;
    Recalculate;
  end;
end;

initialization
  RegisterTeeFunction( TDownSamplingFunction, {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionDownSampling,
                                              {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended );
finalization
  UnRegisterTeeFunctions([TDownSamplingFunction]);
end.