Permutationen

--  FILE:    Permute.adb
--  PROJECT: Programmieruebungen, Uebungsblatt 2
--  VERSION: 1.0
--  DATE:    10.11.2006
--  AUTHOR:  http://www.CodeWelt.com
--
-------------------------------------------------------------------
--
--  Aufgabe 2.4: Permutationen
--
--  Menschen haben die Fähigkeit in längeren Texten Wörter lesen
--  zu können, an denen nur die Anzahl der Buchstaben sowie
--  der erste und letzte Buchstabe korrekt geschrieben sind.
--  o Das Programm gibt den Text "Gib ein Wort ein: " aus.
--    Der Benutzer gibt ein Wort ein.
--  o Das Programm listet alle möglichen Permutationen des
--    Wortes auf, wobei das erste und das letzte Zeichen des
--    Wortes jeweils undverändert bleiben.
--
-------------------------------------------------------------------
 
with Ada.Text_Io, Ada.Strings.Unbounded,
     Ada.Strings.Unbounded.Text_Io,Ada.Strings;
use  Ada.Text_Io, Ada.Strings.Unbounded,
     Ada.Strings.Unbounded.Text_Io,Ada.Strings;
 
procedure Permute is
 
   --  function Fakultaet
   --  Die rekursive Funktion berechnet die Fakultät einer gegebenen
   --  Zahl und gibt das Ergebnis zurück.
   --
   --  PARAMETERS:
   --  Param ist die Zahl dessen Fakultät berechnet werden soll.
   --
   --  returnS: Die Fakultät der als Parameter gelieferten
   --  Zahl wird als Integer zurückgegeben.
   function Fakultaet (Param : Integer) return Integer is
   begin
      if Param = 0 then
         return 1;
      else
         return Param * Fakultaet(Param - 1);
      end if;
   end Fakultaet;
 
 
   TYPE Permutation is ARRAY (Integer RANGE <>) OF Integer;
   -- Die Obergrenze ist hier auf 100_000 Buchstaben festgelegt.
   -- Bitte beachten Sie bei der Eingabe, dass bereits bei einem Wort mit
   -- acht Zeichen 720 Permutationen ausgegeben werden.
   Permuteme : Permutation (1..100000);  
 
   Eingabe : Unbounded_String := Null_Unbounded_String;
   EingabeUser : Unbounded_String := Null_Unbounded_String;
 
   GroesstmoeglicheI : Integer := 0;
   KleinsteElementZ : Integer := Integer'Last;
 
   Vertauschen1 : Integer := 0;
   Vertauschen2 : Integer := 0;
   BubbleSortVertauschen1 : Integer := 0;
   BubbleSortVertauschen2 : Integer := 0;
 
   Alphanumeric : String :="0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
   AlphanumericValue : ARRAY(1 .. 62) OF Integer;
 
   -- Der Counter von der While Schleife wird mit Startwert 1 festgelegt, da
   -- die erste sortierte Permutation vorab erstellt und ausgegeben wird.
   Counter : Integer := 1;
