Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/drivers_for_dynamic_lifting.adb, Revision 1.1
1.1 ! maekawa 1: with integer_io; use integer_io;
! 2: with Communications_with_User; use Communications_with_User;
! 3: with Timing_Package; use Timing_Package;
! 4: with Numbers_io; use Numbers_io;
! 5: with Standard_Integer_Vectors; use Standard_Integer_Vectors;
! 6: with Standard_Integer_Vectors_io; use Standard_Integer_Vectors_io;
! 7: with Standard_Floating_Vectors;
! 8: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
! 9: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
! 10: with Lists_of_Integer_Vectors_io; use Lists_of_Integer_Vectors_io;
! 11: with Lists_of_Vectors_Utilities; use Lists_of_Vectors_Utilities;
! 12: with Arrays_of_Integer_Vector_Lists; use Arrays_of_Integer_Vector_Lists;
! 13: with Arrays_of_Integer_Vector_Lists_io; use Arrays_of_Integer_Vector_Lists_io;
! 14: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
! 15: with Power_Lists; use Power_Lists;
! 16: with Drivers_for_Vertex_Points; use Drivers_for_Vertex_Points;
! 17: with Integer_Lifting_Utilities; use Integer_Lifting_Utilities;
! 18: with Integer_Mixed_Subdivisions; use Integer_Mixed_Subdivisions;
! 19: with Integer_Mixed_Subdivisions_io; use Integer_Mixed_Subdivisions_io;
! 20: with Mixed_Volume_Computation; use Mixed_Volume_Computation;
! 21: with Simplices,Triangulations; use Simplices,Triangulations;
! 22: with Triangulations_io; use Triangulations_io;
! 23: with Dynamic_Triangulations; use Dynamic_Triangulations;
! 24: with Cayley_Trick; use Cayley_Trick;
! 25: with Driver_for_Minkowski_Polynomials;
! 26: with Flatten_Mixed_Subdivisions; use Flatten_Mixed_Subdivisions;
! 27: with Triangulations_and_Subdivisions; use Triangulations_and_Subdivisions;
! 28: with Dynamic_Mixed_Subdivisions; use Dynamic_Mixed_Subdivisions;
! 29: with Dynamic_Polyhedral_Continuation; use Dynamic_Polyhedral_Continuation;
! 30: with Driver_for_Polyhedral_Continuation;
! 31: with Pruning_Statistics;
! 32:
! 33: package body Drivers_for_Dynamic_Lifting is
! 34:
! 35: procedure Dynamic_Lifting_Info is
! 36:
! 37: i : array(1..6) of string(1..65);
! 38:
! 39: begin
! 40: i(1):=" Dynamic lifting can be used to compute mixed volumes";
! 41: i(2):="incrementally, i.e.: by adding the points repeatedly to the";
! 42: i(3):="already constructed subdivision. This method works efficiently";
! 43: i(4):="when all Newton polytopes are (almost) equal. The Cayley trick";
! 44: i(5):="is implemented by means of dynamic lifting. This trick computes";
! 45: i(6):="all cells in a mixed subdivision. ";
! 46: for k in i'range loop
! 47: put_line(i(k));
! 48: end loop;
! 49: end Dynamic_Lifting_Info;
! 50:
! 51: procedure Write_Type_of_Mixture
! 52: ( file : in file_type; mix,per : in Vector ) is
! 53:
! 54: -- DESCRIPTION :
! 55: -- Writes the information about the type of mixture on file
! 56: -- and the permutations in the support.
! 57:
! 58: begin
! 59: new_line(file);
! 60: put(file,"TYPE OF MIXTURE : ");
! 61: put(file,"#supports : "); put(file,mix'last,1);
! 62: put(file," occurrences : "); put(file,mix);
! 63: new_line(file);
! 64: put(file," permutation : "); put(file,per);
! 65: new_line(file);
! 66: end Write_Type_of_Mixture;
! 67:
! 68: procedure Driver_for_Dynamic_Mixed_Volume_Computation
! 69: ( file : in file_type; p : in Poly_Sys; byebye : in boolean;
! 70: q : out Poly_Sys; qsols : out Solution_List;
! 71: mv : out natural ) is
! 72:
! 73: welcome : constant string := "Mixed-Volume Computation by Dynamic Lifting";
! 74:
! 75: -- GLOBAL VARIABLES :
! 76:
! 77: supports : Array_of_Lists(p'range);
! 78: n : natural := p'last;
! 79: timer : timing_widget;
! 80: r,max : natural;
! 81: mix,perms : Link_to_Vector;
! 82: ans : character;
! 83: permp,qq : Poly_Sys(p'range);
! 84: qqsols : Solution_List;
! 85: subfile,solsft,qft : file_type;
! 86: vol : natural := 0;
! 87: mixsub : Mixed_Subdivision;
! 88:
! 89: -- GLOBAL SWITCHES :
! 90:
! 91: verpts : boolean; -- if the set of vertex points is computed
! 92: order : boolean; -- process points in fixed instead of random order
! 93: inter : boolean; -- if interior points are possible
! 94: conmv : boolean; -- if checks on zero contributions have to be made
! 95: caytrick : boolean; -- if the Cayley trick has to be applied
! 96: reportnew : boolean; -- if the new cells have to be reported
! 97: reportflat : boolean; -- if before flattening, reporting has to be done
! 98: subonfile : boolean; -- put the subdivision on separate file
! 99: tosolve : boolean; -- if the system needs to be solved
! 100: contrep : boolean; -- if intermediate output during continuation
! 101: ranstart : boolean; -- if random coefficient start system
! 102:
! 103: minkpoly : natural; -- 0 : no; 1 : only poly, > 1 : all subdivisions
! 104:
! 105: -- EXTRACT THE ADDITIONAL POINTS :
! 106:
! 107: function Is_In_Lifted ( pt : Link_to_Vector; lifted : List )
! 108: return boolean is
! 109:
! 110: -- DESCRIPTION :
! 111: -- Returns true if the point is in the lifted list.
! 112:
! 113: tmp : List := lifted;
! 114: lpt : Link_to_Vector;
! 115:
! 116: begin
! 117: while not Is_Null(tmp) loop
! 118: lpt := Head_Of(tmp);
! 119: if pt(pt'range) = lpt(pt'range)
! 120: then return true;
! 121: else tmp := Tail_Of(tmp);
! 122: end if;
! 123: end loop;
! 124: return false;
! 125: end Is_In_Lifted;
! 126:
! 127: function Difference ( supp,liftsupp : in List ) return List is
! 128:
! 129: res,res_last : List;
! 130: tmp : List := supp;
! 131: pt : Link_to_Vector;
! 132:
! 133: begin
! 134: tmp := supp;
! 135: while not Is_Null(tmp) loop
! 136: pt := Head_Of(tmp);
! 137: if not Is_In_Lifted(pt,liftsupp)
! 138: then Append(res,res_last,pt.all);
! 139: end if;
! 140: tmp := Tail_Of(tmp);
! 141: end loop;
! 142: return res;
! 143: end Difference;
! 144:
! 145: function Difference ( supp,liftsupp : in Array_of_Lists )
! 146: return Array_of_Lists is
! 147:
! 148: -- DESCRIPTION :
! 149: -- Returns a tuple of point lists, made of points in supp
! 150: -- that do not belong to the corresponding lifted supports.
! 151:
! 152: res : Array_of_Lists(supp'range);
! 153:
! 154: begin
! 155: for i in supp'range loop
! 156: res(i) := Difference(supp(i),liftsupp(i));
! 157: end loop;
! 158: return res;
! 159: end Difference;
! 160:
! 161: -- DETERMINING THE ORDER OF PROCESSING THE POINTS :
! 162:
! 163: function Determine_Order ( l : List ) return List is
! 164:
! 165: -- DESCRIPTION :
! 166: -- Interactive ordering of the points in the list.
! 167: -- This function displays all points and asks the user for a position.
! 168:
! 169: len : constant natural := Length_Of(l);
! 170: pos : vector(1..len);
! 171: res : List;
! 172:
! 173: function Read_New_Positions
! 174: ( l : List; length : natural ) return vector is
! 175:
! 176: -- DESCRIPTION :
! 177: -- Lists all points in the lists and prompts for a new position.
! 178: -- Returns the position vector.
! 179:
! 180: newpos : vector(1..length);
! 181: tmp : List := l;
! 182: cnt : natural := 0;
! 183:
! 184: begin
! 185: put("There are "); put(length,1); put_line(" points to order.");
! 186: put_line("Give for each separate point its new position :");
! 187: while not Is_Null(tmp) loop
! 188: cnt := cnt + 1;
! 189: loop
! 190: put(Head_Of(tmp)); put(" : ");
! 191: Read_Natural(newpos(cnt));
! 192: exit when (newpos(cnt) >= 1) and (newpos(cnt) <= length);
! 193: put("New position out of range 1.."); put(length,1);
! 194: put_line(". Please try again.");
! 195: end loop;
! 196: tmp := Tail_Of(tmp);
! 197: end loop;
! 198: return newpos;
! 199: end Read_New_Positions;
! 200:
! 201: function Get ( l : List; pos : natural ) return Link_to_Vector is
! 202:
! 203: -- DESCRIPTION :
! 204: -- Returns the point on the indicated position in the list l.
! 205:
! 206: tmp : List := l;
! 207: res : Link_to_Vector;
! 208:
! 209: begin
! 210: if not Is_Null(l)
! 211: then for i in 1..(pos-1) loop
! 212: tmp := Tail_Of(tmp);
! 213: exit when Is_Null(tmp);
! 214: end loop;
! 215: if not Is_Null(tmp)
! 216: then res := Head_Of(tmp);
! 217: end if;
! 218: end if;
! 219: return res;
! 220: end Get;
! 221:
! 222: function Sort ( l : in List; pos : in vector ) return List is
! 223:
! 224: -- DESCRIPTION :
! 225: -- Sorts the given list according to the given position vector:
! 226: -- pos(i) determines the new position of the ith point in the list.
! 227: -- If the returning list is empty, then the position vector was
! 228: -- not a permutation.
! 229:
! 230: empty,res,res_last : List;
! 231: index : natural;
! 232:
! 233: begin
! 234: for i in pos'range loop -- search index : pos(index) = i
! 235: index := 0;
! 236: for j in pos'range loop
! 237: if pos(j) = i
! 238: then index := j;
! 239: end if;
! 240: exit when (index /= 0);
! 241: end loop;
! 242: exit when (index = 0);
! 243: Append(res,res_last,get(l,index)); -- append the vector
! 244: end loop;
! 245: if index = 0
! 246: then return empty;
! 247: else return res;
! 248: end if;
! 249: end Sort;
! 250:
! 251: begin
! 252: if Is_Null(l)
! 253: then return l;
! 254: else loop
! 255: pos := Read_New_Positions(l,len);
! 256: res := Sort(l,pos);
! 257: exit when not Is_Null(res);
! 258: put_line("The given position vector was not a permutation.");
! 259: put_line("Please try again...");
! 260: end loop;
! 261: return res;
! 262: end if;
! 263: end Determine_Order;
! 264:
! 265: procedure Determine_Processing_Order
! 266: ( supports : in out Array_of_Lists; mix : in Link_to_Vector;
! 267: fixed : out boolean ) is
! 268:
! 269: choice : character;
! 270: cnt : natural;
! 271:
! 272: begin
! 273: new_line;
! 274: put_line("MENU for the Order of the points to add : ");
! 275: put_line(" 1. fixed order, given by the monomial ordering");
! 276: put_line(" 2. random order, generated by the algorithm");
! 277: put_line(" 3. interactively defined by you");
! 278: put("Type 1,2, or 3 : "); Ask_Alternative(choice,"123");
! 279: case choice is
! 280: when '1' => fixed := true;
! 281: when '2' => fixed := false;
! 282: when others => fixed := true;
! 283: cnt := supports'first;
! 284: for i in mix'range loop
! 285: supports(cnt) := Determine_Order(supports(cnt));
! 286: cnt := cnt + mix(i);
! 287: end loop;
! 288: end case;
! 289: end Determine_Processing_Order;
! 290:
! 291: -- INSTANTIATIONS OF THE GENERICS :
! 292:
! 293: procedure Report_New_Simplices
! 294: ( t : in Triangulation; point : in Vector ) is
! 295:
! 296: -- DESCRIPTION :
! 297: -- Writes the new simplices on file and computes their volume.
! 298:
! 299: v : natural;
! 300:
! 301: begin
! 302: new_line(file);
! 303: put(file,"The new simplices by adding "); put(file,point);
! 304: put_line(file," : ");
! 305: put(file,n,t,v);
! 306: put(file," with volume addition : ");
! 307: put(file,vol,1); put(file," + "); put(file,v,1);
! 308: vol := vol + v; put(file," = "); put(file,vol,1); put_line(file,".");
! 309: end Report_New_Simplices;
! 310: procedure R_Dynamic_Lifting is
! 311: new Dynamic_Triangulations.Dynamic_Lifting_with_New(Report_New_Simplices);
! 312:
! 313: procedure Collect_Flattening ( t : in Triangulation; l : List ) is
! 314:
! 315: -- DESCRIPTION :
! 316: -- Updates the subdivision mixsub with the flattened cells.
! 317: -- The triangulation on entry contains the whole triangulation,
! 318: -- not just the new cells.
! 319:
! 320: cells : Mixed_Subdivision;
! 321:
! 322: begin
! 323: if Is_Null(mixsub)
! 324: then cells := Deep_Create(n,t);
! 325: else cells := Non_Flat_Deep_Create(n,t);
! 326: Construct(Head_Of(mixsub),cells);
! 327: end if;
! 328: Flatten(cells);
! 329: mixsub := cells;
! 330: end Collect_Flattening;
! 331:
! 332: procedure Report_Flattening
! 333: ( t : in Triangulation; l : in List ) is
! 334:
! 335: -- DESCRIPTION :
! 336: -- Writes the list of lifted points and the triangulation on file
! 337: -- and updates the mixed subdivision.
! 338:
! 339: begin
! 340: new_line(file);
! 341: put_line(file,"The list of lifted points before flattening : ");
! 342: put(file,l);
! 343: new_line(file);
! 344: put_line(file,"The triangulation before flattening : ");
! 345: put(file,n,t,vol);
! 346: put(file," with volume "); put(file,vol,1); put_line(file,".");
! 347: Collect_Flattening(t,l);
! 348: end Report_Flattening;
! 349: procedure C_Dynamic_Lifting is
! 350: new Dynamic_Triangulations.Dynamic_Lifting_with_Flat(Collect_Flattening);
! 351: procedure F_Dynamic_Lifting is
! 352: new Dynamic_Triangulations.Dynamic_Lifting_with_Flat(Report_Flattening);
! 353: procedure FR_Dynamic_Lifting is
! 354: new Dynamic_Triangulations.Dynamic_Lifting_with_Flat_and_New
! 355: ( Before_Flattening => Report_Flattening,
! 356: Process_New_Simplices => Report_New_Simplices);
! 357:
! 358: procedure Report_New_Cells
! 359: ( mixsub : in out Mixed_Subdivision;
! 360: i : in natural; point : in Vector ) is
! 361:
! 362: -- DESCRIPTION :
! 363: -- Writes the new mixed cells on file and computes the mixed volume.
! 364:
! 365: v : natural;
! 366:
! 367: begin
! 368: if not Is_Null(mixsub)
! 369: then
! 370: new_line(file);
! 371: put(file,"The new mixed cells by adding "); put(file,point);
! 372: new_line(file);
! 373: put(file," to the "); put(file,i,1); put_line(file,"th component : ");
! 374: put(file,n,mix.all,mixsub,v);
! 375: put(file," with volume addition : ");
! 376: put(file,vol,1); put(file," + "); put(file,v,1);
! 377: vol := vol + v; put(file," = "); put(file,vol,1); new_line(file);
! 378: end if;
! 379: end Report_New_Cells;
! 380: procedure R_Dynamic_Cayley is
! 381: new Cayley_Trick.Dynamic_Cayley_with_New(Report_New_Cells);
! 382: procedure Rt_Dynamic_Cayley is
! 383: new Cayley_Trick.Dynamic_Cayley_with_Newt(Report_New_Cells);
! 384: procedure R_Dynamic_Lifting is
! 385: new Dynamic_Mixed_Subdivisions.Dynamic_Lifting_with_New(Report_New_Cells);
! 386:
! 387: procedure Report_Flattening
! 388: ( mixsub : in out Mixed_Subdivision;
! 389: lifted : in Array_of_Lists ) is
! 390:
! 391: -- DESCRIPTION :
! 392: -- Writes the list of lifted points and the subdivision on file.
! 393:
! 394: begin
! 395: new_line(file);
! 396: put_line(file,"The list of lifted points before flattening : ");
! 397: for i in lifted'range loop
! 398: put(file," points of "); put(file,i,1);
! 399: put_line(file,"th component : ");
! 400: put(file,lifted(i));
! 401: end loop;
! 402: new_line(file);
! 403: put_line(file,"The mixed subdivision before flattening : ");
! 404: put(file,n,mix.all,mixsub,vol);
! 405: put(file," with volume "); put(file,vol,1); put_line(file,".");
! 406: end Report_Flattening;
! 407: procedure F_Dynamic_Cayley is
! 408: new Cayley_Trick.Dynamic_Cayley_with_Flat(Report_Flattening);
! 409: procedure Ft_Dynamic_Cayley is
! 410: new Cayley_Trick.Dynamic_Cayley_with_Flatt(Report_Flattening);
! 411: procedure FR_Dynamic_Cayley is
! 412: new Cayley_Trick.Dynamic_Cayley_with_Flat_and_New
! 413: (Before_Flattening => Report_Flattening,
! 414: Process_New_Cells => Report_New_Cells);
! 415: procedure FRt_Dynamic_Cayley is
! 416: new Cayley_Trick.Dynamic_Cayley_with_Flat_and_Newt
! 417: (Before_Flattening => Report_Flattening,
! 418: Process_New_Cells => Report_New_Cells);
! 419:
! 420: procedure Report_Flattening
! 421: ( mixsub : in out Mixed_Subdivision;
! 422: fs : in Face_Structures ) is
! 423:
! 424: -- DESCRIPTION :
! 425: -- Writes the list of lifted points and the subdivision on file.
! 426:
! 427: begin
! 428: new_line(file);
! 429: put_line(file,"The lists of lifted points before flattening : ");
! 430: for i in fs'range loop
! 431: put(file," points of "); put(file,i,1);
! 432: put_line(file,"th component : ");
! 433: put(file,fs(i).l);
! 434: end loop;
! 435: new_line(file);
! 436: put_line(file,"The mixed subdivision before flattening : ");
! 437: put(file,n,mix.all,mixsub,vol);
! 438: put(file," with volume "); put(file,vol,1); put_line(file,".");
! 439: end Report_Flattening;
! 440: procedure F_Dynamic_Lifting is
! 441: new Dynamic_Mixed_Subdivisions.Dynamic_Lifting_with_Flat
! 442: (Report_Flattening);
! 443: procedure FR_Dynamic_Lifting is
! 444: new Dynamic_Mixed_Subdivisions.Dynamic_Lifting_with_Flat_and_New
! 445: (Before_Flattening => Report_Flattening,
! 446: Process_New_Cells => Report_New_Cells);
! 447:
! 448: -- MAIN CONSTRUCTORS :
! 449:
! 450: procedure Compute_Triangulation is
! 451:
! 452: -- DESCRIPTION :
! 453: -- Application of the dynamic lifting algorithm
! 454: -- to compute a triangulation of one polytope.
! 455:
! 456: t : Triangulation;
! 457: support,lifted,lifted_last : List;
! 458: arlifted : Array_of_Lists(mix'range);
! 459:
! 460: begin
! 461: support := supports(supports'first);
! 462: if verpts
! 463: then Vertex_Points(file,support);
! 464: end if;
! 465: new_line(file);
! 466: put_line(file,"CREATION OF THE TRIANGULATION :");
! 467: new_line(file);
! 468: tstart(timer);
! 469: if reportnew
! 470: then
! 471: if reportflat
! 472: then FR_Dynamic_Lifting(support,order,inter,max,lifted,lifted_last,t);
! 473: else R_Dynamic_Lifting(support,order,inter,max,lifted,lifted_last,t);
! 474: end if;
! 475: elsif reportflat
! 476: then
! 477: F_Dynamic_Lifting(support,order,inter,max,lifted,lifted_last,t);
! 478: elsif subonfile
! 479: then
! 480: C_Dynamic_Lifting
! 481: (support,order,inter,max,lifted,lifted_last,t);
! 482: else
! 483: Dynamic_Lifting(support,order,inter,max,lifted,lifted_last,t);
! 484: end if;
! 485: tstop(timer);
! 486: new_line(file);
! 487: print_times(file,timer,"computing the triangulation");
! 488: new_line(file);
! 489: put_line(file,"THE LIFTED SUPPORTS :"); new_line(file);
! 490: put(file,lifted);
! 491: new_line(file);
! 492: put_line(file,"THE TRIANGULATION :"); new_line(file);
! 493: tstart(timer);
! 494: put(file,n,t,vol);
! 495: tstop(timer);
! 496: new_line(file);
! 497: put(file,"The volume : "); put(file,vol,1); new_line(file);
! 498: new_line(file);
! 499: print_times(file,timer,"computing the volume");
! 500: if subonfile
! 501: then if Is_Null(mixsub)
! 502: then put(subfile,n,1); new_line(subfile);
! 503: put(subfile,1,1); new_line(subfile); -- type of mixture
! 504: put(subfile,n,t);
! 505: else declare
! 506: lastcells : Mixed_Subdivision := Non_Flat_Deep_Create(n,t);
! 507: begin
! 508: Construct(Head_Of(mixsub),lastcells);
! 509: mixsub := lastcells;
! 510: put(subfile,n,mix.all,mixsub);
! 511: end;
! 512: end if;
! 513: Close(subfile);
! 514: end if;
! 515: mv := vol;
! 516: end Compute_Triangulation;
! 517:
! 518: procedure Compute_Cayley_Triangulation is
! 519:
! 520: -- DESCRIPTION :
! 521: -- Application of the dynamic lifting algorithm to compute a mixed
! 522: -- subdivision of a tuple of polytopes by means of the Cayley trick.
! 523:
! 524: supp,lifted : Array_of_Lists(1..r);
! 525: t : Triangulation;
! 526: numtri,mr : natural;
! 527: newperms : Link_to_Vector;
! 528:
! 529: begin
! 530: if verpts
! 531: then Vertex_Points(file,mix,supports);
! 532: Clear(mix);
! 533: Compute_Mixture(supports,mix,newperms);
! 534: Write_Type_of_Mixture(file,mix.all,newperms.all);
! 535: end if;
! 536: mr := mix'last;
! 537: supp(1..mr) := Typed_Lists(mix.all,supports);
! 538: new_line(file);
! 539: put_line(file,"CREATION OF THE MIXED SUBDIVISION :");
! 540: new_line(file);
! 541: tstart(timer);
! 542: if reportnew
! 543: then
! 544: if reportflat
! 545: then
! 546: if minkpoly > 0
! 547: then FRt_Dynamic_Cayley
! 548: (n,mix.all,supp(1..mr),order,inter,max,lifted(1..mr),t);
! 549: else FR_Dynamic_Cayley
! 550: (n,mix.all,supp(1..mr),order,inter,max,
! 551: lifted(1..mr),mixsub,numtri);
! 552: end if;
! 553: else
! 554: if minkpoly > 0
! 555: then Rt_Dynamic_Cayley
! 556: (n,mix.all,supp(1..mr),order,inter,max,lifted(1..mr),t);
! 557: else R_Dynamic_Cayley
! 558: (n,mix.all,supp(1..mr),order,inter,max,lifted(1..mr),
! 559: mixsub,numtri);
! 560: end if;
! 561: end if;
! 562: elsif reportflat
! 563: then
! 564: if minkpoly > 0
! 565: then Ft_Dynamic_Cayley
! 566: (n,mix.all,supp(1..mr),order,inter,max,lifted(1..mr),t);
! 567: else F_Dynamic_Cayley
! 568: (n,mix.all,supp(1..mr),order,inter,max,
! 569: lifted(1..mr),mixsub,numtri);
! 570: end if;
! 571: else
! 572: if minkpoly > 0
! 573: then Dynamic_Cayley
! 574: (n,mix.all,supp(1..mr),order,inter,max,lifted(1..mr),t);
! 575: else Dynamic_Cayley
! 576: (n,mix.all,supp(1..mr),order,inter,max,
! 577: lifted(1..mr),mixsub,numtri);
! 578: end if;
! 579: end if;
! 580: tstop(timer);
! 581: new_line(file);
! 582: print_times(file,timer,"Computing the mixed subdivision");
! 583: new_line(file);
! 584: put_line(file,"THE LIFTED SUPPORTS :");
! 585: new_line(file);
! 586: put(file,lifted);
! 587: if minkpoly > 0
! 588: then declare
! 589: alltri : boolean := (minkpoly > 1);
! 590: begin
! 591: Driver_for_Minkowski_Polynomials(file,n,mix.all,t,alltri,mixsub);
! 592: numtri := Length_Of(t);
! 593: end;
! 594: end if;
! 595: new_line(file);
! 596: put_line(file,"THE MIXED SUBDIVISION :");
! 597: new_line(file);
! 598: tstart(timer);
! 599: put(file,n,mix.all,mixsub,vol);
! 600: tstop(timer);
! 601: new_line(file);
! 602: put(file,"The mixed volume equals : "); put(file,vol,1);
! 603: new_line(file);
! 604: put(file,"Number of cells in auxiliary triangulation : ");
! 605: put(file,numtri,1); new_line(file);
! 606: new_line(file);
! 607: print_times(file,timer,"Computing the mixed volume");
! 608: if subonfile
! 609: then put(subfile,n,mix.all,mixsub);
! 610: Close(subfile);
! 611: end if;
! 612: mv := vol;
! 613: end Compute_Cayley_Triangulation;
! 614:
! 615: procedure Report_Results
! 616: ( file : in file_type; n : in natural; mix : in Link_to_Vector;
! 617: mixsub : in out Mixed_Subdivision;
! 618: fs : in Face_Structures ) is
! 619: begin
! 620: new_line(file);
! 621: put_line(file,"THE LIFTED SUPPORTS :");
! 622: new_line(file);
! 623: for i in fs'range loop
! 624: put(file,fs(i).l); new_line(file);
! 625: end loop;
! 626: put_line(file,"THE MIXED SUBDIVISION :");
! 627: new_line(file);
! 628: tstart(timer);
! 629: if r = 1
! 630: then put(file,n,fs(fs'first).t,vol);
! 631: else put(file,n,mix.all,mixsub,vol);
! 632: end if;
! 633: tstop(timer);
! 634: new_line(file);
! 635: put(file,"The mixed volume equals : "); put(file,vol,1); new_line(file);
! 636: new_line(file);
! 637: print_times(file,timer,"Computing the mixed volume");
! 638: if subonfile
! 639: then put(subfile,n,mix.all,mixsub);
! 640: Close(subfile);
! 641: end if;
! 642: mv := vol;
! 643: end Report_Results;
! 644:
! 645: procedure Compute_Mixed_Subdivision is
! 646:
! 647: -- DESCRIPTION :
! 648: -- Application of the dynamic lifting algorithm
! 649: -- to compute a mixed subdivision of a tuple of polytopes.
! 650:
! 651: supp,lifted : Array_of_Lists(1..r);
! 652: fs : Face_Structures(1..r);
! 653: nbsucc,nbfail : Standard_Floating_Vectors.Vector(1..r) := (1..r => 0.0);
! 654: mr : natural;
! 655: newperms : Link_to_Vector;
! 656:
! 657: begin
! 658: if verpts
! 659: then Vertex_Points(file,mix,supports);
! 660: Clear(mix);
! 661: Compute_Mixture(supports,mix,newperms);
! 662: Write_Type_of_Mixture(file,mix.all,newperms.all);
! 663: end if;
! 664: mr := mix'last;
! 665: supp(1..mr) := Typed_Lists(mix.all,supports);
! 666: new_line(file);
! 667: put_line(file,"CREATION OF THE MIXED SUBDIVISION :");
! 668: new_line(file);
! 669: tstart(timer);
! 670: if reportnew
! 671: then
! 672: if reportflat
! 673: then FR_Dynamic_Lifting
! 674: (n,mix.all,supp(1..mr),order,inter,conmv,max,mixsub,
! 675: fs(1..mr),nbsucc(1..mr),nbfail(1..mr));
! 676: else R_Dynamic_Lifting
! 677: (n,mix.all,supp(1..mr),order,inter,conmv,max,mixsub,
! 678: fs(1..mr),nbsucc(1..mr),nbfail(1..mr));
! 679: end if;
! 680: elsif reportflat
! 681: then F_Dynamic_Lifting
! 682: (n,mix.all,supp(1..mr),order,inter,conmv,max,mixsub,
! 683: fs(1..mr),nbsucc(1..mr),nbfail(1..mr));
! 684: else Dynamic_Lifting
! 685: (n,mix.all,supp(1..mr),order,inter,conmv,max,mixsub,
! 686: fs(1..mr),nbsucc(1..mr),nbfail(1..mr));
! 687: end if;
! 688: tstop(timer);
! 689: Pruning_Statistics(file,nbsucc(1..mr),nbfail(1..mr));
! 690: new_line(file);
! 691: print_times(file,timer,"Computing the mixed subdivision");
! 692: Report_Results(file,n,mix,mixsub,fs(1..mr));
! 693: end Compute_Mixed_Subdivision;
! 694:
! 695: procedure Solve_Coefficient_System is
! 696:
! 697: -- DESCRIPTION :
! 698: -- Application of the dynamic lifting algorithm
! 699: -- to compute a mixed subdivision of a tuple of polytopes and
! 700: -- to solve a start system, with randomized coefficients.
! 701:
! 702: supp : Array_of_Lists(1..r);
! 703: fs : Face_Structures(1..r);
! 704: lifted : Array_of_Lists(1..r);
! 705: numtri : natural := 0;
! 706: lif,lif_last : List;
! 707: nbsucc,nbfail : Standard_Floating_Vectors.Vector(1..r) := (1..r => 0.0);
! 708: mr : natural;
! 709: newperms : Link_to_Vector;
! 710:
! 711: begin
! 712: if verpts
! 713: then Vertex_Points(file,mix,supports);
! 714: if r > 1
! 715: then Clear(mix);
! 716: Compute_Mixture(supports,mix,newperms);
! 717: Write_Type_of_Mixture(file,mix.all,newperms.all);
! 718: qq := Permute(qq,newperms);
! 719: for i in supports'range loop
! 720: qq(i) := Select_Terms(qq(i),supports(i));
! 721: end loop;
! 722: end if;
! 723: end if;
! 724: mr := mix'last;
! 725: supp(1..mr) := Typed_Lists(mix.all,supports);
! 726: new_line(file);
! 727: put_line(file,"SOLVING THE RANDOM COEFFICIENT SYSTEM :");
! 728: new_line(file);
! 729: tstart(timer);
! 730: if mix'last = mix'first
! 731: then
! 732: Dynamic_Unmixed_Solve
! 733: (file,n,supp(supp'first),order,inter,max,fs(fs'first).l,
! 734: fs(fs'first).last,fs(fs'first).t,qq,qqsols);
! 735: else
! 736: if caytrick
! 737: then
! 738: Dynamic_Cayley_Solve(file,n,mix.all,supp(1..mr),order,inter,max,
! 739: lifted(1..mr),mixsub,numtri,qq,qqsols);
! 740: for i in 1..mr loop
! 741: fs(i).l := lifted(i);
! 742: end loop;
! 743: else
! 744: Dynamic_Mixed_Solve
! 745: (file,n,mix.all,supp(1..mr),order,inter,conmv,max,mixsub,
! 746: fs(1..mr),nbsucc(1..mr),nbfail(1..mr),qq,qqsols);
! 747: end if;
! 748: end if;
! 749: tstop(timer);
! 750: if mix'last > mix'first and not caytrick
! 751: then Pruning_Statistics(file,nbsucc(1..mr),nbfail(1..mr));
! 752: end if;
! 753: new_line(file);
! 754: print_times(file,timer,"Computing the solution list");
! 755: Report_Results(file,n,mix,mixsub,fs(1..mr));
! 756: q := qq; qsols := qqsols;
! 757: if not ranstart
! 758: then put(solsft,qqsols);
! 759: Close(solsft);
! 760: end if;
! 761: if ranstart
! 762: then new_line(qft); put_line(qft,"THE SOLUTIONS :"); new_line(qft);
! 763: put(qft,Length_Of(qqsols),n,qqsols);
! 764: Close(qft);
! 765: end if;
! 766: end Solve_Coefficient_System;
! 767:
! 768: begin
! 769: new_line; put_line(welcome);
! 770: -- READING GENERAL INPUT INFORMATION :
! 771: supports := Create(p);
! 772: new_line;
! 773: put("Do you want to enforce a type of mixture ? (y/n) ");
! 774: Ask_Yes_or_No(ans);
! 775: if ans /= 'y'
! 776: then Compute_Mixture(supports,mix,perms); r := mix'last;
! 777: else put("Give number of different supports : "); Read_Natural(r);
! 778: put("Give vector of occurrences : "); get(r,mix);
! 779: perms := new Vector(1..n);
! 780: for i in perms'range loop
! 781: perms(i) := i;
! 782: end loop;
! 783: end if;
! 784: Write_Type_of_Mixture(file,mix.all,perms.all);
! 785: -- DETERMINE THE GLOBAL SWITCHES :
! 786: put("Do you first want to extract the vertex points ? (y/n) ");
! 787: Ask_Yes_or_No(ans);
! 788: verpts := (ans = 'y');
! 789: inter := not verpts;
! 790: put("Do you have a maximum lifting value ? (y/n) ");
! 791: Ask_Yes_or_No(ans);
! 792: if ans = 'y'
! 793: then put(" Give the maximum lifting value : ");
! 794: Read_Positive(max);
! 795: else max := 0;
! 796: end if;
! 797: Determine_Processing_Order(supports,mix,order);
! 798: if (r > 1)
! 799: then new_line;
! 800: put_line("MENU for Cayley trick : ");
! 801: put_line(" 0. No Cayley trick, pruning for mixed cells.");
! 802: put_line(" 1. Cayley trick : auxiliary triangulation.");
! 803: put_line(" 2. Cayley trick with Minkowski-polynomial.");
! 804: put_line(" 3. Cayley trick with all subdivisions.");
! 805: put("Type 0,1,2, or 3 : ");
! 806: Ask_Alternative(ans,"0123");
! 807: caytrick := not (ans = '0');
! 808: case ans is
! 809: when '2' => minkpoly := 1;
! 810: when '3' => minkpoly := 2;
! 811: when others => minkpoly := 0;
! 812: end case;
! 813: if not caytrick
! 814: then put("Do you want online checks on zero contributions ? (y/n) ");
! 815: Ask_Yes_or_No(ans);
! 816: conmv := (ans = 'y');
! 817: else conmv := false;
! 818: end if;
! 819: else caytrick := false; conmv := false;
! 820: end if;
! 821: put("Do you want to have the subdivision on separate file ? (y/n) ");
! 822: Ask_Yes_or_No(ans);
! 823: if ans = 'y'
! 824: then subonfile := true;
! 825: put_line("Reading the name of the file.");
! 826: Read_Name_and_Create_File(subfile);
! 827: else subonfile := false;
! 828: end if;
! 829: new_line;
! 830: put("Are the cells to be written on file, during computation ? (y/n) ");
! 831: Ask_Yes_or_No(ans);
! 832: reportnew := (ans = 'y');
! 833: put("Are the cells to be written on file, before flattening ? (y/n) ");
! 834: Ask_Yes_or_No(ans);
! 835: reportflat := (ans = 'y');
! 836: permp := Permute(p,perms);
! 837: Driver_for_Polyhedral_Continuation
! 838: (file,permp,0,byebye,qq,qft,solsft,tosolve,ranstart,contrep);
! 839: -- HANDLING THE UNMIXED AND THE MIXED CASE SEPARATELY :
! 840: if not tosolve
! 841: then if r = 1
! 842: then Compute_Triangulation;
! 843: else if caytrick
! 844: then Compute_Cayley_Triangulation;
! 845: else Compute_Mixed_Subdivision;
! 846: end if;
! 847: end if;
! 848: else Solve_Coefficient_System;
! 849: end if;
! 850: end Driver_for_Dynamic_Mixed_Volume_Computation;
! 851:
! 852: end Drivers_for_Dynamic_Lifting;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to drivers_for_dynamic_lifting.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