Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/lists_of_vectors_utilities.adb, Revision 1.1
1.1 ! maekawa 1: with Standard_Integer_Norms; use Standard_Integer_Norms;
! 2: with Standard_Integer_Matrices; use Standard_Integer_Matrices;
! 3: with Standard_Integer_Linear_Solvers; use Standard_Integer_Linear_Solvers;
! 4:
! 5: package body Lists_of_Vectors_Utilities is
! 6:
! 7: procedure Compute_Normal ( v : in VecVec; n : out Link_to_Vector;
! 8: deg : out natural ) is
! 9:
! 10: d : Link_to_Vector renames v(v'last);
! 11: im : matrix(d'range,d'range);
! 12: res : Link_to_Vector;
! 13: cnt : integer;
! 14:
! 15: begin
! 16: res := new Vector(d'range);
! 17: cnt := im'first(1);
! 18: for i in v'first..(v'last-1) loop
! 19: for j in im'range(2) loop
! 20: im(cnt,j) := v(i)(j) - d(j);
! 21: end loop;
! 22: cnt := cnt + 1;
! 23: end loop;
! 24: for i in cnt..im'last(1) loop
! 25: for j in im'range(2) loop
! 26: im(i,j) := 0;
! 27: end loop;
! 28: end loop;
! 29: Upper_Triangulate(im);
! 30: cnt := 1;
! 31: for k in im'first(1)..im'last(1)-1 loop
! 32: cnt := cnt*im(k,k);
! 33: end loop;
! 34: if cnt < 0
! 35: then deg := -cnt;
! 36: else deg := cnt;
! 37: end if;
! 38: Scale(im);
! 39: Solve0(im,res.all);
! 40: Normalize(res.all);
! 41: n := res;
! 42: end Compute_Normal;
! 43:
! 44: function Compute_Normal ( v : VecVec ) return Link_to_Vector is
! 45:
! 46: deg : natural;
! 47: res : Link_to_Vector;
! 48:
! 49: begin
! 50: Compute_Normal(v,res,deg);
! 51: return res;
! 52: end Compute_Normal;
! 53:
! 54: function Pointer_to_Last ( l : List ) return List is
! 55:
! 56: res : List := l;
! 57:
! 58: begin
! 59: if not Is_Null(res)
! 60: then while not Is_Null(Tail_Of(res)) loop
! 61: res := Tail_Of(res);
! 62: end loop;
! 63: end if;
! 64: return res;
! 65: end Pointer_to_Last;
! 66:
! 67: procedure Move_to_Front ( l : in out List; v : in Vector ) is
! 68:
! 69: tmp : List := l;
! 70: found : boolean := false;
! 71: first,lv : Link_to_Vector;
! 72:
! 73: begin
! 74: while not Is_Null(tmp) loop
! 75: lv := Head_Of(tmp);
! 76: if Equal(lv.all,v)
! 77: then found := true;
! 78: else tmp := Tail_Of(tmp);
! 79: end if;
! 80: exit when found;
! 81: end loop;
! 82: if found
! 83: then
! 84: first := Head_Of(l);
! 85: if first /= lv
! 86: then
! 87: lv.all := first.all; Set_Head(tmp,lv);
! 88: first.all := v; Set_Head(l,first);
! 89: end if;
! 90: end if;
! 91: end Move_to_Front;
! 92:
! 93: function Difference ( l1,l2 : List ) return List is
! 94:
! 95: res,res_last : List;
! 96: tmp : List := l1;
! 97: pt : Link_to_Vector;
! 98:
! 99: begin
! 100: while not Is_Null(tmp) loop
! 101: pt := Head_Of(tmp);
! 102: if not Is_In(l2,pt.all)
! 103: then Append(res,res_last,pt.all);
! 104: end if;
! 105: tmp := Tail_Of(tmp);
! 106: end loop;
! 107: return res;
! 108: end Difference;
! 109:
! 110: function Different_Points ( l : List ) return List is
! 111:
! 112: tmp,res,res_last : List;
! 113:
! 114: begin
! 115: tmp := l;
! 116: while not Is_Null(tmp) loop
! 117: Append_Diff(res,res_last,Head_Of(tmp).all);
! 118: tmp := Tail_Of(tmp);
! 119: end loop;
! 120: return res;
! 121: end Different_Points;
! 122:
! 123: procedure Remove_Duplicates ( l : in out List ) is
! 124:
! 125: res : List := Different_Points(l);
! 126:
! 127: begin
! 128: Deep_Clear(l);
! 129: l := res;
! 130: end Remove_Duplicates;
! 131:
! 132: end Lists_of_Vectors_Utilities;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>