Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/lists_of_vectors_utilities.adb, Revision 1.1.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>