Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Supports/floating_support_functions.adb, Revision 1.1.1.1
1.1 maekawa 1: package body Floating_Support_Functions is
2:
3: function Maximal_Support ( l : List; v : Vector ) return double_float is
4:
5: sp,max : double_float;
6: tmp : List;
7:
8: begin
9: if not Is_Null(l)
10: then max := Head_Of(l).all*v;
11: tmp := Tail_Of(l);
12: while not Is_Null(tmp) loop
13: sp := Head_Of(tmp).all*v;
14: if sp > max
15: then max := sp;
16: end if;
17: tmp := Tail_Of(tmp);
18: end loop;
19: return max;
20: else return 0.0;
21: end if;
22: end Maximal_Support;
23:
24: function Minimal_Support ( l : List; v : Vector ) return double_float is
25:
26: sp,min : double_float;
27: tmp : List;
28:
29: begin
30: if not Is_Null(l)
31: then min := Head_Of(l).all*v;
32: tmp := Tail_Of(l);
33: while not Is_Null(tmp) loop
34: sp := Head_Of(tmp).all*v;
35: if sp < min
36: then min := sp;
37: end if;
38: tmp := Tail_Of(tmp);
39: end loop;
40: return min;
41: else return 0.0;
42: end if;
43: end Minimal_Support;
44:
45: function Face ( l : List; v : Vector; m,tol : double_float ) return List is
46:
47: res,tmp,res_last : List;
48: d : Vector(v'range);
49:
50: begin
51: tmp := l;
52: while not Is_Null(tmp) loop
53: d := Head_Of(tmp).all;
54: if abs(d*v - m) < tol
55: then Append(res,res_last,d);
56: end if;
57: tmp := Tail_Of(tmp);
58: end loop;
59: return res;
60: end Face;
61:
62: end Floating_Support_Functions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>