Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Lösung des 8 Damenproblems

Uploader:MitgliedFBTron
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