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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>