Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/cayley_trick.adb, Revision 1.1
1.1 ! maekawa 1: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
! 2: with Simplices; use Simplices;
! 3: with Dynamic_Triangulations; use Dynamic_Triangulations;
! 4: with Cayley_Embedding; use Cayley_Embedding;
! 5: with Flatten_Mixed_Subdivisions; use Flatten_Mixed_Subdivisions;
! 6:
! 7: package body Cayley_Trick is
! 8:
! 9: -- UTILITIES :
! 10:
! 11: function Extract ( n : natural; mix : Vector; lifted : in List )
! 12: return Array_of_Lists is
! 13:
! 14: -- DESCRIPTION :
! 15: -- Extracts from the list of lifted points to compute the Cayley
! 16: -- triangulation, the tuple of lifted points.
! 17:
! 18: res : Array_of_Lists(mix'range);
! 19:
! 20: begin
! 21: for k in res'range loop
! 22: res(k) := Extract(k-1,n,lifted);
! 23: Deflate(n,res(k));
! 24: end loop;
! 25: return res;
! 26: end Extract;
! 27:
! 28: procedure Extract ( n : in natural; mix : in Vector;
! 29: t : in Triangulation; liftedt : in List;
! 30: mixsub : out Mixed_Subdivision;
! 31: lifted : out Array_of_Lists ) is
! 32:
! 33: -- DESCRIPTION :
! 34: -- Extracts the useful information from the Cayley polytope.
! 35:
! 36: res : Mixed_Subdivision;
! 37:
! 38: begin
! 39: lifted := Extract(n,mix,liftedt);
! 40: res := Extract_Mixed_Cells(n,mix,t);
! 41: Deflate(n,res);
! 42: mixsub := res;
! 43: end Extract;
! 44:
! 45: procedure Extract_and_Clear
! 46: ( n : in natural; mix : in Vector;
! 47: t : in out Triangulation; liftedt : in out List;
! 48: lent : out natural; mixsub : out Mixed_Subdivision;
! 49: lifted : out Array_of_Lists ) is
! 50:
! 51: -- DESCRIPTION :
! 52: -- Extracts the useful information from the Cayley polytope.
! 53: -- All intermediate data structures will be cleared.
! 54:
! 55: begin
! 56: lent := Length_Of(t);
! 57: Extract(n,mix,t,liftedt,mixsub,lifted);
! 58: Clear(t); Clear(liftedt);
! 59: end Extract_and_Clear;
! 60:
! 61: -- BASIC VERSION :
! 62:
! 63: procedure Dynamic_Cayley
! 64: ( n : in natural; mix : in Vector;
! 65: supports : in Array_of_Lists; order,inter : in boolean;
! 66: maxli : in natural; lifted : out Array_of_Lists;
! 67: mixsub : out Mixed_Subdivision; numtri : out natural ) is
! 68:
! 69: tmpsub,lastcells : Mixed_Subdivision;
! 70: l,liftedl,liftedl_last : list;
! 71: t : Triangulation;
! 72:
! 73: procedure Col_Flat ( nt : in Triangulation; l : List ) is
! 74:
! 75: -- DESCRIPTION :
! 76: -- Updates the subdivision mixsub with the flattened cells.
! 77: -- The triangulation on entry contains the whole triangulation,
! 78: -- not just the new cells.
! 79:
! 80: cells : Mixed_Subdivision;
! 81:
! 82: begin
! 83: if Is_Null(tmpsub)
! 84: then cells := Extract_Mixed_Cells(n,mix,nt);
! 85: Deflate(n,cells);
! 86: else cells := Extract_non_Flat_Mixed_Cells(n,mix,nt);
! 87: Deflate(n,cells);
! 88: Construct(Head_Of(tmpsub),cells);
! 89: end if;
! 90: Flatten(cells);
! 91: tmpsub := cells;
! 92: end Col_Flat;
! 93: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat(Col_Flat);
! 94:
! 95: begin
! 96: l := Embedding_before_Lifting(supports);
! 97: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
! 98: if Is_Null(tmpsub)
! 99: then Extract_and_Clear(n,mix,t,liftedl,numtri,mixsub,lifted);
! 100: else lastcells := Extract_non_Flat_Mixed_Cells(n,mix,t);
! 101: Deflate(n,lastcells);
! 102: Construct(Head_Of(tmpsub),lastcells);
! 103: mixsub := lastcells;
! 104: lifted := Extract(n,mix,liftedl);
! 105: numtri := Length_Of(t);
! 106: end if;
! 107: end Dynamic_Cayley;
! 108:
! 109: procedure Dynamic_Cayley
! 110: ( n : in natural; mix : in Vector;
! 111: supports : in Array_of_Lists; order,inter : in boolean;
! 112: maxli : in natural; lifted : out Array_of_Lists;
! 113: t : in out Triangulation ) is
! 114:
! 115: l,liftedl,liftedl_last : list;
! 116:
! 117: begin
! 118: l := Embedding_before_Lifting(supports);
! 119: Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
! 120: lifted := Extract(n,mix,liftedl); Clear(liftedl);
! 121: end Dynamic_Cayley;
! 122:
! 123: -- EXTENDED VERSIONS :
! 124:
! 125: procedure Dynamic_Cayley_with_Flat
! 126: ( n : in natural; mix : in Vector;
! 127: supports : in Array_of_Lists; order,inter : in boolean;
! 128: maxli : in natural; lifted : out Array_of_Lists;
! 129: mixsub : out Mixed_Subdivision; numtri : out natural ) is
! 130:
! 131: l,liftedl,liftedl_last : list;
! 132: t : Triangulation;
! 133: tmpsub,lastcells : Mixed_Subdivision;
! 134:
! 135: procedure Bef_Flat ( tt : in Triangulation; lft : in List ) is
! 136:
! 137: cells,cells1 : Mixed_Subdivision;
! 138: lftpts : Array_of_Lists(mix'range);
! 139:
! 140: begin
! 141: Extract(n,mix,tt,lft,cells,lftpts);
! 142: Before_Flattening(cells,lftpts);
! 143: if Is_Null(tmpsub)
! 144: then cells := Extract_Mixed_Cells(n,mix,tt);
! 145: Deflate(n,cells);
! 146: else cells := Extract_non_Flat_Mixed_Cells(n,mix,tt);
! 147: Deflate(n,cells);
! 148: Construct(Head_Of(tmpsub),cells);
! 149: end if;
! 150: Flatten(cells);
! 151: tmpsub := cells;
! 152: end Bef_Flat;
! 153: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat (Bef_Flat);
! 154:
! 155: begin
! 156: l := Embedding_before_Lifting(supports);
! 157: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
! 158: if Is_Null(tmpsub)
! 159: then Extract_and_Clear(n,mix,t,liftedl,numtri,mixsub,lifted);
! 160: else lastcells := Extract_non_Flat_Mixed_Cells(n,mix,t);
! 161: Deflate(n,lastcells);
! 162: Construct(Head_Of(tmpsub),lastcells);
! 163: mixsub := lastcells;
! 164: lifted := Extract(n,mix,liftedl);
! 165: numtri := Length_Of(t);
! 166: end if;
! 167: end Dynamic_Cayley_with_Flat;
! 168:
! 169: procedure Dynamic_Cayley_with_Flatt
! 170: ( n : in natural; mix : in Vector;
! 171: supports : in Array_of_Lists; order,inter : in boolean;
! 172: maxli : in natural; lifted : out Array_of_Lists;
! 173: t : in out Triangulation ) is
! 174:
! 175: l,liftedl,liftedl_last : list;
! 176:
! 177: procedure Bef_Flat ( tt : in Triangulation; lft : in List ) is
! 178:
! 179: cells : Mixed_Subdivision;
! 180: lftpts : Array_of_Lists(supports'range);
! 181:
! 182: begin
! 183: Extract(n,mix,tt,lft,cells,lftpts);
! 184: Before_Flattening(cells,lftpts);
! 185: end Bef_Flat;
! 186: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat (Bef_Flat);
! 187:
! 188: begin
! 189: l := Embedding_before_Lifting(supports);
! 190: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
! 191: lifted := Extract(n,mix,liftedl); Clear(liftedl);
! 192: end Dynamic_Cayley_with_Flatt;
! 193:
! 194: procedure Dynamic_Cayley_with_New
! 195: ( n : in natural; mix : in Vector;
! 196: supports : in Array_of_Lists; order,inter : in boolean;
! 197: maxli : in natural; lifted : out Array_of_Lists;
! 198: mixsub : out Mixed_Subdivision; numtri : out natural ) is
! 199:
! 200: l,liftedl,liftedl_last : list;
! 201: t : Triangulation;
! 202: tmpsub,lastcells : Mixed_Subdivision;
! 203:
! 204: procedure Col_Flat ( nt : in Triangulation; l : List ) is
! 205:
! 206: -- DESCRIPTION :
! 207: -- Updates the subdivision mixsub with the flattened cells.
! 208: -- The triangulation on entry contains the whole triangulation,
! 209: -- not just the new cells.
! 210:
! 211: cells : Mixed_Subdivision;
! 212:
! 213: begin
! 214: if Is_Null(tmpsub)
! 215: then cells := Extract_Mixed_Cells(n,mix,nt);
! 216: Deflate(n,cells);
! 217: else cells := Extract_non_Flat_Mixed_Cells(n,mix,nt);
! 218: Deflate(n,cells);
! 219: Construct(Head_Of(tmpsub),cells);
! 220: end if;
! 221: Flatten(cells);
! 222: tmpsub := cells;
! 223: end Col_Flat;
! 224:
! 225: procedure New_Cell ( tt : in Triangulation; pt : in vector ) is
! 226:
! 227: cells : Mixed_Subdivision := Extract_Mixed_Cells(n,mix,tt);
! 228: index : natural := 1;
! 229:
! 230: begin
! 231: Deflate(n,cells);
! 232: for i in 1..mix'last-1 loop
! 233: if pt(i+n) /= 0
! 234: then index := i+1;
! 235: end if;
! 236: exit when index > 1;
! 237: end loop;
! 238: Process_New_Cells(cells,index,pt);
! 239: end New_Cell;
! 240: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat_and_New
! 241: (Before_Flattening => Col_Flat, Process_New_Simplices => New_Cell);
! 242:
! 243: begin
! 244: l := Embedding_before_Lifting(supports);
! 245: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
! 246: if Is_Null(tmpsub)
! 247: then Extract_and_Clear(n,mix,t,liftedl,numtri,mixsub,lifted);
! 248: else lastcells := Extract_non_Flat_Mixed_Cells(n,mix,t);
! 249: Deflate(n,lastcells);
! 250: Construct(Head_Of(tmpsub),lastcells);
! 251: mixsub := lastcells;
! 252: lifted := Extract(n,mix,liftedl);
! 253: numtri := Length_Of(t);
! 254: end if;
! 255: end Dynamic_Cayley_with_New;
! 256:
! 257: procedure Dynamic_Cayley_with_Newt
! 258: ( n : in natural; mix : in Vector;
! 259: supports : in Array_of_Lists; order,inter : in boolean;
! 260: maxli : in natural; lifted : out Array_of_Lists;
! 261: t : in out Triangulation ) is
! 262:
! 263: l,liftedl,liftedl_last : list;
! 264:
! 265: procedure New_Cell ( tt : in Triangulation; pt : in vector ) is
! 266:
! 267: cells : Mixed_Subdivision := Extract_Mixed_Cells(n,mix,tt);
! 268: index : natural := 1;
! 269:
! 270: begin
! 271: Deflate(n,cells);
! 272: for i in 1..mix'last-1 loop
! 273: if pt(i+n) /= 0
! 274: then index := i+1;
! 275: end if;
! 276: exit when index > 1;
! 277: end loop;
! 278: Process_New_Cells(cells,index,pt);
! 279: end New_Cell;
! 280: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_New(New_Cell);
! 281:
! 282: begin
! 283: l := Embedding_before_Lifting(supports);
! 284: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
! 285: lifted := Extract(n,mix,liftedl); Clear(liftedl);
! 286: end Dynamic_Cayley_with_Newt;
! 287:
! 288: procedure Dynamic_Cayley_with_Flat_and_New
! 289: ( n : in natural; mix : in Vector;
! 290: supports : in Array_of_Lists; order,inter : in boolean;
! 291: maxli : in natural; lifted : out Array_of_Lists;
! 292: mixsub : out Mixed_Subdivision; numtri : out natural ) is
! 293:
! 294: l,liftedl,liftedl_last : list;
! 295: t : Triangulation;
! 296: tmpsub,lastcells : Mixed_Subdivision;
! 297:
! 298: procedure Bef_Flat ( tt : in Triangulation; lft : in List ) is
! 299:
! 300: cells,cells1 : Mixed_Subdivision;
! 301: lftpts : Array_of_Lists(mix'range);
! 302:
! 303: begin
! 304: Extract(n,mix,tt,lft,cells,lftpts);
! 305: Before_Flattening(cells,lftpts);
! 306: if Is_Null(tmpsub)
! 307: then cells := Extract_Mixed_Cells(n,mix,tt);
! 308: Deflate(n,cells);
! 309: else cells := Extract_non_Flat_Mixed_Cells(n,mix,tt);
! 310: Deflate(n,cells);
! 311: Construct(Head_Of(tmpsub),cells);
! 312: end if;
! 313: Flatten(cells);
! 314: tmpsub := cells;
! 315: end Bef_Flat;
! 316:
! 317: procedure New_Cell ( tt : in Triangulation; pt : in vector ) is
! 318:
! 319: cells : Mixed_Subdivision := Extract_Mixed_Cells(n,mix,tt);
! 320: index : natural := 1;
! 321:
! 322: begin
! 323: Deflate(n,cells);
! 324: for i in 1..mix'last-1 loop
! 325: if pt(i+n) /= 0
! 326: then index := i+1;
! 327: end if;
! 328: exit when index > 1;
! 329: end loop;
! 330: Process_New_Cells(cells,index,pt);
! 331: end New_Cell;
! 332:
! 333: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat_and_New
! 334: (Before_Flattening => Bef_Flat, Process_New_Simplices => New_Cell);
! 335:
! 336: begin
! 337: l := Embedding_before_Lifting(supports);
! 338: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
! 339: if Is_Null(tmpsub)
! 340: then Extract_and_Clear(n,mix,t,liftedl,numtri,mixsub,lifted);
! 341: else lastcells := Extract_non_Flat_Mixed_Cells(n,mix,t);
! 342: Deflate(n,lastcells);
! 343: Construct(Head_Of(tmpsub),lastcells);
! 344: mixsub := lastcells;
! 345: numtri := Length_Of(t);
! 346: end if;
! 347: end Dynamic_Cayley_with_Flat_and_New;
! 348:
! 349: procedure Dynamic_Cayley_with_Flat_and_Newt
! 350: ( n : in natural; mix : in Vector;
! 351: supports : in Array_of_Lists; order,inter : in boolean;
! 352: maxli : in natural; lifted : out Array_of_Lists;
! 353: t : in out Triangulation ) is
! 354:
! 355: l,liftedl,liftedl_last : list;
! 356:
! 357: procedure Bef_Flat ( tt : in Triangulation; lft : in List ) is
! 358:
! 359: cells : Mixed_Subdivision;
! 360: lftpts : Array_of_Lists(supports'range);
! 361:
! 362: begin
! 363: Extract(n,mix,tt,lft,cells,lftpts);
! 364: Before_Flattening(cells,lftpts);
! 365: end Bef_Flat;
! 366:
! 367: procedure New_Cell ( tt : in Triangulation; pt : in vector ) is
! 368:
! 369: cells : Mixed_Subdivision := Extract_Mixed_Cells(n,mix,tt);
! 370: index : natural := 1;
! 371:
! 372: begin
! 373: Deflate(n,cells);
! 374: for i in 1..mix'last-1 loop
! 375: if pt(i+n) /= 0
! 376: then index := i+1;
! 377: end if;
! 378: exit when index > 1;
! 379: end loop;
! 380: Process_New_Cells(cells,index,pt);
! 381: end New_Cell;
! 382:
! 383: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat_and_New
! 384: (Before_Flattening => Bef_Flat, Process_New_Simplices => New_Cell);
! 385:
! 386: begin
! 387: l := Embedding_before_Lifting(supports);
! 388: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
! 389: lifted := Extract(n,mix,liftedl); Clear(liftedl);
! 390: end Dynamic_Cayley_with_Flat_and_Newt;
! 391:
! 392: end Cayley_Trick;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to cayley_trick.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