Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Stalift/floating_lifting_functions.adb, Revision 1.1.1.1
1.1 maekawa 1: with Standard_Random_Numbers; use Standard_Random_Numbers;
2: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
3: with Standard_Complex_Vectors;
4: with Standard_Floating_VecVecs; use Standard_Floating_VecVecs;
5:
6: package body Floating_Lifting_Functions is
7:
8: -- AUXILIARIES :
9:
10: function Flt2Cmplx ( x : Standard_Floating_Vectors.Vector )
11: return Standard_Complex_Vectors.Vector is
12:
13: -- DESCRIPTION :
14: -- Returns a vector with complex entries.
15:
16: res : Standard_Complex_Vectors.Vector(x'range);
17:
18: begin
19: for i in x'range loop
20: res(i) := Create(x(i));
21: end loop;
22: return res;
23: end Flt2Cmplx;
24:
25: -- RANDOM FLOATING-POINT LIFTING :
26:
27: function Random_Lift ( lflow,lfupp : double_float ) return double_float is
28:
29: res : double_float := random; -- in [-1,1]
30:
31: begin
32: res := ((1.0+res)/2.0)*lflow + ((1.0-res)/2.0)*lfupp; -- in [lflow,lfupp]
33: return res;
34: end Random_Lift;
35:
36: function Random_Lift ( v : Vector; lflow,lfupp : double_float )
37: return Vector is
38:
39: res : Vector(v'first..v'last+1);
40:
41: begin
42: res(v'range) := v;
43: res(res'last) := Random_Lift(lflow,lfupp);
44: return res;
45: end Random_Lift;
46:
47: function Random_Lift ( l : List; lflow,lfupp : double_float ) return List is
48:
49: res,res_last : List;
50: tmp : List := l;
51:
52: begin
53: while not Is_Null(tmp) loop
54: Append(res,res_last,Random_Lift(Head_Of(tmp).all,lflow,lfupp));
55: tmp := Tail_Of(tmp);
56: end loop;
57: return res;
58: end Random_Lift;
59:
60: function Random_Lift ( l : Arrays_of_Floating_Vector_Lists.Array_of_Lists;
61: lflow,lfupp : Vector )
62: return Arrays_of_Floating_Vector_Lists.Array_of_Lists is
63:
64: res : Arrays_of_Floating_Vector_Lists.Array_of_Lists(l'range);
65:
66: begin
67: for i in res'range loop
68: res(i) := Random_Lift(l(i),lflow(i),lfupp(i));
69: end loop;
70: return res;
71: end Random_Lift;
72:
73: -- LINEAR LIFTING FUNCTIONS :
74:
75: function Linear_Lift ( x,v : Vector ) return Vector is
76:
77: res : Vector(x'first..x'last+1);
78:
79: begin
80: res(x'range) := x;
81: res(res'last) := x*v;
82: return res;
83: end Linear_Lift;
84:
85: function Linear_Lift ( f : Face; v : Vector ) return Face is
86:
87: res : Face := new VecVec(f'range);
88:
89: begin
90: for i in res'range loop
91: res(i) := new Standard_Floating_Vectors.Vector'(Linear_Lift(f(i).all,v));
92: end loop;
93: return res;
94: end Linear_Lift;
95:
96: function Linear_Lift ( l : List; v : Vector ) return List is
97:
98: -- DESCRIPTION :
99: -- Returns a linearly lifted list of points.
100:
101: res,res_last : List;
102: tmp : List := l;
103:
104: begin
105: while not Is_Null(tmp) loop
106: Append(res,res_last,Linear_Lift(Head_Of(tmp).all,v));
107: tmp := Tail_Of(tmp);
108: end loop;
109: return res;
110: end Linear_Lift;
111:
112: function Linear_Lift ( f : Faces; v : Vector ) return Faces is
113:
114: res,res_last : Faces;
115: tmp : Faces := f;
116:
117: begin
118: while not Is_Null(tmp) loop
119: Append(res,res_last,Linear_Lift(Head_Of(tmp),v));
120: tmp := Tail_Of(tmp);
121: end loop;
122: return res;
123: end Linear_Lift;
124:
125: -- RANDOM FLOATING-POINT LINEAR LIFTING :
126:
127: function Random ( n : natural; lflow,lfupp : double_float ) return Vector is
128:
129: res : Vector(1..n);
130:
131: begin
132: for i in res'range loop
133: res(i) := Random_Lift(lflow,lfupp);
134: end loop;
135: return res;
136: end Random;
137:
138: -- POLYNOMIAL LIFTING FUNCTIONS :
139:
140: function Polynomial_Lift ( lf : Poly; x : Vector ) return Vector is
141:
142: res : Vector(x'first..x'last+1);
143:
144: begin
145: res(x'range) := x;
146: res(res'last) := REAL_PART(Eval(lf,Flt2Cmplx(x)));
147: return res;
148: end Polynomial_Lift;
149:
150: function Polynomial_Lift ( lf : Eval_Poly; x : Vector ) return Vector is
151:
152: res : Vector(x'first..x'last+1);
153:
154: begin
155: res(x'range) := x;
156: res(res'last) := REAL_PART(Eval(lf,Flt2Cmplx(x)));
157: return res;
158: end Polynomial_Lift;
159:
160: function Polynomial_Lift ( lf : Poly; l : List ) return List is
161:
162: res,res_last,tmp : List;
163:
164: begin
165: tmp := l;
166: while not Is_Null(tmp) loop
167: Append(res,res_last,Polynomial_Lift(lf,Head_Of(tmp).all));
168: tmp := Tail_Of(tmp);
169: end loop;
170: return res;
171: end Polynomial_Lift;
172:
173: function Polynomial_Lift ( lf : Eval_Poly; l : List ) return List is
174:
175: res,res_last,tmp : List;
176:
177: begin
178: tmp := l;
179: while not Is_Null(tmp) loop
180: Append(res,res_last,Polynomial_Lift(lf,Head_Of(tmp).all));
181: tmp := Tail_Of(tmp);
182: end loop;
183: return res;
184: end Polynomial_Lift;
185:
186: function Polynomial_Lift ( lf : Poly_Sys; l : Array_of_Lists )
187: return Array_of_Lists is
188:
189: res : Array_of_Lists(l'range);
190:
191: begin
192: for i in res'range loop
193: res(i) := Polynomial_Lift(lf(i),l(i));
194: end loop;
195: return res;
196: end Polynomial_Lift;
197:
198: function Polynomial_Lift ( lf : Eval_Poly_Sys; l : Array_of_Lists )
199: return Array_of_Lists is
200:
201: res : Array_of_Lists(l'range);
202:
203: begin
204: for i in res'range loop
205: res(i) := Polynomial_Lift(lf(i),l(i));
206: end loop;
207: return res;
208: end Polynomial_Lift;
209:
210: end Floating_Lifting_Functions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to floating_lifting_functions.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Stalift