Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [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

KUI.bas

Uploader:MitgliedMuttonhead
Datum/Zeit:03.09.2015 08:05:24

'Wertigkeiten/Multiplikator der Stellungen als Konstanten
'frei Schnauze... wieviel man hier mit etwas Feintuning rausholen kann, keine Ahnung
const as integer Wert_Neutral     =0
const as integer Wert_Einfach     =1
const as integer Wert_Zweifach_Ges=2
const as integer Wert_Zweifach_Ntr=4
const as integer Wert_Zweifach_Neg=8
const as integer Wert_Muehle_Ges  =16
const as integer Wert_Zweifach_Pos=32
const as integer Wert_Muehle_neu  =64'neu entstandene Mühle

#include once "Statistik.bas"

type Kuenstliche_UnIntelligenz
  VorZug  as Statistik
  NachZug as Statistik

  'Speicher für empfohlenen Zug
  Score       as integer'höchste Bewertung
  SteinIndex  as integer'Stein der zu ziehen
  ZugRichtung as integer

  declare sub Setze_Farbe(PIndex as integer, Farbe as integer)
  declare sub Erstelle_Statistik
  declare sub Drucke_Statistik
  declare sub Berechne_Zug (Farbe as integer)

end type

sub Kuenstliche_UnIntelligenz.Setze_Farbe(PIndex as integer, Farbe as integer)
  VorZug.Brett(PIndex).farbe=Farbe
end sub

sub Kuenstliche_UnIntelligenz.Erstelle_Statistik
  VorZug.Erstelle_Statistik
end sub

sub Kuenstliche_UnIntelligenz.Drucke_Statistik
  VorZug.Drucke_Statistik
end sub

sub Kuenstliche_UnIntelligenz.Berechne_Zug(farbe as integer)
  dim as integer gegner,ZielIndex,TempScore,DiffM,farbeIndex,gegnerIndex
  gegner=iif(farbe=1,2,1)
  farbeIndex =farbe-1
  gegnerIndex=gegner-1

  Score=-1000
  'Zu Vergleichszwecken eine Statistik von VorZug erstellen.
  'Im Wesentlichen ist dieser Schritt eigentlich nur nötig um festzustellen
  'ob und wieviele Mühlen durch diesen Zug geschlossen wurden
  VorZug.Erstelle_Statistik

  for QuellIndex as integer=0 to 23'gesammte Spielfeld "VorZug" durchsuchen
    if VorZug.Brett(QuellIndex).farbe=farbe then 'sollte auf einer Brettposition ein Stein der gewünschten Farbe liegen
      'in allen vier Richtungen untersuchen, ob das Spielfeld einen Zug dahin zulässt und
      'wenn ja ob dort auch frei ist!!!
      for Richtung as integer =0 to 3
        ZielIndex=VorZug.Brett(QuellIndex).link_pos(Richtung)
        if ZielIndex>-1 then'wenn Brettlayout Zug zulässt...
          if VorZug.Brett(ZielIndex).farbe=0 then'LEEEEEER!!!
            'wenn man bis hierher gekommen ist, weiß man nun Folgendes:
            'Auf Brettposition QuellIndex befindet sich ein Stein mit der gewünschten Farbe und
            'von Position QuellIndex aus in Richtung "Richtung" befindet die Brettposition ZielIndex die auch noch frei ist! Supi
            'UND DAHIN BEWEGEN WIR DEN STEIN!!!

            'vor jedem internen Zug das komplette Spielfeld aus "VorZug"
            'nach "NachZug" kopieren. Langsamste aber auch sicherste Variante um
            'die Ausgangsstellung in "NachZug" zu restaurieren
            for copyindex as integer=0 to 23
              NachZug.Brett(copyindex).farbe=VorZug.Brett(copyindex).farbe
            next copyindex
            'Stein bewegen
            NachZug.Brett(QuellIndex).farbe=0
            NachZug.Brett(ZielIndex).farbe=farbe
            'nun existiert die neue Spielsituation mit gezogenem Stein in NachZug

            NachZug.Erstelle_Statistik
            NachZug.Drucke_Statistik

            TempScore=0
            TempScore += Wert_Neutral      * NachZug.Neutral(farbeIndex)
            TempScore += Wert_Einfach      * NachZug.Einfach(farbeIndex)
            TempScore += Wert_Zweifach_Ges * NachZug.Zweifach_Geschl(farbeIndex)
            TempScore += Wert_Zweifach_Neg * NachZug.Zweifach_Negativ(farbeIndex)
            TempScore += Wert_Zweifach_Ntr * NachZug.Zweifach_Neutral(farbeIndex)
            TempScore += Wert_Zweifach_Pos * NachZug.Zweifach_Positiv(farbeIndex)
            TempScore += Wert_Muehle_Ges   * NachZug.Muehle(farbeIndex)
            TempScore -= Wert_Neutral      * NachZug.Neutral(gegnerIndex)
            TempScore -= Wert_Einfach      * NachZug.Einfach(gegnerIndex)
            TempScore -= Wert_Zweifach_Ges * NachZug.Zweifach_Geschl(gegnerIndex)
            TempScore -= Wert_Zweifach_Neg * NachZug.Zweifach_Negativ(gegnerIndex)
            TempScore -= Wert_Zweifach_Ntr * NachZug.Zweifach_Neutral(gegnerIndex)
            TempScore -= Wert_Zweifach_Pos * NachZug.Zweifach_Positiv(gegnerIndex)
            TempScore -= Wert_Muehle_Ges   * NachZug.Muehle(gegnerIndex)

            '"Belohnung" für eine neue Mühle, gibt es nur wenn der Gegner "freie" Steine auf dem Brett hat.
            'd.h. das Schliessen einer Mühle macht nur Sinn wenns auch was zum Klauen gibt.
            if NachZug.Steine_Brett(gegnerIndex) > VorZug.Steine_Geschuetzt(gegnerIndex) then'wenn mehr Steine auf Brett als in Mühlen
              If NachZug.Muehle(farbeIndex) then' sind überhaupt geschl. Mühlen da
                DiffM=NachZug.Muehle(farbeIndex)-VorZug.Muehle(farbeIndex)' Differenz MühlenZahlvor MühlenZahlnach
                if DiffM>0 then TempScore +=DiffM * Wert_Muehle_neu'ist sie größer als 0 Sachlage klar
                'falls Differnz 0 ist, Mühlen auf Lageänderung prüfen
                if (DiffM=0) and ( NachZug.CheckBits_Muehle(farbeIndex) <> VorZug.CheckBits_Muehle(farbeIndex) ) then
                  TempScore +=Wert_Muehle_neu
                end if
              end if
            end if

            if TempScore>=Score then
              'wenn eine besser bewerteter Zug gefunden ist, diesen merken
              Score=TempScore
              SteinIndex=QuellIndex
              ZugRichtung=Richtung
            end if

          end if
        end if
      next Richtung
    end if
  next QuellIndex
end sub