Annotation of OpenXM_contrib/PHC/Ada/Schubert/deformation_posets.adb, Revision 1.1
1.1 ! maekawa 1: with unchecked_deallocation;
! 2: with integer_io; use integer_io;
! 3: with Timing_Package; use Timing_Package;
! 4: with Characters_and_Numbers; use Characters_and_Numbers;
! 5: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
! 6: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
! 7: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
! 8: with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
! 9: with Standard_Complex_Vectors_io; use Standard_Complex_Vectors_io;
! 10: with Standard_Natural_Matrices;
! 11: with Standard_Complex_Matrices;
! 12: with Standard_Complex_Matrices_io; use Standard_Complex_Matrices_io;
! 13: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
! 14: with Symbol_Table; use Symbol_Table;
! 15: with Standard_Complex_Poly_Functions; use Standard_Complex_Poly_Functions;
! 16: with Standard_Complex_Poly_SysFun; use Standard_Complex_Poly_SysFun;
! 17: with Standard_Complex_Poly_Systems; use Standard_Complex_Poly_Systems;
! 18: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
! 19: with Standard_Complex_Poly_Matrices;
! 20: with Standard_Complex_Poly_Matrices_io; use Standard_Complex_Poly_Matrices_io;
! 21: with Brackets,Brackets_io; use Brackets,Brackets_io;
! 22: with Bracket_Monomials; use Bracket_Monomials;
! 23: with Bracket_Polynomials; use Bracket_Polynomials;
! 24: with Bracket_Systems; use Bracket_Systems;
! 25: with Bracket_Systems_io; use Bracket_Systems_io;
! 26: with Plane_Representations; use Plane_Representations;
! 27: with Symbolic_Minor_Equations; use Symbolic_Minor_Equations;
! 28: with Numeric_Minor_Equations; use Numeric_Minor_Equations;
! 29: with Determinantal_Systems; use Determinantal_Systems;
! 30: with Specialization_of_Planes; use Specialization_of_Planes;
! 31: with Curves_into_Grassmannian; use Curves_into_Grassmannian;
! 32: with Curves_into_Grassmannian_io; use Curves_into_Grassmannian_io;
! 33: with Pieri_Homotopies; use Pieri_Homotopies;
! 34: with Pieri_Continuation; use Pieri_Continuation;
! 35:
! 36: package body Deformation_Posets is
! 37:
! 38: -- BRACKET AUXILIARITIES TO DETERMINE PIVOTS :
! 39:
! 40: function Complement ( n : natural; b : Bracket ) return Bracket is
! 41:
! 42: -- DESCRIPTION :
! 43: -- Returns the complement of the bracket b, defined as a bracket
! 44: -- of range 1..n-b'length as an ordered subset of {1..n} \ b.
! 45:
! 46: res : Bracket(1..n-b'last);
! 47: cnt : natural := 0;
! 48: ind : natural := 1;
! 49:
! 50: begin
! 51: for i in 1..n loop
! 52: if ((ind > b'last) or else (i < b(ind)))
! 53: then cnt := cnt+1;
! 54: res(cnt) := i;
! 55: elsif i = b(ind)
! 56: then ind := ind+1;
! 57: end if;
! 58: end loop;
! 59: return res;
! 60: end Complement;
! 61:
! 62: function Remove ( b : Bracket; l : natural ) return Bracket is
! 63:
! 64: -- DESCRIPTION :
! 65: -- Returns a smaller bracket that does not contain l.
! 66:
! 67: -- REQUIRED : there exists a k: b(k) = l.
! 68:
! 69: res : Bracket(1..b'last-1);
! 70: cnt : natural := 0;
! 71:
! 72: begin
! 73: for i in b'range loop
! 74: if b(i) /= l
! 75: then cnt := cnt+1;
! 76: res(cnt) := b(i);
! 77: end if;
! 78: end loop;
! 79: return res;
! 80: end Remove;
! 81:
! 82: function Is_In ( b : Bracket; l : natural ) return boolean is
! 83:
! 84: -- DESCRIPTION :
! 85: -- Returns true if there exists an index k such that b(k) = l.
! 86:
! 87: begin
! 88: for k in b'range loop
! 89: if b(k) = l
! 90: then return true;
! 91: end if;
! 92: end loop;
! 93: return false;
! 94: end Is_In;
! 95:
! 96: function Remove ( b1,b2 : Bracket ) return Bracket is
! 97:
! 98: -- DESCRIPTION :
! 99: -- Returns b1 minus the first element in b2 that also occurs in b1.
! 100:
! 101: begin
! 102: for i in b2'range loop
! 103: if Is_In(b1,b2(i))
! 104: then return Remove(b1,b2(i));
! 105: end if;
! 106: end loop;
! 107: return b1;
! 108: end Remove;
! 109:
! 110: function Remove ( cols,b,subb : Bracket ) return Bracket is
! 111:
! 112: -- DESCRIPTION :
! 113: -- The indices in cols correspond to the entries in b.
! 114: -- The bracket subb is a sub-bracket of b, with only one entry removed.
! 115: -- The indices on return correspond to the entries in subb.
! 116:
! 117: res : Bracket(subb'range);
! 118:
! 119: begin
! 120: for i in subb'range loop
! 121: if b(i) = subb(i)
! 122: then res(i) := cols(i);
! 123: else res(i) := cols(i+1);
! 124: end if;
! 125: end loop;
! 126: return res;
! 127: end Remove;
! 128:
! 129: -- POSET-ORIENTED PIERI DEFORMATIONS :
! 130:
! 131: function Leaf_Plane ( n : natural; nd : Node )
! 132: return Standard_Complex_Matrices.Matrix is
! 133:
! 134: -- DESCRIPTION :
! 135: -- Returns the solution plane that corresponds to a leaf of the poset.
! 136:
! 137: res : Standard_Complex_Matrices.Matrix(1..n,nd.top'range);
! 138:
! 139: begin
! 140: for i in res'range(1) loop
! 141: for j in res'range(2) loop
! 142: res(i,j) := Create(0.0);
! 143: end loop;
! 144: end loop;
! 145: for i in nd.top'range loop
! 146: res(nd.top(i),i) := Create(1.0);
! 147: end loop;
! 148: return res;
! 149: end Leaf_Plane;
! 150:
! 151: -- DEFORMATIONS :
! 152:
! 153: function Path_Coordinates ( level,label,child : natural )
! 154: return string is
! 155: begin
! 156: return "tracing (User time) at node("
! 157: & Convert(level) & ")("
! 158: & Convert(label) & ") from child "
! 159: & Convert(child);
! 160: end Path_Coordinates;
! 161:
! 162: procedure Write_Path_Coordinates
! 163: ( file : in file_type;
! 164: level,label,path,child,childpath : in natural ) is
! 165:
! 166: -- DESCRIPTION :
! 167: -- Writes all coordinates from the current path that is to be traced.
! 168:
! 169: begin
! 170: put(file,"Tracing at node("); put(file,level,1); put(file,")(");
! 171: put(file,label,1); put(file,") path "); put(file,path,1);
! 172: put(file," as path "); put(file,childpath,1);
! 173: put(file," from child "); put(file,child,1); new_line(file);
! 174: end Write_Path_Coordinates;
! 175:
! 176: procedure Write_Path_Coordinates
! 177: ( file : in file_type;
! 178: level,label,child : in natural ) is
! 179:
! 180: -- DESCRIPTION :
! 181: -- Writes all coordinates from the current path that is to be traced.
! 182:
! 183: begin
! 184: put(file,"Tracing paths at node("); put(file,level,1); put(file,")(");
! 185: put(file,label,1);
! 186: put(file,") from child "); put(file,child,1); new_line(file);
! 187: end Write_Path_Coordinates;
! 188:
! 189: procedure Deform_from_Children
! 190: ( file : in file_type;
! 191: poset : in out Array_of_Array_of_VecMats;
! 192: nd : in Node; n,uplevel : in natural;
! 193: homotopy : in Poly_Sys; report,outlog : in boolean;
! 194: x : in Standard_Complex_Poly_Matrices.Matrix;
! 195: npaths : in out Standard_Natural_Vectors.Vector;
! 196: timings : in out Duration_Array ) is
! 197:
! 198: -- DESCRIPTION :
! 199: -- Deforms from the i-th non-empty child of nd at uplevel.
! 200:
! 201: -- ON ENTRY :
! 202: -- file to write intermediate results on;
! 203: -- poset poset of solution p-planes;
! 204: -- nd current node in the localization poset;
! 205: -- n dimension of the working space;
! 206: -- uplevel level where to find the start planes in the poset;
! 207: -- homotopy family of moving planes;
! 208: -- report indicates whether intermediate output during continuation;
! 209: -- outlog flag to write homotopies on file if set to true.
! 210: -- x matrix of unknowns according to a localization pattern.
! 211:
! 212: -- ON RETURN :
! 213: -- poset updated poset of solution p-planes;
! 214: -- npaths updated number of paths traced at that level;
! 215: -- timings updated elapsed user timings.
! 216:
! 217: locmap : Standard_Natural_Matrices.Matrix(1..n,1..nd.p);
! 218: solcnt : natural := 0;
! 219: label : natural;
! 220:
! 221: begin
! 222: for i in nd.child_labels'range loop
! 223: label := nd.child_labels(i);
! 224: if not Empty(poset,uplevel,label) -- child.roco > 0
! 225: then
! 226: Write_Path_Coordinates(file,nd.level,nd.label,label);
! 227: declare
! 228: planes : VecMat(poset(uplevel)(label)'range);
! 229: timer : Timing_Widget;
! 230: begin
! 231: tstart(timer);
! 232: for i in planes'range loop -- create to avoid sharing
! 233: planes(i) := new Standard_Complex_Matrices.Matrix'
! 234: (poset(uplevel)(label)(i).all);
! 235: end loop;
! 236: locmap := Standard_Coordinate_Frame(x,planes(planes'first).all);
! 237: Trace_Paths(file,homotopy,locmap,report,outlog,planes);
! 238: for i in planes'range loop
! 239: solcnt := solcnt+1;
! 240: poset(nd.level)(nd.label)(solcnt) := planes(i);
! 241: end loop;
! 242: tstop(timer);
! 243: new_line(file);
! 244: print_times(file,timer,Path_Coordinates(nd.level,nd.label,label));
! 245: new_line(file);
! 246: timings(nd.level) := timings(nd.level) + Elapsed_User_Time(timer);
! 247: end;
! 248: end if;
! 249: end loop;
! 250: npaths(nd.level) := npaths(nd.level) + solcnt;
! 251: end Deform_from_Children;
! 252:
! 253: procedure Quantum_Deform_from_Children
! 254: ( file : in file_type;
! 255: poset : in out Array_of_Array_of_VecMats;
! 256: nd : in Node; n,q,uplevel : in natural;
! 257: homotopy : in Poly_Sys; conpar,s_mode : in natural;
! 258: report,outlog : in boolean;
! 259: x : in Standard_Complex_Poly_Matrices.Matrix;
! 260: npaths : in out Standard_Natural_Vectors.Vector;
! 261: timings : in out Duration_Array ) is
! 262:
! 263: -- DESCRIPTION :
! 264: -- Deforms from the i-th non-empty child of nd at uplevel.
! 265: -- This is the quantum analogue to the hypersurface Pieri.
! 266:
! 267: -- ON ENTRY :
! 268: -- file to write intermediate results on;
! 269: -- poset poset of solution p-planes;
! 270: -- nd current node in the localization poset;
! 271: -- n dimension of the working space;
! 272: -- q degree of the curve;
! 273: -- uplevel level where to find the start planes in the poset;
! 274: -- homotopy family of moving planes;
! 275: -- conpar number of the continuation parameter;
! 276: -- s_mode if = 0, then s = 0, otherwise s = 1 at start;
! 277: -- report indicates whether intermediate output during continuation;
! 278: -- outlog flag to write homotopies on file if set to true;
! 279: -- x symbolic representation of the curve matrix of polynomials.
! 280:
! 281: -- ON RETURN :
! 282: -- poset updated poset of solution p-planes;
! 283: -- npaths updated number of paths at each level;
! 284: -- timings updated CPU user timings for each level.
! 285:
! 286: m : constant natural := n - nd.p;
! 287: rws : constant natural := n*(q+1);
! 288: locmap : Standard_Natural_Matrices.Matrix(1..rws,1..nd.p);
! 289: solcnt : natural := 0;
! 290: label : natural;
! 291:
! 292: begin
! 293: for i in nd.child_labels'range loop
! 294: label := nd.child_labels(i);
! 295: if not Empty(poset,uplevel,label) -- child.roco > 0
! 296: then
! 297: Write_Path_Coordinates(file,nd.level,nd.label,label);
! 298: declare
! 299: planes : VecMat(poset(uplevel)(label)'range);
! 300: timer : Timing_Widget;
! 301: begin
! 302: tstart(timer);
! 303: for i in planes'range loop -- create to avoid sharing
! 304: planes(i) := new Standard_Complex_Matrices.Matrix'
! 305: (poset(uplevel)(label)(i).all);
! 306: end loop;
! 307: locmap := Standard_Coordinate_Frame
! 308: (m,nd.p,q,nd.top,nd.bottom,planes(planes'first).all);
! 309: Quantum_Trace_Paths
! 310: (file,m,nd.p,q,nd,homotopy,conpar,s_mode,locmap,
! 311: report,outlog,planes);
! 312: for i in planes'range loop
! 313: solcnt := solcnt+1;
! 314: poset(nd.level)(nd.label)(solcnt) := planes(i);
! 315: end loop;
! 316: tstop(timer);
! 317: new_line(file);
! 318: print_times(file,timer,Path_Coordinates(nd.level,nd.label,label));
! 319: new_line(file);
! 320: timings(nd.level) := timings(nd.level) + Elapsed_User_Time(timer);
! 321: end;
! 322: end if;
! 323: end loop;
! 324: npaths(nd.level) := npaths(nd.level) + solcnt;
! 325: end Quantum_Deform_from_Children;
! 326:
! 327: procedure Hypersurface_Deform
! 328: ( file : in file_type; n : in natural;
! 329: poset : in out Array_of_Array_of_VecMats;
! 330: nd : in Node; expbp : in Bracket_Polynomial;
! 331: planes : in VecMat; report,outlog : in boolean;
! 332: npaths : in out Standard_Natural_Vectors.Vector;
! 333: timings : in out Duration_Array ) is
! 334:
! 335: -- DESCRIPTION :
! 336: -- Does the Pieri deformations to the node, same specifications as Solve
! 337: -- for the hypersurface case.
! 338:
! 339: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
! 340:
! 341: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
! 342: := Localization_Pattern(n,nd.top,nd.bottom);
! 343: homsys : Poly_Sys(1..nd.level);
! 344:
! 345: begin
! 346: if nd.tp = mixed
! 347: then homsys := Two_Hypersurface_Pieri_Homotopy(n,nd,expbp,xpm,planes);
! 348: Deform_from_Children
! 349: (file,poset,nd,n,nd.level-2,homsys,report,outlog,
! 350: xpm,npaths,timings);
! 351: else homsys := One_Hypersurface_Pieri_Homotopy(n,nd,expbp,xpm,planes);
! 352: Deform_from_Children
! 353: (file,poset,nd,n,nd.level-1,homsys,report,outlog,
! 354: xpm,npaths,timings);
! 355: end if;
! 356: Standard_Complex_Poly_Matrices.Clear(xpm);
! 357: Clear(homsys);
! 358: end Hypersurface_Deform;
! 359:
! 360: procedure One_General_Deform
! 361: ( file : in file_type; n,ind : in natural;
! 362: poset : in out Array_of_Array_of_VecMats; nd : in Node;
! 363: start,target : in Standard_Complex_Matrices.Matrix;
! 364: planes : in VecMat; bs : in Bracket_System;
! 365: report,outlog : in boolean;
! 366: npaths : in out Standard_Natural_Vectors.Vector;
! 367: timings : in out Duration_Array ) is
! 368:
! 369: -- DESCRIPTION :
! 370: -- Does the Pieri deformations to the node, same specifications as Solve
! 371: -- for the general case.
! 372:
! 373: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
! 374:
! 375: -- ON ENTRY :
! 376: -- file to write intermediate output to;
! 377: -- n number of rows in the matrices;
! 378: -- ind planes(ind) is currently being folded in with this chain;
! 379: -- poset contains solution planes at higher levels;
! 380: -- nd current node in the localization poset;
! 381: -- start start (m+1-k)-plane for pivots;
! 382: -- target target (m+1-k)-plane for pivots;
! 383: -- planes target planes;
! 384: -- bs structure to expand the minors;
! 385: -- report switch to determine output during continuation;
! 386: -- outlog flag to write homotopies on file if set to true.
! 387:
! 388: -- ON RETURN :
! 389: -- poset solution planes at (nd.level)(nd.label) are determined;
! 390: -- npaths number of paths followed at each level;
! 391: -- timings CPU user time at each level.
! 392:
! 393: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
! 394: := Localization_Pattern(n,nd.top,nd.bottom);
! 395: hom : Link_to_Poly_Sys
! 396: := One_General_Pieri_Homotopy(n,ind,nd,bs,start,target,xpm,planes);
! 397:
! 398: begin
! 399: Deform_from_Children
! 400: (file,poset,nd,n,nd.level-1,hom.all,report,outlog,xpm,npaths,timings);
! 401: Standard_Complex_Poly_Matrices.Clear(xpm);
! 402: Clear(hom);
! 403: end One_General_Deform;
! 404:
! 405: procedure Two_General_Deform
! 406: ( file : in file_type; n,ind : in natural;
! 407: poset : in out Array_of_Array_of_VecMats; nd : in Node;
! 408: top_start,top_target,bot_start,bot_target
! 409: : in Standard_Complex_Matrices.Matrix;
! 410: planes : in VecMat; top_bs,bot_bs : in Bracket_System;
! 411: report,outlog : in boolean;
! 412: npaths : in out Standard_Natural_Vectors.Vector;
! 413: timings : in out Duration_Array ) is
! 414:
! 415: -- DESCRIPTION :
! 416: -- Does the Pieri deformations to the node, same specifications as Solve
! 417: -- for the general case.
! 418:
! 419: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
! 420:
! 421: -- ON ENTRY :
! 422: -- file to write intermediate output to;
! 423: -- n number of rows in the matrices;
! 424: -- ind planes(ind) is currently being folded in with this chain;
! 425: -- poset contains solution planes at higher levels;
! 426: -- nd current node in the localization poset;
! 427: -- top_start start (m+1-k)-plane for top pivots;
! 428: -- top_target target (m+1-k)-plane for top pivots;
! 429: -- bot_start start (m+1-k)-plane for bottom pivots;
! 430: -- bot_target target (m+1-k)-plane for bottom pivots;
! 431: -- planes target planes;
! 432: -- top_bs structure to expand the minors for top pivots;
! 433: -- bot_bs structure to expand the minors for bottom pivots;
! 434: -- report switch to determine output during continuation;
! 435: -- outlog flag to write homotopies on file if set to true.
! 436:
! 437: -- ON RETURN :
! 438: -- poset solution planes at (nd.level)(nd.label) are determined;
! 439: -- npaths number of paths traced at each level;
! 440: -- timings updated CPU user times for each level.
! 441:
! 442: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
! 443: := Localization_Pattern(n,nd.top,nd.bottom);
! 444: homotopy : Link_to_Poly_Sys;
! 445:
! 446: begin
! 447: case nd.tp is
! 448: when top
! 449: => homotopy := One_General_Pieri_Homotopy
! 450: (n,ind,nd,top_bs,top_start,top_target,xpm,planes);
! 451: Deform_from_Children
! 452: (file,poset,nd,n,nd.level-1,homotopy.all,report,outlog,xpm,
! 453: npaths,timings);
! 454: when bottom
! 455: => homotopy := One_General_Pieri_Homotopy
! 456: (n,ind,nd,bot_bs,bot_start,bot_target,xpm,planes);
! 457: Deform_from_Children
! 458: (file,poset,nd,n,nd.level-1,homotopy.all,report,outlog,xpm,
! 459: npaths,timings);
! 460: when mixed
! 461: => homotopy := Two_General_Pieri_Homotopy
! 462: (n,ind,nd,top_bs,bot_bs,top_start,top_target,
! 463: bot_start,bot_target,xpm,planes);
! 464: Deform_from_Children
! 465: (file,poset,nd,n,nd.level-2,homotopy.all,report,outlog,xpm,
! 466: npaths,timings);
! 467: end case;
! 468: Standard_Complex_Poly_Matrices.Clear(xpm);
! 469: Clear(homotopy);
! 470: end Two_General_Deform;
! 471:
! 472: procedure Quantum_Deform
! 473: ( file : in file_type; n,q : in natural;
! 474: poset : in out Array_of_Array_of_VecMats;
! 475: nd : in Node; expbp : in Bracket_Polynomial;
! 476: planes : in VecMat; s : Standard_Complex_Vectors.Vector;
! 477: report,outlog : in boolean;
! 478: npaths : in out Standard_Natural_Vectors.Vector;
! 479: timings : in out Duration_Array ) is
! 480:
! 481: -- DESCRIPTION :
! 482: -- This is the q-analogue to the Hypersurface Deform.
! 483:
! 484: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
! 485:
! 486: m : constant natural := n-nd.p;
! 487: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
! 488: := Symbolic_Create(m,nd.p,q,nd.top,nd.bottom);
! 489:
! 490: begin
! 491: if outlog
! 492: then put(file,"Curve at node(");
! 493: put(file,nd.level,1); put(file,")("); put(file,nd.label,1);
! 494: put(file,") for pivots (");
! 495: put(file,nd.top); put(file,","); put(file,nd.bottom);
! 496: put_line(file,") :");
! 497: One_Set_up_Symbol_Table(m,nd.p,q,nd.top,nd.bottom);
! 498: put(file,xpm);
! 499: end if;
! 500: if nd.tp = mixed
! 501: then
! 502: declare
! 503: homsys : Poly_Sys(1..nd.level+2);
! 504: begin
! 505: homsys := Two_Quantum_Pieri_Homotopy(n,nd,expbp,xpm,planes,s);
! 506: if outlog
! 507: then Two_Set_up_Symbol_Table(m,nd.p,q,nd.top,nd.bottom);
! 508: put_line(file,"The homotopy : "); put_line(file,homsys);
! 509: end if;
! 510: Quantum_Deform_from_Children
! 511: (file,poset,nd,n,q,nd.level-2,homsys,nd.level+3,1,
! 512: report,outlog,xpm,npaths,timings);
! 513: Clear(homsys);
! 514: end;
! 515: else
! 516: declare
! 517: homsys : Poly_Sys(1..nd.level+1);
! 518: begin
! 519: homsys := One_Quantum_Pieri_Homotopy(n,nd,expbp,xpm,planes,s);
! 520: if outlog
! 521: then put_line(file,"The homotopy : "); put_line(file,homsys);
! 522: end if;
! 523: Quantum_Deform_from_Children
! 524: (file,poset,nd,n,q,nd.level-1,homsys,nd.level+2,1,
! 525: report,outlog,xpm,npaths,timings);
! 526: Clear(homsys);
! 527: end;
! 528: end if;
! 529: Standard_Complex_Poly_Matrices.Clear(xpm);
! 530: end Quantum_Deform;
! 531:
! 532: function Moving_Point_Mode
! 533: ( l,k : natural; modpiv : Bracket ) return natural is
! 534:
! 535: -- DESCRIPTION :
! 536: -- Returns a natural number that indicates the moving of the
! 537: -- interpolation point. The value on return means the following
! 538: -- when = 0 : s goes from 0 to 1;
! 539: -- = 1 : s remains constant at 1;
! 540: -- = 2 : s goes from 1 to a target value.
! 541:
! 542: begin
! 543: if l = 0
! 544: then return 2;
! 545: elsif l = k-1 and modpiv(1) > 1
! 546: then return 0;
! 547: else return 1;
! 548: end if;
! 549: end Moving_Point_Mode;
! 550:
! 551: procedure One_General_Quantum_Deform
! 552: ( file : in file_type; n,q,l,k,ind : in natural;
! 553: poset : in out Array_of_Array_of_VecMats; nd : in Node;
! 554: modpiv : in Bracket;
! 555: start,target : in Standard_Complex_Matrices.Matrix;
! 556: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
! 557: bs : in Bracket_System; report,outlog : in boolean;
! 558: npaths : in out Standard_Natural_Vectors.Vector;
! 559: timings : in out Duration_Array ) is
! 560:
! 561: -- DESCRIPTION :
! 562: -- This is the quantum analogue to One_General_Deform.
! 563:
! 564: -- REQUIRED : nd.level > 0, solutions at children of nd are in poset.
! 565:
! 566: -- ON ENTRY :
! 567: -- file to write intermediate output to;
! 568: -- n number of rows in the matrices;
! 569: -- q degree of the map;
! 570: -- l runs from k-1 downto 0;
! 571: -- k co-dimension currently being treated;
! 572: -- ind planes(ind) is currently being folded in with this chain;
! 573: -- poset contains solution planes at higher levels;
! 574: -- nd current node in the localization poset;
! 575: -- modpiv bottom or top pivots modulo n;
! 576: -- start start (m+1-k)-plane for pivots;
! 577: -- target target (m+1-k)-plane for pivots;
! 578: -- planes target planes;
! 579: -- s interpolation points where the maps meets the planes;
! 580: -- bs structure to expand the minors;
! 581: -- report switch to determine output during continuation;
! 582: -- outlog flag to write homotopies on file if set to true.
! 583:
! 584: -- ON RETURN :
! 585: -- poset solution planes at (nd.level)(nd.label) are determined;
! 586: -- npaths number of paths followed at each level;
! 587: -- timings CPU user time at each level.
! 588:
! 589: m : constant natural := n-nd.p;
! 590: xpm : Standard_Complex_Poly_Matrices.Matrix(1..n,1..nd.p)
! 591: := Symbolic_Create(m,nd.p,q,nd.top,nd.bottom);
! 592: s_mode : constant natural := Moving_Point_Mode(l,k,modpiv);
! 593: hom : Link_to_Poly_Sys
! 594: := One_General_Quantum_Pieri_Homotopy
! 595: (n,ind,nd,s_mode,bs,start,target,xpm,planes,s);
! 596:
! 597: begin
! 598: if outlog
! 599: then put(file,"level l : "); put(file,l,1); put(file," ");
! 600: put(file,"codim k : "); put(file,k,1); new_line(file);
! 601: put(file,"Curve at node(");
! 602: put(file,nd.level,1); put(file,")("); put(file,nd.label,1);
! 603: put(file,") for pivots (");
! 604: put(file,nd.top); put(file,","); put(file,nd.bottom);
! 605: put_line(file,") :");
! 606: One_Set_up_Symbol_Table(m,nd.p,q,nd.top,nd.bottom);
! 607: put(file,xpm);
! 608: put_line(file,"The homotopy : "); put_line(file,hom.all);
! 609: end if;
! 610: Quantum_Deform_from_Children
! 611: (file,poset,nd,n,q,nd.level-1,hom.all,nd.level+2,s_mode,
! 612: report,outlog,xpm,npaths,timings);
! 613: Standard_Complex_Poly_Matrices.Clear(xpm);
! 614: Clear(hom);
! 615: end One_General_Quantum_Deform;
! 616:
! 617: -- CREATORS :
! 618:
! 619: function Create ( index_poset : Array_of_Array_of_Nodes )
! 620: return Array_of_Array_of_VecMats is
! 621:
! 622: res : Array_of_Array_of_VecMats(index_poset'range);
! 623: lnd : Link_to_Node;
! 624:
! 625: begin
! 626: for i in index_poset'range loop
! 627: if index_poset(i) /= null
! 628: then res(i) := new Array_of_VecMats(index_poset(i)'range);
! 629: for j in res(i)'range loop
! 630: lnd := index_poset(i)(j);
! 631: if lnd.roco /= 0
! 632: then res(i)(j) := new VecMat(1..lnd.roco);
! 633: end if;
! 634: end loop;
! 635: end if;
! 636: end loop;
! 637: return res;
! 638: end Create;
! 639:
! 640: -- SELECTORS :
! 641:
! 642: function Empty ( poset : Array_of_Array_of_VecMats; level,label : natural )
! 643: return boolean is
! 644:
! 645: use Standard_Complex_Matrices;
! 646:
! 647: begin
! 648: if poset(level) = null
! 649: then return true;
! 650: elsif poset(level)(label) = null
! 651: then return true;
! 652: else declare
! 653: lavm : Link_to_VecMat := poset(level)(label);
! 654: begin
! 655: return (lavm(lavm'first) = null);
! 656: end;
! 657: end if;
! 658: end Empty;
! 659:
! 660: -- ANALOGUES TO THE ROOT COUNTERS :
! 661:
! 662: procedure Recursive_Hypersurface_Solve
! 663: ( file : in file_type; n : in natural;
! 664: nd : in Node; expbp : in Bracket_Polynomial;
! 665: poset : in out Array_of_Array_of_VecMats;
! 666: planes : in VecMat; report,outlog : in boolean;
! 667: npaths : in out Standard_Natural_Vectors.Vector;
! 668: timings : in out Duration_Array ) is
! 669:
! 670: -- DESCRIPTION :
! 671: -- This additional layer is added to avoid the repeated construction
! 672: -- of the structure of the equations, that is now in expbp.
! 673:
! 674: begin
! 675: if Empty(poset,nd.level,nd.label)
! 676: then
! 677: if nd.level = 0
! 678: then
! 679: poset(nd.level)(nd.label)(1)
! 680: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
! 681: else
! 682: for i in nd.children'range(1) loop
! 683: for j in nd.children'range(2) loop
! 684: if nd.children(i,j) /= null
! 685: then Recursive_Hypersurface_Solve
! 686: (file,n,nd.children(i,j).all,expbp,
! 687: poset,planes,report,outlog,npaths,timings);
! 688: end if;
! 689: end loop;
! 690: end loop;
! 691: Hypersurface_Deform
! 692: (file,n,poset,nd,expbp,planes,report,outlog,npaths,timings);
! 693: end if;
! 694: end if;
! 695: end Recursive_Hypersurface_Solve;
! 696:
! 697: procedure Solve ( file : in file_type; n : in natural;
! 698: poset : in out Array_of_Array_of_VecMats;
! 699: nd : in Node; planes : in VecMat;
! 700: report,outlog : in boolean;
! 701: npaths : in out Standard_Natural_Vectors.Vector;
! 702: timings : in out Duration_Array ) is
! 703:
! 704: bm : Bracket_Monomial := Maximal_Minors(n,n);
! 705: bs : Bracket_System(0..Number_of_Brackets(bm))
! 706: := Minor_Equations(n,n-nd.p,bm);
! 707:
! 708: begin
! 709: Recursive_Hypersurface_Solve
! 710: (file,n,nd,bs(1),poset,planes,report,outlog,npaths,timings);
! 711: Clear(bm); Clear(bs);
! 712: end Solve;
! 713:
! 714: procedure One_Solve_along_Chains
! 715: ( file : in file_type; nd : in Node; n,l,k,ind : in natural;
! 716: poset : in out Array_of_Array_of_VecMats;
! 717: pivots,columns : in Bracket; bs : in Bracket_System;
! 718: special,start,target : in Standard_Complex_Matrices.Matrix;
! 719: planes : in VecMat; report,outlog : in boolean;
! 720: npaths : in out Standard_Natural_Vectors.Vector;
! 721: timings : in out Duration_Array ) is
! 722:
! 723: -- DESCRIPTION :
! 724: -- Applies the general solver along the nodes in all chains that end at
! 725: -- the current node. This is the analogue to the hypersurface solver,
! 726: -- for use in connection with the grandchildren first recursive solving.
! 727: -- This procedure is only called in "One_Solve".
! 728:
! 729: -- ON ENTRY :
! 730: -- file to write intermediate results on;
! 731: -- nd current node in the localization poset;
! 732: -- n working dimension, equation m+p;
! 733: -- l runs from 0 to k-1;
! 734: -- k current codimension condition;
! 735: -- poset structure with all solution p-planes;
! 736: -- ind ind-1 planes are already folded in;
! 737: -- pivots pivot elements used for the special m-plane;
! 738: -- columns which columns of the special m-plane are used;
! 739: -- bs Laplace expansion of the polynomial equations;
! 740: -- special special m-plane for top pivots;
! 741: -- start (m+1-k)-plane used at the start of the deformation;
! 742: -- target (m+1-k)-plane used as target;
! 743: -- planes sequence of (m+1-k)-planes;
! 744: -- report indicates whether intermediate output during continuation;
! 745: -- outlog flag to write homotopies on file if set to true.
! 746:
! 747: -- ON RETURN :
! 748: -- poset updated structure of all solution p-planes;
! 749: -- npaths updated numbers of paths traced at each level;
! 750: -- timings updated CPU user times at each level.
! 751:
! 752: m : constant natural := n - nd.p;
! 753: new_piv,new_col : Bracket(1..pivots'last-1);
! 754: new_start : Standard_Complex_Matrices.Matrix(1..n,start'range(2));
! 755:
! 756: begin
! 757: if empty(poset,nd.level,nd.label)
! 758: then
! 759: if l < k-1
! 760: then
! 761: for i in nd.children'range(1) loop
! 762: for j in nd.children'range(2) loop
! 763: if ((nd.children(i,j) /= null)
! 764: and then (nd.children(i,j).roco > 0))
! 765: then
! 766: if nd.children(i,j).tp = top
! 767: then new_piv := Remove(pivots,nd.children(i,j).top);
! 768: else new_piv := Remove(pivots,nd.children(i,j).bottom);
! 769: end if;
! 770: new_col := Remove(columns,pivots,new_piv);
! 771: new_start := Special_Plane(n,m,k,new_col,special);
! 772: One_Solve_along_Chains
! 773: (file,nd.children(i,j).all,n,l+1,k,ind,poset,new_piv,
! 774: new_col,bs,special,new_start,start,planes,report,outlog,
! 775: npaths,timings);
! 776: end if;
! 777: end loop;
! 778: end loop;
! 779: end if;
! 780: One_General_Deform
! 781: (file,n,ind,poset,nd,start,target,planes,bs,report,outlog,
! 782: npaths,timings);
! 783: end if;
! 784: end One_Solve_along_Chains;
! 785:
! 786: procedure One_Quantum_Solve_along_Chains
! 787: ( file : in file_type; nd : in Node; n,q,l,k,ind : in natural;
! 788: poset : in out Array_of_Array_of_VecMats;
! 789: pivots,columns : in Bracket; bs : in Bracket_System;
! 790: special,start,target : in Standard_Complex_Matrices.Matrix;
! 791: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
! 792: report,outlog : in boolean;
! 793: npaths : in out Standard_Natural_Vectors.Vector;
! 794: timings : in out Duration_Array ) is
! 795:
! 796: -- DESCRIPTION :
! 797: -- Applies the general solver along the nodes in all chains that end at
! 798: -- the current node. This is the analogue to the hypersurface solver,
! 799: -- for use in connection with the grandchildren first recursive solving.
! 800: -- This procedure is only called in the q-analogue of "One_Solve".
! 801:
! 802: -- ON ENTRY :
! 803: -- file to write intermediate results on;
! 804: -- nd current node in the localization poset;
! 805: -- n working dimension, equation m+p;
! 806: -- q degree of the map;
! 807: -- l runs from 0 to k-1;
! 808: -- k current codimension condition;
! 809: -- poset structure with all solution p-planes;
! 810: -- ind ind-1 planes are already folded in;
! 811: -- pivots pivot elements used for the special m-plane;
! 812: -- columns which columns of the special m-plane are used;
! 813: -- bs Laplace expansion of the polynomial equations;
! 814: -- special special m-plane for top pivots;
! 815: -- start (m+1-k)-plane used at the start of the deformation;
! 816: -- target (m+1-k)-plane used as target;
! 817: -- planes sequence of (m+1-k)-planes;
! 818: -- s interpolation points where the map meets the planes;
! 819: -- report indicates whether intermediate output during continuation;
! 820: -- outlog flag to write homotopies on file if set to true.
! 821:
! 822: -- ON RETURN :
! 823: -- poset updated structure of all solution p-planes;
! 824: -- npaths updated numbers of paths traced at each level;
! 825: -- timings updated CPU user times at each level.
! 826:
! 827: m : constant natural := n - nd.p;
! 828: new_piv,new_col : Bracket(1..pivots'last-1);
! 829: new_start : Standard_Complex_Matrices.Matrix(1..n,start'range(2));
! 830: mod_piv : Bracket(1..nd.p);
! 831:
! 832: begin
! 833: if empty(poset,nd.level,nd.label)
! 834: then
! 835: if l < k-1
! 836: then
! 837: for i in nd.children'range(1) loop
! 838: for j in nd.children'range(2) loop
! 839: if ((nd.children(i,j) /= null)
! 840: and then (nd.children(i,j).roco > 0))
! 841: then
! 842: if nd.children(i,j).tp = top
! 843: then mod_piv := Modulo(nd.children(i,j).top,n);
! 844: new_piv := Remove(pivots,mod_piv);
! 845: put(file,"Top pivots at node : ");
! 846: put(file,nd.top);
! 847: put(file," child top pivots : ");
! 848: put(file,nd.children(i,j).top); new_line(file);
! 849: else mod_piv := Modulo(nd.children(i,j).bottom,n);
! 850: new_piv := Remove(pivots,mod_piv);
! 851: put(file,"Bottom pivots at node : ");
! 852: put(file,nd.bottom);
! 853: put(file," child bottom pivots : ");
! 854: put(file,nd.children(i,j).bottom); new_line(file);
! 855: end if;
! 856: put(file,"Modular pivots : "); put(file,mod_piv);
! 857: put(file," new pivots : "); put(file,new_piv);
! 858: new_line(file);
! 859: put(file,"Pivot columns : "); put(file,columns);
! 860: put(file," new columns : "); put(file,new_piv);
! 861: new_line(file);
! 862: new_col := Remove(columns,pivots,new_piv);
! 863: new_start := Special_Plane(n,m,k,new_col,special);
! 864: One_Quantum_Solve_along_Chains
! 865: (file,nd.children(i,j).all,n,q,l+1,k,ind,poset,new_piv,
! 866: new_col,bs,special,new_start,start,planes,s,report,outlog,
! 867: npaths,timings);
! 868: end if;
! 869: end loop;
! 870: end loop;
! 871: end if;
! 872: One_General_Quantum_Deform
! 873: (file,n,q,l,k,ind,poset,nd,mod_piv,start,target,planes,s,bs,
! 874: report,outlog,npaths,timings);
! 875: end if;
! 876: end One_Quantum_Solve_along_Chains;
! 877:
! 878: procedure Solve_along_One_Chain
! 879: ( file : in file_type; nd : in Node; n,l,k,ind : in natural;
! 880: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
! 881: pivots,columns : in Bracket; bs : in Bracket_System;
! 882: special,start,target : in Standard_Complex_Matrices.Matrix;
! 883: planes : in VecMat; report,outlog : in boolean;
! 884: npaths : in out Standard_Natural_Vectors.Vector;
! 885: timings : in out Duration_Array ) is
! 886:
! 887: -- DESCRIPTION :
! 888: -- Applies the general solver along the nodes in all chains that end at
! 889: -- the current node. This is the analogue to the hypersurface solver,
! 890: -- which can be used in a general control structure.
! 891:
! 892: -- ON ENTRY :
! 893: -- file to write intermediate results on;
! 894: -- nd current node in the localization poset;
! 895: -- n working dimension, equation m+p;
! 896: -- l runs from 0 to k-1;
! 897: -- k current codimension condition;
! 898: -- poset structure with all solution p-planes;
! 899: -- ind ind-1 planes are already folded in;
! 900: -- pivots pivot elements used for the special m-plane;
! 901: -- columns which columns of the special m-plane are used;
! 902: -- bs Laplace expansion of the polynomial equations;
! 903: -- special special m-plane for top pivots;
! 904: -- start (m+1-k)-plane used at the start of the deformation;
! 905: -- target (m+1-k)-plane used as target;
! 906: -- planes sequence of (m+1-k)-planes;
! 907: -- report indicates whether intermediate output during continuation;
! 908: -- outlog file to write homotopies on if set to true.
! 909:
! 910: -- ON RETURN :
! 911: -- poset updated structure of solution p-planes;
! 912: -- npaths updated number of paths traced at each level;
! 913: -- timings updated CPU user times for each level.
! 914:
! 915: m : constant natural := n - nd.p;
! 916:
! 917: begin
! 918: if empty(poset,nd.level,nd.label)
! 919: then
! 920: if nd.level = 0
! 921: then poset(nd.level)(nd.label)(1)
! 922: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
! 923: elsif nd.roco > 0
! 924: then
! 925: if l = k
! 926: then
! 927: if cod'last > cod'first
! 928: then
! 929: declare
! 930: kk : constant natural := cod(cod'last-1);
! 931: kd : constant natural := n+1-kk;
! 932: new_piv,new_col : Bracket(1..m);
! 933: new_special : Standard_Complex_Matrices.Matrix(1..n,1..m);
! 934: new_target : constant Standard_Complex_Matrices.Matrix
! 935: := planes(cod'last-1).all;
! 936: new_start
! 937: : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
! 938: new_bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 939: new_bs : Bracket_System(0..Number_of_Brackets(new_bm))
! 940: := Minor_Equations(kd,kd-nd.p,new_bm);
! 941: begin
! 942: for i in new_col'range loop
! 943: new_col(i) := i;
! 944: end loop;
! 945: if nd.tp = top
! 946: then new_piv := Complement(n,nd.top);
! 947: new_special := Special_Top_Plane(m,nd.top);
! 948: else new_piv := Complement(n,nd.bottom);
! 949: new_special := Special_Bottom_Plane(m,nd.bottom);
! 950: end if;
! 951: new_start := Special_Plane(n,m,kk,new_col,new_special);
! 952: Solve_along_One_Chain
! 953: (file,nd,n,0,kk,cod'last-1,cod(cod'first..cod'last-1),
! 954: poset,new_piv,new_col,new_bs,new_special,new_start,
! 955: new_target,planes,report,outlog,npaths,timings);
! 956: Clear(new_bm); Clear(new_bs);
! 957: end;
! 958: end if;
! 959: else
! 960: declare
! 961: new_piv,new_col : Bracket(1..pivots'last-1);
! 962: new_start
! 963: : Standard_Complex_Matrices.Matrix(1..n,start'range(2));
! 964: begin
! 965: for i in nd.children'range(1) loop
! 966: for j in nd.children'range(2) loop
! 967: if ((nd.children(i,j) /= null)
! 968: and then (nd.children(i,j).roco > 0))
! 969: then
! 970: if nd.children(i,j).tp = top
! 971: then new_piv := Remove(pivots,nd.children(i,j).top);
! 972: else new_piv
! 973: := Remove(pivots,nd.children(i,j).bottom);
! 974: end if;
! 975: new_col := Remove(columns,pivots,new_piv);
! 976: new_start := Special_Plane(n,m,k,new_col,special);
! 977: Solve_along_One_Chain
! 978: (file,nd.children(i,j).all,n,l+1,k,ind,cod,poset,
! 979: new_piv,new_col,bs,special,new_start,start,
! 980: planes,report,outlog,npaths,timings);
! 981: end if;
! 982: end loop;
! 983: end loop;
! 984: One_General_Deform
! 985: (file,n,ind,poset,nd,start,target,planes,bs,
! 986: report,outlog,npaths,timings);
! 987: end;
! 988: end if;
! 989: end if;
! 990: end if;
! 991: end Solve_along_One_Chain;
! 992:
! 993: procedure Solve_along_Two_Chains
! 994: ( file : in file_type; nd : in Node;
! 995: n,l_top,k_top,l_bot,k_bot,ind : in natural;
! 996: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
! 997: top_pivots,top_columns,bot_pivots,bot_columns : in Bracket;
! 998: top_bs,bot_bs : in Bracket_System;
! 999: top_special,top_start,top_target,bot_special,bot_start,
! 1000: bot_target : in Standard_Complex_Matrices.Matrix;
! 1001: planes : in VecMat; report,outlog : in boolean;
! 1002: npaths : in out Standard_Natural_Vectors.Vector;
! 1003: timings : in out Duration_Array );
! 1004:
! 1005: -- DESCRIPTION :
! 1006: -- Applies the general solver along the nodes in all chains that end at
! 1007: -- the current node. This is the analogue to the hypersurface solver
! 1008: -- where the type of the node may be anything.
! 1009:
! 1010: -- ON ENTRY :
! 1011: -- file to write intermediate results on;
! 1012: -- nd current node in the localization poset;
! 1013: -- n working dimension, equation m+p;
! 1014: -- l_top runs from 0 to k_top-1;
! 1015: -- k_top co-dimension condition satisfied incrementing top pivots;
! 1016: -- l_bot runs from 0 to k_bot-1;
! 1017: -- k_bot co-dimension condition satisfied decrementing bottom pivots;
! 1018: -- poset structure with all solution p-planes;
! 1019: -- ind ind-1 planes are already folded in;
! 1020: -- top_pivots pivot elements used for the special top m-plane;
! 1021: -- top_columns which columns of the special top m-plane are used;
! 1022: -- bot_pivots pivot elements used for the special bottom m-plane;
! 1023: -- bot_columns which columns of the special bottom m-plane are used;
! 1024: -- top_bs Laplace expansion of the polynomial equations;
! 1025: -- bot_bs Laplace expansion of the polynomial equations;
! 1026: -- top_special special m-plane for top pivots;
! 1027: -- top_start (m+1-k)-plane used at the start of the deformation;
! 1028: -- top_target (m+1-k)-plane used as target satisfied with top pivots;
! 1029: -- bot_special special m-plane for top pivots;
! 1030: -- bot_start (m+1-k)-plane used at the start of the deformation;
! 1031: -- bot_target (m+1-k)-plane used as target satisfied with bottom pivots;
! 1032: -- planes sequence of (m+1-k)-planes;
! 1033: -- report indicates whether intermediate output during continuation;
! 1034: -- outlog flag to write homotopies on file if set to true.
! 1035:
! 1036: -- ON RETURN :
! 1037: -- poset updated structure of solution p-planes;
! 1038: -- npaths updated number of paths traced at each level;
! 1039: -- timings updated CPU user timings at each level.
! 1040:
! 1041: procedure Solve_along_Two_Chains_Deforming_Top_and_Bottom
! 1042: ( file : in file_type; nd : in Node;
! 1043: n,l_top,k_top,l_bot,k_bot,ind : in natural;
! 1044: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
! 1045: top_pivots,top_columns,bot_pivots,bot_columns : in Bracket;
! 1046: top_bs,bot_bs : in Bracket_System;
! 1047: top_special,top_start,top_target,bot_special,bot_start,
! 1048: bot_target : in Standard_Complex_Matrices.Matrix;
! 1049: planes : in VecMat; report,outlog : in boolean;
! 1050: npaths : in out Standard_Natural_Vectors.Vector;
! 1051: timings : in out Duration_Array ) is
! 1052:
! 1053: -- DESCRIPTION :
! 1054: -- Assumes that k_top > l_top and k_bot > l_bot so that the deformations
! 1055: -- involve both incrementing top and decrementing bottom pivots.
! 1056:
! 1057: m : constant natural := n - nd.p;
! 1058: top_piv,top_col : Bracket(1..top_pivots'last-1);
! 1059: bot_piv,bot_col : Bracket(1..bot_pivots'last-1);
! 1060: new_top_start : Standard_Complex_Matrices.Matrix(1..n,top_start'range(2));
! 1061: new_bot_start : Standard_Complex_Matrices.Matrix(1..n,bot_start'range(2));
! 1062:
! 1063: begin
! 1064: for i in nd.children'range(1) loop
! 1065: for j in nd.children'range(2) loop
! 1066: if ((nd.children(i,j) /= null)
! 1067: and then (nd.children(i,j).roco > 0))
! 1068: then if nd.children(i,j).tp = top or nd.children(i,j).tp = mixed
! 1069: then top_piv := Remove(top_pivots,nd.children(i,j).top);
! 1070: top_col := Remove(top_columns,top_pivots,top_piv);
! 1071: new_top_start
! 1072: := Special_Plane(n,m,k_top,top_col,top_special);
! 1073: end if;
! 1074: if nd.children(i,j).tp = bottom or nd.children(i,j).tp = mixed
! 1075: then bot_piv := Remove(bot_pivots,nd.children(i,j).bottom);
! 1076: bot_col := Remove(bot_columns,bot_pivots,bot_piv);
! 1077: new_bot_start
! 1078: := Special_Plane(n,m,k_bot,bot_col,bot_special);
! 1079: end if;
! 1080: Solve_along_Two_Chains
! 1081: (file,nd.children(i,j).all,
! 1082: n,l_top+1,k_top,l_bot+1,k_bot,ind,cod,poset,
! 1083: top_piv,top_col,bot_piv,bot_col,top_bs,bot_bs,
! 1084: top_special,new_top_start,top_start,
! 1085: bot_special,new_bot_start,bot_start,
! 1086: planes,report,outlog,npaths,timings);
! 1087: end if;
! 1088: end loop;
! 1089: end loop;
! 1090: Two_General_Deform
! 1091: (file,n,ind,poset,nd,top_start,top_target,bot_start,
! 1092: bot_target,planes,top_bs,bot_bs,report,outlog,npaths,timings);
! 1093: end Solve_along_Two_Chains_Deforming_Top_and_Bottom;
! 1094:
! 1095: procedure Switch_Top_and_Solve_along_Two_Chains
! 1096: ( file : in file_type; nd : in Node;
! 1097: n,l_bot,k_bot,ind : in natural; cod : in Bracket;
! 1098: poset : in out Array_of_Array_of_VecMats;
! 1099: bot_pivots,bot_columns : in Bracket;
! 1100: bot_bs : in Bracket_System;
! 1101: bot_special,bot_start,bot_target
! 1102: : in Standard_Complex_Matrices.Matrix;
! 1103: planes : in VecMat; report,outlog : in boolean;
! 1104: npaths : in out Standard_Natural_Vectors.Vector;
! 1105: timings : in out Duration_Array ) is
! 1106:
! 1107: -- DESCRIPTION :
! 1108: -- Assumes that l_top = k_top, l_bot < k_bot, and ind > cod'first so
! 1109: -- that first a new top chain can be started, which is then solved
! 1110: -- along with the existing chain for decrementing bottom pivots.
! 1111:
! 1112: m : constant natural := n - nd.p;
! 1113: new_k_top : constant natural := cod(ind);
! 1114: kd : constant natural := n+1-new_k_top;
! 1115: new_top_pivots : Bracket(1..m) := Complement(n,nd.top);
! 1116: new_top_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
! 1117: := Special_Top_Plane(m,nd.top);
! 1118: new_top_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top)
! 1119: := planes(ind).all;
! 1120: new_top_columns : Bracket(1..m);
! 1121: new_top_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top);
! 1122: new_top_bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 1123: new_top_bs : Bracket_System(0..Number_of_Brackets(new_top_bm))
! 1124: := Minor_Equations(kd,kd-nd.p,new_top_bm);
! 1125:
! 1126: begin
! 1127: for i in new_top_columns'range loop
! 1128: new_top_columns(i) := i;
! 1129: end loop;
! 1130: new_top_start
! 1131: := Special_Plane(n,m,new_k_top,new_top_columns,new_top_special);
! 1132: Solve_along_Two_Chains_Deforming_Top_and_Bottom
! 1133: (file,nd,n,0,new_k_top,l_bot,k_bot,ind,cod,poset,
! 1134: new_top_pivots,new_top_columns,bot_pivots,bot_columns,
! 1135: new_top_bs,bot_bs,new_top_special,new_top_start,new_top_target,
! 1136: bot_special,bot_start,bot_target,planes,
! 1137: report,outlog,npaths,timings);
! 1138: Clear(new_top_bm); Clear(new_top_bs);
! 1139: end Switch_Top_and_Solve_along_Two_Chains;
! 1140:
! 1141: procedure Switch_Top_and_Solve_along_One_Chain
! 1142: ( file : in file_type; nd : in Node; n,ind : in natural;
! 1143: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
! 1144: planes : in VecMat; report,outlog : in boolean;
! 1145: npaths : in out Standard_Natural_Vectors.Vector;
! 1146: timings : in out Duration_Array ) is
! 1147:
! 1148: -- DESCRIPTION :
! 1149: -- Assumes that l_top = k_top, l_bot = k_bot, with nd.tp = top
! 1150: -- and ind > cod'first so that a new top chain can be started.
! 1151:
! 1152: m : constant natural := n - nd.p;
! 1153: new_k_top : constant natural := cod(ind);
! 1154: kd : constant natural := n+1-new_k_top;
! 1155: new_top_pivots : Bracket(1..m) := Complement(n,nd.top);
! 1156: new_top_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
! 1157: := Special_Top_Plane(m,nd.top);
! 1158: new_top_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top)
! 1159: := planes(ind).all;
! 1160: new_top_columns : Bracket(1..m);
! 1161: new_top_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top);
! 1162: new_top_bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 1163: new_top_bs : Bracket_System(0..Number_of_Brackets(new_top_bm))
! 1164: := Minor_Equations(kd,kd-nd.p,new_top_bm);
! 1165:
! 1166: begin
! 1167: for i in new_top_columns'range loop
! 1168: new_top_columns(i) := i;
! 1169: end loop;
! 1170: new_top_start
! 1171: := Special_Plane(n,m,new_k_top,new_top_columns,new_top_special);
! 1172: Solve_along_One_Chain
! 1173: (file,nd,n,0,new_k_top,ind,cod(cod'first..ind),poset,
! 1174: new_top_pivots,new_top_columns,new_top_bs,
! 1175: new_top_special,new_top_start,new_top_target,
! 1176: planes,report,outlog,npaths,timings);
! 1177: Clear(new_top_bm); Clear(new_top_bs);
! 1178: end Switch_Top_and_Solve_along_One_Chain;
! 1179:
! 1180: procedure Switch_Bottom_and_Solve_along_Two_Chains
! 1181: ( file : in file_type; nd : in Node;
! 1182: n,l_top,k_top,ind : in natural; cod : in Bracket;
! 1183: poset : in out Array_of_Array_of_VecMats;
! 1184: top_pivots,top_columns : in Bracket;
! 1185: top_bs : in Bracket_System;
! 1186: top_special,top_start,top_target
! 1187: : in Standard_Complex_Matrices.Matrix;
! 1188: planes : in VecMat; report,outlog : in boolean;
! 1189: npaths : in out Standard_Natural_Vectors.Vector;
! 1190: timings : in out Duration_Array ) is
! 1191:
! 1192: -- DESCRIPTION :
! 1193: -- Assumes that l_top < k_top, l_bot = k_bot, and ind > cod'first so
! 1194: -- that first a new bottom chain can be launched, which is then solved
! 1195: -- along with the existing chain for incrementing top pivots.
! 1196:
! 1197: m : constant natural := n - nd.p;
! 1198: new_k_bot : constant natural := cod(ind);
! 1199: kd : constant natural := n+1-new_k_bot;
! 1200: new_bot_pivots : Bracket(1..m) := Complement(n,nd.bottom);
! 1201: new_bot_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
! 1202: := Special_Bottom_Plane(m,nd.bottom);
! 1203: new_bot_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot)
! 1204: := planes(ind).all;
! 1205: new_bot_columns : Bracket(1..m);
! 1206: new_bot_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot);
! 1207: new_bot_bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 1208: new_bot_bs : Bracket_System(0..Number_of_Brackets(new_bot_bm))
! 1209: := Minor_Equations(kd,kd-nd.p,new_bot_bm);
! 1210:
! 1211: begin
! 1212: for i in new_bot_columns'range loop
! 1213: new_bot_columns(i) := i;
! 1214: end loop;
! 1215: new_bot_start
! 1216: := Special_Plane(n,m,new_k_bot,new_bot_columns,new_bot_special);
! 1217: Solve_along_Two_Chains_Deforming_Top_and_Bottom
! 1218: (file,nd,n,l_top,k_top,0,new_k_bot,ind,cod,poset,
! 1219: top_pivots,top_columns,new_bot_pivots,new_bot_columns,
! 1220: top_bs,new_bot_bs,top_special,top_start,top_target,
! 1221: new_bot_special,new_bot_start,new_bot_target,
! 1222: planes,report,outlog,npaths,timings);
! 1223: Clear(new_bot_bm); Clear(new_bot_bs);
! 1224: end Switch_Bottom_and_Solve_along_Two_Chains;
! 1225:
! 1226: procedure Switch_Bottom_and_Solve_along_One_Chain
! 1227: ( file : in file_type; nd : in Node; n,ind : in natural;
! 1228: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
! 1229: planes : in VecMat; report,outlog : in boolean;
! 1230: npaths : in out Standard_Natural_Vectors.Vector;
! 1231: timings : in out Duration_Array ) is
! 1232:
! 1233: -- DESCRIPTION :
! 1234: -- Assumes that l_top < k_top, l_bot = k_bot, and ind > cod'first so
! 1235: -- that first a new bottom chain can be launched, which is then solved
! 1236: -- along with the existing chain for incrementing top pivots.
! 1237:
! 1238: m : constant natural := n - nd.p;
! 1239: new_k_bot : constant natural := cod(ind);
! 1240: kd : constant natural := n+1-new_k_bot;
! 1241: new_bot_pivots : Bracket(1..m) := Complement(n,nd.bottom);
! 1242: new_bot_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
! 1243: := Special_Bottom_Plane(m,nd.bottom);
! 1244: new_bot_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot)
! 1245: := planes(ind).all;
! 1246: new_bot_columns : Bracket(1..m);
! 1247: new_bot_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot);
! 1248: new_bot_bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 1249: new_bot_bs : Bracket_System(0..Number_of_Brackets(new_bot_bm))
! 1250: := Minor_Equations(kd,kd-nd.p,new_bot_bm);
! 1251:
! 1252: begin
! 1253: for i in new_bot_columns'range loop
! 1254: new_bot_columns(i) := i;
! 1255: end loop;
! 1256: new_bot_start
! 1257: := Special_Plane(n,m,new_k_bot,new_bot_columns,new_bot_special);
! 1258: Solve_along_One_Chain
! 1259: (file,nd,n,0,new_k_bot,ind,cod(cod'first..ind),poset,
! 1260: new_bot_pivots,new_bot_columns,new_bot_bs,
! 1261: new_bot_special,new_bot_start,new_bot_target,
! 1262: planes,report,outlog,npaths,timings);
! 1263: Clear(new_bot_bm); Clear(new_bot_bs);
! 1264: end Switch_Bottom_and_Solve_along_One_Chain;
! 1265:
! 1266: procedure Switch_Top_Bottom_and_Solve_along_Two_Chains
! 1267: ( file : in file_type; nd : in Node; n,ind : in natural;
! 1268: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
! 1269: planes : in VecMat; report,outlog : in boolean;
! 1270: npaths : in out Standard_Natural_Vectors.Vector;
! 1271: timings : in out Duration_Array ) is
! 1272:
! 1273: -- DESCRIPTION :
! 1274: -- Assumes that l_top = k_top, l_bot = k_bot, and ind > cod'first+1
! 1275: -- so that first new top and bottom chains can be started which are
! 1276: -- then solved along.
! 1277:
! 1278: m : constant natural := n - nd.p;
! 1279: new_k_top : constant natural := cod(ind);
! 1280: new_k_bot : constant natural := cod(ind+1);
! 1281: kd_top : constant natural := n+1-new_k_top;
! 1282: kd_bot : constant natural := n+1-new_k_bot;
! 1283: new_top_pivots : Bracket(1..m) := Complement(n,nd.top);
! 1284: new_bot_pivots : Bracket(1..m) := Complement(n,nd.bottom);
! 1285: new_top_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
! 1286: := Special_Top_Plane(m,nd.top);
! 1287: new_bot_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
! 1288: := Special_Bottom_Plane(m,nd.bottom);
! 1289: new_top_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top)
! 1290: := planes(ind).all;
! 1291: new_bot_target : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot)
! 1292: := planes(ind+1).all;
! 1293: new_top_columns,new_bot_columns : Bracket(1..m);
! 1294: new_top_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_top);
! 1295: new_bot_start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-new_k_bot);
! 1296: new_top_bm : Bracket_Monomial := Maximal_Minors(n,kd_top);
! 1297: new_bot_bm : Bracket_Monomial := Maximal_Minors(n,kd_bot);
! 1298: new_top_bs : Bracket_System(0..Number_of_Brackets(new_top_bm))
! 1299: := Minor_Equations(kd_top,kd_top-nd.p,new_top_bm);
! 1300: new_bot_bs : Bracket_System(0..Number_of_Brackets(new_bot_bm))
! 1301: := Minor_Equations(kd_bot,kd_bot-nd.p,new_bot_bm);
! 1302:
! 1303: begin
! 1304: for i in new_bot_columns'range loop
! 1305: new_top_columns(i) := i;
! 1306: new_bot_columns(i) := i;
! 1307: end loop;
! 1308: new_top_start
! 1309: := Special_Plane(n,m,new_k_top,new_top_columns,new_top_special);
! 1310: new_bot_start
! 1311: := Special_Plane(n,m,new_k_bot,new_bot_columns,new_bot_special);
! 1312: Solve_along_Two_Chains_Deforming_Top_and_Bottom
! 1313: (file,nd,n,0,new_k_top,0,new_k_bot,ind,cod,poset,
! 1314: new_top_pivots,new_top_columns,new_bot_pivots,new_bot_columns,
! 1315: new_top_bs,new_bot_bs,new_top_special,new_top_start,new_top_target,
! 1316: new_bot_special,new_bot_start,new_bot_target,
! 1317: planes,report,outlog,npaths,timings);
! 1318: Clear(new_top_bm); Clear(new_top_bs);
! 1319: Clear(new_bot_bm); Clear(new_bot_bs);
! 1320: end Switch_Top_Bottom_and_Solve_along_Two_Chains;
! 1321:
! 1322: procedure Solve_along_Two_Chains
! 1323: ( file : in file_type; nd : in Node;
! 1324: n,l_top,k_top,l_bot,k_bot,ind : in natural;
! 1325: cod : in Bracket; poset : in out Array_of_Array_of_VecMats;
! 1326: top_pivots,top_columns,bot_pivots,bot_columns : in Bracket;
! 1327: top_bs,bot_bs : in Bracket_System;
! 1328: top_special,top_start,top_target,bot_special,bot_start,
! 1329: bot_target : in Standard_Complex_Matrices.Matrix;
! 1330: planes : in VecMat; report,outlog : in boolean;
! 1331: npaths : in out Standard_Natural_Vectors.Vector;
! 1332: timings : in out Duration_Array ) is
! 1333:
! 1334: -- DESCRIPTION :
! 1335: -- Does the dispatching according to the case analysis.
! 1336:
! 1337: -- IMPORTANT :
! 1338: -- The control structure in the case analysis matches the structure
! 1339: -- in Localization_Posets.Recursive_Top_Bottom_Create.
! 1340:
! 1341: begin
! 1342: if empty(poset,nd.level,nd.label)
! 1343: then
! 1344: if nd.level = 0
! 1345: then poset(nd.level)(nd.label)(1)
! 1346: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
! 1347: elsif nd.roco > 0
! 1348: then
! 1349: if ((l_top < k_top) and (l_bot < k_bot))
! 1350: then Solve_along_Two_Chains_Deforming_Top_and_Bottom
! 1351: (file,nd,n,l_top,k_top,l_bot,k_bot,ind,cod,poset,
! 1352: top_pivots,top_columns,bot_pivots,bot_columns,
! 1353: top_bs,bot_bs,top_special,top_start,top_target,
! 1354: bot_special,bot_start,bot_target,planes,
! 1355: report,outlog,npaths,timings);
! 1356: elsif ((l_top = k_top) and (l_bot < k_bot))
! 1357: then
! 1358: if ind = cod'first
! 1359: then Solve_along_One_Chain
! 1360: (file,nd,n,l_bot,k_bot,ind,cod,poset,
! 1361: bot_pivots,bot_columns,bot_bs,bot_special,
! 1362: bot_start,bot_target,planes,report,outlog,
! 1363: npaths,timings);
! 1364: else Switch_Top_and_Solve_along_Two_Chains
! 1365: (file,nd,n,l_bot,k_bot,ind-1,cod,poset,
! 1366: bot_pivots,bot_columns,bot_bs,bot_special,
! 1367: bot_start,bot_target,planes,report,outlog,
! 1368: npaths,timings);
! 1369: end if;
! 1370: elsif ((l_top < k_top) and (l_bot = k_bot))
! 1371: then
! 1372: if ind = cod'first
! 1373: then Solve_along_One_Chain
! 1374: (file,nd,n,l_top,k_top,ind,cod,poset,
! 1375: top_pivots,top_columns,top_bs,top_special,
! 1376: top_start,top_target,planes,report,outlog,
! 1377: npaths,timings);
! 1378: else Switch_Bottom_and_Solve_along_Two_Chains
! 1379: (file,nd,n,l_top,k_top,ind-1,cod,poset,
! 1380: top_pivots,top_columns,top_bs,top_special,
! 1381: top_start,top_target,planes,report,outlog,
! 1382: npaths,timings);
! 1383: end if;
! 1384: else -- ((l_top = k_top) and (l_bot = k_bot))
! 1385: if ind > cod'first+1
! 1386: then Switch_Top_Bottom_and_Solve_along_Two_Chains
! 1387: (file,nd,n,ind-2,cod,poset,planes,
! 1388: report,outlog,npaths,timings);
! 1389: elsif ind > cod'first
! 1390: then
! 1391: if nd.tp = bottom
! 1392: then
! 1393: Switch_Bottom_and_Solve_along_One_Chain
! 1394: (file,nd,n,ind-1,cod,poset,planes,
! 1395: report,outlog,npaths,timings);
! 1396: else
! 1397: Switch_Top_and_Solve_along_One_Chain
! 1398: (file,nd,n,ind-1,cod,poset,planes,
! 1399: report,outlog,npaths,timings);
! 1400: end if;
! 1401: end if;
! 1402: end if;
! 1403: end if;
! 1404: end if;
! 1405: end Solve_along_Two_Chains;
! 1406:
! 1407: procedure One_Solve
! 1408: ( file : in file_type; n : in natural; cod : in Bracket;
! 1409: poset : in out Array_of_Array_of_VecMats;
! 1410: nd : in Node; planes : in VecMat;
! 1411: report,outlog : in boolean;
! 1412: npaths : in out Standard_Natural_Vectors.Vector;
! 1413: timings : in out Duration_Array ) is
! 1414:
! 1415: -- NOTE :
! 1416: -- We assume that we are always folding in the last condition, with
! 1417: -- codimension cod(cod'last). In passing recursively to higher levels
! 1418: -- in the deformation poset, we take a slice of k, omitting the last one.
! 1419: -- Applies the solver first to all grandchildren of the current node,
! 1420: -- which is the additional layer compared to the hypersurface case.
! 1421: -- This implementation will only work in the non-mixed case.
! 1422:
! 1423: m : constant natural := n - nd.p;
! 1424: kk : constant natural := cod(cod'last);
! 1425: kd : constant natural := n+1-kk;
! 1426:
! 1427: procedure Solve_Grand_Child
! 1428: ( lnd : in Link_to_Node; continue : out boolean ) is
! 1429:
! 1430: -- DESCRIPTION :
! 1431: -- This node lnd is a grandchild of the current node.
! 1432:
! 1433: begin
! 1434: if Empty(poset,lnd.level,lnd.label)
! 1435: then if lnd.level = 0
! 1436: then poset(lnd.level)(lnd.label)(1)
! 1437: := new Standard_Complex_Matrices.Matrix'
! 1438: (Leaf_Plane(n,lnd.all));
! 1439: elsif lnd.roco > 0
! 1440: then One_Solve(file,n,cod(cod'first..cod'last-1),poset,
! 1441: lnd.all,planes,report,outlog,npaths,timings);
! 1442: end if;
! 1443: end if;
! 1444: continue := true;
! 1445: end Solve_Grand_Child;
! 1446:
! 1447: procedure Solve_Grand_Children is
! 1448: new Enumerate_Grand_Children(Solve_Grand_Child);
! 1449:
! 1450: begin
! 1451: if (Empty(poset,nd.level,nd.label) and (nd.roco > 0))
! 1452: then
! 1453: if cod'last >= cod'first
! 1454: then Solve_Grand_Children(nd,kk);
! 1455: end if;
! 1456: declare
! 1457: pivots,columns : Bracket(1..m);
! 1458: special : Standard_Complex_Matrices.Matrix(1..n,1..m);
! 1459: target : constant Standard_Complex_Matrices.Matrix
! 1460: := planes(cod'last).all;
! 1461: start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
! 1462: bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 1463: bs : Bracket_System(0..Number_of_Brackets(bm))
! 1464: := Minor_Equations(kd,kd-nd.p,bm);
! 1465: begin
! 1466: for i in columns'range loop
! 1467: columns(i) := i;
! 1468: end loop;
! 1469: if nd.tp = top
! 1470: then pivots := Complement(n,nd.top);
! 1471: special := Special_Top_Plane(m,nd.top);
! 1472: else pivots := Complement(n,nd.bottom);
! 1473: special := Special_Bottom_Plane(m,nd.bottom);
! 1474: end if;
! 1475: start := Special_Plane(n,m,kk,columns,special);
! 1476: One_Solve_along_Chains
! 1477: (file,nd,n,0,kk,cod'last,poset,pivots,columns,bs,
! 1478: special,start,target,planes,report,outlog,npaths,timings);
! 1479: Clear(bm); Clear(bs);
! 1480: end;
! 1481: end if;
! 1482: end One_Solve;
! 1483:
! 1484: procedure Chain_Solve
! 1485: ( file : in file_type; n : in natural; cod : in Bracket;
! 1486: poset : in out Array_of_Array_of_VecMats; nd : in Node;
! 1487: planes : in VecMat; report,outlog : in boolean;
! 1488: npaths : in out Standard_Natural_Vectors.Vector;
! 1489: timings : in out Duration_Array ) is
! 1490:
! 1491: -- NOTE :
! 1492: -- The convention is that the last co-dimension condition is treated
! 1493: -- when the type of the node is not mixed, otherwise the last two entries
! 1494: -- of the vector of co-dimension conditions are sliced off when moving
! 1495: -- to the upper levels.
! 1496: -- This is another organization of One_Solve and only works when the
! 1497: -- type of the nodes are not mixed.
! 1498:
! 1499: begin
! 1500: if Empty(poset,nd.level,nd.label)
! 1501: then
! 1502: if nd.level = 0
! 1503: then poset(nd.level)(nd.label)(1)
! 1504: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
! 1505: elsif nd.roco > 0
! 1506: then declare
! 1507: m : constant natural := n - nd.p;
! 1508: pivots,columns : Bracket(1..m);
! 1509: special : Standard_Complex_Matrices.Matrix(1..n,1..m);
! 1510: kk : constant natural := cod(cod'last);
! 1511: kd : constant natural := n+1-kk;
! 1512: start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
! 1513: target : constant Standard_Complex_Matrices.Matrix
! 1514: := planes(planes'last).all;
! 1515: bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 1516: bs : Bracket_System(0..Number_of_Brackets(bm))
! 1517: := Minor_Equations(kd,kd-nd.p,bm);
! 1518: begin
! 1519: for i in columns'range loop
! 1520: columns(i) := i;
! 1521: end loop;
! 1522: if nd.tp = top
! 1523: then pivots := Complement(n,nd.top);
! 1524: special := Special_Top_Plane(m,nd.top);
! 1525: else pivots := Complement(n,nd.bottom);
! 1526: special := Special_Bottom_Plane(m,nd.bottom);
! 1527: end if;
! 1528: start := Special_Plane(n,m,kk,columns,special);
! 1529: Solve_along_One_Chain
! 1530: (file,nd,n,0,cod(cod'last),cod'last,cod,poset,
! 1531: pivots,columns,bs,special,start,target,planes,
! 1532: report,outlog,npaths,timings);
! 1533: Clear(bm); Clear(bs);
! 1534: end;
! 1535: end if;
! 1536: end if;
! 1537: end Chain_Solve;
! 1538:
! 1539: procedure Solve ( file : in file_type; n : in natural; cod : in Bracket;
! 1540: poset : in out Array_of_Array_of_VecMats; nd : in Node;
! 1541: planes : in VecMat; report,outlog : in boolean;
! 1542: npaths : in out Standard_Natural_Vectors.Vector;
! 1543: timings : in out Duration_Array ) is
! 1544:
! 1545: -- REQUIREMENT ONE :
! 1546: -- The convention is that the last co-dimension condition is treated
! 1547: -- when the type of the node is not mixed, otherwise the last two entries
! 1548: -- of the vector of co-dimension conditions are sliced off when moving
! 1549: -- to the upper levels.
! 1550: -- REQUIREMENT TWO :
! 1551: -- The nodes that are not mixed appear at the top of the poset.
! 1552:
! 1553: begin
! 1554: if Empty(poset,nd.level,nd.label)
! 1555: then
! 1556: if nd.level = 0
! 1557: then poset(nd.level)(nd.label)(1)
! 1558: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n,nd));
! 1559: elsif nd.roco > 0
! 1560: then
! 1561: if nd.tp /= mixed
! 1562: then
! 1563: declare
! 1564: m : constant natural := n - nd.p;
! 1565: pivots,columns : Bracket(1..m);
! 1566: special : Standard_Complex_Matrices.Matrix(1..n,1..m);
! 1567: kk : constant natural := cod(cod'last);
! 1568: kd : constant natural := n+1-kk;
! 1569: start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
! 1570: target : constant Standard_Complex_Matrices.Matrix
! 1571: := planes(planes'last).all;
! 1572: bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 1573: bs : Bracket_System(0..Number_of_Brackets(bm))
! 1574: := Minor_Equations(kd,kd-nd.p,bm);
! 1575: begin
! 1576: for i in columns'range loop
! 1577: columns(i) := i;
! 1578: end loop;
! 1579: if nd.tp = top
! 1580: then pivots := Complement(n,nd.top);
! 1581: special := Special_Top_Plane(m,nd.top);
! 1582: else pivots := Complement(n,nd.bottom);
! 1583: special := Special_Bottom_Plane(m,nd.bottom);
! 1584: end if;
! 1585: start := Special_Plane(n,m,kk,columns,special);
! 1586: Solve_along_One_Chain
! 1587: (file,nd,n,0,cod(cod'last),cod'last,cod,poset,
! 1588: pivots,columns,bs,special,start,target,planes,
! 1589: report,outlog,npaths,timings);
! 1590: Clear(bm); Clear(bs);
! 1591: end;
! 1592: else
! 1593: declare
! 1594: m : constant natural := n - nd.p;
! 1595: top_col,bot_col : Bracket(1..m);
! 1596: kk_top : constant natural := cod(cod'last-1);
! 1597: kk_bot : constant natural := cod(cod'last);
! 1598: kd_top : constant natural := n+1-kk_top;
! 1599: kd_bot : constant natural := n+1-kk_bot;
! 1600: top_bm : Bracket_Monomial := Maximal_Minors(n,kd_top);
! 1601: bot_bm : Bracket_Monomial := Maximal_Minors(n,kd_bot);
! 1602: top_bs : Bracket_System(0..Number_of_Brackets(top_bm))
! 1603: := Minor_Equations(kd_top,kd_top-nd.p,top_bm);
! 1604: bot_bs : Bracket_System(0..Number_of_Brackets(bot_bm))
! 1605: := Minor_Equations(kd_bot,kd_bot-nd.p,bot_bm);
! 1606: top_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
! 1607: := Special_Top_Plane(m,nd.top);
! 1608: bot_special : Standard_Complex_Matrices.Matrix(1..n,1..m)
! 1609: := Special_Bottom_Plane(m,nd.bottom);
! 1610: top_piv : Bracket(1..m) := Complement(n,nd.top);
! 1611: bot_piv : Bracket(1..m) := Complement(n,nd.bottom);
! 1612: top_start,top_target
! 1613: : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk_top);
! 1614: bot_start,bot_target
! 1615: : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk_bot);
! 1616: begin
! 1617: for i in top_col'range loop
! 1618: top_col(i) := i;
! 1619: end loop;
! 1620: top_start := Special_Plane(n,m,kk_top,top_col,top_special);
! 1621: top_target := planes(planes'last-1).all;
! 1622: for i in bot_col'range loop
! 1623: bot_col(i) := i;
! 1624: end loop;
! 1625: bot_start := Special_Plane(n,m,kk_bot,bot_col,bot_special);
! 1626: bot_target := planes(planes'last).all;
! 1627: Solve_along_Two_Chains
! 1628: (file,nd,n,0,kk_top,0,kk_bot,cod'last-1,cod,poset,
! 1629: top_piv,top_col,bot_piv,bot_col,top_bs,bot_bs,
! 1630: top_special,top_start,top_target,bot_special,bot_start,
! 1631: bot_target,planes,report,outlog,npaths,timings);
! 1632: Clear(top_bm); Clear(top_bs); Clear(bot_bm); Clear(bot_bs);
! 1633: end;
! 1634: end if;
! 1635: end if;
! 1636: end if;
! 1637: end Solve;
! 1638:
! 1639: procedure Recursive_Quantum_Solve
! 1640: ( file : in file_type; n,q : in natural;
! 1641: nd : in Node; expbp : in Bracket_Polynomial;
! 1642: poset : in out Array_of_Array_of_VecMats;
! 1643: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
! 1644: report,outlog : in boolean;
! 1645: npaths : in out Standard_Natural_Vectors.Vector;
! 1646: timings : in out Duration_Array ) is
! 1647:
! 1648: -- DESCRIPTION :
! 1649: -- This additional layer is added to avoid the repeated construction
! 1650: -- of the structure of the equations, that is now in expbp.
! 1651: -- This is the q-analogue to the Recursive Hypersurface Solver.
! 1652:
! 1653: begin
! 1654: if Empty(poset,nd.level,nd.label)
! 1655: then
! 1656: if nd.level = 0
! 1657: then
! 1658: poset(nd.level)(nd.label)(1)
! 1659: := new Standard_Complex_Matrices.Matrix'(Leaf_Plane(n*(q+1),nd));
! 1660: else
! 1661: for i in nd.children'range(1) loop
! 1662: for j in nd.children'range(2) loop
! 1663: if nd.children(i,j) /= null
! 1664: then Recursive_Quantum_Solve
! 1665: (file,n,q,nd.children(i,j).all,expbp,poset,
! 1666: planes,s,report,outlog,npaths,timings);
! 1667: end if;
! 1668: end loop;
! 1669: end loop;
! 1670: Quantum_Deform(file,n,q,poset,nd,expbp,planes,s,report,outlog,
! 1671: npaths,timings);
! 1672: end if;
! 1673: end if;
! 1674: end Recursive_Quantum_Solve;
! 1675:
! 1676: procedure Solve ( file : in file_type; n,q : in natural;
! 1677: poset : in out Array_of_Array_of_VecMats; nd : in Node;
! 1678: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
! 1679: report,outlog : in boolean;
! 1680: npaths : in out Standard_Natural_Vectors.Vector;
! 1681: timings : in out Duration_Array ) is
! 1682:
! 1683: bm : Bracket_Monomial := Maximal_Minors(n,n);
! 1684: bs : Bracket_System(0..Number_of_Brackets(bm))
! 1685: := Minor_Equations(n,n-nd.p,bm);
! 1686:
! 1687: begin
! 1688: Recursive_Quantum_Solve(file,n,q,nd,bs(1),poset,planes,s,report,outlog,
! 1689: npaths,timings);
! 1690: Clear(bm); Clear(bs);
! 1691: end Solve;
! 1692:
! 1693: procedure One_Solve
! 1694: ( file : in file_type; n,q : in natural; cod : in Bracket;
! 1695: poset : in out Array_of_Array_of_VecMats; nd : in Node;
! 1696: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
! 1697: report,outlog : in boolean;
! 1698: npaths : in out Standard_Natural_Vectors.Vector;
! 1699: timings : in out Duration_Array ) is
! 1700:
! 1701: m : constant natural := n - nd.p;
! 1702: kk : constant natural := cod(cod'last);
! 1703: kd : constant natural := n+1-kk;
! 1704:
! 1705: procedure Solve_Grand_Child
! 1706: ( lnd : in Link_to_Node; continue : out boolean ) is
! 1707:
! 1708: -- DESCRIPTION :
! 1709: -- This node lnd is a grandchild of the current node.
! 1710:
! 1711: begin
! 1712: if Empty(poset,lnd.level,lnd.label)
! 1713: then if lnd.level = 0
! 1714: then poset(lnd.level)(lnd.label)(1)
! 1715: := new Standard_Complex_Matrices.Matrix'
! 1716: (Leaf_Plane(n*(q+1),lnd.all));
! 1717: elsif lnd.roco > 0
! 1718: then One_Solve(file,n,q,cod(cod'first..cod'last-1),poset,
! 1719: lnd.all,planes,s,report,outlog,npaths,timings);
! 1720: end if;
! 1721: end if;
! 1722: continue := true;
! 1723: end Solve_Grand_Child;
! 1724:
! 1725: procedure Solve_Grand_Children is
! 1726: new Enumerate_Grand_Children(Solve_Grand_Child);
! 1727:
! 1728: begin
! 1729: if (Empty(poset,nd.level,nd.label) and (nd.roco > 0))
! 1730: then
! 1731: if cod'last >= cod'first
! 1732: then Solve_Grand_Children(nd,kk);
! 1733: end if;
! 1734: declare
! 1735: pivots,columns : Bracket(1..m);
! 1736: mod_piv : Bracket(1..nd.p);
! 1737: special : Standard_Complex_Matrices.Matrix(1..n,1..m);
! 1738: target : constant Standard_Complex_Matrices.Matrix
! 1739: := planes(cod'last).all;
! 1740: start : Standard_Complex_Matrices.Matrix(1..n,1..m+1-kk);
! 1741: bm : Bracket_Monomial := Maximal_Minors(n,kd);
! 1742: bs : Bracket_System(0..Number_of_Brackets(bm))
! 1743: := Minor_Equations(kd,kd-nd.p,bm);
! 1744: begin
! 1745: for i in columns'range loop
! 1746: columns(i) := i;
! 1747: end loop;
! 1748: if nd.tp = top
! 1749: then mod_piv := Modulo(nd.top,n);
! 1750: pivots := Complement(n,mod_piv);
! 1751: special := Special_Top_Plane(m,mod_piv);
! 1752: else mod_piv := Modulo(nd.bottom,n);
! 1753: pivots := Complement(n,mod_piv);
! 1754: special := Special_Bottom_Plane(m,mod_piv);
! 1755: end if;
! 1756: start := Special_Plane(n,m,kk,columns,special);
! 1757: One_Quantum_Solve_along_Chains
! 1758: (file,nd,n,q,0,kk,cod'last,poset,pivots,columns,bs,
! 1759: special,start,target,planes,s,report,outlog,npaths,timings);
! 1760: Clear(bm); Clear(bs);
! 1761: end;
! 1762: end if;
! 1763: end One_Solve;
! 1764:
! 1765: procedure Solve ( file : in file_type; n,q : in natural; cod : in Bracket;
! 1766: poset : in out Array_of_Array_of_VecMats; nd : in Node;
! 1767: planes : in VecMat; s : in Standard_Complex_Vectors.Vector;
! 1768: report,outlog : in boolean;
! 1769: npaths : in out Standard_Natural_Vectors.Vector;
! 1770: timings : in out Duration_Array ) is
! 1771:
! 1772: begin
! 1773: null;
! 1774: end Solve;
! 1775:
! 1776: -- DESTRUCTORS :
! 1777:
! 1778: procedure Clear ( avm : in out Array_of_VecMats ) is
! 1779: begin
! 1780: for i in avm'range loop
! 1781: Deep_Clear(avm(i));
! 1782: end loop;
! 1783: end Clear;
! 1784:
! 1785: procedure Clear ( avm : in out Link_to_Array_of_VecMats ) is
! 1786:
! 1787: procedure free is
! 1788: new unchecked_deallocation(Array_of_VecMats,Link_to_Array_of_VecMats);
! 1789:
! 1790: begin
! 1791: if avm /= null
! 1792: then Clear(avm.all);
! 1793: free(avm);
! 1794: end if;
! 1795: end Clear;
! 1796:
! 1797: procedure Clear ( avm : in out Array_of_Array_of_VecMats ) is
! 1798: begin
! 1799: for i in avm'range loop
! 1800: if avm(i) /= null
! 1801: then Clear(avm(i).all);
! 1802: end if;
! 1803: end loop;
! 1804: end Clear;
! 1805:
! 1806: end Deformation_Posets;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to deformation_posets.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Schubert