Return to partitions_of_sets_of_unknowns.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Product

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Product/partitions_of_sets_of_unknowns.adb, Revision 1.1

1.1     ! maekawa     1: package body Partitions_of_Sets_of_Unknowns is
        !             2:
        !             3: -- CREATORS :
        !             4:
        !             5:   procedure Create ( p : in out Partition; n : in natural ) is
        !             6:   begin
        !             7:     for i in p'range loop
        !             8:       p(i) := Create(n);
        !             9:     end loop;
        !            10:   end Create;
        !            11:
        !            12:   function Create ( p : Partition ) return Partition is
        !            13:
        !            14:     res : Partition(p'range);
        !            15:
        !            16:   begin
        !            17:     for i in p'range loop
        !            18:       res(i) := Create(p(i));
        !            19:     end loop;
        !            20:     return res;
        !            21:   end Create;
        !            22:
        !            23: -- CONSTRUCTOR :
        !            24:
        !            25:   procedure Generate_Partitions ( s : in Set ) is
        !            26:
        !            27:   -- NOTE :
        !            28:   --   The algorithm below is a rather unelegant construction.
        !            29:   --   The VADS compiler for IBM RS/6000 had problems with the nested
        !            30:   --   generics, so the generation of all subsets is repeated here in full.
        !            31:
        !            32:     n : constant natural := Dimension(s);
        !            33:     continue : boolean := true;
        !            34:     p : Partition(1..n);
        !            35:     cnt : natural := 0;
        !            36:
        !            37:     procedure Generate ( v : in Set; cont : out boolean );
        !            38:
        !            39:     -- DESCRIPTION :
        !            40:     --   Generation of all partitions makes use of a double recursive process.
        !            41:
        !            42:     procedure Empty_Subsets ( w : in Set; cont : out boolean ) is
        !            43:
        !            44:       rest : Set := Difference(w,p(cnt));
        !            45:
        !            46:     begin
        !            47:       if Extent_of(rest) = 0
        !            48:        then Process(p(1..cnt),cont);
        !            49:        else Generate(rest,cont);
        !            50:       end if;
        !            51:       Clear(rest);
        !            52:     end Empty_Subsets;
        !            53:
        !            54:     procedure All_Subsets ( w : in Set; cont : out boolean ) is
        !            55:
        !            56:       sb : Set := Create(n);
        !            57:
        !            58:       procedure Create_Partition ( sub : in Set; cont : out boolean ) is
        !            59:
        !            60:         rest : Set;
        !            61:         back : Set := Create(p(cnt));   -- back up copy needed to restore
        !            62:
        !            63:       begin
        !            64:         Union(p(cnt),sub);
        !            65:         rest := Difference(w,p(cnt));
        !            66:         if Extent_Of(rest) = 0
        !            67:          then Process(p(1..cnt),cont);
        !            68:          else Generate(rest,cont);
        !            69:         end if;
        !            70:         Clear(p(cnt)); p(cnt) := Create(back);
        !            71:         Clear(rest); Clear(back);
        !            72:       end Create_Partition;
        !            73:
        !            74:       procedure Generate_Subset ( level,start : in natural ) is
        !            75:       begin
        !            76:         if level > 0
        !            77:          then for i in start..n loop
        !            78:                 if Is_In(w,i)
        !            79:                  then Add(sb,i);
        !            80:                       Create_Partition(sb,continue);
        !            81:                       if continue
        !            82:                        then Generate_Subset(level-1,i+1);
        !            83:                             Remove(sb,i);
        !            84:                       end if;
        !            85:                 end if;
        !            86:                 exit when not continue;
        !            87:               end loop;
        !            88:               cont := continue;
        !            89:         end if;
        !            90:       end Generate_Subset;
        !            91:
        !            92:     begin
        !            93:       Generate_Subset(n,1);
        !            94:       Clear(sb);
        !            95:     end All_Subsets;
        !            96:
        !            97:     procedure Generate ( v : in Set; cont : out boolean ) is
        !            98:     begin
        !            99:       for i in 1..n loop
        !           100:         if Is_In(v,i)
        !           101:          then cnt := cnt + 1;
        !           102:               p(cnt) := Create(n); Add(p(cnt),i);
        !           103:               Empty_Subsets(v,continue);
        !           104:               if continue
        !           105:                then declare
        !           106:                       w : Set := Create(v);
        !           107:                     begin
        !           108:                       Remove(w,i);
        !           109:                       All_Subsets(w,cont);
        !           110:                       Clear(w);
        !           111:                     end;
        !           112:               end if;
        !           113:               Clear(p(cnt)); cnt := cnt - 1;
        !           114:               cont := continue;
        !           115:         end if;
        !           116:         exit when Is_In(v,i);
        !           117:       end loop;
        !           118:     end Generate;
        !           119:
        !           120:   begin
        !           121:     Generate(s,continue);
        !           122:   end Generate_Partitions;
        !           123:
        !           124: -- SELECTOR :
        !           125:
        !           126:   function Number_of_Partitions ( n : natural ) return natural is
        !           127:
        !           128:     sum : natural;
        !           129:
        !           130:     function comb ( n,i : natural ) return natural is
        !           131:       n1,n2 : natural := 1;
        !           132:     begin
        !           133:       if (i = 0) or (i = n)
        !           134:        then return 1;
        !           135:        else for k in 1..i loop
        !           136:               n1 := n1 * (n - k + 1);
        !           137:               n2 := n2 * k;
        !           138:             end loop;
        !           139:             return (n1/n2);
        !           140:       end if;
        !           141:     end comb;
        !           142:
        !           143:   begin
        !           144:     if (n = 0) or (n = 1)
        !           145:      then return 1;
        !           146:      else sum := 0;
        !           147:           for k in 0..(n-1) loop
        !           148:             sum := sum + comb(n-1,k) * Number_Of_Partitions(n-1-k);
        !           149:           end loop;
        !           150:           return sum;
        !           151:     end if;
        !           152:   end Number_of_Partitions;
        !           153:
        !           154: -- DESTRUCTOR :
        !           155:
        !           156:   procedure Clear ( p : in out Partition ) is
        !           157:   begin
        !           158:     for i in p'range loop
        !           159:       Clear(p(i));
        !           160:     end loop;
        !           161:   end Clear;
        !           162:
        !           163: end Partitions_of_Sets_of_Unknowns;