Return to ts_defpos.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_Complex_Matrices;
with Standard_Complex_Matrices_io;       use Standard_Complex_Matrices_io;
with Standard_Random_Matrices;           use Standard_Random_Matrices;
with Standard_Complex_VecMats;           use Standard_Complex_VecMats;
with Symbol_Table;                       use Symbol_Table;
with Matrix_Indeterminates;
with Standard_Complex_Poly_Matrices;
with Standard_Complex_Poly_Matrices_io;  use Standard_Complex_Poly_Matrices_io;
with Drivers_for_Poly_Continuation;      use Drivers_for_Poly_Continuation;
with Brackets,Brackets_io;               use Brackets,Brackets_io;
with Symbolic_Minor_Equations;           use Symbolic_Minor_Equations;
with Pieri_Homotopies;                   use Pieri_Homotopies;
with Localization_Posets;                use Localization_Posets;
with Localization_Posets_io;             use Localization_Posets_io;
with Deformation_Posets;                 use Deformation_Posets;

procedure ts_defpos is

-- DESCRIPTION :
--   Test on the deformation posets.

  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 Random_Input_Planes ( m,p : natural ) return VecMat is

  -- DESCRIPTION :
  --   Returns a vector of m*p random m-planes.

    res : VecMat(1..m*p);
    n : constant natural := m+p;

  begin
    for i in res'range loop
      res(i) := new Standard_Complex_Matrices.Matrix'(Random_Matrix(n,m));
    end loop;
    return res;
  end Random_Input_Planes;

  function Random_Input_Planes ( m,p : natural; k : Bracket ) return VecMat is

  -- DESCRIPTION :
  --   Returns a vector of m*p random m-planes.

    res : VecMat(k'range);
    n : constant natural := m+p;

  begin
    for i in res'range loop
      res(i)
        := new Standard_Complex_Matrices.Matrix'(Random_Matrix(n,m+1-k(i)));
    end loop;
    return res;
  end Random_Input_Planes;

  procedure Solve_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.

    deform_poset : Array_of_Array_of_VecMats(index_poset'range)
                 := Create(index_poset);
    planes : VecMat(1..m*p) := Random_Input_Planes(m,p);
    report : boolean;
    timer : Timing_Widget;
    target_level : natural := m*p;
    nbp : natural := 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 : "); 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);
    Matrix_Indeterminates.Initialize_Symbols(m+p,p);
    Add_t_Symbol;
    skip_line;
    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,report);
      end;
    end loop;
    tstop(timer);
    new_line(file);
    print_times(file,timer,"Solving along the deformation poset");
  end Solve_Deformation_Poset;

  procedure Solve_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_Input_Planes(m,p,k);
    report : boolean;
    timer : Timing_Widget;
    target_level : natural := m*p;

  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 : "); get(target_level);
    Matrix_Indeterminates.Initialize_Symbols(m+p,p);
    Add_t_Symbol;
    skip_line;
    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
        if ((root.tp = top) or (root.tp = bottom))
         then --One_Solve(file,m+p,k,deform_poset,root,planes,report);
              Solve(file,m+p,k,deform_poset,root,planes,report);
         else Solve(file,m+p,k,deform_poset,root,planes,report);
        end if;
      end;
    end loop;
    tstop(timer);
    new_line(file);
    print_times(file,timer,"Solving along the deformation poset");
  end Solve_Deformation_Poset;

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

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

    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
    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_Deformation_Poset(file,m,p,level_poset,index_poset);
  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.

    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
    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_Deformation_Poset(file,m,p,level_poset,index_poset);
  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.

    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
    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_Deformation_Poset(file,m,p,level_poset,index_poset);
  end Create_Mixed_Hypersurface_Poset;

  function Finite ( dim : Bracket; m,p : natural ) return boolean is

  -- DESCRIPTION :
  --   Returns true if the codimensions yield a finite number of solutions.

    sum : natural := 0;

  begin
    for i in dim'range loop
      sum := sum + dim(i);
    end loop;
    if sum = m*p
     then return true;
     else return false;
    end if;
  end Finite;

  function Read_Codimensions ( m,p : natural ) return Bracket is

  -- DESCRIPTION :
  --   Reads the vector of codimensions and checks on finiteness.

    codim : Bracket(1..m*p);
    n : natural;
    poset : Array_of_Nodes(0..m*p);

  begin
    loop
      put("Give number of intersection conditions : "); get(n);
      put("Give "); put(n,1); put(" codimensions : ");
      for i in 1..n loop
        get(codim(i));
      end loop;
      for i in 1..n-1 loop
        put(codim(i),1); put(" + ");
      end loop;
      put(codim(n),1);
      if Finite(codim(1..n),m,p)
	   then put(" = "); put(m*p,1); put_line("  Finite #sols.");
            exit;
	   else put(" /= "); put(m*p,1);
            put_line("  Please try again.");
      end if;
    end loop;
    return codim(1..n);
  end Read_Codimensions;

  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.

    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    codim : constant Bracket := Read_Codimensions(m,p);
    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);
    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_Deformation_Poset(file,m,p,codim,index_poset);
  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.

    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    codim : constant Bracket := Read_Codimensions(m,p);
    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);
    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_Deformation_Poset(file,m,p,codim,index_poset);
  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.

    root : Node(p) := Trivial_Root(m,p);
    lnkroot : Link_to_Node := new Node'(root);
    codim : constant Bracket := Read_Codimensions(m,p);
    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);
    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_Deformation_Poset(file,m,p,codim,index_poset);
  end Create_Mixed_General_Poset;

  procedure Main is

    m,p : natural;
    ans : character;
    file : file_type;

  begin
    new_line;
    put_line("MENU for posets for deforming p-planes in (m+p)-space : ");
    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 : "); get(ans);
    skip_line; new_line;
    put_line("Reading the name of the file for the deformations.");
    Read_Name_and_Create_File(file);
    new_line;
    put("Give p, the number of entries in bracket : "); get(p);
    put("Give m, the complementary dimension : "); get(m);
    put(file,"p = "); put(file,p,1); put(file,"  m = "); put(file,m,1);
    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
  new_line;
  put_line("Test on deformation posets for linear subspace intersections.");
  Main;
end ts_defpos;