Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Stalift/integer_mixed_subdivisions.adb, Revision 1.1
1.1 ! maekawa 1: with unchecked_deallocation;
! 2: with Integer_Support_Functions; use Integer_Support_Functions;
! 3: with Standard_Integer_Norms; use Standard_Integer_Norms;
! 4: with Standard_Integer_Matrices; use Standard_Integer_Matrices;
! 5: with Standard_Integer_Linear_Solvers; use Standard_Integer_Linear_Solvers;
! 6:
! 7: package body Integer_Mixed_Subdivisions is
! 8:
! 9: -- CREATORS :
! 10:
! 11: procedure Compute_Inner_Normal ( mic : in out Mixed_Cell ) is
! 12:
! 13: len : constant natural := Length_Of(mic.pts.all) - mic.pts'length;
! 14: im : matrix(1..len,mic.nor'range);
! 15: tmp : List;
! 16: pt,first : Link_to_Vector;
! 17: cnt : natural := 0;
! 18:
! 19: begin
! 20: for i in mic.pts'range loop -- compute the inner normal
! 21: first := Head_Of(mic.pts(i));
! 22: tmp := Tail_Of(mic.pts(i));
! 23: while not Is_Null(tmp) loop
! 24: pt := Head_Of(tmp);
! 25: cnt := cnt + 1;
! 26: for j in im'range(2) loop
! 27: im(cnt,j) := pt(j) - first(j);
! 28: end loop;
! 29: tmp := Tail_Of(tmp);
! 30: end loop;
! 31: end loop;
! 32: Upper_Triangulate(im);
! 33: Scale(im);
! 34: Solve0(im,mic.nor.all);
! 35: Normalize(mic.nor.all);
! 36: if mic.nor(mic.nor'last) < 0 -- orientate the normal
! 37: then Min(mic.nor);
! 38: end if;
! 39: end Compute_Inner_Normal;
! 40:
! 41: function Create ( pts : Array_of_Lists; nor : Vector ) return Mixed_Cell is
! 42:
! 43: res : Mixed_Cell;
! 44: sup : integer;
! 45:
! 46: begin
! 47: res.nor := new Vector'(nor);
! 48: res.pts := new Array_of_Lists(pts'range);
! 49: for k in pts'range loop
! 50: sup := Minimal_Support(pts(k),nor);
! 51: res.pts(k) := Face(pts(k),nor,sup);
! 52: end loop;
! 53: return res;
! 54: end Create;
! 55:
! 56: function Create ( pts : Array_of_Lists; nors : List )
! 57: return Mixed_Subdivision is
! 58:
! 59: res,res_last : Mixed_Subdivision;
! 60: tmp : List := nors;
! 61:
! 62: begin
! 63: while not Is_Null(tmp) loop
! 64: Append(res,res_last,Create(pts,Head_Of(tmp).all));
! 65: tmp := Tail_Of(tmp);
! 66: end loop;
! 67: return res;
! 68: end Create;
! 69:
! 70: function Create ( pts : Array_of_Lists; mixsub : Mixed_Subdivision )
! 71: return Mixed_Subdivision is
! 72:
! 73: tmp,res,res_last : Mixed_Subdivision;
! 74:
! 75: begin
! 76: tmp := mixsub;
! 77: while not Is_Null(tmp) loop
! 78: Append(res,res_last,Create(pts,Head_Of(tmp).nor.all));
! 79: tmp := Tail_Of(tmp);
! 80: end loop;
! 81: return res;
! 82: end Create;
! 83:
! 84: procedure Update ( pts : in Array_of_Lists; nor : in Vector;
! 85: mixsub,mixsub_last : in out Mixed_Subdivision ) is
! 86:
! 87: -- DESCRIPTION :
! 88: -- Given a tuple of point sets and a normal,
! 89: -- the mixed subdivision will be updated.
! 90:
! 91: tmp : Mixed_Subdivision := mixsub;
! 92: done : boolean := false;
! 93:
! 94: begin
! 95: while not Is_Null(tmp) and not done loop
! 96: declare
! 97: mic : Mixed_Cell := Head_Of(tmp);
! 98: last : List;
! 99: begin
! 100: if Equal(mic.nor.all,nor)
! 101: then for k in mic.pts'range loop
! 102: last := mic.pts(k);
! 103: while not Is_Null(Tail_Of(last)) loop
! 104: last := Tail_Of(last);
! 105: end loop;
! 106: Deep_Concat_Diff(mic.pts(k),last,pts(k));
! 107: end loop;
! 108: Set_Head(tmp,mic);
! 109: done := true;
! 110: else tmp := Tail_Of(tmp);
! 111: end if;
! 112: end;
! 113: end loop;
! 114: if not done
! 115: then declare
! 116: mic : Mixed_Cell;
! 117: begin
! 118: mic.pts := new Array_of_Lists(pts'range);
! 119: Copy(pts,mic.pts.all);
! 120: mic.nor := new Standard_Integer_Vectors.Vector'(nor);
! 121: mic.sub := null;
! 122: Append(mixsub,mixsub_last,mic);
! 123: end;
! 124: end if;
! 125: end Update;
! 126:
! 127: procedure Update ( mixsub,mixsub_last : in out Mixed_Subdivision;
! 128: cells : in Mixed_Subdivision ) is
! 129:
! 130: tmp : Mixed_Subdivision := cells;
! 131: mic : Mixed_Cell;
! 132:
! 133: begin
! 134: while not Is_Null(tmp) loop
! 135: mic := Head_Of(tmp);
! 136: Update(mic.pts.all,mic.nor.all,mixsub,mixsub_last);
! 137: tmp := Tail_Of(tmp);
! 138: end loop;
! 139: end Update;
! 140:
! 141: -- CONSTRUCTORS :
! 142:
! 143: procedure Copy ( mic1 : in Mixed_Cell; mic2 : in out Mixed_Cell ) is
! 144: begin
! 145: Deep_Clear(mic2);
! 146: if mic1.nor /= null
! 147: then mic2.nor := new Standard_Integer_Vectors.Vector'(mic1.nor.all);
! 148: end if;
! 149: if mic1.pts /= null
! 150: then mic2.pts := new Array_of_Lists(mic1.pts'range);
! 151: Copy(mic1.pts.all,mic2.pts.all);
! 152: end if;
! 153: if mic1.sub /= null
! 154: then mic2.sub := new Mixed_Subdivision;
! 155: Copy(mic1.sub.all,mic2.sub.all);
! 156: end if;
! 157: end Copy;
! 158:
! 159: procedure Copy ( mixsub1 : in Mixed_Subdivision;
! 160: mixsub2 : in out Mixed_Subdivision ) is
! 161:
! 162: tmp : Mixed_Subdivision := mixsub1;
! 163: mixsub2_last : Mixed_Subdivision;
! 164:
! 165: begin
! 166: Deep_Clear(mixsub2);
! 167: while not Is_Null(tmp) loop
! 168: declare
! 169: mic1,mic2 : Mixed_Cell;
! 170: begin
! 171: mic1 := Head_Of(tmp);
! 172: Copy(mic1,mic2);
! 173: Append(mixsub2,mixsub2_last,mic2);
! 174: end;
! 175: tmp := Tail_Of(tmp);
! 176: end loop;
! 177: end Copy;
! 178:
! 179: procedure Append_Diff ( first,last : in out Mixed_Subdivision;
! 180: mic : in Mixed_Cell ) is
! 181: begin
! 182: if not Is_In(first,mic)
! 183: then Append(first,last,mic);
! 184: end if;
! 185: end Append_Diff;
! 186:
! 187: procedure Concat_Diff ( first,last : in out Mixed_Subdivision;
! 188: mixsub : in Mixed_Subdivision ) is
! 189:
! 190: tmp : Mixed_Subdivision := mixsub;
! 191:
! 192: begin
! 193: while not Is_Null(tmp) loop
! 194: declare
! 195: mic : Mixed_Cell := Head_Of(tmp);
! 196: begin
! 197: if not Is_In(first,mic)
! 198: then Append_Diff(first,last,mic);
! 199: end if;
! 200: end;
! 201: tmp := Tail_Of(tmp);
! 202: end loop;
! 203: end Concat_Diff;
! 204:
! 205: procedure Construct ( mixsub : in Mixed_Subdivision;
! 206: first : in out Mixed_Subdivision ) is
! 207:
! 208: tmp : Mixed_Subdivision := mixsub;
! 209:
! 210: begin
! 211: while not Is_Null(tmp) loop
! 212: declare
! 213: mic : Mixed_Cell := Head_Of(tmp);
! 214: begin
! 215: Construct(mic,first);
! 216: end;
! 217: tmp := Tail_Of(tmp);
! 218: end loop;
! 219: end Construct;
! 220:
! 221: procedure Construct_Diff ( mixsub : in Mixed_Subdivision;
! 222: first : in out Mixed_Subdivision ) is
! 223:
! 224: tmp : Mixed_Subdivision := mixsub;
! 225:
! 226: begin
! 227: while not Is_Null(tmp) loop
! 228: declare
! 229: mic : Mixed_Cell := Head_Of(tmp);
! 230: begin
! 231: if not Is_In(first,mic)
! 232: then Construct(mic,first);
! 233: end if;
! 234: end;
! 235: tmp := Tail_Of(tmp);
! 236: end loop;
! 237: end Construct_Diff;
! 238:
! 239: -- SELECTORS :
! 240:
! 241: function Equal ( mic1,mic2 : Mixed_Cell ) return boolean is
! 242: begin
! 243: if not Equal(mic1.nor,mic2.nor)
! 244: then return false;
! 245: elsif Equal(mic1.pts,mic2.pts)
! 246: then return Equal(mic1.sub,mic2.sub);
! 247: else return false;
! 248: end if;
! 249: end Equal;
! 250:
! 251: function Is_Sub ( mixsub1,mixsub2 : Mixed_Subdivision ) return boolean is
! 252:
! 253: -- DESCRIPTION :
! 254: -- Returns true when every cell in mixsub1 also belongs to mixsub2.
! 255:
! 256: tmp : Mixed_Subdivision := mixsub1;
! 257:
! 258: begin
! 259: while not Is_Null(tmp) loop
! 260: if not Is_In(mixsub2,Head_Of(tmp))
! 261: then return false;
! 262: else tmp := Tail_Of(tmp);
! 263: end if;
! 264: end loop;
! 265: return true;
! 266: end Is_Sub;
! 267:
! 268: function Equal ( mixsub1,mixsub2 : Mixed_Subdivision ) return boolean is
! 269: begin
! 270: if Is_Sub(mixsub1,mixsub2)
! 271: then return Is_Sub(mixsub2,mixsub1);
! 272: else return false;
! 273: end if;
! 274: end Equal;
! 275:
! 276: function Equal ( mixsub1,mixsub2 : Link_to_Mixed_Subdivision )
! 277: return boolean is
! 278: begin
! 279: if mixsub1 = null and then mixsub2 /= null
! 280: then return false;
! 281: elsif mixsub2 = null
! 282: then return true;
! 283: else return Equal(mixsub1.all,mixsub2.all);
! 284: end if;
! 285: end Equal;
! 286:
! 287: function Is_In ( mixsub : Mixed_Subdivision; normal : Vector )
! 288: return boolean is
! 289:
! 290: tmp : Mixed_Subdivision := mixsub;
! 291: c : Mixed_Cell;
! 292:
! 293: begin
! 294: while not Is_Null(tmp) loop
! 295: c := Head_Of(tmp);
! 296: if Equal(c.nor.all,normal)
! 297: then return true;
! 298: end if;
! 299: tmp := Tail_Of(tmp);
! 300: end loop;
! 301: return false;
! 302: end Is_In;
! 303:
! 304: function Is_In ( mixsub : Mixed_Subdivision; mic : Mixed_Cell )
! 305: return boolean is
! 306:
! 307: tmp : Mixed_Subdivision := mixsub;
! 308: mic1 : Mixed_Cell;
! 309:
! 310: begin
! 311: while not Is_Null(tmp) loop
! 312: mic1 := Head_Of(tmp);
! 313: if Equal(mic1,mic)
! 314: then return true;
! 315: else tmp := Tail_Of(tmp);
! 316: end if;
! 317: end loop;
! 318: return false;
! 319: end Is_In;
! 320:
! 321: -- DESTRUCTORS :
! 322:
! 323: procedure free is new unchecked_deallocation
! 324: (Mixed_Subdivision,Link_to_Mixed_Subdivision);
! 325:
! 326: procedure Deep_Clear ( mic : in out Mixed_Cell ) is
! 327: begin
! 328: Clear(mic.nor); Deep_Clear(mic.pts); Deep_Clear(mic.sub);
! 329: end Deep_Clear;
! 330:
! 331: procedure Shallow_Clear ( mic : in out Mixed_Cell ) is
! 332: begin
! 333: Clear(mic.nor); Shallow_Clear(mic.pts); Shallow_Clear(mic.sub);
! 334: end Shallow_Clear;
! 335:
! 336: procedure Deep_Clear ( mixsub : in out Mixed_Subdivision ) is
! 337:
! 338: tmp : Mixed_Subdivision;
! 339:
! 340: begin
! 341: tmp := mixsub;
! 342: while not Is_Null(tmp) loop
! 343: declare
! 344: mic : Mixed_Cell := Head_Of(tmp);
! 345: begin
! 346: Deep_Clear(mic);
! 347: end;
! 348: tmp := Tail_Of(tmp);
! 349: end loop;
! 350: Shallow_Clear(mixsub);
! 351: end Deep_Clear;
! 352:
! 353: procedure Deep_Clear ( mixsub : in out Link_to_Mixed_Subdivision ) is
! 354: begin
! 355: if mixsub /= null
! 356: then Deep_Clear(mixsub.all);
! 357: free(mixsub);
! 358: end if;
! 359: end Deep_Clear;
! 360:
! 361: procedure Shallow_Clear ( mixsub : in out Mixed_Subdivision ) is
! 362: begin
! 363: Lists_of_Mixed_Cells.Clear(Lists_of_Mixed_Cells.List(mixsub));
! 364: end Shallow_Clear;
! 365:
! 366: procedure Shallow_Clear ( mixsub : in out Link_to_Mixed_Subdivision ) is
! 367: begin
! 368: if mixsub /= null
! 369: then Shallow_Clear(mixsub.all);
! 370: free(mixsub);
! 371: end if;
! 372: end Shallow_Clear;
! 373:
! 374: end Integer_Mixed_Subdivisions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to integer_mixed_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 / Stalift