Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/linear_symmetric_reduction.adb, Revision 1.1
1.1 ! maekawa 1: with Standard_Integer_Vectors; use Standard_Integer_Vectors;
! 2: with Standard_Complex_Vectors;
! 3: with Permutations,Permute_Operations; use Permutations,Permute_Operations;
! 4: with Random_Product_System;
! 5:
! 6: package body Linear_Symmetric_Reduction is
! 7:
! 8: -- AUXILIARY DATA STRUCTURE AND OPERATIONS :
! 9:
! 10: type Lin_Sys is array(integer range <>)
! 11: of Standard_Complex_Vectors.Link_to_Vector;
! 12:
! 13: -- ELEMENTARY OPERATIONS :
! 14:
! 15: function Linear_System ( pos : Vector ) return Lin_Sys is
! 16:
! 17: -- DESCRIPTION :
! 18: -- Creates a linear system, by extracting the vectors that
! 19: -- correspond to the entries in the given position.
! 20:
! 21: res : Lin_Sys(pos'range);
! 22: use Random_Product_System;
! 23:
! 24: begin
! 25: for k in res'range loop
! 26: res(k) := Get_Hyperplane(k,pos(k));
! 27: end loop;
! 28: return res;
! 29: end Linear_System;
! 30:
! 31: function Permute ( p : Permutation; ls : Lin_Sys ) return Lin_Sys is
! 32:
! 33: -- DESCRIPTION :
! 34: -- Permutes the equations in the linear system.
! 35:
! 36: res : Lin_Sys(ls'range);
! 37: use Standard_Complex_Vectors;
! 38:
! 39: begin
! 40: for i in p'range loop
! 41: if p(i) >= 0
! 42: then res(i) := ls(p(i));
! 43: else res(i) := -ls(-p(i));
! 44: end if;
! 45: end loop;
! 46: return res;
! 47: end Permute;
! 48:
! 49: function Permute ( ls : Lin_Sys; p : Permutation ) return Lin_Sys is
! 50:
! 51: -- DESCRIPTION :
! 52: -- Permutes the unknowns in the linear system.
! 53:
! 54: res : Lin_Sys(ls'range);
! 55:
! 56: begin
! 57: for k in res'range loop
! 58: res(k) := new Standard_Complex_Vectors.Vector'(p*ls(k).all);
! 59: end loop;
! 60: return res;
! 61: end Permute;
! 62:
! 63: function Permutable ( ls1,ls2 : Lin_Sys ) return boolean is
! 64:
! 65: -- DESCRIPTION :
! 66: -- Returns true when there exists a permutation that permutes
! 67: -- the first linear system into the second one.
! 68:
! 69: found : boolean := true;
! 70:
! 71: begin
! 72: for i in ls1'range loop
! 73: for j in ls2'range loop
! 74: found := Permutable(ls1(i).all,ls2(j).all);
! 75: exit when found;
! 76: end loop;
! 77: exit when not found;
! 78: end loop;
! 79: return found;
! 80: end Permutable;
! 81:
! 82: function Sign_Permutable ( ls1,ls2 : Lin_Sys ) return boolean is
! 83:
! 84: -- DESCRIPTION :
! 85: -- Returns true when there exists a permutation that permutes
! 86: -- the first linear system into the second one, also w.r.t. sign
! 87: -- permutations.
! 88:
! 89: found : boolean := true;
! 90:
! 91: begin
! 92: for i in ls1'range loop
! 93: for j in ls2'range loop
! 94: found := Sign_Permutable(ls1(i).all,ls2(j).all);
! 95: exit when found;
! 96: end loop;
! 97: exit when not found;
! 98: end loop;
! 99: return found;
! 100: end Sign_Permutable;
! 101:
! 102: procedure Clear ( ls : in out Lin_Sys ) is
! 103:
! 104: -- DESCRIPTION :
! 105: -- Deallocation of the occupied memory space.
! 106:
! 107: begin
! 108: for k in ls'range loop
! 109: Standard_Complex_Vectors.Clear(ls(k));
! 110: end loop;
! 111: end Clear;
! 112:
! 113: -- UTILITIES :
! 114:
! 115: procedure Search_Permutable
! 116: ( sub : in Lin_Sys; pos : in Vector;
! 117: res,res_last : in out List ) is
! 118:
! 119: -- DESCRIPTION :
! 120: -- In the list of positions, already in res, it will be searched
! 121: -- whether there exists a linear system that is permutable with the
! 122: -- given linear system.
! 123:
! 124: tmp : List := res;
! 125: found : boolean := false;
! 126: ls2 : Lin_Sys(sub'range);
! 127:
! 128: begin
! 129: while not Is_Null(tmp) loop
! 130: ls2 := Linear_System(Head_Of(tmp).all);
! 131: found := Permutable(sub,ls2);
! 132: exit when found;
! 133: tmp := Tail_Of(tmp);
! 134: end loop;
! 135: if not found
! 136: then Append(res,res_last,pos);
! 137: end if;
! 138: end Search_Permutable;
! 139:
! 140: procedure Search_Sign_Permutable
! 141: ( sub : in Lin_Sys; pos : in Vector;
! 142: res,res_last : in out List ) is
! 143:
! 144: -- DESCRIPTION :
! 145: -- In the list of positions, already in res, it will be searched
! 146: -- whether there exists a linear system that is sign permutable
! 147: -- with the given linear system.
! 148:
! 149: tmp : List := res;
! 150: found : boolean := false;
! 151: ls2 : Lin_Sys(sub'range);
! 152:
! 153: begin
! 154: while not Is_Null(tmp) loop
! 155: ls2 := Linear_System(Head_Of(tmp).all);
! 156: found := Sign_Permutable(sub,ls2);
! 157: exit when found;
! 158: tmp := Tail_Of(tmp);
! 159: end loop;
! 160: if not found
! 161: then Append(res,res_last,pos);
! 162: end if;
! 163: end Search_Sign_Permutable;
! 164:
! 165: function Search_Position ( sub : Lin_Sys ) return Vector is
! 166:
! 167: -- DESCRIPTION :
! 168: -- Returns the position of the system in the product system.
! 169:
! 170: res : Vector(sub'range);
! 171: lh : Standard_Complex_Vectors.Link_to_Vector;
! 172:
! 173: begin
! 174: for k in 1..Random_Product_System.Dimension loop
! 175: res(k) := 0;
! 176: for l in 1..Random_Product_System.Number_of_Hyperplanes(k) loop
! 177: lh := Random_Product_System.Get_Hyperplane(k,l);
! 178: if Standard_Complex_Vectors.Equal(sub(k).all,lh.all)
! 179: then res(k) := l;
! 180: end if;
! 181: exit when res(k) /= 0;
! 182: end loop;
! 183: end loop;
! 184: return res;
! 185: end Search_Position;
! 186:
! 187: procedure Permute_and_Search
! 188: ( v,w : List_of_Permutations; sub : in Lin_Sys;
! 189: pos : in Vector; res,res_last : in out List ) is
! 190:
! 191: -- DESCRIPTION :
! 192: -- The permutations are applied to the subsystem.
! 193: -- If none of the positions of the permuted systems already
! 194: -- belongs to res, then its position pos will be added to res.
! 195:
! 196: lv,lw : List_of_Permutations;
! 197: found : boolean := false;
! 198:
! 199: begin
! 200: lv := v; lw := w;
! 201: -- put_line("The permuted positions : ");
! 202: while not Is_Null(lv) loop
! 203: declare
! 204: vpersub : Lin_Sys(sub'range)
! 205: := Permute(sub,Permutation(Head_Of(lv).all));
! 206: wpersub : Lin_Sys(sub'range)
! 207: := Permute(Permutation(Head_Of(lw).all),vpersub);
! 208: perpos : Vector(pos'range) := Search_Position(wpersub);
! 209: begin
! 210: if Is_In(res,perpos)
! 211: then found := true;
! 212: end if;
! 213: end;
! 214: exit when found;
! 215: lv := Tail_Of(lv);
! 216: lw := Tail_Of(lw);
! 217: end loop;
! 218: if not found
! 219: then Append(res,res_last,pos);
! 220: end if;
! 221: end Permute_and_Search;
! 222:
! 223: function Generate_Positions return List is
! 224:
! 225: res,res_last : List;
! 226: n : constant natural := Random_Product_System.Dimension;
! 227: pos : Vector(1..n) := (1..n => 1);
! 228:
! 229: procedure Generate_Positions ( k : natural ) is
! 230: begin
! 231: if k > n
! 232: then Append(res,res_last,pos);
! 233: else for l in 1..Random_Product_System.Number_of_Hyperplanes(k) loop
! 234: pos(k) := l;
! 235: Generate_Positions(k+1);
! 236: end loop;
! 237: end if;
! 238: end Generate_Positions;
! 239:
! 240: begin
! 241: Generate_Positions(1);
! 242: return res;
! 243: end Generate_Positions;
! 244:
! 245: -- TARGET ROUTINES :
! 246:
! 247: function Linear_Symmetric_Reduce ( sign : boolean ) return List is
! 248:
! 249: res : List;
! 250:
! 251: begin
! 252: res := Generate_Positions;
! 253: Linear_Symmetric_Reduce(res,sign);
! 254: return res;
! 255: end Linear_Symmetric_Reduce;
! 256:
! 257: function Linear_Symmetric_Reduce
! 258: ( v,w : List_of_Permutations ) return List is
! 259:
! 260: res : List;
! 261:
! 262: begin
! 263: res := Generate_Positions;
! 264: Linear_Symmetric_Reduce(v,w,res);
! 265: return res;
! 266: end Linear_Symmetric_Reduce;
! 267:
! 268: procedure Linear_Symmetric_Reduce ( lp : in out List; sign : in boolean ) is
! 269:
! 270: res,res_last : List;
! 271: sub : Lin_Sys(1..Random_Product_System.Dimension);
! 272: pos : Vector(sub'range);
! 273: tlp : List := lp;
! 274:
! 275: begin
! 276: while not Is_Null(tlp) loop
! 277: pos := Head_Of(tlp).all;
! 278: sub := Linear_System(pos);
! 279: if not sign
! 280: then Search_Permutable(sub,pos,res,res_last);
! 281: else Search_Sign_Permutable(sub,pos,res,res_last);
! 282: end if;
! 283: tlp := Tail_Of(tlp);
! 284: end loop;
! 285: Clear(lp);
! 286: lp := res;
! 287: end Linear_Symmetric_Reduce;
! 288:
! 289: procedure Linear_Symmetric_Reduce
! 290: ( v,w : in List_of_Permutations; lp : in out List ) is
! 291:
! 292: res,res_last : List;
! 293: sub : Lin_Sys(1..Random_Product_System.Dimension);
! 294: pos : Vector(sub'range);
! 295: tlp : List := lp;
! 296:
! 297: begin
! 298: while not Is_Null(tlp) loop
! 299: pos := Head_Of(tlp).all;
! 300: sub := Linear_System(pos);
! 301: Permute_and_Search(v,w,sub,pos,res,res_last);
! 302: tlp := Tail_Of(tlp);
! 303: end loop;
! 304: Clear(lp);
! 305: lp := res;
! 306: end Linear_Symmetric_Reduce;
! 307:
! 308: end Linear_Symmetric_Reduction;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to linear_symmetric_reduction.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 / Symmetry