Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/symmetric_lifting_functions.adb, Revision 1.1
1.1 ! maekawa 1: with Standard_Random_Numbers; use Standard_Random_Numbers;
! 2: with Lists_of_Integer_Vectors;
! 3: with Lists_of_Floating_Vectors;
! 4: with Mixed_Volume_Computation; use Mixed_Volume_Computation;
! 5: with Permutations,Permute_Operations; use Permutations,Permute_Operations;
! 6:
! 7: package body Symmetric_Lifting_Functions is
! 8:
! 9: procedure Classify_Orbits
! 10: ( supports : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
! 11: mix : in Standard_Integer_Vectors.Vector;
! 12: v,w : in List_of_Permutations; norb : out natural;
! 13: orbits : out Arrays_of_Integer_Vector_Lists.Array_of_Lists ) is
! 14:
! 15: use Standard_Integer_Vectors;
! 16: use Lists_of_Integer_Vectors;
! 17: use Arrays_of_Integer_Vector_Lists;
! 18:
! 19: res,done,res_last,done_last : Array_of_Lists(mix'range);
! 20: cnt,k,orbit,inmixk : natural;
! 21: n : constant natural := supports'last - supports'first + 1;
! 22: tmp : List;
! 23: lv : Link_to_Vector;
! 24:
! 25: function Lift ( lv : Link_to_Vector ) return Link_to_Vector is
! 26:
! 27: res : Link_to_Vector;
! 28:
! 29: begin
! 30: res := new Vector(lv'first..lv'last+1);
! 31: res(lv'range) := lv.all;
! 32: res(res'last) := orbit;
! 33: return res;
! 34: end Lift;
! 35:
! 36: function Search_and_Lift ( lv : Link_to_Vector; l : List )
! 37: return Link_to_Vector is
! 38: begin
! 39: if Is_In(l,lv)
! 40: then return Lift(lv);
! 41: else return lv;
! 42: end if;
! 43: end Search_and_Lift;
! 44:
! 45: procedure Update ( k : in natural; lv,liftlv : in Link_to_Vector ) is
! 46: begin
! 47: if not Is_In(done(k),lv)
! 48: then Append(done(k),done_last(k),lv.all);
! 49: Append(res(k),res_last(k),liftlv.all);
! 50: end if;
! 51: end Update;
! 52:
! 53: begin
! 54: orbit := 0;
! 55: k := supports'first;
! 56: for i in mix'range loop
! 57: tmp := supports(k);
! 58: inmixk := Compute_Index(k,mix);
! 59: while not Is_Null(tmp) loop
! 60: lv := Head_Of(tmp);
! 61: if not Is_In(done(inmixk),lv)
! 62: then orbit := orbit + 1; -- new orbit
! 63: declare
! 64: tmpv,tmpw : List_of_Permutations;
! 65: liftlv : Link_to_Vector := Lift(lv);
! 66: begin
! 67: Update(inmixk,lv,liftlv); Clear(liftlv);
! 68: tmpv := v; tmpw := w;
! 69: while not Is_Null(tmpv) loop -- construct the orbit
! 70: declare
! 71: plv : Link_to_Vector := new Vector(lv'range);
! 72: index : natural := Head_Of(tmpw)(k);
! 73: inmix : natural := Compute_Index(index,mix);
! 74: begin
! 75: plv.all := Permutation(Head_Of(tmpv).all)*lv.all;
! 76: liftlv := Search_and_Lift(plv,supports(index));
! 77: if liftlv'last = n+1
! 78: then inmix := Compute_Index(index,mix);
! 79: Update(inmix,plv,liftlv); Clear(liftlv);
! 80: end if;
! 81: Clear(plv);
! 82: end;
! 83: tmpv := Tail_Of(tmpv);
! 84: tmpw := Tail_Of(tmpw);
! 85: end loop;
! 86: end;
! 87: end if;
! 88: tmp := Tail_Of(tmp);
! 89: end loop;
! 90: k := k + mix(i);
! 91: end loop;
! 92: Deep_Clear(done);
! 93: cnt := 1;
! 94: for i in res'range loop
! 95: for j in 1..mix(i) loop
! 96: orbits(cnt) := res(i);
! 97: cnt := cnt + 1;
! 98: end loop;
! 99: end loop;
! 100: norb := orbit;
! 101: end Classify_Orbits;
! 102:
! 103: procedure Float_Lift_Orbits
! 104: ( orbits : in out Arrays_of_Floating_Vector_Lists.Array_of_Lists;
! 105: lifting : in Standard_Floating_Vectors.Vector ) is
! 106:
! 107: use Standard_Floating_Vectors;
! 108: use Lists_of_Floating_Vectors;
! 109: tmp : List;
! 110:
! 111: begin
! 112: for k in orbits'range loop
! 113: tmp := orbits(k);
! 114: while not Is_Null(tmp) loop
! 115: declare
! 116: lv : Link_to_Vector := Head_Of(tmp);
! 117: begin
! 118: lv(lv'last) := lifting(integer(lv(lv'last)));
! 119: Set_Head(tmp,lv);
! 120: end;
! 121: tmp := Tail_Of(tmp);
! 122: end loop;
! 123: end loop;
! 124: end Float_Lift_Orbits;
! 125:
! 126: procedure Integer_Lift_Orbits
! 127: ( orbits : in out Arrays_of_Integer_Vector_Lists.Array_of_Lists;
! 128: lifting : in Standard_Integer_Vectors.Vector ) is
! 129:
! 130: use Standard_Integer_Vectors;
! 131: use Lists_of_Integer_Vectors;
! 132: tmp : List;
! 133:
! 134: begin
! 135: for k in orbits'range loop
! 136: tmp := orbits(k);
! 137: while not Is_Null(tmp) loop
! 138: declare
! 139: lv : Link_to_Vector := Head_Of(tmp);
! 140: begin
! 141: lv(lv'last) := lifting(lv(lv'last));
! 142: Set_Head(tmp,lv);
! 143: end;
! 144: tmp := Tail_Of(tmp);
! 145: end loop;
! 146: end loop;
! 147: end Integer_Lift_Orbits;
! 148:
! 149: procedure Float_Random_Lift_Orbits
! 150: ( orbits : in out Arrays_of_Floating_Vector_Lists.Array_of_Lists;
! 151: norb : in natural; lower,upper : in double_float ) is
! 152:
! 153: use Standard_Floating_Vectors;
! 154: rv : Vector(1..norb);
! 155:
! 156: begin
! 157: for k in rv'range loop
! 158: rv(k) := (Random + 1.0)*(upper - lower)/2.0;
! 159: end loop;
! 160: Float_Lift_Orbits(orbits,rv);
! 161: end Float_Random_Lift_Orbits;
! 162:
! 163: procedure Integer_Random_Lift_Orbits
! 164: ( orbits : in out Arrays_of_Integer_Vector_Lists.Array_of_Lists;
! 165: norb : in natural; lower,upper : in integer ) is
! 166:
! 167: use Standard_Integer_Vectors;
! 168: rv : Vector(1..norb);
! 169:
! 170: begin
! 171: for k in rv'range loop
! 172: rv(k) := Random(lower,upper);
! 173: end loop;
! 174: Integer_Lift_Orbits(orbits,rv);
! 175: end Integer_Random_Lift_Orbits;
! 176:
! 177: end Symmetric_Lifting_Functions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to symmetric_lifting_functions.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