Einzelnen Beitrag anzeigen

Jens01

Registriert seit: 14. Apr 2009
673 Beiträge
 
#12

AW: Windpark als Polygon

  Alt 29. Aug 2015, 23:31
ich habe mir gerade die Zeit genommen und den Algo von Peter Bone auf ein modernes Delphi zu übersetzen und etwas nachzubessern (es ist getestet aber nur dürftig) :
Delphi-Quellcode:
uses System.Math.Vectors, ...;

class function TPolygon.ConvexHullXY(const V: array of TVector): TArray<TVector>;
/// Author: Peter Bone
/// Date added: 03 March, 2006
/// return the boundary points of the convex hull of a set of points
/// Url:
/// http://www.delphipages.com/tip/find_the_convex_hull_or_a_set_of_2d_points-10803.html
/// http://www.swissdelphicenter.ch/de/showcode.php?id=2230
var
  i, ii, iii : Integer;
  LPivot: TVector;
  Points: TList<TVector>;
  V1, V2: TVector;
begin
  SetLength(Result, 0);
  if System.Length(V) < 3 then
    Exit;

  Points := TList<TVector>.Create;
  try
    Points.AddRange(V);
    if Points.Count = 3 then
      Exit(Points.toArray); // already a convex hull

    // find pivot point, which is known to be on the hull
    // point with lowest y - if there are multiple, point with highest x
    Points.Sort(TComparer<TVector>.Construct(
      function(const L, R: TVector): Integer
      begin
        Result := CompareValue(R.y, L.y);
        if Result = 0 then
          Result := CompareValue(R.x, L.x);
      end));

    LPivot := Points.Extract(Points.First);

    // sort the points by angle
    Points.Sort(TComparer<TVector>.Construct(
      function(const L, R: TVector): Integer
      var
        L1, R1: TVector;
        LA, RA: Double;
      begin
        L1 := LPivot - L;
        LA := L1.x / Hypot(L1.x, L1.y);

        R1 := LPivot - R;
        RA := R1.x / Hypot(R1.x, R1.y);
        Result := CompareValue(RA, LA);
      end));

    Points.Add(LPivot);

    iii := 0;
    repeat
      // step through array to remove points that are not part of the convex hull
      ii := 0;
      for i := Points.Count - 2 downto 1 do
      begin
        // assign points behind and infront of current point
        // work out if we are making a right or left turn using vector product
        V1 := Points[i - 1] - Points[i];
        V2 := Points[i + 1] - Points[i];
        if CompareValue(V1.CrossProduct(V2).w, 0) > -1 then
        begin
          Points.Delete(i);
          Inc(ii);
        end;
      end;
      Inc(iii);
    until (ii = 0) or (iii > 10);

    Result := Points.toArray;
  finally
    Points.Free;
  end;
end;
Achtung: Bin kein Informatiker sondern komme vom Bau.
  Mit Zitat antworten Zitat