was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

36 Visitors Online


 
...die konvexe Hülle von 2D Punkten finden?
Autor: Peter Bone
Homepage: http://www.geocities.com/peter_bone_uk
[ Tip ausdrucken ]  

Tip Bewertung (10):  
     


uses
  
Math;

type
  
TPointArray = array of TPoint;

  TPointFloat = record
    
X: Real;
    Y: Real;
  end;

  // return the boundary points of the convex hull of a set of points using Grahams scan
  // over-writes the input array - so make a copy first
function FindConvexHull(var APoints: TPointArray): Boolean;
var
  
LAngles: array of Real;
  Lindex, LMinY, LMaxX, LPivotIndex: Integer;
  LPivot: TPoint;
  LBehind, LInfront: TPoint;
  LRightTurn: Boolean;
  LVecPoint: TPointFloat;
begin
  
Result := True;

  if Length(Points) = 3 then Exit; // already a convex hull
  
if Length(Points) < 3 then
  begin 
// not enough points
    
Result := False;
    Exit;
  end;

  // find pivot point, which is known to be on the hull
  // point with lowest y - if there are multiple, point with highest x
  
LMinY := 1000;
  LMaxX := 1000;
  LPivotIndex := 0;
  for Lindex := 0 to High(APoints) do
  begin
    if 
APoints[Lindex].Y = LMinY then
    begin
      if 
APoints[Lindex].X > LMaxX then
      begin
        
LMaxX := APoints[Lindex].X;
        LPivotIndex := Lindex;
      end;
    end
    else if 
APoints[Lindex].Y < LMinY then
    begin
      
LMinY := APoints[Lindex].Y;
      LMaxX := APoints[Lindex].X;
      LPivotIndex := Lindex;
    end;
  end;
  // put pivot into seperate variable and remove from array
  
LPivot := APoints[LPivotIndex];
  APoints[LPivotIndex] := APoints[High(APoints)];
  SetLength(APoints, High(APoints));

  // calculate angle to pivot for each point in the array
  // quicker to calculate dot product of point with a horizontal comparison vector
  
SetLength(LAngles, Length(APoints));
  for Lindex := 0 to High(APoints) do
  begin
    
LVecPoint.X := LPivot.X - APoints[Lindex].X; // point vector
    
LVecPoint.Y := LPivot.Y - APoints[Lindex].Y;
    // reduce to a unit-vector - length 1
    
LAngles[Lindex] := LVecPoint.X / Hypot(LVecPoint.X, LVecPoint.Y);
  end;

  // sort the points by angle
  
QuickSortAngle(APoints, LAngles, 0, High(APoints));

  // step through array to remove points that are not part of the convex hull
  
Lindex := 1;
  repeat
    
// assign points behind and infront of current point
    
if Lindex = 0 then LRightTurn := True
    else
    begin
      
LBehind := APoints[Lindex - 1];
      if Lindex = High(APoints) then LInfront := LPivot
      else
        
LInfront := APoints[Lindex + 1];

      // work out if we are making a right or left turn using vector product
      
if ((LBehind.X - APoints[Lindex].X) * (LInfront.Y - APoints[Lindex].Y)) -
        ((LInfront.X - APoints[Lindex].X) * (LBehind.Y - APoints[Lindex].Y)) < 0 then
        
LRightTurn := True
      else
        
LRightTurn := False;
    end;

    if LRightTurn then
    begin 
// point is currently considered part of the hull
      
Inc(Lindex); // go to next point
    
end
    else
    begin 
// point is not part of the hull
      // remove point from convex hull
      
if Lindex = High(APoints) then
      begin
        
SetLength(APoints, High(APoints));
      end
      else
      begin
        
Move(APoints[Lindex + 1], APoints[Lindex],
        (High(APoints) - Lindex) * SizeOf(TPoint) + 1);
        SetLength(APoints, High(APoints));
      end;

      Dec(Lindex); // backtrack to previous point
    
end;
  until Lindex = High(APoints);

  // add pivot back into points array
  
SetLength(APoints, Length(APoints) + 1);
  APoints[High(APoints)] := LPivot;
end;

// sort an array of points by angle
procedure QuickSortAngle(var A: TPointArray; Angles: array of Real; iLo, iHi: Integer);
var
  
Lo, Hi: Integer;
  Mid: Real;
  TempPoint: TPoint;
  TempAngle: Real;
begin
  
Lo  := iLo;
  Hi  := iHi;
  Mid := Angles[(Lo + Hi) div 2];
  repeat
    while 
Angles[Lo] < Mid do Inc(Lo);
    while Angles[Hi] > Mid do Dec(Hi);
    if Lo <= Hi then
    begin
      
// swap points
      
TempPoint := A[Lo];
      A[Lo] := A[Hi];
      A[Hi] := TempPoint;
      // swap angles
      
TempAngle := Angles[Lo];
      Angles[Lo] := Angles[Hi];
      Angles[Hi] := TempAngle;
      Inc(Lo);
      Dec(Hi);
    end;
  until Lo > Hi;
  // perform quicksorts on subsections
  
if Hi > iLo then QuickSortAngle(A, Angles, iLo, Hi);
  if Lo < iHi then QuickSortAngle(A, Angles, Lo, iHi);
end;

 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners