Return to driver_for_pieri_homotopies.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Schubert

Import the second public release of PHCpack.

OKed by Jan Verschelde.

with text_io,integer_io;                 use text_io,integer_io;
with Communications_with_User;           use Communications_with_User;
with Timing_Package;                     use Timing_Package;
with Standard_Floating_Numbers;          use Standard_Floating_Numbers;
with Standard_Natural_Vectors;
with Standard_Complex_Numbers;           use Standard_Complex_Numbers;
with Standard_Complex_Vectors;
with Standard_Complex_Vectors_io;        use Standard_Complex_Vectors_io;
with Standard_Natural_Matrices;
with Standard_Natural_Matrices_io;       use Standard_Natural_Matrices_io;
with Standard_Floating_Matrices;
with Standard_Complex_Matrices;
with Standard_Complex_Matrices_io;       use Standard_Complex_Matrices_io;
with Standard_Complex_Norms_Equals;      use Standard_Complex_Norms_Equals;
with Standard_Random_Numbers;            use Standard_Random_Numbers;
with Standard_Random_Vectors;            use Standard_Random_Vectors;
with Standard_Matrix_Inversion;          use Standard_Matrix_Inversion;
with Standard_Complex_VecMats;           use Standard_Complex_VecMats;
with Symbol_Table;                       use Symbol_Table;
with Matrix_Indeterminates;
with Standard_Complex_Polynomials;       use Standard_Complex_Polynomials;
with Standard_Complex_Poly_Matrices;
with Standard_Complex_Poly_Matrices_io;  use Standard_Complex_Poly_Matrices_io;
with Standard_Complex_Poly_Systems;      use Standard_Complex_Poly_Systems;
with Standard_Complex_Poly_SysFun;       use Standard_Complex_Poly_SysFun;
with Standard_Complex_Poly_Systems_io;   use Standard_Complex_Poly_Systems_io;
with Homotopy;
with Standard_Complex_Solutions;         use Standard_Complex_Solutions;
with Standard_Complex_Solutions_io;      use Standard_Complex_Solutions_io;
with Standard_Root_Refiners;             use Standard_Root_Refiners;
with Increment_and_Fix_Continuation;     use Increment_and_Fix_Continuation;
with Drivers_for_Poly_Continuation;      use Drivers_for_Poly_Continuation;
with Brackets,Brackets_io;               use Brackets,Brackets_io;
with Bracket_Monomials,Bracket_Systems;  use Bracket_Monomials,Bracket_Systems;
with Specialization_of_Planes;           use Specialization_of_Planes;
with Symbolic_Minor_Equations;           use Symbolic_Minor_Equations;
with Numeric_Minor_Equations;            use Numeric_Minor_Equations;
with Determinantal_Systems;              use Determinantal_Systems;
with Plane_Representations;              use Plane_Representations;
with Localization_Posets;                use Localization_Posets;
with Localization_Posets_io;             use Localization_Posets_io;
with Deformation_Posets;                 use Deformation_Posets;
with Drivers_for_Input_Planes;           use Drivers_for_Input_Planes;

procedure Driver_for_Pieri_Homotopies
                ( file : in file_type; n,d : in natural ) is

