![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to 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 sets_of_unknowns.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Product |
1.1 maekawa 1: with unchecked_deallocation;
2:
3: package body Sets_of_Unknowns is
4:
5: -- REPRESENTATION OF A SET :
6:
7: type Set_Rep is array (positive range <> ) of boolean;
8:
9: procedure free is new unchecked_deallocation(Set_Rep,Set);
10:
11: -- CREATORS :
12:
13: function Create ( n : natural ) return Set is
14:
15: s : Set := new Set_Rep'(1..n => false);
16:
17: begin
18: return s;
19: end Create;
20:
21: function Create ( s : Set ) return Set is
22:
23: s1 : Set;
24:
25: begin
26: if s = null
27: then s1 := s;
28: else s1 := new Set_Rep'(s.all);
29: end if;
30: return s1;
31: end Create;
32:
33: -- CONSTRUCTORS :
34:
35: procedure Add ( s : in out Set; i : in natural ) is
36: begin
37: s(i) := true;
38: end Add;
39:
40: procedure Union ( s1 : in out Set; s2 : in Set ) is
41: begin
42: for i in 1..Dimension(s2) loop
43: if Is_In(s2,i)
44: then Add(s1,i);
45: end if;
46: end loop;
47: end Union;
48:
49: function Union ( s1,s2 : Set ) return Set is
50:
51: s : Set := Create(s1);
52:
53: begin
54: Union(s,s2);
55: return s;
56: end Union;
57:
58: procedure Remove ( s : in out Set; i : in natural ) is
59: begin
60: s(i) := false;
61: end Remove;
62:
63: procedure Difference ( s1 : in out Set; s2 : in Set ) is
64: begin
65: for i in 1..Dimension(s2) loop
66: if Is_In(s2,i)
67: then Remove(s1,i);
68: end if;
69: end loop;
70: end Difference;
71:
72: function Difference ( s1,s2 : Set ) return Set is
73:
74: s : Set := Create(s1);
75:
76: begin
77: Difference(s,s2);
78: return s;
79: end Difference;
80:
81: procedure Intersection ( s1 : in out Set; s2 : in Set ) is
82: begin
83: for i in 1..Dimension(s1) loop
84: if Is_In(s1,i) and then not Is_In(s2,i)
85: then Remove(s1,i);
86: end if;
87: end loop;
88: end Intersection;
89:
90: function Intersection ( s1,s2 : Set ) return Set is
91:
92: s : Set := Create(s1);
93:
94: begin
95: Intersection(s,s2);
96: return s;
97: end Intersection;
98:
99: -- SELECTORS :
100:
101: function Dimension ( s : Set ) return natural is
102: begin
103: if s = null
104: then return 0;
105: else return s'last;
106: end if;
107: end Dimension;
108:
109: function Extent_Of ( s : Set ) return natural is
110:
111: cnt : natural := 0;
112:
113: begin
114: for i in 1..Dimension(s) loop
115: if Is_In(s,i)
116: then cnt := cnt + 1;
117: end if;
118: end loop;
119: return cnt;
120: end Extent_Of;
121:
122: function Is_In ( s : Set; i : natural ) return boolean is
123: begin
124: return s(i);
125: end Is_In;
126:
127: function Is_Subset ( s1,s2 : Set ) return boolean is
128: begin
129: for i in 1..Dimension(s1) loop
130: if Is_In(s1,i) and then not Is_In(s2,i)
131: then return false;
132: end if;
133: end loop;
134: return true;
135: end Is_Subset;
136:
137: function Is_Equal ( s1,s2 : Set ) return boolean is
138: begin
139: return (Is_Subset(s1,s2) and then Is_Subset(s2,s1));
140: end Is_Equal;
141:
142: procedure Generate_Subsets ( s : in Set; k : in positive ) is
143:
144: n : constant natural := Dimension(s);
145: sub : Set := Create(n);
146: cont : boolean;
147:
148: procedure Generate ( level,start : in natural ) is
149: begin
150: if level = 0
151: then Process(sub,cont);
152: else for i in start..n-level+1 loop
153: if Is_In(s,i)
154: then Add(sub,i);
155: Generate(level-1,i+1);
156: Remove(sub,i);
157: end if;
158: exit when not cont;
159: end loop;
160: end if;
161: end Generate;
162:
163: begin
164: Generate(k,1);
165: Clear(sub);
166: end Generate_Subsets;
167:
168: procedure Generate_All_Subsets ( s : in Set ) is
169:
170: n : constant natural := Dimension(s);
171: sub : Set := Create(n);
172: cont : boolean;
173:
174: procedure Generate ( level,start : in natural ) is
175: begin
176: if level > 0
177: then for i in start..n loop
178: if Is_In(s,i)
179: then Add(sub,i);
180: Process(sub,cont);
181: if cont
182: then Generate(level-1,i+1);
183: Remove(sub,i);
184: end if;
185: end if;
186: exit when not cont;
187: end loop;
188: end if;
189: end Generate;
190:
191: begin
192: Generate(n,1);
193: Clear(sub);
194: end Generate_All_Subsets;
195:
196: -- DESTRUCTOR :
197:
198: procedure Clear ( s : in out Set ) is
199: begin
200: free(s);
201: end Clear;
202:
203: end Sets_of_Unknowns;