AA Polygon in Rechtecke zerlegen

Flamefire · Verfasst: Do 01.10.09 15:39

In Zusammenhang mit diesem Thread möchte ich versuchen ein Polygon (durch punktearray gegeben) das nur aus waagerechten und senkrechten strichen besteht in rechtecke zu zerlegen

als bsp habe ich mir diese ausgedacht:
tmp

(das sollte alle sonderfälle abdecken)

meine idee war, die polygone (schwarz) entlang der x-achse in rechtecke zu zerlegen, immer dann, wenn ich einen punkt weiter rechts vom aktuellem finde. (rot)

ich komme nur nicht so richtig weiter.

erste idee war das hier:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

procedure GetRects(Pts:Array of TPoint;Result:TRectArray);
var cur,imax,i,imin,pt1,pt2,swap:Integer;
begin
  SetLength(Result,2);
  cur:=0;
  imax:=2;
  imin:=0;
  //Get lower left point
  for i := 1 to Length(Pts) - 1 do
    if(Pts[imin].X>Pts[i].X)
      or (Pts[imin].X=Pts[i].X) and (Pts[imin].Y>Pts[i].Y) then imin:=i;
  pt1:=imin+2;
  if(pt1>=Length(Pts)) then Dec(pt1,Length(Pts));
  pt2:=imin-2;
  if(pt2<0) then Inc(pt2,Length(Pts));
  if(pt1<>pt2) and (Pts[pt2].X<Pts[pt1].X) then begin
    swap:=pt1;
    pt1:=pt2;
    pt2:=swap;
  end;
  Result[cur].Left:=Pts[imin].X;
  Result[cur].Bottom:=Pts[imin].Y;
  Result[cur].Right:=Pts[pt1].X;
  if(Pts[pt1].Y<Pts[imin].Y) then Result[cur].Top:=Pts[pt2].Y
  else Result[cur].Top:=Pts[pt1].Y;
  Inc(cur);
end;

Idee dahinter:
-Beginne beim ersten punkt von links. bei mehreren nimm den untersten
-von dem punkt ausgehend suche entlang der linien des polygons nach den nächsten 2 punkten in beiden richtungen und nimm den am weitesten links
-nach einer validitätsprüfung (5. bsp wäre sonst falsch) füge ein neues rechteck ein

weiß nur nicht, was ich mit den andren rechtecken machen soll. und glaube auch, einen fehler bei einem der bsp mit dieser variate zu erkennen

nächste idee:
laufe von links nach rechts durch und erstelle an jeder stelle, wo ein punkt getroffen wird ein rechteck zum vorherigen

aber weiß auch nicht genau, wie ich das implementieren soll. finde immer n gegenbeispiel zu meinen ideen :-(

Einloggen, um Attachments anzusehen!

jakobwenzel · Verfasst: Do 01.10.09 15:56

Du musst einfach für jeden Punkt gucken, ob er einer der Punkte ist, die das Polygon konkav machen, und dann muss eine der Abtrennlinien in diesem Punkt starten.

_________________
I thought what I'd do was, I'd pretend I was one of those deaf-mutes.

Flamefire · Verfasst: Do 01.10.09 18:29

*bahnhof*

sry ;-)

Tryer · Beiträge: 226 Erhaltene Danke: 7

ungetestet (und nicht optimiert). Für 8 Punkte lohnt die TList zum sortieren vermutlich nicht

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

function SortXY(P1, P2: Pointer):Integer;
begin
  Result := PPoint(P1)^.X - PPoint(P2)^.X;
  if Result = 0 then
    Result := PPoint(P1)^.Y - PPoint(P2)^.Y;
end;

procedure GetRects(Pts: array of TPoint; Result: TRectArray);
var 
  cur,imax,i,imin: Integer;
  iList: TList;
