Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/triangulations_and_subdivisions.adb, Revision 1.1
1.1 ! maekawa 1: with Standard_Integer_VecVecs; use Standard_Integer_VecVecs;
! 2: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
! 3: with Transforming_Integer_Vector_Lists; use Transforming_Integer_Vector_Lists;
! 4: with Arrays_of_Integer_Vector_Lists; use Arrays_of_Integer_Vector_Lists;
! 5: with Dynamic_Triangulations; use Dynamic_Triangulations;
! 6: with Unfolding_Subdivisions; use Unfolding_Subdivisions;
! 7:
! 8: package body Triangulations_and_Subdivisions is
! 9:
! 10: -- REFINEMENT ROUTINES :
! 11:
! 12: procedure Refine ( n : in natural; mic : in out Mixed_Cell ) is
! 13:
! 14: -- NOTE :
! 15: -- Dynamic lifting will be applied with standard settings,
! 16: -- under the assumption that there are only few points in the cell.
! 17:
! 18: support : List := Reduce(mic.pts(1),n+1);
! 19: t : Triangulation;
! 20: lifted,lifted_last : List;
! 21:
! 22: begin
! 23: Dynamic_Lifting(support,false,true,0,lifted,lifted_last,t);
! 24: mic.sub := new Mixed_Subdivision'(Deep_Create(n,t));
! 25: Deep_Clear(lifted); Clear(t);
! 26: -- pity that Shallow_Clear(t) is not yet possible ...
! 27: end Refine;
! 28:
! 29: procedure Refine ( n : in natural; mixsub : in out Mixed_Subdivision ) is
! 30:
! 31: -- NOTE :
! 32: -- Refines the mixed subdivision, under the safe assumption that
! 33: -- there is only one support set to deal with.
! 34:
! 35: res,res_last : Mixed_Subdivision;
! 36: tmp : Mixed_Subdivision := mixsub;
! 37: mic : Mixed_Cell;
! 38:
! 39: begin
! 40: while not Is_Null(tmp) loop
! 41: mic := Head_Of(tmp);
! 42: if Length_Of(mic.pts(1)) > n+1
! 43: then Refine(n,mic);
! 44: end if;
! 45: Append(res,res_last,mic);
! 46: tmp := Tail_Of(tmp);
! 47: end loop;
! 48: mixsub := res;
! 49: end Refine;
! 50:
! 51: -- TARGET PROCEDURES :
! 52:
! 53: function Deep_Create ( n : natural; s : Simplex ) return Mixed_Cell is
! 54:
! 55: res : Mixed_Cell;
! 56: ver : constant VecVec := Vertices(s);
! 57:
! 58: begin
! 59: res.nor := new Standard_Integer_Vectors.Vector'(Normal(s));
! 60: res.pts := new Array_of_Lists(1..1);
! 61: res.pts(1) := Deep_Create(ver);
! 62: return res;
! 63: end Deep_Create;
! 64:
! 65: function Shallow_Create ( n : natural; s : Simplex ) return Mixed_Cell is
! 66:
! 67: res : Mixed_Cell;
! 68: ver : constant VecVec := Vertices(s);
! 69:
! 70: begin
! 71: res.nor := new Standard_Integer_Vectors.Vector'(Normal(s));
! 72: res.pts := new Array_of_Lists(1..1);
! 73: res.pts(1) := Shallow_Create(ver);
! 74: return res;
! 75: end Shallow_Create;
! 76:
! 77: function Deep_Create ( n : natural; t : Triangulation )
! 78: return Mixed_Subdivision is
! 79:
! 80: res,res_last : Mixed_Subdivision;
! 81: tmp : Triangulation := t;
! 82:
! 83: begin
! 84: while not Is_Null(tmp) loop
! 85: Append(res,res_last,Deep_Create(n,Head_Of(tmp)));
! 86: tmp := Tail_Of(tmp);
! 87: end loop;
! 88: return res;
! 89: end Deep_Create;
! 90:
! 91: function Shallow_Create ( n : natural; t : Triangulation )
! 92: return Mixed_Subdivision is
! 93:
! 94: res,res_last : Mixed_Subdivision;
! 95: tmp : Triangulation := t;
! 96:
! 97: begin
! 98: while not Is_Null(tmp) loop
! 99: Append(res,res_last,Shallow_Create(n,Head_Of(tmp)));
! 100: tmp := Tail_Of(tmp);
! 101: end loop;
! 102: return res;
! 103: end Shallow_Create;
! 104:
! 105: function Deep_Create ( n : natural; flatnor : Vector; t : Triangulation )
! 106: return Mixed_Subdivision is
! 107:
! 108: res,res_last : Mixed_Subdivision;
! 109: tmp : Triangulation := t;
! 110: s : Simplex;
! 111:
! 112: begin
! 113: while not Is_Null(tmp) loop
! 114: s := Head_Of(tmp);
! 115: exit when (flatnor = Normal(s));
! 116: Append(res,res_last,Deep_Create(n,s));
! 117: tmp := Tail_Of(tmp);
! 118: end loop;
! 119: res := Merge(res); -- merge cells with same inner normal
! 120: Refine(n,res); -- refine the non-fine cells
! 121: return res;
! 122: end Deep_Create;
! 123:
! 124: function Shallow_Create ( n : natural; flatnor : Vector; t : Triangulation )
! 125: return Mixed_Subdivision is
! 126:
! 127: res,res_last : Mixed_Subdivision;
! 128: tmp : Triangulation := t;
! 129: s : Simplex;
! 130:
! 131: begin
! 132: while not Is_Null(tmp) loop
! 133: s := Head_Of(tmp);
! 134: exit when (flatnor = Normal(s));
! 135: Append(res,res_last,Shallow_Create(n,s));
! 136: tmp := Tail_Of(tmp);
! 137: end loop;
! 138: res := Merge(res); -- merge cells with same inner normal
! 139: Refine(n,res); -- refine the non-fine cells
! 140: return res;
! 141: end Shallow_Create;
! 142:
! 143: function Non_Flat_Deep_Create ( n : natural; t : Triangulation )
! 144: return Mixed_Subdivision is
! 145:
! 146: flatnor : Vector(1..n+1) := (1..n+1 => 0);
! 147:
! 148: begin
! 149: flatnor(n+1) := 1;
! 150: return Deep_Create(n,flatnor,t);
! 151: end Non_Flat_Deep_Create;
! 152:
! 153: function Non_Flat_Shallow_Create ( n : natural; t : Triangulation )
! 154: return Mixed_Subdivision is
! 155:
! 156: flatnor : Vector(1..n+1) := (1..n+1 => 0);
! 157:
! 158: begin
! 159: flatnor(n+1) := 1;
! 160: return Shallow_Create(n,flatnor,t);
! 161: end Non_Flat_Shallow_Create;
! 162:
! 163: function Deep_Create ( n : natural; mixsub : Mixed_Subdivision )
! 164: return Triangulation is
! 165:
! 166: res : Triangulation;
! 167: tmp : Mixed_Subdivision := mixsub;
! 168: mic : Mixed_Cell;
! 169:
! 170: begin
! 171: while not Is_Null(tmp) loop
! 172: mic := Head_Of(tmp);
! 173: declare
! 174: v : VecVec(0..n);
! 175: tmppts : List := mic.pts(mic.pts'first);
! 176: s : Simplex;
! 177: begin
! 178: for i in v'range loop
! 179: v(i) := new Standard_Integer_Vectors.Vector'(Head_Of(tmppts).all);
! 180: tmppts := Tail_Of(tmppts);
! 181: exit when Is_Null(tmppts);
! 182: end loop;
! 183: s := Create(v);
! 184: Construct(s,res);
! 185: end;
! 186: tmp := Tail_Of(tmp);
! 187: end loop;
! 188: Connect(res);
! 189: return res;
! 190: end Deep_Create;
! 191:
! 192: function Shallow_Create ( n : natural; mixsub : Mixed_Subdivision )
! 193: return Triangulation is
! 194:
! 195: res : Triangulation;
! 196: tmp : Mixed_Subdivision := mixsub;
! 197: mic : Mixed_Cell;
! 198:
! 199: begin
! 200: while not Is_Null(tmp) loop
! 201: mic := Head_Of(tmp);
! 202: declare
! 203: v : VecVec(0..n);
! 204: tmppts : List := mic.pts(mic.pts'first);
! 205: s : Simplex;
! 206: begin
! 207: for i in v'range loop
! 208: v(i) := Head_Of(tmppts);
! 209: tmppts := Tail_Of(tmppts);
! 210: exit when Is_Null(tmppts);
! 211: end loop;
! 212: s := Create(v);
! 213: Construct(s,res);
! 214: end;
! 215: tmp := Tail_Of(tmp);
! 216: end loop;
! 217: Connect(res);
! 218: return res;
! 219: end Shallow_Create;
! 220:
! 221: end Triangulations_and_Subdivisions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to triangulations_and_subdivisions.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