Return to dynamic_lifting_functions.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Dynlift

Import the second public release of PHCpack.

OKed by Jan Verschelde.

package body Dynamic_Lifting_Functions is

  function Lift_to_Place ( s : Simplex; x : Vector ) return integer is 

    nor : constant Vector := Normal(s);
    ips : integer := nor*Vertex(s,1);
    ipx : integer := nor*x;

  begin
    if ips < ipx
     then return x(x'last);
     else ipx := ipx - x(x'last)*nor(nor'last);
          return ((ips - ipx)/nor(nor'last) + 1);
    end if;
  end Lift_to_Place;

  function Lift_to_Place ( t : Triangulation; x : Vector ) return integer is

    tmp : Triangulation := t;
    wrk : Vector(x'range) := x;

  begin
    while not Is_Null(tmp) loop
      wrk(wrk'last) := Lift_to_Place(Head_Of(tmp),wrk);
      tmp := Tail_Of(tmp);
    end loop;
    return wrk(wrk'last);
  end Lift_to_Place;

  function Lift_to_Pull ( s : Simplex; x : Vector ) return integer is

    nor : constant Vector := Normal(s);
    ips : integer := nor*Vertex(s,1);
    ipx : integer := nor*x;

  begin
    if ipx < ips
     then return x(x'last);
     else ipx := ipx - x(x'last)*nor(nor'last);
          return ((ips - ipx)/nor(nor'last) - 1);
    end if;
  end Lift_to_Pull;

  function Lift_to_Pull ( t : Triangulation; x : Vector ) return integer is

    tmp : Triangulation := t;
    wrk : Vector(x'range) := x;

  begin
    while not Is_Null(tmp) loop
      wrk(wrk'last) := Lift_to_Pull(Head_Of(tmp),wrk);
      tmp := Tail_Of(tmp);
    end loop;
    return wrk(wrk'last);
  end Lift_to_Pull;

  function Degenerate ( t : Triangulation; x : Vector ) return boolean is

    tmp : Triangulation := t;
    s : Simplex;

  begin
    while not Is_Null(tmp) loop
      s := Head_Of(tmp);
      declare
        nor : constant Vector := Normal(s);
        apt : constant Vector := Vertex(s,1);
        ipx : constant integer := x*nor;
      begin
        if apt*nor = ipx
         then return true;
        end if;
      end;
      tmp := Tail_Of(tmp);
    end loop;
    return false;
  end Degenerate;

  function Lift_to_Pull ( t1,t2 : Triangulation; x : Vector ) return integer is

    wrk : Vector(x'range) := x;

  begin
    wrk(wrk'last) := Lift_to_Pull(t1,x);
    while Degenerate(t2,wrk) loop   -- pull the lifting further down
      wrk(wrk'last) := wrk(wrk'last) - 1;
    end loop;
    return wrk(wrk'last);
  end Lift_to_Pull;

end Dynamic_Lifting_Functions;