File: [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Product / partitions_of_sets_of_unknowns.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:29 2000 UTC (23 years, 10 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
package body Partitions_of_Sets_of_Unknowns is
-- CREATORS :
procedure Create ( p : in out Partition; n : in natural ) is
begin
for i in p'range loop
p(i) := Create(n);
end loop;
end Create;
function Create ( p : Partition ) return Partition is
res : Partition(p'range);
begin
for i in p'range loop
res(i) := Create(p(i));
end loop;
return res;
end Create;
-- CONSTRUCTOR :
procedure Generate_Partitions ( s : in Set ) is
-- NOTE :
-- The algorithm below is a rather unelegant construction.
-- The VADS compiler for IBM RS/6000 had problems with the nested
-- generics, so the generation of all subsets is repeated here in full.
n : constant natural := Dimension(s);
continue : boolean := true;
p : Partition(1..n);
cnt : natural := 0;
procedure Generate ( v : in Set; cont : out boolean );
-- DESCRIPTION :
-- Generation of all partitions makes use of a double recursive process.
procedure Empty_Subsets ( w : in Set; cont : out boolean ) is
rest : Set := Difference(w,p(cnt));
begin
if Extent_of(rest) = 0
then Process(p(1..cnt),cont);
else Generate(rest,cont);
end if;
Clear(rest);
end Empty_Subsets;
procedure All_Subsets ( w : in Set; cont : out boolean ) is
sb : Set := Create(n);
procedure Create_Partition ( sub : in Set; cont : out boolean ) is
rest : Set;
back : Set := Create(p(cnt)); -- back up copy needed to restore
begin
Union(p(cnt),sub);
rest := Difference(w,p(cnt));
if Extent_Of(rest) = 0
then Process(p(1..cnt),cont);
else Generate(rest,cont);
end if;
Clear(p(cnt)); p(cnt) := Create(back);
Clear(rest); Clear(back);
end Create_Partition;
procedure Generate_Subset ( level,start : in natural ) is
begin
if level > 0
then for i in start..n loop
if Is_In(w,i)
then Add(sb,i);
Create_Partition(sb,continue);
if continue
then Generate_Subset(level-1,i+1);
Remove(sb,i);
end if;
end if;
exit when not continue;
end loop;
cont := continue;
end if;
end Generate_Subset;
begin
Generate_Subset(n,1);
Clear(sb);
end All_Subsets;
procedure Generate ( v : in Set; cont : out boolean ) is
begin
for i in 1..n loop
if Is_In(v,i)
then cnt := cnt + 1;
p(cnt) := Create(n); Add(p(cnt),i);
Empty_Subsets(v,continue);
if continue
then declare
w : Set := Create(v);
begin
Remove(w,i);
All_Subsets(w,cont);
Clear(w);
end;
end if;
Clear(p(cnt)); cnt := cnt - 1;
cont := continue;
end if;
exit when Is_In(v,i);
end loop;
end Generate;
begin
Generate(s,continue);
end Generate_Partitions;
-- SELECTOR :
function Number_of_Partitions ( n : natural ) return natural is
sum : natural;
function comb ( n,i : natural ) return natural is
n1,n2 : natural := 1;
begin
if (i = 0) or (i = n)
then return 1;
else for k in 1..i loop
n1 := n1 * (n - k + 1);
n2 := n2 * k;
end loop;
return (n1/n2);
end if;
end comb;
begin
if (n = 0) or (n = 1)
then return 1;
else sum := 0;
for k in 0..(n-1) loop
sum := sum + comb(n-1,k) * Number_Of_Partitions(n-1-k);
end loop;
return sum;
end if;
end Number_of_Partitions;
-- DESTRUCTOR :
procedure Clear ( p : in out Partition ) is
begin
for i in p'range loop
Clear(p(i));
end loop;
end Clear;
end Partitions_of_Sets_of_Unknowns;