ADA Vier Gewinnt v5 KI fertig
2009-05-03 16:41:09

with Ada.Numerics.Discrete_Random, Ada.Unchecked_Deallocation;
with Ada.Text_IO, Ada.Integer_Text_IO;
use  Ada.Text_IO, Ada.Integer_Text_IO;

procedure Vier_Gewinnt is

   subtype Zeile  is Natural range 1 .. 6;
   subtype Spalte is Natural range 1 .. 7;
   type Spielfeld is array (Zeile, Spalte) of Character;   
   
   package Rand is new Ada.Numerics.Discrete_Random (Spalte);
   use Rand;
   
   type Knoten;   
   type Ref_Knoten is access Knoten;
   type Moeglichkeit is array (Spalte) of Ref_Knoten;
   
   type Knoten is record
      Zug : Natural;
      Gewonnen : Boolean;
      Naechste : Moeglichkeit;
   end record;

-------------------------------------------------------------------------------

   --  Gibt den Speicher eines Baums wieder frei. Der Baum wird rekursiv
   --  durchlaufen und von unten nach oben aufgelöst.
   procedure Free is new Ada.Unchecked_Deallocation (Knoten, Ref_Knoten);
   procedure Free_Baum (X : in out Ref_Knoten) is
   begin
      if X /= null then
         for I in Spalte loop
            Free_Baum (X.Naechste (I));
         end loop;
         Free (X);
      end if;
   end Free_Baum;

-------------------------------------------------------------------------------

   --  Gibt das Spielfeld aus.
   procedure Put (SF : in Spielfeld) is
   begin
      --  Spaltennummerierung
      for I in SF'Range (2) loop
         Put (I, 2);         
      end loop;
      New_Line;
      --  Das eigentliche Spielfeld
      for I in SF'Range (1) loop
         Put ('|');
         for J in SF'Range (2) loop
            Put (SF (I, J) & '|');
         end loop;
         New_Line;
      end loop;
   end Put;