begin
  // Result so gross wie ggf. möglich setzen um nur noch verkleinern zu müssen
  SetLength(Result, ((Length(Pts) - 4) div 2) + 1; 
  cur := 0;
  iList := TList.Create;
  try
    iList.Count := Length(Pts);
    for i := 0 to Pred(iList.Count) do
      iList.Items[i] := @Pts[i];
    iList.Sort(SortXY);
    iMin := 0;
    iMax := 1;
    repeat
      while PPoint(iList[iMin])^.X = PPoint(iList[iMax])^.X do
        Inc(iMax);
      // iMin: kleinstes X, kleinstes Y
      Result[cur].TopLeft := PPoint(iList[MinIndex])^; 
      // iMax - 1: kleinstes X und dazu maximales Y
      Result[cur].Bottom := PPoint(iList[iMax - 1])^.Y; 
      // nächstes X
      Result[cur].Right := PPoint(iList[iMax])^.X; 
      Inc(cur);
      iMin := iMax;
      Inc(iMax);
    until PPoint(iList[iMax])^.X = PPoint(iList[Pred(iList.Count)])^.X;
  finally
    iList.Free;
  end;
  SetLength(Result, cur + 1);
end;

Grüsse, Dirk

---Moderiert von Narses: Beiträge zusammengefasst---

Vergiss es, geht so auch nicht.

Flamefire · Verfasst: Fr 02.10.09 07:06

ok danke. werde ich heute nachmittag mal testen

BTW: du hast ein while und ein until...
was ist es denn nun? ^^

Hidden · Verfasst: Fr 02.10.09 08:24

Es ist eine While-Schleife, die in einer repeat-Schleife läuft. Wenn du dir die Einrückung ansiehst, bezieht sich das repeat until auf einen ganzen Block, das while jedoch nur auf das nachfolgende Inc(), da ein begin end-Block fehlt

E: Wie

Tryer am Ende noch schreibt, funktioniert der Code aber so nicht

_________________
Centaur spears can block many spells, but no one tries to block if they see that the spell is a certain shade of green. For this purpose it is useful to know some green stunning hexes. (HPMoR)

Tryer · Beiträge: 226 Erhaltene Danke: 7

Das war ja mal endlich wieder knifflig, und nun scheint es zu funktionieren. Viel optimieren geht imo auch nicht mehr, ausser es gibt einen anderen mathematischen Ansatz der das ganze vereinfacht. Mein lahmer Lappi (Pentium M/1,3) schafft 1 Mio Durchläufe mit 12 Punkten in ca. 2,2 Sekunden, ich denke das ist akzeptabel. Aber vielleicht kannst Du ja noch was rausholen.
Ich sortiere alle Punkte nach X - und Y - Koordinate, und arbeite mich mit steigenden X durch die Punkte. Um schnell arbeiten zu können geschieht das ganze halt mit Pointern damit nicht mit den TPoint - Records jongliert werden muss.
Der Durchbruch war das ich erkannte: Wenn eine Y - Koordinate sich in der nächsten Spalte wiederholt, dann ist sie überflüssig und muss weg(da Abschluß des gerade gebauten Rechtecks), wenn sie hingegen fehlt dann wird sie für das nächste Rechteck gebraucht (Da hier die Strecke einfach hindurchging). Da ich nur Pointer habe und Pts nicht angreifen wollte habe ich zwei zusätzliche TPoint - Variablen(P1, P2), auf welche ich dann bei Bedarf die Zeiger setze um fehlende Punkte für das nächste Rechteck zu ergänzen.
Bitte fleißig testen, ich bin nicht sicher ob es noch Sonderfälle gibt wo das ganze fehlschlägt. Wichtig ist auf jeden Fall das keine überflüssigen Punkte in Pts stecken, da dürfen wirklich nur Ecken drin stehen.
[Edit] Einen Sonderfall gibt es bei diesem Vorgehen natürlich: eine "C" Figur kann nur gedreht als "U" ausgewertet werden, da sonst zwei Rechtecke gleichzeitig bearbeitet werden müssten[/Edit]

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:

type
  TRectArray = array of TRect;
  TPointArray = array of TPoint;

  TPPointArray = array of PPoint;
  PPPointArray = ^TPPointArray;

procedure GetRects(Pts: TPointArray; var Result: TRectArray);
var
  i, cur, iMax, iMin, ActX: Integer;
  iList: TPPointArray;
  TopFound, BtmFound: Boolean;
  P1, P2: TPoint;
const
  MaxPoint: TPoint = (X: High(Integer); Y: High(Integer));
begin
  // Result so gross wie ggf. möglich setzen
  SetLength(Result, (Length(Pts) - 4) div 2 + 1);
  try
    cur := 0;
    SetLength(iList, Length(Pts) + 1);
    try
      for i := Low(Pts) to High(Pts) do
        iList[i] := @Pts[i];
      // Dummy anhängen um Längenprüfung zu sparen
      iList[High(iList)] := @MaxPoint;
      { Liste der Punkte sortieren, kann entfallen wenn
        Pts nach X und dann Y sortiert ist }
      QSort(@iList, 0, High(iList));
      iMin := 0;
      iMax := 2;
      TopFound := False;
      BtmFound := False;
      repeat
        // iMin: kleinstes X, kleinstes Y
        Result[cur].TopLeft := iList[iMin]^;
        // iMax - 1: kleinstes X und dazu maximales Y
        Result[cur].Bottom := iList[Pred(iMax)]^.Y;
        // iMax: nächstes X
        Result[cur].Right := iList[iMax]^.X;
        { Alle Punkte löschen die den Ecken des gerade erzeugten
          Rechtecks entsprechen, da diese nur noch stören würden.}
        iMin := iMax;
        i := iMax;
        ActX := iList[iMax]^.X;
        while (iList[i]^.X = ActX) do
        begin
          if iList[i]^.Y = Result[cur].Top then
          begin
            iList[i] := iList[Pred(i)];
            Inc(iMin);
            TopFound := True;
          end else
            if iList[i]^.Y = Result[cur].Bottom then
            begin
              //max. 2 Werte vor Bottom mgl.? -> hochschieben
              iList[i] := iList[Pred(i)];
              iList[Pred(i)] := iList[i-2];
              Inc(iMin);
              BtmFound := True;
            end;
          Inc(i);
        end;
        { Wurden die Ecken des aktuellen Rechtecks nicht gefunden, dann werden sie
          für das nächste gebraucht und deshalb hinzugefügt}
        if not TopFound then
        begin
          Dec(iMin);
          P1.X := ActX;
          P1.Y := Result[cur].Top;
          iList[iMin] := @P1;
        end else
          TopFound := False;
        if not BtmFound then
        begin
          Dec(iMin);
          P2.X := ActX;
          P2.Y := Result[cur].Bottom;
          {Da die Form zusammenhängend ist muss es einen kleineren Wert als Bottom
            geben. also muss dieser vor Bottom gestellt werden. In der ersten
            Spalte können nur(müssen!) 2 Werte stehen, also kann auf ein
            "Sort" verzichtet werden}
          iList[iMin] := iList[Succ(iMin)];
          iList[Succ(iMin)] := @P2;
        end else
          BtmFound := False;
        iMax := iMin + 2;
        Inc(cur);
      until iMax > High(iList);
    finally
      SetLength(iList, 0);
    end;
    SetLength(Result, Succ(cur));
  except
    SetLength(Result, 0);
  end;
end;

procedure QSort(PList: PPPointArray; L, R: Integer);
var
  I, J: Integer;
  P, Swap: Pointer;

  function SortXY(P1, P2: PPoint):Integer;
  begin
    Result := P1^.X - P2^.X;
    if Result = 0 then
      Result := P1^.Y - P2^.Y;
  end;

begin
  repeat
    I := L;
    J := R;
    P := PList^[(L + R) shr 1];
    repeat
      while SortXY(PList^[I], P) < 0 do
        Inc(I);
      while SortXY(PList^[J], P) > 0 do
        Dec(J);
      if I <= J then
      begin
        Swap := PList^[I];
        PList^[I] := PList^[J];
        PList^[J] := Swap;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QSort(PList, L, J);
    L := I;
  until I >= R;
end;

Grüsse, Dirk

Flamefire · Verfasst: So 04.10.09 20:43

ist eine idee
mir ist aber auch eine gekommen:
1) alle horizontalen LINIEN herausfiltern und nach X sortieren
2) dann jeweils das eine paar linien, dass am weitesten links beginnt bearbeiten: kürzere der linien nehmen und endpunkt davon als eckpunkt fürs rechteck setzen. schon hat mein ein rechteck. die küzere linie wird gelöscht, von der andren wird der anfangspunkt auf den endpunkt des rechtecks gesetzt
3) bei 2 weiter machen bis keine linien mehr da sind

