Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Lösung des 8 Damenproblems
| Uploader: |  FBTron |
| Datum/Zeit: | 20.12.2016 22:14:05 |
'=====================================================================
' Das Programm berechnet sämtliche Lösungen des 8 Damen Problems.
'=====================================================================
' Schachspiel:
' 8 feindliche Damen sind auf einem 8x8 Schachbrett so zu stellen,
' dass keine der 8 Damen eine andere Dame bedrohen.
'
' Frage: wie viele verschiedene Lösungen existieren ?
' --------------------------------------------------------------------
' Verallgemeinerung des 8 Damen Problems
' 5 feindliche Damen auf einem 5x5 Schachbrett, Anzahl Lösungen ?
' 6 feindliche Damen auf einem 6x6 Schachbrett, Anzahl Lösungen ?
' 7 feindliche Damen auf einem 7x7 Schachbrett, Anzahl Lösungen ?
' : : :
' 9 feindliche Damen auf einem 9x9 Schachbrett, Anzahl Lösungen ?
' 10 feindliche Damen auf einem 10x10 Schachbrett, Anzahl Lösungen ?
' 11 feindliche Damen auf einem 11x11 Schachbrett, Anzahl Lösungen ?
' : : :
' N . . . . . . . . . . . . . . NxN . . . . . . . Anzahl Lösungen ?
'
' (die Rechenzeit und die Anzahl der Lösungen
' steigt exponentiell mit steigendem N)
'=====================================================================
'Anzahl Damen max. 32
'Schachbrett B(), max. 32x32
' Hilfsfeld H(), max. 32x32
' Linien A...H... (vertikal)
' Reihen Bit0...Bit31 (horizontzal)
Dim Shared As UInteger B(0 To 31),H(0 To 31)
Sub ChkBild(N As Integer,ByRef Info As Integer )
'************************************************************
' Prüfung ob mehr als eine Damen in einer Diagonale steht
'
' global:
' B(0...N) Brett als Bitfeld
'
' Eingaben:
' N Anzahl-1 Reihen, Linien
'
' Ausgabe:
' Info =0 Prüfung nicht bestanden
' zwei oder mehr Damen in einer Diagonale
' Info =1 Prüfung bestanden,
' höchstend eine Dame je Diagonale
'
' die folgende Diagonalprüfung ist nicht erforderlich,
' Dreieck oben links
' If Bit(B(j),N-j-k) Then S2+=1 : If S2>1 Then Exit Sub
'************************************************************
Dim As Integer j,k,S1,S2,S3,S4
Info = 1
S1 = 0
S2 = 0
For j=0 To N
'Diagonale 2
If Bit(B(N-j),j) Then S2+=1 : If S2>1 Then Exit Sub
'Diagonale 1
If Bit(B(j),j) Then S1+=1 : If S1>1 Then Exit Sub
Next j
For k=1 to N-1
S1 = 0
S2 = 0
S3 = 0
S4 = 0
For j=0 To N-k
'Dreieck oben rechts
If Bit(B(j+k),j) Then S1+=1 : If S1>1 Then Exit Sub
'Dreieck unten links
If Bit(B(j),j+k) Then S3+=1 : If S3>1 Then Exit Sub
'Dreieck unten rechts
If Bit(B(j+k),N-j) Then S4+=1 : If S4>1 Then Exit Sub
Next j,k
'Prüfung bestanden
Info = 0
End Sub
Sub DruBild(kOut As Integer,N As Integer,ByRef Nx As Integer)
'***************************************************************************
' Ausgabe der Koordinaten besetzter Schachbrettfelder in eine Ausgabedatei
'
' global deklariert:
' B(0...N) Brett als Bitfeld
' H(0...N) Brett als Bitfeld (Hilfsfeld)
' H() wird bei der Ausgabe von B() mit der an
' der Horizontalen gespiegelten Stellung von B() gefüllt.
' Diese horizontal gespiegelte Stellung ist ebenfalls Lösung.
'
' Eingaben:
' kOut Ausgabekanal der geöffneten Ausgabedatei
' N Anzahl-1 Reihen und Linien
' Nx Zähler
'
' Ausgaben:
' Nx Zähler, um 2 erhöht
'***************************************************************************
Dim As String Z1,Z2,XX
Dim As Integer i,j
Z1 = ""
Z2 = ""
For i=0 To N
H(i)=0
For j=0 To N
If Bit(B(i),j) Then
H(i) = BitSet(H(i),N-j)
Z1+=Right$(" "+Str$(N-j+1),3)
Z2+=Right$(" "+Str$(j+1),3)
EndIf
Next j,i
Nx+=1 : Print #kOut,Using Z1+" |#########.";Nx
Nx+=1 : Print #kOut,Using Z2+" |#########.";Nx
End Sub
Sub DNXN(kOut As Integer,kB As Integer,N As Integer,ByRef Nx As Integer)
'***********************************************************************
' Das Programm ermittelt die Lösungen
' eines N Damen Problems auf einem N x N Schachbrett.
'
' Die Rechenzeit und die Größe der Ausgabedatei
' nimmt exponentiell mit N zu.
'
' global deklariert:
' B(0...N) Brett als Bitfeld
' H(0...N) Brett als Bitfeld (Hilfsfeld)
'
' Eingaben:
' kOut Nummer der geöffneten Ausgabedatei
' N Anzahl Damen, NxN Schachbrett
' kB=0 Startwert
' Nx=0 Startwert
'
' Ausgabe:
' Nx Anzahl Lösungen
'
' Hinweis: DNXN(...) muss mit kB=0 aufgerufen werden !
'***********************************************************************
Dim As Integer i,j,Info
For i=N To 0 Step -1
'Prüfung der Reihe i
'-------------------
For j=0 To kB-1
If Bit(B(j),i) Then GoTo DNXN2
Next j
'eine Dame auf das Feld Linie kB, Reihe i stellen (Bit setzen)
B(kB)= BitSet(B(kB),i)
'Prüfung in diagonalen Richtungen (Läuferlinien)
'-----------------------------------------------
ChkBild(kB,Info) : If Info Then GoTo DNXN1
If kB<N Then
DNXN(kOut,kB+1,N,Nx) : If B(0)=0 Then Exit Sub
GoTo DNXN1
EndIf
'die Suche nach Lösungen fortsetzen, solange bis die neue Lösung in B(0...N)
'ungleich der letzten gepiegelten Lösung in H(0...N) ist
'---------------------------------------------------------------------------
For j=0 To N
If B(j)<>H(j) Then GoTo DNXN0
Next j
B(0)=0 : Exit Sub
'Lösung in die Ausgabedatei schreiben
'------------------------------------
DNXN0: DruBild(kOut,N,Nx)
'Dame von dem Feld Linie kB, Reihe i wegnehmen (Bit löschen)
DNXN1: B(kB)= BitReset(B(kB),i)
DNXN2:
Next i
End Sub
'==================================================
' Das Programm ermittelt die Lösungen eines
' N Damen Problems auf einem N x N Schachbrett.
'==================================================
Dim As Integer i,N,Nx,kIn,kOut,k
Dim As String DNameEin,DNameAus,XX
Dim As Double T0,T1
XX = Command$
XX = Trim$(XX)
k=Len(XX)
If XX = "" Then
Cls
Locate 5,14
Line Input"N = ",XX
EndIf
If XX = "" Then End
N = Val(XX)
If N>32 Then
Print Tab(17);N;" ist zu hoch"
Sleep
End
EndIf
XX = Right$("00"+Str$(N),2)
DNameAus = "D_"+XX+"x"+XX+".txt"
kOut = FreeFile
Open DNameAus For Output As #kOut
'ein paar dummy Kopfzeilen in die Ausgabedatei schreiben
'-------------------------------------------------------
For i=1 To 6
Print #kOut,String$(38," ")
Next i
Print #kOut,String$(3*N+12,"-")
For i=1 To N
Print #kOut,Tab(3*i);Chr$(64+i);
Next i
Print #kOut,
Print #kOut,String$(3*N+12,"-")
'-------------------------------------------------------
T0 = Timer
'Zähler für Lösungen
Nx = 0
'Lösungen des N-Damen-Problems berechnen
' mit (nn,0,N-1,Nx) starten !
'----------0----------------------------
DNXN(kOut,0,N-1,Nx)
'----------0----------------------------
T1 = Timer
Put #kOut, 2,"Rechenzeit "+Str$(T1-T0)
Put #kOut, 82," Brett "+Str$(N)+ " x "+Str$(N)
Put #kOut,122," Damen "+Str$(N)
Put #kOut,162," Lösungen "+Str$(Nx)
Close kOut
Locate 2,1
Print " Rechenzeit "+Str$(T1-T0)
Print
Print " Brett "+Str$(N)+ " x "+Str$(N)
Print " Damen "+Str$(N)
Print " L"+Chr$(148)+"sungen "+Str$(Nx)
Print
Print " Ausgabedatei ";DNameAus
'------------------------------------------------
'eine Übersicht in die Info-Datei kopieren
'------------------------------------------------
DNameEin = DNameAus
DNameAus = Left$(DNameEin,7)+"_Info.txt"
kIn = FreeFile
Open DNameEin For Input As #kIn
kOut = FreeFile
Open DNameAus For Output As #kOut
'die ersten 13 Zeilen kopieren
For i=1 To 13
Line Input #kIn,XX:Print #kOut,XX
Next i
Print #kOut,
'die letzten 4 Zeilen kopieren
Seek #kIn,Lof(kIn)-(3*N+14)*4
Do While Not Eof(kIn)
Line Input #kIn,XX:Print #kOut,XX
Loop
Close
Print " Ausgabedatei ";DNameAus
'------------------------------------------------
If k=0 Then Sleep
End