![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to partitions_of_sets_of_unknowns.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Product|
Return to partitions_of_sets_of_unknowns.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Product |
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;