hat aber das gleiche problem, dass kein "C" erlaubt ist. könnte man aber sogar noch beheben, indem man die horiz. linien anhand der vertikalen paarweise gruppiert

der organist · Verfasst: So 04.10.09 20:47

möchtest du eine optimale Lösung? z.B.: möglichst wenige Linien, möglichst wenig Teilflächen? Ansonsten einfach alle vorhandenen Linien verlängern....dabei ist zwar so manches überflüssig, aber immerhin...

_________________
»Gedanken sind mächtiger als Waffen. Wir erlauben es unseren Bürgern nicht, Waffen zu führen - warum sollten wir es ihnen erlauben, selbständig zu denken?« Josef Stalin

Flamefire · Verfasst: So 04.10.09 22:12

vorhandene linien verlängern? dann käme ich am ende auf eine boundingbox. bringt mir aber nicht viel, da ich dann nicht feststellen kann, ob ein punkt in dem gebiet liegt.

Tryer · Beiträge: 226 Erhaltene Danke: 7

Die Idee mit den sortierten Strecken ist gut, ich hab das mal umgesetzt. Mit etwas Mehraufwand (gucken ob Linien zwischen den gerade behandelten "auftauchen") werden jetzt auch beliebige C - Formen richtig umgewandelt. Die Laufzeit hat sich verlängert da nach dem Ändern der Startkoordinaten immer wieder neu sortiert werden muss, aber dafür gibt es jetzt keine Einschränkungen mehr.
Das ganze wieder optimiert unter Verzicht auf jegliche Lesbarkeit *g*.
Da diesmal ein Wert verändert werden muss reichten die Pointer nicht aus, also habe ich einen Record TStrecke angelegt der zusätzlich noch die veränderliche X-Koordinate der Linie enthält. Dadurch bleibt Pts wieder unangetastet.

