Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Stalift/floating_lifting_functions.adb, Revision 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>