File: [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Implift / lists_of_vectors_utilities.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:28 2000 UTC (23 years, 10 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
with Standard_Integer_Norms; use Standard_Integer_Norms;
with Standard_Integer_Matrices; use Standard_Integer_Matrices;
with Standard_Integer_Linear_Solvers; use Standard_Integer_Linear_Solvers;
package body Lists_of_Vectors_Utilities is
procedure Compute_Normal ( v : in VecVec; n : out Link_to_Vector;
deg : out natural ) is
d : Link_to_Vector renames v(v'last);
im : matrix(d'range,d'range);
res : Link_to_Vector;
cnt : integer;
begin
res := new Vector(d'range);
cnt := im'first(1);
for i in v'first..(v'last-1) loop
for j in im'range(2) loop
im(cnt,j) := v(i)(j) - d(j);
end loop;
cnt := cnt + 1;
end loop;
for i in cnt..im'last(1) loop
for j in im'range(2) loop
im(i,j) := 0;
end loop;
end loop;
Upper_Triangulate(im);
cnt := 1;
for k in im'first(1)..im'last(1)-1 loop
cnt := cnt*im(k,k);
end loop;
if cnt < 0
then deg := -cnt;
else deg := cnt;
end if;
Scale(im);
Solve0(im,res.all);
Normalize(res.all);
n := res;
end Compute_Normal;
function Compute_Normal ( v : VecVec ) return Link_to_Vector is
deg : natural;
res : Link_to_Vector;
begin
Compute_Normal(v,res,deg);
return res;
end Compute_Normal;
function Pointer_to_Last ( l : List ) return List is
res : List := l;
begin
if not Is_Null(res)
then while not Is_Null(Tail_Of(res)) loop
res := Tail_Of(res);
end loop;
end if;
return res;
end Pointer_to_Last;
procedure Move_to_Front ( l : in out List; v : in Vector ) is
tmp : List := l;
found : boolean := false;
first,lv : Link_to_Vector;
begin
while not Is_Null(tmp) loop
lv := Head_Of(tmp);
if Equal(lv.all,v)
then found := true;
else tmp := Tail_Of(tmp);
end if;
exit when found;
end loop;
if found
then
first := Head_Of(l);
if first /= lv
then
lv.all := first.all; Set_Head(tmp,lv);
first.all := v; Set_Head(l,first);
end if;
end if;
end Move_to_Front;
function Difference ( l1,l2 : List ) return List is
res,res_last : List;
tmp : List := l1;
pt : Link_to_Vector;
begin
while not Is_Null(tmp) loop
pt := Head_Of(tmp);
if not Is_In(l2,pt.all)
then Append(res,res_last,pt.all);
end if;
tmp := Tail_Of(tmp);
end loop;
return res;
end Difference;
function Different_Points ( l : List ) return List is
tmp,res,res_last : List;
begin
tmp := l;
while not Is_Null(tmp) loop
Append_Diff(res,res_last,Head_Of(tmp).all);
tmp := Tail_Of(tmp);
end loop;
return res;
end Different_Points;
procedure Remove_Duplicates ( l : in out List ) is
res : List := Different_Points(l);
begin
Deep_Clear(l);
l := res;
end Remove_Duplicates;
end Lists_of_Vectors_Utilities;