-------------------------------------------------------------------------------

   --  Überprüft, ob die Spalte N schon voll ist.
   --  Wichtig: Es wird nicht überprüft, ob die Spalte N im Spielfeld
   --  vorhanden ist. Vorher abfragen!
   function Setzen_Erlaubt (SF : Spielfeld; N : Spalte) return Boolean is
   begin
      return SF (SF'First (1), N) = ' ';
   end Setzen_Erlaubt;

-------------------------------------------------------------------------------

   --  Lässt einen Spielstein in die Spalte N fallen.
   --  Wichtig: Vorher mit "Setzen_Erlaubt" prüfen, ob die Spalte schon
   --  voll ist oder nicht.
   procedure Spielstein_Setzen (SF : in out Spielfeld; N : in Spalte;
                                Spielstein : in Character) is
   begin
      for I in reverse SF'Range (1) loop
         if SF (I, N) = ' ' then
            SF (I, N) := Spielstein;
            return;
         end if;
      end loop;
   end Spielstein_Setzen;

-------------------------------------------------------------------------------

   --  Betrachtet den zuletzt eingeworfenen Spielstein in der Spalte N
   --  und kontrolliert vertikal, horizontal und diagonal, ob 4 dieser
   --  Steine nebeneinander sind = gewonnen wurde.
   function Gewonnen (SF : Spielfeld; N : Spalte) return Boolean is
      X, Y : Natural;
      Spielstein : Character;
      Gefunden, B1, B2, B3 : Boolean;
   begin
      --  Ermitteln vom letzten Stein, der in der Spalte N eingeworfen
      --  wurde. Art des Steins (X oder O) und die Position X, Y merken.
      Gefunden := False;
      for I in SF'Range (1) loop
         if not Gefunden and SF (I, N) /= ' ' then
            Spielstein := SF (I, N);
            Gefunden := True;
            X := I;
            Y := N;
         end if;
      end loop;
      
      --  False zurückgeben, wenn in der Spalte N kein Spielstein
      --  gefunden wurde.
      if not Gefunden then
         return False;
      end if;
      
      --  Vertikal überprüfen
      if X <= (SF'Last (1) - 3) then
         if SF (X + 1, Y) = Spielstein and SF (X + 2, Y) = Spielstein and
            SF (X + 3, Y) = Spielstein then
            return True;
         end if;
      end if;
      
      for I in 0 .. 3 loop
         --  Horizontal überprüfen
         B1 := True;
         for J in 0 .. 3 loop
            if B1 and (Y - I + J) in Spalte then
               if SF (X, Y - I + J) /= Spielstein then
                  B1 := False;
               end if;
            else
               B1 := False;
            end if;
         end loop;
         
         --  Diagonal 1 überprüfen
         B2 := True;
         for J in 0 .. 3 loop
            if B2 and (Y - I + J) in Spalte and (X + I - J) in Zeile then
               if SF (X + I - J, Y - I + J) /= Spielstein then
                  B2 := False;
               end if;
            else
               B2 := False;
            end if;
         end loop;
         
         --  Diagonal 2 überprüfen
         B3 := True;
         for J in 0 .. 3 loop
            if B3 and (Y - I + J) in Spalte and (X - I + J) in Zeile then
               if SF (X - I + J, Y - I + J) /= Spielstein then
                  B3 := False;
               end if;
            else
               B3 := False;
            end if;
         end loop;

         if B1 or B2 or B3 then
            return True;
         end if;
      end loop;
      return False;
   end Gewonnen;

-------------------------------------------------------------------------------

   --  Erstellt einen Baum der möglichen Zustände.
   --  Die Höhe des Baums ist von der Schwierigkeitsstufe abhängig.
   --  In den Knoten des Baums wird mit einem Boolean Wert gespeichert, ob
   --  der Zug zum Gewinn geführt hat.
   function Gib_Baum (SF : Spielfeld; Zug : Natural;
               N : Spalte; S1, S2 : Character) return Ref_Knoten is
      K : Ref_Knoten := new Knoten;
      SF_Kopie : Spielfeld := SF;
   begin
      if Setzen_Erlaubt (SF, N) then
         Spielstein_Setzen (SF_Kopie, N, S1);
         K.Gewonnen := Gewonnen (SF_Kopie, N);
         K.Zug := Zug;
         if Zug > 0 then
            for I in Spalte loop
               K.Naechste (I) := Gib_Baum (SF_Kopie, Zug - 1, I, S2, S1);
            end loop;
         end if;
         return K;
      end if;
      return null;
   end Gib_Baum;

-------------------------------------------------------------------------------

   procedure Hilfestellung (B : in Ref_Knoten) is
   begin
      if B = null then
         Put_Line ("Es ist sinnvoll in der Mitte anzufangen.");
         New_Line;
      else
         Put_Line ("Yeah...");
         New_Line;
      end if;
   end Hilfestellung;
   
-------------------------------------------------------------------------------

   function Bewertung (K : Ref_Knoten; Stufe : Natural) return Integer is
      X, Hilf : Integer := 0;
   begin
      if K /= null then
         if (Stufe * 2) = K.Zug and K.Gewonnen then
            X := 1000000;
         elsif ((Stufe * 2) -1) = K.Zug and K.Gewonnen then
            X := -10000;
         else
            if K.Zug mod 2 = 1 and K.Gewonnen then
               X := -K.Zug**2;
            elsif K.Zug mod 2 = 0 and K.Gewonnen then
               X := K.Zug**2;
            else
               X := K.Zug**2;
            end if;
         end if;
         for I in Spalte loop
            X := X + Bewertung (K.Naechste (I), Stufe);
         end loop;         
         return X;
      end if;
      return 0;   
   end Bewertung;

-------------------------------------------------------------------------------

   function KI (B : Ref_Knoten; Zug, Stufe : Natural) return Spalte is
      Gen : Generator;
      A : array (Spalte) of Integer;
      Return_Spalte : Spalte;
      Return_Max : Integer;
   begin
      Reset (Gen);

      for I in Spalte loop
         A (I) := Bewertung (B.Naechste (I), Stufe);
         if A (I) = 0 then
            A (I) := Integer'First;
         end if;
         --  Put (A (I)'Img & " / ");
      end loop;
      
      Return_Spalte := 4;
      Return_Max := A (4);
      
      for I in Spalte loop
         if A (I) > Return_Max then
            Return_Spalte := I;
            Return_Max := A (I);
         end if;
      end loop;
      
      return Return_Spalte;
   end KI;

-------------------------------------------------------------------------------

   Spieler : array (0 .. 1) of String (1 .. 9) := ("Spieler 1", "Spieler 2");
   Spielstein : array (0 .. 1) of Character := ('X', 'O');
   SF, SF_Kopie : Spielfeld := (others => (others => ' '));

   N : Natural;          --  Eingabe der Spalte beim Einwurf
   S : Natural;          --  Unterscheidung des aktiven Spielers
   Stufe : Natural;      --  Unterscheidung des Schwierigkeitsgrades
   Zug : Natural;        --  Zähler der einzelnen Züge
   Eingabe : Character;  --  Eingabevariable für alles
   B : Ref_Knoten;       --  Baum mit möglichen Spielzügen

-------------------------------------------------------------------------------

begin
   Put_Line ("========== VIER GEWINNT ==========");
   New_Line;
   Put_Line ("1 - Spieler gegen Spieler");
   Put_Line ("2 - Spieler gegen PC Gegner (einfach)");
   Put_Line ("3 - Spieler gegen PC Gegner (mittel)");
   Put_Line ("4 - Spieler gegen PC Gegner (schwer)");
   
   --  Eingabe der Spielart
   Menu : loop
      Put ("Eingabe: ");
      Get (Eingabe);
      case Eingabe is
         when '1' =>
            --  Spieler gegen Spieler
            --  Namen bleiben bei Spieler 1 und Spieler 2
            --  Stufe wird auf 0 gesetzt
            Stufe := 0;
            exit Menu;
         when '2' | '3' | '4' =>
            --  Spieler gegen PC Gegner
            --  Name des 2. Spielers wird auf PC Gegner gesetzt
            --  Stufe wird auf "Eingabe-1" gesetzt
            --     Stufe 1 - einfach
            --     Stufe 2 - mittel
            --     Stufe 3 - schwer
            Stufe := Integer'Value (Eingabe & "") - 1;
            Spieler (1) := "PC Gegner";
            New_Line;
            Put_Line ("Tipp: Gib 'H' bei einem Spiel gegen den PC Gegner ein");
            Put_Line ("um eine Hilfestellung von ihm zu erhalten.");
            New_Line;
            exit Menu;
         when others =>
            --  Ungültige Eingabe
            --  Eingabedialog wird erneut aufgerufen
            Put_Line ("Eingabe ungueltig.");
            New_Line;
      end case;
   end loop Menu;
   New_Line (2);
   
   --  Spielstart!
   --  Das Spielt startet mit dem 0. Zug
   Zug := 0;
   
   Spiel : loop
      S := Zug mod 2; --  aktiver Spieler (0 oder 1)
      Put (SF);
      New_Line;

      Einwurf : loop
         Put (Spieler (S) & " (" & Spielstein (S) & ") ist dran: ");
         if Stufe > 0 and S = 1 then
            --  PC Gegner
            N := KI (B, Zug, Stufe);
            Put (N, 0);
            exit Einwurf;
         else --  Mensch
            Get (Eingabe);
            if Stufe > 0 and (Eingabe = 'H' or Eingabe = 'h') then
               Hilfestellung (B);
            else
               N := Integer'Value (Eingabe & "");
               if N in Spalte then
                  if not Setzen_Erlaubt (SF, N) then
                     Put_Line ("Diese Spalte ist schon voll!");
                     New_Line;
                  else
                     exit Einwurf;
                  end if;
               else
                  Put_Line ("Ungueltige Spaltennummer!");
                  New_Line;
               end if;
            end if;
         end if;
      end loop Einwurf;

      New_Line (4);
      SF_Kopie := SF;
      Spielstein_Setzen (SF, N, Spielstein (S));
      Free_Baum (B);

      if Gewonnen (SF, N) then
         Put (SF);
         New_Line;
         Put_Line (Spieler (S) & " hat das Spiel gewonnen!");
         exit Spiel;
      elsif (Zug  + 1) = SF'Last (1) * SF'Last (2) then
         Put (SF);
         New_Line;
         Put_Line ("Unentschieden!");
         exit Spiel;
      else
         if Stufe > 0 and S = 0 then
            B := Gib_Baum (SF_Kopie, (Stufe * 2) + 1, N,
                  Spielstein (0), Spielstein (1));
         end if;
         Zug := Zug + 1;
      end if;
   end loop Spiel;
   
   --  Ende
   New_Line (2);
   Put_Line ("Druecke eine beliebige Taste um das Spiel zu beenden.");
   Get (Eingabe);
   if Eingabe = 'n' then
      Vier_Gewinnt;
   end if;
end Vier_Gewinnt;