[Edit] kleine Verbesserung: An Stelle der zwei Zeiger auf die Punkte kann man genauso gut die zwei weiteren Koordinaten eintragen die relevant sind. Das erspart späteres dereferenzieren.[/Edit]

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:

type
  TPointArray = array of TPoint;
  TRectArray = array of TRect;

  TStrecke = record
    X1, X2, Y: Integer;
  end;
  PStrecke = ^TStrecke;

  TStreckenArray = array of TStrecke;
  TPStreckenArray = array of PStrecke;

procedure GetRects(const Pts: TPointArray; var Rects: TRectArray);
var
  cur, i, n, Len1, Len2, LMax, LCount, Oldi: Integer;
  iList: TStreckenArray;
  iPList: TPStreckenArray;
  S1, S2, Sn: PStrecke;

  procedure QSortStrecken(L, R: Integer);
  var
    I, J: Integer;
    P, Swap: PStrecke;

    function SortXY(const S1, S2: PStrecke):Integer;
    begin
      Result := S1^.X1 - S2^.X1;
      if Result = 0 then
        Result := S1^.Y - S2^.Y;
    end;

  begin
    repeat
      I := L;
      J := R;
      P := iPList[(L + R) shr 1];
      repeat
        while SortXY(iPList[I], P) < 0 do
          Inc(I);
        while SortXY(iPList[J], P) > 0 do
          Dec(J);
        if I <= J then
        begin
          Swap := iPList[I];
          iPList[I] := iPList[J];
          iPList[J] := Swap;
          Inc(I);
          Dec(J);
        end;
      until I > J;
      if L < J then
        QSortStrecken(L, J);
      L := I;
    until I >= R;
  end;