begin
 
   for Count IN 1..100000 loop   -- Die Werte im zu permutierenden Array werden
      Permuteme(Count) := 0;     -- für den Anfang alle auf Null gesetzt.
   end loop;
 
   -- In diesem Schritt wird der Array mit den Werten für jedes Zeichen
   -- im String Alphanumeric gefüllt.
   for Countthis IN 1..62 loop
      AlphanumericValue(Countthis) := Countthis;
   end loop;
 
   Ada.Text_IO.Put ("Gib ein Wort ein: ");   -- Benutzer gibt ein Wort ein.
   Get_Line(EingabeUser);
 
   -- Das erste und das letzte Zeichen werden gelöscht, bleiben aber in der
   -- Variable EingabeUser zur späteren Konkatenation erhalten.
   Eingabe := EingabeUser;
   Delete (Eingabe, Length(Eingabe), Length(Eingabe));
   Delete (Eingabe, 1, 1);  
 
   -- Hier wird der zu permutierende Array Permuteme mit den
   -- Werten jedes Buchstabens der Eingabe gefüllt.
   for Laufvar IN 1..Length(Eingabe) loop
      for Laufvar2 IN 1..62 loop
         if Alphanumeric(Laufvar2) = Element(Eingabe, Laufvar) then
            Permuteme(Laufvar) := AlphanumericValue(Laufvar2);
         end if;
      end loop;
   end loop;
 
   -- Dieser einfache Bubble Sort Algorithmus sortiert die Werte
   -- in dem zu permutierenden Array vor der Schleife für den Anfang,
   -- damit am Ende alle möglichen Permutationen ausgegeben werden.
   for Unsorted IN reverse 1 .. Length(Eingabe) - 1 loop
      for J IN 1 .. Unsorted loop
         if Permuteme (J) > Permuteme (J+1) then
            -- Sortieren durch direktes Austauschen
            BubbleSortVertauschen1 := Permuteme (J);
            BubbleSortVertauschen2 := Permuteme (J + 1);
            Permuteme (J) := BubbleSortVertauschen2;
            Permuteme (J + 1) := BubbleSortVertauschen1;
         end if;
      end loop;
   end loop;
 
   -- Diese, gerade sortierte, erste Permutation wird als Buchstaben ausgegeben.
   Put(Element(EingabeUser, 1));
   for Laufvar IN 1..Length(Eingabe) loop
      Put(Alphanumeric(Permuteme(Laufvar)));
   end loop;
   Put(Element(EingabeUser, Length(Eingabe) + 2));
   New_Line;
 
   -------------------------------------------------------------------
   -- Hier beginnt der Permutations Algorithmus der solange permutiert
   -- bis die letzte Permutation erreicht wurde.
   -- Gezählt wird vom Startwert 1 bis zur Fakultät von der Anzahl
   -- der zu permutierenden Zeichen.
   -- Der folgende Quelltext wird am Beispiel von Folie 228 erläutert.
   while Counter /= Fakultaet(Length(Eingabe)) loop
 
      -- Es wird das größte i mit 
      -- Permuteme(i) < Permuteme(i + 1) ermittelt.
      for Index IN 1..Length(Eingabe) loop
         if Index < Length(Eingabe) then
            if Permuteme(Index) < Permuteme(Index + 1) then
               GroesstmoeglicheI := Index;
            end if;
         end if;
      end loop;
 
      -- Es wird in Permuteme(i + 1) bis Permuteme(n) das kleinste
      -- Element z mit z > Permuteme(i) ermittelt.
      for Indexx IN GroesstmoeglicheI + 1 .. Length(Eingabe) loop
         if Permuteme(Indexx) > Permuteme(GroesstmoeglicheI) then
            KleinsteElementZ := Indexx;
         end if;
      end loop;
 
      -- Die gefundenen Zahlen werden ausgetauscht.
      Vertauschen1 := Permuteme(GroesstmoeglicheI);
      Vertauschen2 := Permuteme(KleinsteElementZ);
      Permuteme(GroesstmoeglicheI) := Vertauschen2;
      Permuteme(KleinsteElementZ) := Vertauschen1;
 
      -- Dieser einfache Bubble Sort Algorithmus sortiert von
      -- Permuteme(i + 1) bis Permuteme(n)
      for Unsorted IN reverse GroesstmoeglicheI + 1 .. Length(Eingabe) - 1 loop
         for J IN GroesstmoeglicheI + 1 .. Unsorted loop
            if Permuteme (J) > Permuteme (J+1) then
               -- Sortieren durch direktes Austauschen
               BubbleSortVertauschen1 := Permuteme (J);
               BubbleSortVertauschen2 := Permuteme (J + 1);
               Permuteme (J) := BubbleSortVertauschen2;
               Permuteme (J + 1) := BubbleSortVertauschen1;
            end if;
         end loop;
      end loop;
 
      -- Die ermittelte Permutation wird in Form von Buchstaben ausgegeben.
      Put(Element(EingabeUser, 1));
      for Laufvar IN 1..Length(Eingabe) loop
         Put(Alphanumeric(Permuteme(Laufvar)));  
      end loop;
      Put(Element(EingabeUser, Length(Eingabe) + 2)); 
      New_Line;   
 
      Counter := Counter + 1;
   end loop;
   -------------------------------------------------------------------
end Permute;