Autor |
Beitrag |
Narses
Beiträge: 10182
Erhaltene Danke: 1255
W10ent
TP3 .. D7pro .. D10.2CE
|
Verfasst: Di 25.12.07 02:06
Moin!
Hier nun eine (Muster-)Lösung für Paranuss 1: Karte färben. Da die Durchsicht der Abgaben etwas dauern wird, möchte ich an dieser Stelle schonmal um etwas Geduld bitten.
Wie wir im Team beim Löschen der Tipps aus den Beiträgen im laufenden Gewinnspiel schon gesehen haben sind bereits Einige dahinter gekommen, dass das Grundproblem aus der Graphentheorie stammt, konkret geht es um die Färbung eines Graphen. Um das ganze etwas anschaulicher zu gestalten, haben wir uns auf eine Teilmenge der Graphen beschränkt, die planaren Graphen, da man diese zum einen schön als Landkarte darstellen kann und zum anderen für diese Graphen-Klasse ein Spezialfall gilt: der 4-Farben-Satz: Wikipedia hat folgendes geschrieben: | Der Vier-Farben-Satz [...] besagt, dass vier Farben immer ausreichen, um eine beliebige Landkarte in der euklidischen Ebene so einzufärben, dass keine zwei angrenzenden Länder die gleiche Farbe bekommen. [...] Dies gilt unter den Einschränkungen, dass ein gemeinsamer Punkt nicht als "Grenze" zählt und jedes Land aus einer zusammenhängenden Fläche besteht, also keine Exklaven vorhanden sind. |
Daraus folgt speziell für diese Paranuss:
Wenn 4 Farben nicht ausreichen, um die Karte zu färben, ist der Graph entweder nicht planar oder der Algorithmus zum Bestimmen der Färbung ist nicht korrekt!
Da wir den Graphen aus einem Kartenbild ableiten, muss er planar (gewesen) sein. Daraus folgt: wenn man mehr als 4 Farben benötigt, ist der gewählte Algorithmus zur Bestimmung der Kanten des Graphen (=angrenzende Flächen) nicht korrekt. Fazit: Bei 5 Farben kann die Lösung nicht korrekt sein.
Die Aufgabe lässt sich in drei Teilprobleme zerlegen: - Wählen einer geeigneten Datenstruktur für die interne Abbildung eines planaren Graphen
- Bestimmen des Graphen aus einem Landkartenbild
- Bestimmen einer gültigen Färbung (mit max. 4 Farben)
Wir werden einen OOP-Ansatz verfolgen. Hier zunächst die (leicht gekürzte) Deklaration der Graphenklasse:
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:
| type TPlane = class(TObject) private FOwner: TPlanarGraph; public constructor Create(AOwner: TPlanarGraph; const AID,X,Y: Integer); destructor Destroy; override; property ID: Integer read FID; property Point: TPoint read FPoint; property Color: TColor read FColor write SetColor; property ColorIndex: Integer read FColorIndex write FColorIndex; procedure SetColorByIndex; property Connections: TList read FConnections; function IsColorIndexValid: Boolean; end;
TPlanarGraph = class(TObjectList) private FImageRef: TImage; FPlaneMap: TBitmap; public constructor Create; destructor Destroy; override; procedure Pickup(AImage: TImage); property Plane[const AIndex: Integer]: TPlane read GetPlane; function GetPlaneByPoint(Point: TPoint): TPlane; procedure SetColorByIndex; end;
implementation
constructor TPlane.Create(AOwner: TPlanarGraph; const AID,X,Y: Integer); begin inherited Create; FConnections := TList.Create; FOwner := AOwner; FID := AID; FPoint.X := X; FPoint.Y := Y; FColorIndex := -1; with FOwner.FPlaneMap.Canvas do begin Brush.Color := FID; FloodFill(FPoint.X,FPoint.Y,Pixels[FPoint.X,FPoint.Y],fsSurface); end; end;
procedure TPlane.SetColor(const Value: TColor); begin if (FColor <> Value) then begin FColor := Value; with FOwner.FImageRef.Picture.Bitmap.Canvas do begin Brush.Color := FColor; FloodFill(FPoint.X,FPoint.Y,Pixels[FPoint.X,FPoint.Y],fsSurface); end; end; end;
procedure TPlane.SetColorByIndex; begin SetColor(GraphColor[2,FColorIndex]); end;
function TPlane.IsColorIndexValid: Boolean; var i: Integer; begin Result := FALSE; for i := 0 to FConnections.Count-1 do if (TPlane(FConnections.Items[i]).ColorIndex = FColorIndex) then Exit; Result := TRUE; end;
constructor TPlanarGraph.Create; begin inherited Create;
FPlaneMap := TBitmap.Create; end;
function TPlanarGraph.GetPlane(const AIndex: Integer): TPlane; begin Result := TPlane(Items[AIndex]); end;
function TPlanarGraph.GetPlaneByPoint(Point: TPoint): TPlane; var PlaneID: Integer; begin Result := NIL; if (Count > 0) then begin PlaneID := FPlaneMap.Canvas.Pixels[Point.X,Point.Y]; if (PlaneID <= Count) then Result := GetPlane(PlaneID); end; end; |
Das Kernstück ist natürlich die Methode TPlanarGraph.Pickup(AImage: TImage), die wir jetzt im Detail untersuchen wollen:
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:
| procedure TPlanarGraph.Pickup(AImage: TImage); var x,y: Integer; ScanLine: PByteArray; Plane: TPlane; TempPlanes: TList;
procedure ExaminePixelEnvironment(const BaseX, BaseY: Integer); function Colorize(const APlaneID: Integer): Boolean; begin Self.Clear; if Assigned(AImage) then begin AImage.Picture.Bitmap.PixelFormat := pf24bit; FImageRef := AImage; FPlaneMap.Assign(AImage.Picture.Bitmap); for y := 0 to FPlaneMap.Height-1 do begin ScanLine := FPlaneMap.ScanLine[y]; for x := 0 to 3*FPlaneMap.Width-1 do Scanline^[x] := 254 or (Scanline^[x] and 1); end; for y := 1 to FPlaneMap.Height-2 do for x := 1 to FPlaneMap.Width-2 do if (FPlaneMap.Canvas.Pixels[x,y] = clWhite) then Add(TPlane.Create(Self,Self.Count,x,y)); if (Self.Count > 0) then begin TempPlanes := TList.Create; try for y := 1 to FPlaneMap.Height-2 do for x := 1 to FPlaneMap.Width-2 do if (FPlaneMap.Canvas.Pixels[x,y] = $FEFEFE) then ExaminePixelEnvironment(x,y); if NOT Colorize(0) then raise Exception.Create('Der Graph ist nicht planar!'); finally TempPlanes.Free; end; end; end else raise Exception.Create('Referenz-Image ungültig!'); end; |
Zunächst wird eine Kopie der Kartengrafik angelegt und so bearbeitet, dass weiße Pixel unverändert bleiben, aber schwarze (=Rand) zu $FEFEFE umgefärbt werden. So können wir die gefundenen Flächen mit dem Index als Farbe markieren und das Bild später zum Identifizieren von Flächen verwenden.
A - Flächenerkennung- Pixelweise das Bild absuchen
- Weißer Pixel gefunden -> hier ist eine neue Fläche -> Flächenobjekt in die Liste einfügen, beim Anlegen wird die Fläche über den Referenzpixel mit dem Index als Farbe gefärbt (per FloodFill)
- Die Pixel einer bereits bekannten Fläche sind jetzt nicht mehr weiß und werden deshalb nicht mehr beachtet
B - Angrenzende Flächen bestimmen
Idee: das Bild nach Randpixeln absuchen und die Umgebung dieser Punkte auswerten. Dazu wird die folgende lokale Prozedur verwendet:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22:
| procedure ExaminePixelEnvironment(const BaseX, BaseY: Integer); var i,c: Integer; begin TempPlanes.Clear; with FPlaneMap.Canvas do for i := 0 to 8 do if (i <> 4) then begin c := Pixels[BaseX+(i div 3)-1,BaseY+(i mod 3)-1]; if (c <> $FEFEFE) then begin Plane := GetPlane(c); if (TempPlanes.IndexOf(Plane) = -1) then TempPlanes.Add(Plane); end; end; if (TempPlanes.Count = 2) then for i := 0 to 1 do begin Plane := TPlane(TempPlanes.Items[i]); if (Plane.Connections.IndexOf(TempPlanes.Items[1-i]) = -1) then Plane.Connections.Add(TempPlanes.Items[1-i]); end; end; |
Der "Trick" ist hierbei, nur Pixelumgebungen mit genau zwei verschiedenen Flächen zu beachten. Zusammen mit der Kartenbildvorgabe, dass die kleinste Fläche ein 3-Pixel großes Dreieck ist, ergibt sich so immer ein planarer Graph.
C - Färbung bestimmen
Die Färbung bekommen wir über einen simplen Backtracking-Algorithmus, der zwar im schlechtesten Fall alle Kombinationen ausprobiert, aber dafür einen planaren Graphen garantiert mit 4 Farben färbt. Geht das nicht, kann der Graph nicht planar sein!
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20:
| function Colorize(const APlaneID: Integer): Boolean; var i: Integer; begin Result := (APlaneID < 0) or (APlaneID >= Count); if (NOT Result) then begin for i := 0 to 3 do begin GetPlane(APlaneID).ColorIndex := i; if GetPlane(APlaneID).IsColorIndexValid then begin Result := Colorize(APlaneID +1); if Result then Exit; end; end; GetPlane(APlaneID).ColorIndex := -1; end; end; |
Der Funktionswert sagt aus, ob die angegebene Fläche (regelgerecht) gefärbt werden konnte. Der erste Aufruf erfolgt deshalb mit der ersten Fläche (Index 0). Wird hier FALSE zurückgeliefert, dann konnte keine Färbung für den ganzen Graphen bestimmt werden. In diesem Fall erheben wir einfach mal eine Ausnahme, denn das sollte eigentlich nicht auftreten können.
Das komplette Musterprojekt befindet sich mit Quelltext und Testbildern im Anhang.
cu
Narses
Einloggen, um Attachments anzusehen!
_________________ There are 10 types of people - those who understand binary and those who don´t.
|
|
Martok
Beiträge: 3661
Erhaltene Danke: 604
Win 8.1, Win 10 x64
Pascal: Lazarus Snapshot, Delphi 7,2007; PHP, JS: WebStorm
|
Verfasst: Di 25.12.07 03:49
Sehr schön. Ich habs richtig, glaub ich
EDIT: Mist, doch nicht. Zwei Testbilder sind, sonst wärs nicht mal wem aufgefallen... Ich glaub aber, ich hätte nen Fix dafür
Deine Flächenerkennung gefällt mir. Schön einfach, da wär ich so nicht drauf gekommen.
_________________ "The phoenix's price isn't inevitable. It's not part of some deep balance built into the universe. It's just the parts of the game where you haven't figured out yet how to cheat."
|
|
Xion
Beiträge: 1952
Erhaltene Danke: 128
Windows XP
Delphi (2005, SmartInspect), SQL, Lua, Java (Eclipse), C++ (Visual Studio 2010, Qt Creator), Python (Blender), Prolog (SWIProlog), Haskell (ghci)
|
Verfasst: Di 25.12.07 14:52
voll auf die Schwachstellen von meinem Programm rumhacken gemeine Karten...naja, bin mal gespannt, bei wem das so funktioniert.
Vor allem frag ich mich, warum die letzte Karte nicht geht *grübel*
_________________ a broken heart is like a broken window - it'll never heal
In einem gut regierten Land ist Armut eine Schande, in einem schlecht regierten Reichtum. (Konfuzius)
|
|
Martok
Beiträge: 3661
Erhaltene Danke: 604
Win 8.1, Win 10 x64
Pascal: Lazarus Snapshot, Delphi 7,2007; PHP, JS: WebStorm
|
Verfasst: Di 25.12.07 15:19
Die Letzte wurde sogar mal als Gegenbeweis für den 4-Farben-Satz angebracht. Bis dann einer bewiesen hat, dass sie auch 4-Färbbar ist... hatte ich irgendwo bei meinen Nachforschungen gelesen...
Ich hatte halt zuviel Vertrauen in mein Programm: statt zu Backtracken, dachte ich die erste Lösung wäre schon optimal
_________________ "The phoenix's price isn't inevitable. It's not part of some deep balance built into the universe. It's just the parts of the game where you haven't figured out yet how to cheat."
|
|
jaenicke
Beiträge: 19285
Erhaltene Danke: 1743
W11 x64 (Chrome, Edge)
Delphi 11 Pro, Oxygene, C# (VS 2022), JS/HTML, Java (NB), PHP, Lazarus
|
Verfasst: Di 25.12.07 17:54
Martok hat folgendes geschrieben: | Ich hatte halt zuviel Vertrauen in mein Programm: statt zu Backtracken, dachte ich die erste Lösung wäre schon optimal |
Ich wusste, dass meine Lösung per Greedy-Algorithmus nicht immer funktioniert, ich bin aber schlicht nicht dazu gekommen das noch zu ändern, auch wenn es eigentlich gar nicht so viel gewesen wäre. Das habe ich auch in den Quelltext geschrieben, dass das nicht immer geht.
Morgen werde ich aber wohl dazu kommen und dann die jetzige Lösung und die korrigierte Variante vorstellen.
Alle Bilder bis auf das letzte Bild funktionieren bei mir.
|
|
Kha
Beiträge: 3803
Erhaltene Danke: 176
Arch Linux
Python, C, C++ (vim)
|
Verfasst: Di 25.12.07 18:34
Omg... tut euch einen Gefallen und streicht mein Programm im Voraus von der Liste. War doch keine so gute Idee, gestern in allerletzter Sekunde abzugeben und dabei fatalerweise folgende Zeile zu vergessen :
Narses hat folgendes geschrieben: | Delphi-Quelltext 1: 2:
| GetPlane(APlaneID).ColorIndex := -1; | |
Bei den Beispielen ist der Fehler nicht aufgefallen, weil dort Backtracking anscheinend nicht/wenig nötig ist; nur bei 111 hakt es (mit Fix in ca. 50 Sekunden, wie sieht's bei den anderen aus?).
PS: 000.bmp ist gemein .
|
|
GTA-Place
Beiträge: 5248
Erhaltene Danke: 2
WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
|
Verfasst: Di 25.12.07 20:46
Hab grad ne PN bekommen, dass mein Programm 111_von_Fiete.bmp mit 5 Farben statts 4 färbt. Kann ich im Moment aber nicht ausprobieren. Schade.
_________________ "Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)
|
|
Chryzler
Beiträge: 1097
Erhaltene Danke: 2
|
Verfasst: Di 25.12.07 22:06
Mein Prog ist auch fehlerhaft. Bin mal gespannt wie viele das richtig hinbekommen haben.
|
|
Xion
Beiträge: 1952
Erhaltene Danke: 128
Windows XP
Delphi (2005, SmartInspect), SQL, Lua, Java (Eclipse), C++ (Visual Studio 2010, Qt Creator), Python (Blender), Prolog (SWIProlog), Haskell (ghci)
|
Verfasst: Mi 26.12.07 11:07
ich glaub das mit der Karte war wohl die schwerste Paranuss...Schade, dass ich nicht mehr Zeit dafür hatte. Naja, mitmachen ist alles
_________________ a broken heart is like a broken window - it'll never heal
In einem gut regierten Land ist Armut eine Schande, in einem schlecht regierten Reichtum. (Konfuzius)
|
|
|