begin
  SetLength(Rects, (Length(Pts) - 4) div 2 + 1);
  try
    cur := 0;
    SetLength(iList, Length(Pts));
    SetLength(iPList, Length(Pts));
    try
      LCount := 0;
      for i := Low(Pts) to Pred(High(Pts)) do
      begin
        if Pts[i].X < Pts[i+1].X then
        begin
          S1 := @iList[LCount];
          S1^.X1 := Pts[i].X;
          S1^.Y := Pts[i].Y;
          S1^.X2 := Pts[Succ(i)].X;
          iPList[LCount] := S1;
          Inc(LCount);
        end else
          if Pts[i].X > Pts[i+1].X then
          begin
            S1 := @iList[LCount];
            S1^.X1 := Pts[Succ(i)].X;
            S1^.X2 := Pts[i].X;
            S1^.Y := Pts[i].Y;
            iPList[LCount] := S1;
            Inc(LCount);
          end;
      end;
      if Pts[High(Pts)].X < Pts[Low(Pts)].X then
      begin
        S1 := @iList[LCount];
        S1^.X1 := Pts[High(Pts)].X;
        S1^.X2 := Pts[Low(Pts)].X;
        S1^.Y:= Pts[Low(Pts)].Y;
        iPList[LCount] := S1;
        Inc(LCount);
      end else
        if Pts[High(Pts)].X > Pts[Low(Pts)].X then
        begin
          S1 := @iList[LCount];
          S1^.X1 := Pts[Low(Pts)].X;
          S1^.Y := Pts[Low(Pts)].Y;
          S1^.X2 := Pts[High(Pts)].X;
          iPList[LCount] := S1;
          Inc(LCount);
        end;
      SetLength(iList, LCount);
      SetLength(iPList, LCount);
      QSortStrecken(0, High(iPList));
      i := 0;
      repeat
        S1 := iPList[i];
        S2 := iPList[i+1];
        Len1 := S1^.X2;
        Len2 := S2^.X2;
        LMax := Math.Min(Len1, Len2);
        for n := (i + 2) to Pred(LCount) do
        begin
          Sn := iPList[n];
          if Sn^.X1 >= LMax then
            Break
          else
            if (Sn^.Y > S1^.Y) and
              (Sn^.Y < S2^.Y) then
            begin
              LMax := Sn^.X1;
              Break;
            end;
        end;
        Rects[cur].Top := S1^.Y;
        Rects[cur].Left := S1^.X1;
        Rects[cur].Right := LMax;
        Rects[cur].Bottom := S2^.Y;
        Inc(cur);
        S1^.X1 := LMax;
        S2^.X1 := LMax;
        if S1^.X1 = S1^.X2 then
          S1^.X1 := -1;
        if S2^.X1 = S2^.X2 then
          S2^.X1 := -1;
        Oldi := i;
        if (S1^.X1 = -1) and (S2^.X1 = -1) then
          Inc(i, 2)
        else
        begin
          if (S1^.X1 = -1) or (S2^.X1 = -1) then
            Inc(i);
          QSortStrecken(Oldi, Pred(LCount));
        end;
      until i > (LCount - 2);
    finally
      SetLength(iList, 0);
      SetLength(iPList, 0);
    end;
    SetLength(Rects, Succ(cur));
  except
    SetLength(Rects, 0);
  end;
end;

Viel Spass damit.

Grüsse, Dirk

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme