Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/frequency_graph.adb, Revision 1.1
1.1 ! maekawa 1: package body Frequency_Graph is
! 2:
! 3: -- CREATORS :
! 4:
! 5: function Occurrences ( i : natural; l : List ) return natural is
! 6:
! 7: res : natural := 0;
! 8: tmp : List := l;
! 9: pt : Link_to_Vector;
! 10:
! 11: begin
! 12: while not Is_Null(tmp) loop
! 13: pt := Head_Of(tmp);
! 14: if pt(i) /= 0
! 15: then res := res + 1;
! 16: end if;
! 17: tmp := Tail_Of(tmp);
! 18: end loop;
! 19: return res;
! 20: end Occurrences;
! 21:
! 22: function Graph ( n : natural; supports : Array_of_Lists ) return Matrix is
! 23:
! 24: res : Matrix(1..n,supports'range);
! 25:
! 26: begin
! 27: for i in 1..n loop
! 28: for j in supports'range loop
! 29: res(i,j) := Occurrences(i,supports(j));
! 30: end loop;
! 31: end loop;
! 32: return res;
! 33: end Graph;
! 34:
! 35: -- MODIFIER :
! 36:
! 37: procedure Ignore ( m : in out Matrix; point : in Vector ) is
! 38: begin
! 39: for i in point'range loop
! 40: if point(i) /= 0
! 41: then for j in m'range(2) loop
! 42: m(i,j) := 1;
! 43: end loop;
! 44: end if;
! 45: end loop;
! 46: end Ignore;
! 47:
! 48: -- SELECTORS :
! 49:
! 50: function Occurrence ( i : natural; m : Matrix ) return natural is
! 51:
! 52: res : natural := 0;
! 53:
! 54: begin
! 55: for j in m'range(2) loop
! 56: if m(i,j) /= 0
! 57: then res := res + 1;
! 58: end if;
! 59: end loop;
! 60: return res;
! 61: end Occurrence;
! 62:
! 63: function Occurrence ( i : natural; m : Matrix; col : natural; perm : Vector )
! 64: return natural is
! 65:
! 66: res : natural := 0;
! 67:
! 68: begin
! 69: for j in col+1..m'last(2) loop
! 70: if m(i,perm(j)) /= 0
! 71: then res := res + 1;
! 72: end if;
! 73: end loop;
! 74: return res;
! 75: end Occurrence;
! 76:
! 77: function Occurrence ( v : Vector; m : Matrix ) return natural is
! 78:
! 79: min : natural := 1000000;
! 80: occ : natural;
! 81:
! 82: begin
! 83: for i in v'range loop
! 84: if v(i) /= 0
! 85: then occ := Occurrence(i,m);
! 86: if occ < min
! 87: then min := occ;
! 88: end if;
! 89: end if;
! 90: end loop;
! 91: return min;
! 92: end Occurrence;
! 93:
! 94: function Occurrence ( v : Vector; m : Matrix; col : natural; perm : Vector )
! 95: return natural is
! 96:
! 97: min : natural := 1000000;
! 98: occ : natural;
! 99:
! 100: begin
! 101: for i in v'range loop
! 102: if v(i) /= 0
! 103: then occ := Occurrence(i,m,col,perm);
! 104: if occ < min
! 105: then min := occ;
! 106: end if;
! 107: end if;
! 108: end loop;
! 109: return min;
! 110: end Occurrence;
! 111:
! 112: function Lowest_Occurrence
! 113: ( Vec : VecVec; start : natural; m : Matrix ) return natural is
! 114:
! 115: res : natural := start;
! 116: min : natural := Occurrence(vec(start).all,m);
! 117: occ : natural;
! 118:
! 119: begin
! 120: for i in start+1..vec'last loop
! 121: occ := Occurrence(vec(i).all,m);
! 122: if occ < min
! 123: then min := occ; res := i;
! 124: end if;
! 125: end loop;
! 126: return res;
! 127: end Lowest_Occurrence;
! 128:
! 129: function Lowest_Occurrence
! 130: ( vec : VecVec; start : natural; m : Matrix;
! 131: col : natural; perm : Vector ) return natural is
! 132:
! 133: res : natural := start;
! 134: min : natural := Occurrence(vec(start).all,m,col,perm);
! 135: occ : natural;
! 136:
! 137: begin
! 138: for i in start+1..vec'last loop
! 139: occ := Occurrence(vec(i).all,m,col,perm);
! 140: if occ < min
! 141: then min := occ; res := i;
! 142: end if;
! 143: end loop;
! 144: return res;
! 145: end Lowest_Occurrence;
! 146:
! 147: -- CONSTRUCTORS :
! 148:
! 149: function Sort ( l : List; m : Matrix ) return List is
! 150:
! 151: res : List;
! 152: vec : VecVec(1..Length_Of(l))
! 153: := Deep_Create(l);
! 154: tmp : Link_to_Vector;
! 155: low : natural;
! 156:
! 157: begin
! 158: if Length_Of(l) <= 1
! 159: then Copy(l,res);
! 160: else for i in vec'first..vec'last-1 loop
! 161: low := Lowest_Occurrence(vec,i,m);
! 162: if low /= i
! 163: then tmp := vec(i);
! 164: vec(i) := vec(low);
! 165: vec(low) := tmp;
! 166: end if;
! 167: end loop;
! 168: res := Deep_Create(vec);
! 169: Clear(vec);
! 170: end if;
! 171: return res;
! 172: end Sort;
! 173:
! 174: procedure Sort ( l : in out List; m : in Matrix ) is
! 175:
! 176: res : List := Sort(l,m);
! 177:
! 178: begin
! 179: Copy(res,l); Deep_Clear(res);
! 180: end Sort;
! 181:
! 182: function Sort ( l : List; m : Matrix; col : natural; perm : Vector )
! 183: return List is
! 184:
! 185: res : List;
! 186: vec : VecVec(1..Length_Of(l)) := Deep_Create(l);
! 187: tmp : Link_to_Vector;
! 188: low : natural;
! 189:
! 190: begin
! 191: if Length_Of(l) <= 1
! 192: then Copy(l,res);
! 193: else for i in vec'first..vec'last-1 loop
! 194: low := Lowest_Occurrence(vec,i,m,col,perm);
! 195: if low /= i
! 196: then tmp := vec(i);
! 197: vec(i) := vec(low);
! 198: vec(low) := tmp;
! 199: end if;
! 200: end loop;
! 201: res := Deep_Create(vec);
! 202: Clear(vec);
! 203: end if;
! 204: return res;
! 205: end Sort;
! 206:
! 207: procedure Sort ( l : in out List; m : in Matrix;
! 208: col : in natural; perm : in Vector ) is
! 209:
! 210: res : List := Sort(l,m,col,perm);
! 211:
! 212: begin
! 213: Copy(res,l); Deep_Clear(res);
! 214: end Sort;
! 215:
! 216: end Frequency_Graph;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to frequency_graph.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 / Dynlift