-- Porzadek leksykograficzny
--
-- Generowanie:
--  - permutacji
--  - podzbiorow
--  - podziorow k-elementowych
--  - slow n-elementowych
--
-- www.algorytm.org
-- (c) 2007 Tomasz Lubinski

with Text_IO;
use Text_IO;

procedure porz_leks is

   type setOfString is array (Positive range <>) of String(1..6);
   type intArray is array (Positive range <>) of Integer;

   procedure NextWord(Alf: String; slowo: in out String; result: out Boolean) is
   
        i : Integer := slowo'Last;
        j : Integer := Alf'First;
   begin             
        while (i >= slowo'First) and then (slowo(i) = Alf(Alf'Last)) loop
           i := i - 1;
        end loop;
        
        if (i < slowo'First) then
           result := False;
           return;
        end if;
        
        while (Alf(j) /= slowo(i)) loop
           j := j + 1;
        end loop;
        
        slowo(i) := Alf(j+1);
        for s in i+1..slowo'Last loop
           slowo(s):=Alf(Alf'First);
        end loop;
        
        result := True;
   end;

   procedure Slowa(Alf: String; k: Integer) is

        slowo : String (1..k);
        p : File_Type;
        res: Boolean;
   begin
           
        for i in slowo'range loop
           slowo(i) := Alf(Alf'first);
        end loop;
           
        slowo(k) := '0';
        Create(p, Out_File, "slowa.txt");
        Put_Line(p, slowo);
        loop
            NextWord(Alf,slowo,res);
            exit when res = False;
            Put_Line(p, slowo);
        end loop;
        
        Close(p);
   end;

   procedure Podzbiory(Zbior: setOfString) is

        Alf : String := "01";
        slowo : String(zbior'Range);
        p : File_Type;
        res: Boolean;
   begin
        
        Create(p, Out_File, "podzbiory.txt");

        for i in slowo'range loop
           slowo(i) := Alf(Alf'first);
        end loop;
        
        Put_Line(p, "zbior pusty");
        
        loop
                NextWord(Alf,slowo,res);
                exit when res = False;
                for i in slowo'Range loop
                        if (slowo(i) = '1') then
                            Put(p, Zbior(i) & " ");
                        end if;
                end loop;
                Put_Line(p, "");
        end loop;
        
        Close(p);
   end;

   procedure NastPerm(perm: in out intArray; res: out Boolean) is
        i : Integer := perm'Last;
        min, indmin: Integer;
        a, b: Integer;
   begin        
        if (perm'Length = 1) then
           res := False;
           return;
        end if;

        while(i>perm'First) and then (perm(i)<perm(i-1)) loop
           i := i-1;
        end loop;
        
        if(i = perm'First) then
           res := False;
           return;
        end if;
        
        i := i-1;
        min := perm(i+1);
        indmin := i+1;
        for j in i+2..perm'Last loop
                if(perm(j)>perm(i)) and then
                  (perm(j)<min) then
                        min := perm(j);
                        indmin := j;
                end if;
        end loop;
        perm(indmin) := perm(i);
        perm(i) := min;
        a := i+1;
        b := perm'Last;
        while(a<b) loop
                min:=perm(a); perm(a):=perm(b); perm(b):=min;
                a:=a+1; b:=b-1;
        end loop;
        res := True;
   end;

   procedure Permutacje(zbior: setOfString) is

        tab : intArray(zbior'range);
        p : File_Type;
        res : Boolean;
   begin        
        Create(p, Out_File, "permutacje.txt");
        for i in tab'Range loop
           tab(i) := i;
        end loop;
        
        loop
                for i in tab'Range loop
                    Put(p, zbior(tab(i)) & " ");
                end loop;
                Put_Line(p, "");
                NastPerm(tab, res);
                exit when (res = False);
        end loop;
        
        Close(p);
   end;

   procedure NastKomb(slowo: in out intArray; res: out Boolean) is

        i, j, pom : Integer;
   begin        
        if slowo'length = 1 then
           res := False;
           return;
        end if;
        
        i := slowo'Last-1;
        while(i>=slowo'First) and then not(slowo(i)=0 and then slowo(i+1)=1) loop
           i := i-1;
        end loop;
           
        if i < slowo'First then
           res := False;
           return;
        end if;
        
        slowo(i) := 1;
        slowo(i+1) := 0;
        if slowo(slowo'Last) = 1 or else
           i = slowo'Last-1 then
           res := True;
           return;
        end if;
        
        i := i+2;
        
        if (slowo(i) = 0) then
           res := True;
           return;
        end if;
           
        j := slowo'Last;
        while(i<j) loop
                pom := slowo(i);
                slowo(i) := slowo(j);
                slowo(j) := pom;
                i := i+1;
                j := j-1;
        end loop;
        
        res := True;
   end;

   procedure Podzbiory_k_elementowe(zbior: setOfString; k: Integer) is
        tab : intArray(zbior'Range);
        p : File_Type;
        res : Boolean;
   begin        
        Create(p, Out_File, "podzbkelemnt.txt");
        
        for i in tab'Last-k+1..tab'Last loop
                tab(i):=1;
        end loop;
        
        for i in tab'First..tab'Last-k loop
                tab(i) := 0;
        end loop;
        
        loop         
                for i in tab'Range loop
                        if (tab(i) = 1) then
                            Put(p, zbior(i) & " ");
                        end if;
                end loop;
                Put_Line(p, "");
                NastKomb(tab, res);
                exit when (res = False);
        end loop;
        
        Close(p);
   end;

   zb : setOfString := ("ala   ","ma    ","malego","kotka ");
   Alfabet : String := "01";
        
begin
               
        Podzbiory_k_elementowe(zb,2);
        Permutacje(zb);
        Podzbiory(zb);
        Slowa(Alfabet,4);
end;