Microsoft Excel

Herbers Excel/VBA-Archiv

Schachrätsel mit VBA lösen

Betrifft: Schachrätsel mit VBA lösen von: Remo
Geschrieben am: 26.08.2004 13:41:29

Hallo Freunde des Excels

Es gibt doch dieses bekannte Schachrätsel: "Wie bringe ich acht Damen auf ein
Schachbrett, ohne dass eine die andere Schlagen darf?"

Soll heissen: Keine Horizontale, Vertikale oder Diagonale darf durch mehr als eine Dame besetzt sein.

Hat jemand von euch eine Idee, wie sich das per VBA lösen liesse?

Bin gespannt...

Gruss Remo

  


Betrifft: AW: Schachrätsel mit VBA lösen von: Andreas Walter
Geschrieben am: 26.08.2004 13:54:19

Brute Force
1. Schleife von 1 bis 8
2a. Schleife von 1 bis 8
2b. Schleife von 1 bis 8
Für jede Stelle auf dem Brett, die sich ergibt aus 2a und 2b
Ist die Stelle schon besetzt?
Ja: geh zu next von 2b
Nein: dann hier weiter
Jetzt schleifen horizontal, vertikal und diagonal von Stelle 2a 2b weg in beiden Richtungen bis Ende des Brettes erreicht wird und siehe nach, ob ein besetztes Feld gefunden wird.
Ja: geh zu next von 2b
Nein: Position besetzen
Sind wir bei Dame 8 sprich ist Schleifenvariable 1 gleich 8
Nein: geh zu Next von Schleife 1
Ja: Ausgabe: Ergebnis gefunden
Position von Dame mit Nummer Schleife-1 freigeben
next 2b
next 2a
position von der Dame mit Nummer Schleife-1 freigeben
next 1
Ausgabe "keine weitere lösungen"

So ungefähr


  


Betrifft: AW: Schachrätsel mit VBA lösen von: Remo
Geschrieben am: 26.08.2004 13:59:52

Habe schon eine Lösung, aber die überzeugt mich noch nicht so richtig.
Ich denke es sollte auch mit weniger Code möglich sein.


Sub Acht_richtige()
Application.ScreenUpdating = False
Schleife = 1
Do Until Schleife = 1000000
Range("A1:H8").ClearContents
For i = 1 To 8
Cells(i, Int((8 * Rnd) + 1)) = "X"
Next i
Kontrolle = ""
For z = 1 To 8
Kontrolle = Kontrolle & Application.WorksheetFunction.CountIf(Columns(z), "X")
If Application.WorksheetFunction.CountIf(Columns(z), "X") <> 1 Then Exit For
Next z
If Kontrolle = "11111111" Then

For Each Zelle In Range("A1:H8")
If Zelle = "X" Then
Spalte = Zelle.Column
Zeile = Zelle.Row
Do Until Spalte > 7 Or Zeile > 7
Spalte = Spalte + 1
Zeile = Zeile + 1
If Cells(Zeile, Spalte) = "X" Then GoTo weiter
Loop
End If
Next

For Each Zelle In Range("A1:H8")
If Zelle = "X" Then
Spalte = Zelle.Column
Zeile = Zelle.Row
Do Until Spalte < 2 Or Zeile > 7
Spalte = Spalte - 1
Zeile = Zeile + 1
If Cells(Zeile, Spalte) = "X" Then GoTo weiter
Loop
End If
Next

End
End If
weiter:
Schleife = Schleife + 1
Loop
Application.ScreenUpdating = True

End Sub



  


Betrifft: Aaaaaaarrrrgggghhhhhh von: Andreas Walter
Geschrieben am: 26.08.2004 14:06:18

Da war irgendetwas mit einer unendliche Anzahl von Affen mit unendlich vielen Schreibmaschinen, die ein Shakespeare-Werk schreiben sollten. Oder?

Die angegebene Lösung schmeisst acht Damen auf das Brett und schaut was rauskommt.
Mensch - ist mir schlecht ;-)


  


Betrifft: AW: Aaaaaaarrrrgggghhhhhh von: Remo
Geschrieben am: 26.08.2004 14:22:28

Es fällt kein Meister vom Himmel... :-)

Aber bringst Du es mit weniger Code hin???


  


Betrifft: AW: Aaaaaaarrrrgggghhhhhh von: Andreas Walter
Geschrieben am: 26.08.2004 14:39:39

- Aber bringst Du es mit weniger Code hin???

Keine Ahnung. Und ich schätze das Merkmal "weniger Code" als ziemlich unwichtig.


  


Betrifft: AW: Schachrätsel mit VBA lösen von: Georg
Geschrieben am: 26.08.2004 13:54:38

Stichwort "Backtracking"/Rekursion.
Findet man Lösungsansätze bei google wenn man nach "acht Damen Schach Problem" oder einen von den obigen stichwörtern sucht. In welcher Sprache man das jetzt umsetzt ist was anderes.

(Hab leider nicht die Zeit im Moment das mal in VBA zu probieren)

Gruss
Georg


  


Betrifft: rekursive Lösung von: IngoG
Geschrieben am: 27.08.2004 00:35:13

Hallo Remo,

schau Dir mal die angehängte Datei an.

https://www.herber.de/bbs/user/10185.xls

in K1 kannst Du einen Anfangsstring eingeben, von dem ab gesucht wird um mehr als eine lösung zu finden...

Ich habe das problem rekursiv gelöst.
ich suche einen string mit der länge 8, in dem die stellen die Zeilen festlegen und die jeweilige ziffer die spalte in dieser zeile.

ausgehend von einem Startstring (im normalfall "") probiere ich alle möglichkeiten aus, in dem ich jeweils überprüfe, ob mein akt. string noch den regeln entspricht (mit der Function Kontrolle())
ist dies der Fall setzte ich in die nächste zeile einen neuen stein in die spalte 1.
ist dies nicht der fall, so setzte ich in der aktuellen zeile den stein ein feld weiter nach rechts.
wird der stein so aus dem feld geschoben (also auf spalte 9) so nehem ich den stein wieder vom feld und gehe ich in der zeile vorher eine position weiter nach rechts...

mit dem neuen string arbeite ich dann wieder weiter.

solltest du fragen haben, melde Dich einfach nochmal

Gruß Ingo

PS eine Rückmeldung wäre nett...


  


Betrifft: AW: rekursive Lösung die 2. von: ingoG
Geschrieben am: 27.08.2004 00:42:27

Hallo nochmal,

hab wohl einmal nicht abgespeichert,
hier also die lösung mit dem Startstring in K1

https://www.herber.de/bbs/user/10186.xls


Gruß Ingo