Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Product/sets_of_unknowns.adb, Revision 1.1
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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[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