-- AUXILIARIES IN THE SOLVERS :

  procedure Add_t_Symbol is

  -- DESCRIPTION :
  --   Adds the symbol for the continuation parameter t to the symbol table.

    tsb : Symbol;

  begin
    Symbol_Table.Enlarge(1);
    tsb(1) := 't';
    for i in 2..tsb'last loop
      tsb(i) := ' ';
    end loop;
    Symbol_Table.Add(tsb);
  end Add_t_Symbol;

  procedure Set_Parameters ( file : in file_type; report : out boolean ) is

  -- DESCRIPTION :
  --   Interactive determination of the continuation and output parameters.

    oc : natural;

  begin
    new_line;
    Driver_for_Continuation_Parameters(file);
    new_line;
    Driver_for_Process_io(file,oc);
    report := not (oc = 0);
    new_line;
    put_line("No more input expected.  See output file for results...");
    new_line;
    new_line(file);
  end Set_Parameters;

  function First_Standard_Plane
             ( m,p : natural ) return Standard_Complex_Matrices.Matrix is

  -- DESCRIPTION :
  --   Returns the m-plane spanned by the first m standard basis vectors.

    res : Standard_Complex_Matrices.Matrix(1..m+p,1..m);

  begin
    for j in 1..m loop                 -- assign j-th column
      for i in 1..m+p loop
        res(i,j) := Create(0.0);       -- initialize with zeros
      end loop;
      res(j,j) := Create(1.0);         -- j-th column = j-th basis vector
    end loop;
    return res;
  end First_Standard_Plane;

  function Last_Standard_Plane
             ( m,p : natural ) return Standard_Complex_Matrices.Matrix is

  -- DESCRIPTION :
  --   Returns the m-plane spanned by the last m standard basis vectors.

    res : Standard_Complex_Matrices.Matrix(1..m+p,1..m);

  begin
    for j in 1..m loop                  -- assign j-th column
      for i in 1..m+p loop
        res(i,j) := Create(0.0);        -- initialize with zeros
      end loop;
      res(p+j,j) := Create(1.0);        -- j-th vector = (p+j)-th basis vector
    end loop;
    return res;
  end Last_Standard_Plane;

  procedure Basis_Change ( n : in natural; vm : in VecMat; transvm : out VecMat;
                           trans : out Standard_Complex_Matrices.Matrix ) is

  -- DESCRIPTION :
  --   Changes basis so that the last two planes in vm are spanned by
  --   the first and last standard basis vectors respectively.

    wrk : Standard_Complex_Matrices.Matrix(1..n,1..n);
   -- penuplane : constant Standard_Complex_Matrices.Matrix
   --   := vm(vm'last-1).all;
    frstplane : constant Standard_Complex_Matrices.Matrix := vm(vm'first).all;
    lastplane : constant Standard_Complex_Matrices.Matrix := vm(vm'last).all;
    colind : natural := 0;
    use Standard_Complex_Matrices;
    ranflt : double_float;

  begin
    for j in frstplane'range(2) loop              -- fill up the work matrix
      colind := colind + 1;
      for i in frstplane'range(1) loop
         wrk(i,colind) := frstplane(i,j);
      end loop;
    end loop;
    for j in colind+1..(n-lastplane'length(2)) loop  -- random spacing
      for i in 1..n loop
        ranflt := Random;
        wrk(i,j) := Create(ranflt);
      end loop;
    end loop;
    colind := n+1;
    for j in reverse lastplane'range(2) loop
      colind := colind - 1;
      for i in lastplane'range(1) loop
         wrk(i,colind) := lastplane(i,j);
      end loop;
    end loop;
    trans := Inverse(wrk);                        -- transformation = inverse
    for i in vm'first+1..vm'last-1 loop
      transvm(i-1) := new Standard_Complex_Matrices.Matrix'
                           (trans*vm(i).all);
    end loop;
    transvm(transvm'last-1)
      := new Standard_Complex_Matrices.Matrix'(trans*vm(vm'first).all);
    transvm(transvm'last)
      := new Standard_Complex_Matrices.Matrix'(trans*vm(vm'last).all);
  end Basis_Change;

  function Solution_Plane ( locmap : Standard_Natural_Matrices.Matrix;
                            mat : Standard_Complex_Matrices.Matrix )
                          return Solution is

  -- DESCRIPTION :
  --   Returns the representation of the solution plane as a vector.

    solloc : constant Standard_Complex_Vectors.Vector
           := Vector_Rep(locmap,Localize(locmap,mat));
    sol : Solution(solloc'length);

  begin
    sol.m := 1;
    sol.t := Create(0.0);
    sol.res := 0.0;
    sol.err := 0.0;
    sol.rco := 0.0;
    sol.v := solloc;
    return sol;
  end Solution_Plane;

  function Solution_Planes ( locmap : Standard_Natural_Matrices.Matrix;
                             vm : VecMat ) return Solution_List is

  -- DESCRIPTION :
  --   Returns the representation of the vector of planes as a solution list.

    res,res_last : Solution_List;

  begin
    for i in vm'range loop
      Append(res,res_last,Solution_Plane(locmap,vm(i).all));
    end loop;
    return res;
  end Solution_Planes;

  function Create_Hypersurface_System
             ( n : natural; locmap : Standard_Natural_Matrices.Matrix;
               xpm : Standard_Complex_Poly_Matrices.Matrix; planes : VecMat )
             return Poly_Sys is

  -- DESCRIPTION :
  --   Returns the polynomial system that collects the hypersurface
  --   intersection conditions for meeting the given m-planes.
  --   The system is localized according to the given localization map.

    wrksys : Poly_Sys(1..n) := Polynomial_Equations(planes(1..n),xpm);
    res : Poly_Sys(1..n) := Localize(locmap,wrksys);

  begin
    Clear(wrksys);
    return res;
  end Create_Hypersurface_System;

  function Create_General_System
             ( locmap : Standard_Natural_Matrices.Matrix;
               xpm : Standard_Complex_Poly_Matrices.Matrix; planes : VecMat )
             return Poly_Sys is

  -- DESCRIPTION :
  --   Returns the polynomial system that collects the general
  --   intersection conditions for meeting the given (m+1-k(i))-planes.
  --   The system is localized according to the given localization map.

    wrksys : constant Poly_Sys := Polynomial_Equations(planes,xpm);
    res : constant Poly_Sys := Localize(locmap,wrksys);
    tmp : Poly;

  begin
    for i in wrksys'range loop
      tmp := wrksys(i);
      Clear(tmp);
    end loop;
    return res;
  end Create_General_System;

  procedure Evaluate_Roots ( file : in file_type;
                             p : in Poly_sys; sols : in out Solution_List ) is

  -- DESCRIPTION :
  --   Evaluates the roots at the system, good for overdetermined systems.

    tmp : Solution_List := sols;

  begin
    for i in 1..Length_Of(sols) loop
      put(file,"Solution "); put(file,i,1);
      put_line(file," evaluated at the system : ");
      put_line(file,Eval(p,Head_Of(tmp).v));
      tmp := Tail_Of(tmp);
    end loop;
  end Evaluate_Roots;

  function Square ( n : natural; p : Poly_Sys ) return Poly_Sys is

  -- DESCRIPTION :
  --   Returns a n-by-n system, by adding random linear combinations of 
  --   the polynomials p(i), i > n, to the first n polynomials.

    res : Poly_Sys(1..n);
    acc : Poly;

  begin
    for i in res'range loop
      Copy(p(i),res(i));
      for j in n+1..p'last loop
        acc := Random1*p(j);
        Add(res(i),acc);
        Clear(acc);
      end loop;
    end loop;
    return res;
  end Square;

  procedure Refine_Roots ( file : in file_type;
                           p : in Poly_Sys; sols : in out Solution_List ) is

  -- DESCRIPTION :
  --   Calls the root refiner, for square polynomial systems only.

    epsxa : constant double_float := 10.0**(-8);
    epsfa : constant double_float := 10.0**(-8);
    tolsing : constant double_float := 10.0**(-8);
    max : constant natural := 3;
    numit : natural := 0;

  begin
    Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,max,false);
  end Refine_Roots;

  function General_Homotopy
              ( xpm : Standard_Complex_Poly_Matrices.Matrix;
                locmap : Standard_Natural_Matrices.Matrix;
                start,target : VecMat ) return Poly_Sys is

  -- DESCRIPTION :
  --   Returns a general homotopy between start and target planes.
  --   The continuation parameter is inside the determinants.

  -- REQUIRED : dimensions of start and target matrices must correspond.

    res : Link_to_Poly_Sys;
    n : constant natural := xpm'length(1);
    p : constant natural := xpm'length(2);
    m : constant natural := n-p;
    nva : constant natural := n*p + 1;

  begin
    for i in start'range loop
      declare
        moving : Standard_Complex_Poly_Matrices.Matrix
                   (start(i)'range(1),start(i)'range(2))
               := Moving_U_Matrix(nva,start(i).all,target(i).all);
        kd : constant natural := p + start(i)'length(2);
        bm : Bracket_Monomial := Maximal_Minors(n,kd);
        bs : Bracket_System(0..Number_of_Brackets(bm))
           := Minor_Equations(kd,kd-p,bm); 
        sys : Poly_Sys(1..bs'last)
            := Lifted_Expanded_Minors(moving,xpm,bs);
      begin
        Concat(res,sys);
        Standard_Complex_Poly_Matrices.Clear(moving);
      end;
    end loop;
    declare
      locres : constant Poly_Sys := Localize(locmap,res.all);
    begin
      Clear(res);
      return locres;
    end;
  end General_Homotopy;

  procedure Continuation ( file : in file_type; sols : in out Solution_List;
                           report : in boolean ) is

  -- DESCRIPTION :
  --   Calls the path trackers starting at the given solutions.

  -- REQUIRED : Homotopy is properly created.

    procedure Sil_Cont is
      new Silent_Continue(Max_Norm,
                          Homotopy.Eval,Homotopy.Diff,Homotopy.Diff);
    procedure Rep_Cont is
      new Reporting_Continue(Max_Norm,
                             Homotopy.Eval,Homotopy.Diff,Homotopy.Diff);

  begin
    Set_Continuation_Parameter(sols,Create(0.0));
    if report
     then Rep_Cont(file,sols,false,Create(1.0));
     else Sil_Cont(sols,false,Create(1.0));
    end if;
  end Continuation;

  procedure General_Path_Following
               ( file : in file_type; target,homsys : in Poly_Sys;
                 sols : in out Solution_List; report : in boolean ) is

  -- DESCRIPTION :
  --   Given a homotopy with start solutions, the path trackers will
  --   trace the paths defined by this homotopy.

  -- REQUIRED : not Is_Null(sols).

    timer : Timing_Widget;
    neq : constant natural := homsys'last;       -- number of equations 
    dim : constant natural := Head_Of(sols).n;   -- actual dimension
    squhom : Poly_Sys(1..dim) := Square(dim,homsys);

  begin
    tstart(timer);
    Homotopy.Create(squhom,dim+1);
    Continuation(file,sols,report);
    tstop(timer);
    new_line(file);
    print_times(file,timer,"Determinantal Cheater's homotopy to target system");
    new_line(file);
    Evaluate_Roots(file,target,sols);
  end General_Path_Following;

  procedure Path_Following_with_Cheater
               ( file : in file_type; start,target : in Poly_Sys;
                 sols : in out Solution_List; report : in boolean ) is

  -- DESCRIPTION :
  --   Calls the standard continuation routines to solve a specific
  --   target system, starting at the solutions of the start system.
  --   This is the usual linear cheater between start and target system,
  --   although it will take nonsquare inputs, it should only be used
  --   for hypersurface intersection conditions.

  -- REQUIRED : not Is_Null(sols).

    timer : Timing_Widget;
    n : constant natural := target'last;
    a : Standard_Complex_Vectors.Vector(1..n) := Random_Vector(1,n);
    b : Standard_Complex_Vectors.Vector(1..n) := Random_Vector(1,n);
    dimsol : constant natural := Head_Of(sols).n;
    squ_target,squ_start : Poly_Sys(1..dimsol);

  begin
    tstart(timer);
    if dimsol = n
     then Homotopy.Create(target,start,2,a,b,true);        -- linear cheater
     else squ_target := Square(dimsol,target);
          squ_start  := Square(dimsol,start);
          Homotopy.Create(squ_target,squ_start,2,a,b,true);
    end if;
    Continuation(file,sols,report);
    tstop(timer);
    new_line(file);
    print_times(file,timer,"Linear Cheater's homotopy to target system");
    if dimsol = n
     then Refine_Roots(file,target,sols);
     else Refine_Roots(file,squ_target,sols);
          Evaluate_Roots(file,target,sols);
    end if;
  end Path_Following_with_Cheater;

  procedure Solve_Hypersurface_Target_System
                     ( file : in file_type; m,p : in natural;
                       start_planes,target_planes : in VecMat;
                       index_poset : in Array_of_Array_of_Nodes;
                       deform_poset : in Array_of_Array_of_VecMats;
                       target_level : in natural; report : in boolean ) is

  -- DESCRIPTION :
  --   This procedure tests the output of the deformation poset,
  --   creating polynomial representations of the intersection conditions
  --   and solution lists representing the solution planes.

  -- ON ENTRY :
  --   file            to write intermediate output on;
  --   m               dimension of the input planes;
  --   p               dimension of the solution planes;
  --   start_planes    input m-planes in general position;
  --   target_planes   specific input m-planes;
  --   index_poset     indexed localization poset; 
  --   deform_poset    poset with the solution p-planes;
  --   target_level    indicates lowest node in deform_poset that is filled;
  --   report          switch for intermediate output during continuation.

    dim : constant natural := m*p;
    xpm : Standard_Complex_Poly_Matrices.Matrix(1..m+p,1..p)
        := Localization_Pattern(m+p,index_poset(dim)(1).top,
                                    index_poset(dim)(1).bottom);
    solplanes : constant VecMat := deform_poset(target_level)(1).all;
    locmap : Standard_Natural_Matrices.Matrix(1..m+p,1..p)
           := Standard_Coordinate_Frame(xpm,solplanes(1).all);
    locsys : Poly_Sys(start_planes'range)
           := Create_Hypersurface_System(dim,locmap,xpm,start_planes);
    target : Poly_Sys(target_planes'range)
           := Create_Hypersurface_System(dim,locmap,xpm,target_planes);
    sols : Solution_List := Solution_Planes(locmap,solplanes);

  begin
    Matrix_Indeterminates.Reduce_Symbols(locmap);
    put_line(file,"THE GENERIC SYSTEM : ");
    put_line(file,locsys);
    new_line(file);
    put_line(file,"The localization map :"); put(file,locmap);
    Refine_Roots(file,locsys,sols);
    new_line(file);
    put_line(file,"THE TARGET SYSTEM : ");
    put_line(file,target);
    new_line(file);
    Path_Following_with_Cheater(file,locsys,target,sols,report);
  end Solve_Hypersurface_Target_System;

  procedure Solve_General_Target_System
                     ( file : in file_type; m,p : in natural; k : in Bracket;
                       start_planes,target_planes : in VecMat;
                       index_poset : in Array_of_Array_of_Nodes;
                       deform_poset : in Array_of_Array_of_VecMats;
                       target_level : in natural; report : in boolean ) is

  -- DESCRIPTION :
  --   This procedure tests the output of the deformation poset,
  --   creating polynomial representations of the intersection conditions
  --   and solution lists representing the solution planes.

  -- ON ENTRY :
  --   file            to write intermediate output on;
  --   m               dimension of the input planes;
  --   p               dimension of the solution planes;
  --   k               co-dimension conditions;
  --   start_planes    input (m+1-k(i))-planes in general position;
  --   target_planes   specific input (m+1-k(i))-planes;
  --   index_poset     indexed localization poset; 
  --   deform_poset    poset with the solution p-planes;
  --   target_level    indicates lowest node in deform_poset that is filled;
  --   report          switch for intermediate output during continuation.

    dim : constant natural := m*p;
    xpm : Standard_Complex_Poly_Matrices.Matrix(1..m+p,1..p)
        := Localization_Pattern(m+p,index_poset(dim)(1).top,
                                    index_poset(dim)(1).bottom);
    solplanes : constant VecMat := deform_poset(target_level)(1).all;
    locmap : Standard_Natural_Matrices.Matrix(1..m+p,1..p)
           := Standard_Coordinate_Frame(xpm,solplanes(1).all);
    homtpy : constant Poly_Sys
           := General_Homotopy(xpm,locmap,start_planes,target_planes);
    locsys : constant Poly_Sys
           := Create_General_System(locmap,xpm,start_planes);
    target : constant Poly_Sys
           := Create_General_System(locmap,xpm,target_planes);
    sols : Solution_List := Solution_Planes(locmap,solplanes);

  begin
    Matrix_Indeterminates.Reduce_Symbols(locmap);
    put_line(file,"THE GENERIC SYSTEM : ");
    put_line(file,locsys);
    new_line(file);
    put_line(file,"The localization map :"); put(file,locmap);
    Evaluate_Roots(file,locsys,sols);
    new_line(file);
    put_line(file,"THE TARGET SYSTEM : ");
    put_line(file,target);
    new_line(file);
    General_Path_Following(file,target,homtpy,sols,report);
  end Solve_General_Target_System;

  procedure Write_Poset_Times
               ( file : in file_type; timer : in Timing_Widget;
                 npaths : in Standard_Natural_Vectors.Vector;
                 timings : in Duration_Array ) is

  -- DESCRIPTION :
  --   Writes a overview of #paths and timings spent during deformations
  --   along the poset structure.

  begin
    new_line(file);
    put_line(file,"--------------------------------------");
    put_line(file,"|    TIMING INFORMATION OVERVIEW     |");
    put_line(file,"--------------------------------------");
    put_line(file,"|   n   |  #paths  |  user cpu time  |");
    put_line(file,"--------------------------------------");
    for i in npaths'range loop
      if npaths(i) /= 0
       then put(file,"|"); put(file,i,4); put(file,"   |");
            put(file,npaths(i),7);        put(file,"   | ");
            print_hms(file,timings(i));   put(file,"  |"); new_line(file);
      end if;
    end loop;
    put_line(file,"--------------------------------------");
    put(file,"| total |");
    put(file,Standard_Natural_Vectors.Sum(npaths),7);
    put(file,"   | ");
    print_hms(file,Elapsed_User_Time(timer));
    put(file,"  |"); new_line(file);
    put_line(file,"--------------------------------------");
  end Write_Poset_Times;

  procedure Solve_Hypersurface_Deformation_Poset
               ( file : in file_type; m,p : in natural;
                 level_poset : in Array_of_Nodes;
                 index_poset : in Array_of_Array_of_Nodes ) is

  -- DESCRIPTION :
  --   Creates a deformation poset and applies the Solve operator.

    n : constant natural := m+p;
    deform_poset : Array_of_Array_of_VecMats(index_poset'range)
                 := Create(index_poset);
    planes : VecMat(1..m*p) := Random_Complex_Planes(m,p);
    target_planes : VecMat(1..m*p);
    ans : character;
    report,outlog : boolean;
    timer : Timing_Widget;
    target_level : natural := m*p;
    nbp : natural := 0;
    npaths : Standard_Natural_Vectors.Vector(1..target_level)
           := (1..target_level => 0);
    timings : Duration_Array(1..target_level) := (1..target_level => 0.0);

  begin
    put_line("The size of the deformation poset : ");
    put_line(file,"The size of the deformation poset : ");
    put_roco(index_poset);
    put_roco(file,index_poset);
    new_line;
    put("Give target level <= "); put(target_level,1);
    put(" = root level by default : "); get(target_level);
    for i in 1..target_level loop
      nbp := nbp + Row_Root_Count_Sum(level_poset,i);
    end loop;
    put("The number of paths : "); put(nbp,1); new_line;
    put(file,"The number of paths : "); put(file,nbp,1); new_line(file);
    new_line;
    put("Do you want to have the homotopies on file ? (y/n) ");
    Ask_Yes_or_No(ans);
    outlog := (ans = 'y');
    if target_level < m*p
     then planes(m*p).all := Last_Standard_Plane(m,p);
          if target_level < m*p-1
           then planes(m*p-1).all := First_Standard_Plane(m,p);
          end if;
    end if;
    Driver_for_Input_Planes(file,m,p,target_planes); 
    Matrix_Indeterminates.Initialize_Symbols(m+p,p);
    Add_t_Symbol;
    Set_Parameters(file,report);
    tstart(timer);
    for i in index_poset(target_level)'range loop
      declare
        root : Node := index_poset(target_level)(i).all;
      begin
        Solve(file,m+p,deform_poset,root,planes(1..target_level),
              report,outlog,npaths,timings);
      end;
    end loop;
    tstop(timer);
    new_line(file);
    print_times(file,timer,"Solving along the deformation poset");
    Write_Poset_Times(file,timer,
                      npaths(1..target_level),timings(1..target_level));
    if deform_poset(target_level)(1) /= null
     then new_line(file);
          Solve_Hypersurface_Target_System
            (file,m,p,planes,target_planes,index_poset,deform_poset,
             target_level,report);
    end if;
  end Solve_Hypersurface_Deformation_Poset;

  procedure Solve_General_Deformation_Poset
               ( file : in file_type; m,p : in natural; k : in Bracket;
                 index_poset : in Array_of_Array_of_Nodes ) is

  -- DESCRIPTION :
  --   Applies the solver to general intersection conditions.

    deform_poset : Array_of_Array_of_VecMats(index_poset'range)
                 := Create(index_poset);
    planes : VecMat(k'range) := Random_Complex_Planes(m,p,k);
    target_planes : VecMat(k'range);
    ans : character;
    report,outlog : boolean;
    timer : Timing_Widget;
    target_level : natural := m*p;
    npaths : Standard_Natural_Vectors.Vector(1..target_level)
           := (1..target_level => 0);
    timings : Duration_Array(1..target_level) := (1..target_level => 0.0);

  begin
    put_line("The size of the deformation poset : ");
    put_line(file,"The size of the deformation poset : ");
    put_roco(index_poset);
    put_roco(file,index_poset);
    new_line;
    put("Give target level <= "); put(target_level,1);
    put(" = root level by default : "); get(target_level);
    new_line;
    put("Do you want to have the homotopies on file ? (y/n) ");
    Ask_Yes_or_No(ans);
    outlog := (ans = 'y');
    Driver_for_Input_Planes(file,m,p,k,target_planes);
    Matrix_Indeterminates.Initialize_Symbols(m+p,p);
    Add_t_Symbol;
    Set_Parameters(file,report);
    tstart(timer);
    for i in index_poset(target_level)'range loop
      declare
        root : Node := index_poset(target_level)(i).all;
      begin
        Solve(file,m+p,k,deform_poset,root,planes,report,outlog,
              npaths,timings);
      end;
    end loop;
    tstop(timer);
    new_line(file);
    print_times(file,timer,"Solving along the deformation poset");
    Write_Poset_Times(file,timer,
                      npaths(1..target_level),timings(1..target_level));
    if deform_poset(target_level)(1) /= null
     then new_line(file);
          Solve_General_Target_System
            (file,m,p,k,planes,target_planes,index_poset,deform_poset,
             target_level,report);
    end if;
  end Solve_General_Deformation_Poset;

-- HYPERSURFACE SOLVERS :

  procedure Create_Top_Hypersurface_Poset
              ( file : in file_type; m,p : in natural ) is

  -- DESCRIPTION :
  --   Create the poset by incrementing only top pivots.

    timer : Timing_Widget;
    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    level_poset : Array_of_Nodes(0..m*p);
    index_poset : Array_of_Array_of_Nodes(0..m*p);

  begin
    tstart(timer);
    Top_Create(lnkroot,m+p);
    put_line("The poset created from the top : ");
    put_line(file,"The poset created from the top : ");
    level_poset := Create_Leveled_Poset(lnkroot);
    Count_Roots(level_poset);
    index_poset := Create_Indexed_Poset(level_poset);
    put(index_poset);
    put(file,index_poset);
    Solve_Hypersurface_Deformation_Poset(file,m,p,level_poset,index_poset);
    tstop(timer);
    new_line(file);
    print_times(file,timer,
                "Total time for Hypersurface Pieri Homotopy Algorithm");
  end Create_Top_Hypersurface_Poset;

  procedure Create_Bottom_Hypersurface_Poset
              ( file : in file_type; m,p : in natural ) is

  -- DESCRIPTION :
  --   Create the poset by decrementing only bottom pivots.

    timer : Timing_Widget;
    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    level_poset : Array_of_Nodes(0..m*p);
    index_poset : Array_of_Array_of_Nodes(0..m*p);

  begin
    tstart(timer);
    Bottom_Create(lnkroot);
    put_line("The poset created from the bottom : ");
    put_line(file,"The poset created from the bottom : ");
    level_poset := Create_Leveled_Poset(lnkroot);
    Count_Roots(level_poset);
    index_poset := Create_Indexed_Poset(level_poset);
    put(index_poset);
    put(file,index_poset);
    Solve_Hypersurface_Deformation_Poset(file,m,p,level_poset,index_poset);
    tstop(timer);
    new_line(file);
    print_times(file,timer,
                "Total time for Hypersurface Pieri Homotopy Algorithm");
  end Create_Bottom_Hypersurface_Poset;

  procedure Create_Mixed_Hypersurface_Poset
              ( file : in file_type; m,p : in natural ) is

  -- DESCRIPTION :
  --   Create the poset by incrementing top and decrementing bottom pivots.

    timer : Timing_Widget;
    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    level_poset : Array_of_Nodes(0..m*p);
    index_poset : Array_of_Array_of_Nodes(0..m*p);

  begin
    tstart(timer);
    Top_Bottom_Create(lnkroot,m+p);
    put_line("The poset created in a mixed fashion : ");
    put_line(file,"The poset created in a mixed fashion : ");
    level_poset := Create_Leveled_Poset(lnkroot);
    Count_Roots(level_poset);
    index_poset := Create_Indexed_Poset(level_poset);
    put(index_poset);
    put(file,index_poset);
    Solve_Hypersurface_Deformation_Poset(file,m,p,level_poset,index_poset);
    tstop(timer);
    new_line(file);
    print_times(file,timer,
                "Total time for Hypersurface Pieri Homotopy Algorithm");
  end Create_Mixed_Hypersurface_Poset;

-- GENERAL SOLVERS :

  procedure Create_Top_General_Poset
              ( file : in file_type; m,p : in natural ) is

  -- DESCRIPTION :
  --   Creates a poset for counting general subspace intersections,
  --   by consistently incrementing the top pivots.

    timer : Timing_Widget;
    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    codim : constant Bracket := Read_Codimensions(m,p,0);
    level_poset : Array_of_Nodes(0..m*p);
    index_poset : Array_of_Array_of_Nodes(0..m*p);

  begin
    put(file,"  k = "); put(file,codim); new_line(file);
    tstart(timer);
    Top_Create(lnkroot,codim,m+p);
    put_line("The poset created from the top : ");
    put_line(file,"The poset created from the top : ");
    level_poset := Create_Leveled_Poset(lnkroot);
    Count_Roots(level_poset);
    index_poset := Create_Indexed_Poset(level_poset);
    put(index_poset);
	put(file,index_poset);                           
    Solve_General_Deformation_Poset(file,m,p,codim,index_poset);
    tstop(timer);
    new_line(file);
    print_times(file,timer,
                "Total time for General Pieri Homotopy Algorithm");
  end Create_Top_General_Poset;

  procedure Create_Bottom_General_Poset
              ( file : in file_type; m,p : in natural ) is

  -- DESCRIPTION :
  --   Creates a poset for counting general subspace intersections,
  --   by consistently incrementing the top pivots.

    timer : Timing_Widget;
    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    codim : constant Bracket := Read_Codimensions(m,p,0);
    level_poset : Array_of_Nodes(0..m*p);
    index_poset : Array_of_Array_of_Nodes(0..m*p);

  begin
    put(file,"  k = "); put(file,codim); new_line(file);
    tstart(timer);
    Bottom_Create(lnkroot,codim);
    put_line("The poset created from the bottom : ");
    put_line(file,"The poset created from the bottom : ");
    level_poset := Create_Leveled_Poset(lnkroot);
    Count_Roots(level_poset);
    index_poset := Create_Indexed_Poset(level_poset);
    put(index_poset);
    put(file,index_poset);
    Solve_General_Deformation_Poset(file,m,p,codim,index_poset);
    tstop(timer);
    new_line(file);
    print_times(file,timer,
                "Total time for General Pieri Homotopy Algorithm");
  end Create_Bottom_General_Poset;

  procedure Create_Mixed_General_Poset
              ( file : in file_type; m,p : in natural ) is

  -- DESCRIPTION :
  --   Creates a poset for counting general subspace intersections,
  --   by incrementing the top and decrementing the bottom pivots.

    timer : Timing_Widget;
    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    codim : constant Bracket := Read_Codimensions(m,p,0);
    level_poset : Array_of_Nodes(0..m*p);
    index_poset : Array_of_Array_of_Nodes(0..m*p);

  begin
    put(file,"  k = "); put(file,codim); new_line(file);
    tstart(timer);
    Top_Bottom_Create(lnkroot,codim,m+p);
    put_line("The poset created in a mixed fashion : ");
    put_line(file,"The poset created in a mixed fashion : ");
    level_poset := Create_Leveled_Poset(lnkroot);
    Count_Roots(level_poset);
    index_poset := Create_Indexed_Poset(level_poset);
    put(index_poset);
    put(file,index_poset);
    Solve_General_Deformation_Poset(file,m,p,codim,index_poset);
    tstop(timer);
    new_line(file);
    print_times(file,timer,
                "Total time for General Pieri Homotopy Algorithm");
  end Create_Mixed_General_Poset;

  procedure Main is

    p : constant natural := d;
    m : constant natural := n-d;
    ans : character;

  begin
    new_line;
    put_line("MENU for deforming p-planes in (m+p)-space, co-dimensions k : ");
    put_line("  1. k_i = 1  consistently incrementing the top pivots.");
    put_line("  2.          consistently decrementing the bottom pivots.");
    put_line("  3.          mixed top-bottom sequence for poset creation.");
    put_line("  4. k_i >= 1 consistently incrementing the top pivots.");
    put_line("  5.          consistently decrementing the bottom pivots.");
    put_line("  6.          mixed top-bottom sequence for poset creation.");
    put("Type 1, 2, 3, 4, 5, or 6 to choose : ");
    Ask_Alternative(ans,"123456");
    new_line;
    case ans is
      when '1' => new_line(file); Create_Top_Hypersurface_Poset(file,m,p);
      when '2' => new_line(file); Create_Bottom_Hypersurface_Poset(file,m,p);
      when '3' => new_line(file); Create_Mixed_Hypersurface_Poset(file,m,p);
      when '4' => Create_Top_General_Poset(file,m,p);
      when '5' => Create_Bottom_General_Poset(file,m,p);
      when '6' => Create_Mixed_General_Poset(file,m,p);
      when others => put_line("Option not recognized.  Please try again.");
    end case;
  end Main;

begin
  Main;
end Driver_for_Pieri_Homotopies;