Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/unfolding_subdivisions.adb, Revision 1.1
1.1 ! maekawa 1: with Integer_Support_Functions; use Integer_Support_Functions;
! 2: with Flatten_Mixed_Subdivisions; use Flatten_Mixed_Subdivisions;
! 3:
! 4: package body Unfolding_Subdivisions is
! 5:
! 6: function Different_Normals ( mixsub : Mixed_Subdivision ) return List is
! 7:
! 8: tmp : Mixed_Subdivision := mixsub;
! 9: res,res_last : List;
! 10:
! 11: begin
! 12: while not Is_Null(tmp) loop
! 13: Append_Diff(res,res_last,Head_Of(tmp).nor.all);
! 14: tmp := Tail_Of(tmp);
! 15: end loop;
! 16: return res;
! 17: end Different_Normals;
! 18:
! 19: function Extract ( normal : Vector; mixsub : Mixed_Subdivision )
! 20: return Mixed_Subdivision is
! 21:
! 22: tmp : Mixed_Subdivision := mixsub;
! 23: res,res_last : Mixed_Subdivision;
! 24:
! 25: begin
! 26: while not Is_Null(tmp) loop
! 27: declare
! 28: mic : Mixed_Cell := Head_Of(tmp);
! 29: begin
! 30: if mic.nor.all = normal
! 31: then Append(res,res_last,mic);
! 32: end if;
! 33: end;
! 34: tmp := Tail_Of(tmp);
! 35: end loop;
! 36: return res;
! 37: end Extract;
! 38:
! 39: function Merge_Same_Normal ( mixsub : Mixed_Subdivision )
! 40: return Mixed_Cell is
! 41:
! 42: -- DESCRIPTION :
! 43: -- All cells with the same inner normal will be put in one cell,
! 44: -- that will be contained in the mixed subdivision on return.
! 45:
! 46: -- REQUIRED :
! 47: -- not Is_Null(mixsub) and all mixed cells have the same inner normal.
! 48:
! 49: tmp : Mixed_Subdivision;
! 50: resmic,mic : Mixed_Cell;
! 51:
! 52: begin
! 53: mic := Head_Of(mixsub);
! 54: resmic.nor := new Standard_Integer_Vectors.Vector'(mic.nor.all);
! 55: resmic.pts := new Array_of_Lists'(mic.pts.all);
! 56: tmp := Tail_Of(mixsub);
! 57: while not Is_Null(tmp) loop
! 58: mic := Head_Of(tmp);
! 59: declare
! 60: last : List;
! 61: begin
! 62: for k in mic.pts'range loop
! 63: last := resmic.pts(k);
! 64: while not Is_Null(Tail_Of(last)) loop
! 65: last := Tail_Of(last);
! 66: end loop;
! 67: Deep_Concat_Diff(resmic.pts(k),last,mic.pts(k));
! 68: end loop;
! 69: end;
! 70: tmp := Tail_Of(tmp);
! 71: end loop;
! 72: return resmic;
! 73: end Merge_Same_Normal;
! 74:
! 75: function Merge_Same_Normal ( mixsub : Mixed_Subdivision )
! 76: return Mixed_Subdivision is
! 77:
! 78: -- REQUIRED :
! 79: -- not Is_Null(mixsub) and all mixed cells have the same inner normal.
! 80:
! 81: resmic : Mixed_Cell := Merge_Same_Normal(mixsub);
! 82: ressub : Mixed_Subdivision;
! 83:
! 84: begin
! 85: Construct(resmic,ressub);
! 86: return ressub;
! 87: end Merge_Same_Normal;
! 88:
! 89: function Merge ( mixsub : Mixed_Subdivision ) return Mixed_Subdivision is
! 90:
! 91: -- NOTE :
! 92: -- Cells with an unique normal are simply taken over in the result,
! 93: -- cells with the same normal are merged, hereby the refinement of these
! 94: -- cells is destroyed. Though, one could do better...
! 95:
! 96: begin
! 97: if Is_Null(mixsub)
! 98: then return mixsub;
! 99: else
! 100: declare
! 101: tmp : Mixed_Subdivision := mixsub;
! 102: res,res_last : Mixed_Subdivision;
! 103: mic : Mixed_Cell;
! 104: begin
! 105: while not Is_Null(tmp) loop
! 106: mic := Head_Of(tmp);
! 107: if not Is_In(res,mic.nor.all)
! 108: then
! 109: if not Is_In(Tail_Of(tmp),mic.nor.all)
! 110: then Append(res,res_last,mic);
! 111: else declare
! 112: tmpmic : Mixed_Subdivision := Extract(mic.nor.all,tmp);
! 113: bigmic : Mixed_Cell := Merge_Same_Normal(tmpmic);
! 114: begin
! 115: Append(res,res_last,bigmic);
! 116: end;
! 117: end if;
! 118: end if;
! 119: tmp := Tail_Of(tmp);
! 120: end loop;
! 121: return res;
! 122: end;
! 123: end if;
! 124: end Merge;
! 125:
! 126: function Relift ( l : List; point : Vector ) return List is
! 127:
! 128: tmp,res : List;
! 129: pt : Link_to_Vector;
! 130:
! 131: begin
! 132: Copy(l,res);
! 133: tmp := res;
! 134: while not Is_Null(tmp) loop
! 135: pt := Head_Of(tmp);
! 136: if pt.all = point
! 137: then pt(pt'last) := 1;
! 138: else pt(pt'last) := 0;
! 139: end if;
! 140: Set_Head(tmp,pt);
! 141: tmp := Tail_Of(tmp);
! 142: end loop;
! 143: return res;
! 144: end Relift;
! 145:
! 146: function Relift ( pts : Array_of_Lists; point : Vector )
! 147: return Array_of_Lists is
! 148:
! 149: res : Array_of_Lists(pts'range);
! 150:
! 151: begin
! 152: for i in pts'range loop
! 153: res(i) := Relift(pts(i),point);
! 154: end loop;
! 155: return res;
! 156: end Relift;
! 157:
! 158: function Relift ( mic : Mixed_Cell; point : Vector ) return Mixed_Cell is
! 159:
! 160: res : Mixed_Cell;
! 161:
! 162: begin
! 163: res.pts := new Array_of_Lists'(Relift(mic.pts.all,point));
! 164: res.nor := new Standard_Integer_Vectors.Vector'(point'range => 0);
! 165: Compute_Inner_Normal(res);
! 166: return res;
! 167: end Relift;
! 168:
! 169: function Relift ( mixsub : Mixed_Subdivision; point : Vector )
! 170: return Mixed_Subdivision is
! 171:
! 172: tmp,res,res_last : Mixed_Subdivision;
! 173:
! 174: begin
! 175: tmp := mixsub;
! 176: while not Is_Null(tmp) loop
! 177: Append(res,res_last,Relift(Head_Of(tmp),point));
! 178: tmp := Tail_Of(tmp);
! 179: end loop;
! 180: return res;
! 181: end Relift;
! 182:
! 183: function Is_In_Point ( pt : Link_to_Vector; l : List ) return boolean is
! 184:
! 185: -- DESCRIPTION :
! 186: -- Returns true if the first n coordinates of pt belong to l.
! 187:
! 188: tmp : List := l;
! 189: lpt : Link_to_Vector;
! 190:
! 191: begin
! 192: while not Is_Null(tmp) loop
! 193: lpt := Head_Of(tmp);
! 194: if lpt(lpt'first..lpt'last-1) = pt(pt'first..pt'last-1)
! 195: then return true;
! 196: else tmp := Tail_Of(tmp);
! 197: end if;
! 198: end loop;
! 199: return false;
! 200: end Is_In_Point;
! 201:
! 202: function Different_Points ( l1,l2 : List ) return natural is
! 203:
! 204: -- DESCRIPTION :
! 205: -- Return the number of different points of the list l2 w.r.t. l1.
! 206:
! 207: res : natural := 0;
! 208: tmp : List := l2;
! 209:
! 210: begin
! 211: while not Is_Null(tmp) loop
! 212: if not Is_In_Point(Head_Of(tmp),l1)
! 213: then res := res + 1;
! 214: end if;
! 215: tmp := Tail_Of(tmp);
! 216: end loop;
! 217: return res;
! 218: end Different_Points;
! 219:
! 220: function Different_Points ( l1,l2 : List ) return List is
! 221:
! 222: -- DESCRIPTION :
! 223: -- Return the list of different points of the list l2 w.r.t. l1.
! 224:
! 225: res,res_last : List;
! 226: tmp : List := l2;
! 227:
! 228: begin
! 229: while not Is_Null(tmp) loop
! 230: if not Is_In_Point(Head_Of(tmp),l1)
! 231: then Append(res,res_last,Head_Of(tmp).all);
! 232: end if;
! 233: tmp := Tail_Of(tmp);
! 234: end loop;
! 235: return res;
! 236: end Different_Points;
! 237:
! 238: function Different_Points ( pts : Array_of_Lists; mic : Mixed_Cell )
! 239: return natural is
! 240:
! 241: -- DESCRIPTION :
! 242: -- Return the number of different points of the cell mic w.r.t. pts.
! 243:
! 244: res : natural := 0;
! 245:
! 246: begin
! 247: for i in pts'range loop
! 248: res := res + Different_Points(pts(i),mic.pts(i));
! 249: end loop;
! 250: return res;
! 251: end Different_Points;
! 252:
! 253: function Different_Points ( pts : Array_of_Lists; mic : Mixed_Cell )
! 254: return Array_of_Lists is
! 255:
! 256: -- DESCRIPTION :
! 257: -- Return the different points of the cell mic w.r.t. pts.
! 258:
! 259: res : Array_of_Lists(pts'range);
! 260:
! 261: begin
! 262: for i in pts'range loop
! 263: res(i) := Different_Points(pts(i),mic.pts(i));
! 264: end loop;
! 265: return res;
! 266: end Different_Points;
! 267:
! 268: procedure Add ( l : in out List; pts : in List ) is
! 269:
! 270: -- DESCRIPTION :
! 271: -- Adds the points in pts to l.
! 272:
! 273: tmp : List := pts;
! 274: pt : Link_to_Vector;
! 275:
! 276: begin
! 277: while not Is_Null(tmp) loop
! 278: pt := Head_Of(tmp);
! 279: declare
! 280: npt : Link_to_Vector := new Vector'(pt.all);
! 281: begin
! 282: Construct(npt,l);
! 283: end;
! 284: tmp := Tail_Of(tmp);
! 285: end loop;
! 286: end Add;
! 287:
! 288: procedure Add ( l : in out Array_of_Lists; pts : in Array_of_Lists ) is
! 289:
! 290: -- DESCRIPTION :
! 291: -- Adds the points in pts to l.
! 292:
! 293: begin
! 294: for i in l'range loop
! 295: Add(l(i),pts(i));
! 296: end loop;
! 297: end Add;
! 298:
! 299: procedure Put_Next_to_Front ( mixsub : in out Mixed_Subdivision;
! 300: pts : in Array_of_Lists ) is
! 301:
! 302: -- DESCRIPTION :
! 303: -- Selects the next mixed cell to be processed, and puts in front
! 304: -- of the list of cells mixsub.
! 305:
! 306: mic1 : Mixed_Cell := Head_Of(mixsub);
! 307: min1 : natural := Different_Points(pts,mic1);
! 308: tmp : Mixed_Subdivision := Tail_Of(mixsub);
! 309: min : natural;
! 310: mic : Mixed_Cell;
! 311:
! 312: begin
! 313: while not Is_Null(tmp) loop
! 314: mic := Head_Of(tmp);
! 315: min := Different_Points(pts,mic);
! 316: if min < min1
! 317: then min1 := min;
! 318: Set_Head(mixsub,mic);
! 319: Set_Head(tmp,mic1);
! 320: end if;
! 321: tmp := Tail_Of(tmp);
! 322: end loop;
! 323: end Put_Next_to_Front;
! 324:
! 325: procedure Relift ( l : in out List; ref : in List ) is
! 326:
! 327: -- DESCRIPTION :
! 328: -- Gives all points in l, which belong to ref, lifting value 1.
! 329:
! 330: tmp : List := l;
! 331: pt : Link_to_Vector;
! 332:
! 333: begin
! 334: while not Is_Null(tmp) loop
! 335: pt := Head_Of(tmp);
! 336: if Is_In(ref,pt)
! 337: then pt(pt'last) := 1;
! 338: else pt(pt'last) := 0;
! 339: end if;
! 340: Set_Head(tmp,pt);
! 341: tmp := Tail_Of(tmp);
! 342: end loop;
! 343: end Relift;
! 344:
! 345: procedure Relift ( l : in out List ) is
! 346:
! 347: -- DESCRIPTION :
! 348: -- Gives all points lifting value 1.
! 349:
! 350: tmp : List := l;
! 351: pt : Link_to_Vector;
! 352:
! 353: begin
! 354: while not Is_Null(tmp) loop
! 355: pt := Head_Of(tmp);
! 356: pt(pt'last) := 1;
! 357: Set_Head(tmp,pt);
! 358: tmp := Tail_Of(tmp);
! 359: end loop;
! 360: end Relift;
! 361:
! 362: procedure Relift ( l : in out Array_of_Lists; ref : in Array_of_Lists ) is
! 363:
! 364: -- DESCRIPTION :
! 365: -- Gives all points in l, which belong to ref, lifting value 1.
! 366:
! 367: begin
! 368: for i in l'range loop
! 369: Relift(l(i),ref(i));
! 370: end loop;
! 371: end Relift;
! 372:
! 373: procedure Relift ( l : in out Array_of_Lists ) is
! 374:
! 375: -- DESCRIPTION :
! 376: -- Gives all points lifting value 1.
! 377:
! 378: begin
! 379: for i in l'range loop
! 380: Relift(l(i));
! 381: end loop;
! 382: end Relift;
! 383:
! 384: procedure Relift ( mic : in out Mixed_Cell; pts : in out Array_of_Lists ) is
! 385:
! 386: -- DESCRIPTION :
! 387: -- Gives the points in mic, which belong to pts lifting 1,
! 388: -- and computes the new inner normal.
! 389:
! 390: begin
! 391: Relift(mic.pts.all,pts);
! 392: Relift(pts);
! 393: end Relift;
! 394:
! 395: procedure Orientate_Inner_Normal
! 396: ( mic : in out Mixed_Cell; pts : in Array_of_Lists ) is
! 397:
! 398: -- DESCRIPTION :
! 399: -- Orientates the normal of mic w.r.t. the points in pts.
! 400:
! 401: done : boolean := false;
! 402:
! 403: begin
! 404: for i in pts'range loop
! 405: if Minimal_Support(mic.pts(i),mic.nor.all)
! 406: > Minimal_Support(pts(i),mic.nor.all)
! 407: then Min(mic.nor);
! 408: done := true;
! 409: end if;
! 410: exit when done;
! 411: end loop;
! 412: end Orientate_Inner_Normal;
! 413:
! 414: procedure Unfolding ( mixsub : in out Mixed_Subdivision ) is
! 415:
! 416: tmp : Mixed_Subdivision;
! 417:
! 418: begin
! 419: if not Is_Null(mixsub)
! 420: then
! 421: declare
! 422: mic : Mixed_Cell := Head_Of(mixsub);
! 423: pts : Array_of_Lists(mic.pts'range);
! 424: begin
! 425: Flatten(mic);
! 426: Copy(mic.pts.all,pts);
! 427: Process(mic,pts);
! 428: tmp := Tail_Of(mixsub);
! 429: while not Is_Null(tmp) loop
! 430: Put_Next_to_Front(tmp,pts);
! 431: mic := Head_Of(tmp);
! 432: declare
! 433: newpts : Array_of_Lists(pts'range);
! 434: begin
! 435: newpts := Different_Points(pts,mic);
! 436: Relift(mic,newpts);
! 437: Compute_Inner_Normal(mic);
! 438: -- Orientate_Inner_Normal(mic,pts);
! 439: Process(mic,newpts);
! 440: Add(pts,newpts);
! 441: Deep_Clear(newpts);
! 442: end;
! 443: tmp := Tail_Of(tmp);
! 444: end loop;
! 445: end;
! 446: end if;
! 447: end Unfolding;
! 448:
! 449: end Unfolding_Subdivisions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to unfolding_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