├── .gitignore
├── .travis.yml
├── docs
├── index_classes.html
├── index_exceptions.html
├── index_extensions.html
├── index_class_types.html
├── index_methods.html
├── index_module_types.html
├── index_attributes.html
├── index_modules.html
├── index_types.html
├── index.html
├── style.css
├── type_Interval2.html
├── type_Interval1.html
├── Interval2.html
└── Interval1.html
├── Makefile
├── LICENSE
├── tests
├── Makefile
├── t_test_interval.ml
├── log2.txt
├── log2_opt.txt
├── log1.txt
├── log1_opt.txt
├── p_interval2.ml
├── p_interval1.ml
├── test.ml
└── test_interval.ml
├── README.md
├── interval1.mli
├── interval2.mli
├── interval1.ml
└── interval2.ml
/.gitignore:
--------------------------------------------------------------------------------
1 | *.annot
2 | *.cmo
3 | *.cma
4 | *.cmi
5 | *.a
6 | *.o
7 | *.cmx
8 | *.cmxs
9 | *.cmxa
10 |
11 | # ocamlbuild working directory
12 | _build/
13 |
14 | # ocamlbuild targets
15 | *.byte
16 | *.native
17 |
18 | # oasis generated files
19 | setup.data
20 | setup.log
21 |
22 | # tmp
23 | *~
24 | a.out
25 |
26 | # other
27 | p_interval1
28 | p_interval1_opt
29 | p_interval2
30 | p_interval2_opt
31 | t_interval1
32 | t_interval1_opt
33 | t_interval2
34 | t_interval2_opt
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | language: c
2 | sudo: required
3 | env:
4 | global:
5 | - TEST_SAMPLES=500
6 | - INSTALL_XQUARTZ=false
7 | matrix:
8 | - OCAML_VERSION=4.00
9 | - OCAML_VERSION=4.01
10 | - OCAML_VERSION=4.02
11 | - OCAML_VERSION=4.04
12 | - OCAML_VERSION=4.05
13 | os:
14 | - linux
15 | - osx
16 | git:
17 | depth: 1
18 | before_install:
19 | - wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-ocaml.sh
20 | install:
21 | - sh .travis-ocaml.sh
22 | script:
23 | - make test
24 |
--------------------------------------------------------------------------------
/docs/index_classes.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of classes
12 |
13 |
14 |
16 | Index of classes
17 |
19 |
20 |
--------------------------------------------------------------------------------
/docs/index_exceptions.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of exceptions
12 |
13 |
14 |
16 | Index of exceptions
17 |
19 |
20 |
--------------------------------------------------------------------------------
/docs/index_extensions.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of extensions
12 |
13 |
14 |
16 | Index of extensions
17 |
19 |
20 |
--------------------------------------------------------------------------------
/docs/index_class_types.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of class types
12 |
13 |
14 |
16 | Index of class types
17 |
19 |
20 |
--------------------------------------------------------------------------------
/docs/index_methods.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of class methods
12 |
13 |
14 |
16 | Index of class methods
17 |
19 |
20 |
--------------------------------------------------------------------------------
/docs/index_module_types.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of module types
12 |
13 |
14 |
16 | Index of module types
17 |
19 |
20 |
--------------------------------------------------------------------------------
/docs/index_attributes.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of class attributes
12 |
13 |
14 |
16 | Index of class attributes
17 |
19 |
20 |
--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
1 | ML = ocamlc
2 | OPT_ML = ocamlopt
3 |
4 | SRC= interval1.mli\
5 | interval1.ml\
6 | interval2.mli\
7 | interval2.ml
8 |
9 | OBJ_BYTE0 = $(SRC:.ml=.cmo)
10 | OBJ_BYTE = $(OBJ_BYTE0:.mli=.cmi)
11 |
12 | OBJ_NATIVE = $(OBJ_BYTE:.cmo=.cmx)
13 |
14 | .PHONY: all docs test clean
15 |
16 | all: interval.cma interval.cmxa
17 |
18 | docs: interval1.mli interval2.mli
19 | mkdir -p docs
20 | ocamldoc -d docs -html interval1.mli interval2.mli
21 |
22 | test: interval.cma interval.cmxa
23 | cd tests; $(MAKE)
24 |
25 | interval.cma: $(OBJ_BYTE)
26 | $(ML) -a -o interval.cma $(OBJ_BYTE0)
27 |
28 | interval.cmxa: $(OBJ_NATIVE)
29 | $(OPT_ML) -a -o interval.cmxa $(OBJ_BYTE0:.cmo=.cmx)
30 |
31 | %.cmi : %.mli
32 | $(ML) -c $^
33 |
34 | %.cmo : %.ml
35 | $(ML) -c $^
36 |
37 | %.cmx : %.ml
38 | $(OPT_ML) -c $^
39 |
40 | clean:
41 | rm -f *.cmo *.cmi *.cmx *.cma *.cmxa *.o *.a
42 | cd tests; $(MAKE) clean
43 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | MIT License
2 |
3 | Copyright (c) 2017 Alexey Solovyev
4 |
5 | Permission is hereby granted, free of charge, to any person obtaining a copy
6 | of this software and associated documentation files (the "Software"), to deal
7 | in the Software without restriction, including without limitation the rights
8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 |
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 |
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 | SOFTWARE.
22 |
--------------------------------------------------------------------------------
/docs/index_modules.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of modules
12 |
13 |
14 |
16 | Index of modules
17 |
18 | Interval1
21 | A simple OCaml interval library.
22 |
23 | Interval2
26 | A simple OCaml interval library.
27 |
28 |
30 |
31 |
--------------------------------------------------------------------------------
/docs/index_types.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Index of types
12 |
13 |
14 |
16 | Index of types
17 |
30 |
31 |
--------------------------------------------------------------------------------
/docs/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
23 | Interval1
24 | A simple OCaml interval library.
25 |
26 | Interval2
28 | A simple OCaml interval library.
29 |
30 |
32 |
33 |
--------------------------------------------------------------------------------
/tests/Makefile:
--------------------------------------------------------------------------------
1 | all: t_interval1 t_interval1_opt t_interval2 t_interval2_opt
2 | ./t_interval1
3 | ./t_interval1_opt
4 | ./t_interval2
5 | ./t_interval2_opt
6 |
7 | t_interval1:
8 | ocamlc -o t_interval1 -I .. nums.cma unix.cma \
9 | ../interval1.ml test_interval.ml test.ml t_interval1.ml
10 | ocamlc -o p_interval1 -I .. unix.cma \
11 | ../interval1.ml test.ml p_interval1.ml
12 |
13 | t_interval1_opt:
14 | ocamlopt -o t_interval1_opt -I .. nums.cmxa unix.cmxa \
15 | ../interval1.ml test_interval.ml test.ml t_interval1.ml
16 | ocamlopt -o p_interval1_opt -I .. unix.cmxa \
17 | ../interval1.ml test.ml p_interval1.ml
18 |
19 | t_interval2:
20 | ocamlc -o t_interval2 -I .. nums.cma unix.cma \
21 | ../interval2.ml test_interval.ml test.ml t_interval2.ml
22 | ocamlc -o p_interval2 -I .. nums.cma unix.cma \
23 | ../interval2.ml test.ml p_interval2.ml
24 |
25 | t_interval2_opt:
26 | ocamlopt -o t_interval2_opt -I .. nums.cmxa unix.cmxa \
27 | ../interval2.ml test_interval.ml test.ml t_interval2.ml
28 | ocamlopt -o p_interval2_opt -I .. nums.cmxa unix.cmxa \
29 | ../interval2.ml test.ml p_interval2.ml
30 |
31 | t_interval_tmp:
32 | ocamlc -o t_interval_tmp -I .. nums.cma unix.cma \
33 | ../interval_tmp.ml test_interval.ml test.ml t_interval_tmp.ml
34 |
35 | t_interval_tmp_opt:
36 | ocamlopt -o t_interval_tmp_opt -I .. nums.cmxa unix.cmxa \
37 | ../interval_tmp.ml test_interval.ml test.ml t_interval_tmp.ml
38 |
39 | clean:
40 | rm -f *.cmo *.cmi *.cmx *.o \
41 | t_interval1 t_interval2 t_interval_tmp \
42 | p_interval1 p_interval2 p_interval_tmp \
43 | t_interval1_opt t_interval2_opt t_interval_tmp_opt \
44 | p_interval1_opt p_interval2_opt p_interval_tmp_opt
45 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | [](https://travis-ci.org/monadius/ocaml_simple_interval)
2 |
3 | # ocaml_simple_interval
4 | A simple and (hopefully) portable floating-point interval arithmetic library in OCaml.
5 |
6 | Original repository: [https://github.com/monadius/ocaml_simple_interval](https://github.com/monadius/ocaml_simple_interval)
7 |
8 | ## References
9 |
10 | - S. Rump, P. Zimmermann, S. Boldo, G. Melquiond
11 | [*Computing predecessor and successor in rounding to nearest*](https://hal.inria.fr/inria-00337537/document)
12 | [(link2)](http://www.ti3.tuhh.de/paper/rump/RuZiBoMe09.pdf)
13 |
14 | - S. Rump, T. Ogita, Y. Morikura, S. Oishi
15 | [*Interval arithmetic with fixed rounding mode*](https://www.jstage.jst.go.jp/article/nolta/7/3/7_362/_pdf)
16 |
17 | - F. Goualard
18 | [*How do you compute the midpoint of an interval?*](https://hal.archives-ouvertes.fr/hal-00576641/document)
19 |
20 | - [*ValidatedNumerics.jl*](https://github.com/dpsanders/ValidatedNumerics.jl)
21 |
22 | - [*Java library for interval computations*](https://java.net/projects/jinterval)
23 |
24 | - S. Boldo,
25 | [*Dekker algorithm: error of the multiplication*](https://www.lri.fr/~sboldo/progs/Dekker.c.html).
26 | See also S. Boldo, C. Marché,
27 | [*Formal verification of numerical programs: from C annotated programs to mechanical proofs*](https://hal.inria.fr/hal-00777605/document)
28 |
29 | # Interval1
30 |
31 | [`Interval1`](interval1.mli) is a simple OCaml interval arithmetic
32 | library which does not depend on any external files and libraries. It
33 | uses the standard rounding to nearest floating-point operations to
34 | compute rigorous interval enclosures of mathematical operations. These
35 | interval enclosures may be not optimal floating-point intervals but in
36 | most cases the error is no more than 1 ulp for each interval endpoint.
37 |
38 | # Interval2
39 |
40 | [`Interval2`](interval2.mli) is another simple OCaml interval
41 | arithmetic library. It computes optimal floating-point intervals for
42 | basic arithmetic operations. In some cases, it performs computations
43 | with rational arithmetic. This library is slower than `Interval1` but
44 | it may be used in cases when optimal intervals are required (for
45 | instance, when point intervals play an important role or when
46 | discontinuous functions are considered).
47 |
48 | # Docs
49 |
50 | See the [docs](docs) directory.
51 |
52 | # Tests
53 |
54 | See the [tests](tests) directory.
55 |
--------------------------------------------------------------------------------
/docs/style.css:
--------------------------------------------------------------------------------
1 | .keyword { font-weight : bold ; color : Red }
2 | .keywordsign { color : #C04600 }
3 | .superscript { font-size : 4 }
4 | .subscript { font-size : 4 }
5 | .comment { color : Green }
6 | .constructor { color : Blue }
7 | .type { color : #5C6585 }
8 | .string { color : Maroon }
9 | .warning { color : Red ; font-weight : bold }
10 | .info { margin-left : 3em; margin-right: 3em }
11 | .param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }
12 | .code { color : #465F91 ; }
13 | .typetable { border-style : hidden }
14 | .paramstable { border-style : hidden ; padding: 5pt 5pt}
15 | tr { background-color : White }
16 | td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}
17 | div.sig_block {margin-left: 2em}
18 | *:target { background: yellow; }
19 | body {font: 13px sans-serif; color: black; text-align: left; padding: 5px; margin: 0}
20 | h1 { font-size : 20pt ; text-align: center; }
21 | h2 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ;padding: 2px; }
22 | h3 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90DDFF ;padding: 2px; }
23 | h4 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90EDFF ;padding: 2px; }
24 | h5 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90FDFF ;padding: 2px; }
25 | h6 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ; padding: 2px; }
26 | div.h7 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #E0FFFF ; padding: 2px; }
27 | div.h8 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #F0FFFF ; padding: 2px; }
28 | div.h9 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #FFFFFF ; padding: 2px; }
29 | a {color: #416DFF; text-decoration: none}
30 | a:hover {background-color: #ddd; text-decoration: underline}
31 | pre { margin-bottom: 4px; font-family: monospace; }
32 | pre.verbatim, pre.codepre { }
33 | .indextable {border: 1px #ddd solid; border-collapse: collapse}
34 | .indextable td, .indextable th {border: 1px #ddd solid; min-width: 80px}
35 | .indextable td.module {background-color: #eee ; padding-left: 2px; padding-right: 2px}
36 | .indextable td.module a {color: 4E6272; text-decoration: none; display: block; width: 100%}
37 | .indextable td.module a:hover {text-decoration: underline; background-color: transparent}
38 | .deprecated {color: #888; font-style: italic}
39 | .indextable tr td div.info { margin-left: 2px; margin-right: 2px }
40 | ul.indexlist { margin-left: 0; padding-left: 0;}
41 | ul.indexlist li { list-style-type: none ; margin-left: 0; padding-left: 0; }
--------------------------------------------------------------------------------
/tests/t_test_interval.ml:
--------------------------------------------------------------------------------
1 | open Num
2 | open Test
3 | open Test_interval
4 |
5 | (* let () = Random.self_init () *)
6 |
7 | let samples = 1000
8 |
9 | (* next_float tests *)
10 |
11 | let test_next_float x =
12 | let y = next_float x in
13 | ignore begin
14 | match classify_float x with
15 | | FP_nan ->
16 | fact ("nan", is_nan y)
17 | | FP_infinite ->
18 | if x = neg_infinity then
19 | fact ("neg_infinity", is_nan y)
20 | else
21 | fact ("infinity", y = infinity)
22 | | FP_zero | FP_normal | FP_subnormal ->
23 | let d = y -. x in
24 | fact ("mono", y > x);
25 | fact ("pos", d > 0.0);
26 | fact ("eq", x +. d = y);
27 | if x < max_float then fact ("small", x +. d *. 0.25 = x);
28 | end;
29 | true
30 |
31 | let () =
32 | let eta_float = ldexp 1.0 (-1074) in
33 | (* Tests with special values *)
34 | run_eq_f "next_float (eq)" next_float [
35 | -.0.0, eta_float;
36 | 0.0, eta_float;
37 | min_float, min_float +. eta_float;
38 | min_float -. eta_float, min_float;
39 | -.min_float, -.(min_float -. eta_float);
40 | eta_float, 2.0 *. eta_float;
41 | -.eta_float, 0.0;
42 | 1.0, 1.0 +. epsilon_float;
43 | 1.0 -. epsilon_float *. 0.5, 1.0;
44 | -1.0, -.(1.0 -. epsilon_float *. 0.5);
45 | max_float, infinity;
46 | infinity, infinity;
47 | nan, nan;
48 | neg_infinity, nan;
49 | ];
50 |
51 | (* Tests with special data *)
52 | run_test (test_f "next_float (special)" test_next_float)
53 | (special_data_f ());
54 |
55 | (* Tests with randomly generated data *)
56 | run_test (test_f "next_float" test_next_float)
57 | (standard_data_f ~n:samples ~sign:0)
58 |
59 | (* prev_float tests *)
60 |
61 | let test_prev_float x =
62 | let y = prev_float x in
63 | ignore begin
64 | match classify_float x with
65 | | FP_nan ->
66 | fact ("nan", is_nan y)
67 | | FP_infinite ->
68 | if x = neg_infinity then
69 | fact ("neg_infinity", y = neg_infinity)
70 | else
71 | fact ("infinity", is_nan y)
72 | | FP_zero | FP_normal | FP_subnormal ->
73 | let d = x -. y in
74 | fact ("mono", y < x);
75 | fact ("positive", d > 0.0);
76 | fact ("eq", x -. d = y);
77 | if x > -.max_float then fact ("small", x -. d *. 0.25 = x);
78 | end;
79 | true
80 |
81 | let () =
82 | let eta_float = ldexp 1.0 (-1074) in
83 | (* Tests with special values *)
84 | run_eq_f "prev_float (eq)" prev_float [
85 | -.0.0, -.eta_float;
86 | 0.0, -.eta_float;
87 | min_float, min_float -. eta_float;
88 | min_float +. eta_float, min_float;
89 | -.min_float, -.(min_float +. eta_float);
90 | eta_float, 0.0;
91 | -.eta_float, -2.0 *. eta_float;
92 | 1.0, 1.0 -. 0.5 *. epsilon_float;
93 | 1.0 -. epsilon_float *. 0.5, 1.0 -. epsilon_float;
94 | -1.0, -.(1.0 +. epsilon_float);
95 | -.max_float, neg_infinity;
96 | infinity, nan;
97 | nan, nan;
98 | neg_infinity, neg_infinity;
99 | ];
100 |
101 | (* Tests with special data *)
102 | run_test (test_f "prev_float (special)" test_prev_float)
103 | (special_data_f ());
104 |
105 | (* Tests with randomly generated data *)
106 | run_test (test_f "prev_float" test_prev_float)
107 | (standard_data_f ~n:samples ~sign:0)
108 |
109 | (* num_of_float and float_of_num_lo(hi) tests *)
110 |
111 | let test_num_float x =
112 | let r = num_of_float x in
113 | let r1 = Num.pred_num r and
114 | r2 = Num.succ_num r in
115 | let a = float_of_num_lo r and
116 | b = float_of_num_hi r and
117 | a1 = float_of_num_lo r1 and
118 | b1 = float_of_num_hi r1 and
119 | a2 = float_of_num_lo r2 and
120 | b2 = float_of_num_hi r2 in
121 | ignore begin
122 | fact ("eq", a = x && b = x);
123 | fact ("le", a1 < x && b1 <= x);
124 | fact ("ge", a2 >= x && b2 > x);
125 | if b1 = x then fact ("eq_prev", a1 = prev_float x);
126 | if a2 = x then fact ("eq_next", b2 = next_float x);
127 | end;
128 | true
129 |
130 | let () =
131 | let eta_float = ldexp 1.0 (-1074) in
132 | (* Tests with special values *)
133 | run_eq_f "num_of_float (eq)" ~cmp:compare_num num_of_float [
134 | -.0.0, Int 0;
135 | 0.0, Int 0;
136 | eta_float, Int 2 **/ Int (-1074);
137 | -2.0 *. eta_float, Int (-2) **/ Int (-1073);
138 | 1.0, Int 1;
139 | -1.5, Int (-3) // Int 2;
140 | ];
141 |
142 | (* Tests with randomly generated data *)
143 | run_test (test_f "test_num_float" test_num_float)
144 | (standard_data_f ~n:samples ~sign:0)
145 |
--------------------------------------------------------------------------------
/tests/log2.txt:
--------------------------------------------------------------------------------
1 | benchmark samples n mean sigma overhead
2 | empty 10000 10 0.00028 0.00007 0.00028
3 | empty2 10000 10 0.00044 0.00005 0.00044
4 | fsucc 10000 10 0.00054 0.00002 0.00026
5 | fpred 10000 10 0.00072 0.00037 0.00044
6 | +. 10000 10 0.00046 0.00003 0.00046
7 | fadd_low 10000 10 0.00103 0.00012 0.00057
8 | fadd_high 10000 10 0.00098 0.00000 0.00051
9 | -. 10000 10 0.00046 0.00003 0.00046
10 | fsub_low 10000 10 0.00111 0.00001 0.00065
11 | fsub_high 10000 10 0.00113 0.00009 0.00067
12 | *. 10000 10 0.00047 0.00006 0.00047
13 | fmul_low 10000 10 0.00270 0.00017 0.00223
14 | fmul_high 10000 10 0.00271 0.00007 0.00224
15 | /. 10000 10 0.00045 0.00000 0.00045
16 | fdiv_low 10000 10 0.00395 0.00005 0.00350
17 | fdiv_high 10000 10 0.00394 0.00006 0.00349
18 | sqr 10000 10 0.00031 0.00002 0.00031
19 | fsqr_low 10000 10 0.00171 0.00006 0.00141
20 | fsqr_high 10000 10 0.00181 0.00004 0.00150
21 | sqrt 10000 10 0.00027 0.00000 0.00027
22 | fsqrt_low 10000 10 0.00233 0.00013 0.00206
23 | fsqrt_high 10000 10 0.00226 0.00003 0.00198
24 | exp 10000 10 0.00039 0.00000 0.00039
25 | fexp_low 10000 10 0.00078 0.00011 0.00039
26 | fexp_high 10000 10 0.00070 0.00000 0.00031
27 | log 10000 10 0.00034 0.00001 0.00034
28 | flog_low 10000 10 0.00079 0.00001 0.00045
29 | flog_high 10000 10 0.00079 0.00002 0.00045
30 | atan 10000 10 0.00056 0.00000 0.00056
31 | fatan_low 10000 10 0.00094 0.00001 0.00038
32 | fatan_high 10000 10 0.00099 0.00013 0.00044
33 | x^2 10000 10 0.00065 0.00004 0.00065
34 | fpown_low(2) 10000 10 0.00194 0.00017 0.00130
35 | fpown_high(2) 10000 10 0.00205 0.00014 0.00140
36 | x^3 10000 10 0.00064 0.00001 0.00064
37 | fpown_low(3) 10000 10 0.93770 0.00180 0.93706
38 | fpown_high(3) 10000 10 0.94191 0.01058 0.94126
39 | x^(-2) 10000 10 0.00066 0.00003 0.00066
40 | fpown_low(-2) 10000 10 0.79430 0.00121 0.79364
41 | fpown_high(-2) 10000 10 0.80409 0.00103 0.80344
42 | x^(-3) 10000 10 0.00064 0.00001 0.00064
43 | fpown_low(-3) 10000 10 0.97141 0.00189 0.97077
44 | fpown_high(-3) 10000 10 0.97558 0.00796 0.97494
45 |
46 | benchmark samples n mean sigma overhead
47 | empty 10000 10 0.00022 0.00000 0.00022
48 | mid_i 10000 10 0.00071 0.00001 0.00049
49 | neg_i 10000 10 0.00042 0.00000 0.00020
50 | abs_i 10000 10 0.00095 0.00003 0.00073
51 | *test*: add_ii 10000 10 0.00067 0.00001 0.00067
52 | add_ii 10000 10 0.00243 0.00004 0.00176
53 | add_id 10000 10 0.00215 0.00005 0.00148
54 | add_di 10000 10 0.00219 0.00011 0.00151
55 | *test*: sub_ii 10000 10 0.00067 0.00002 0.00067
56 | sub_ii 10000 10 0.00288 0.00002 0.00220
57 | sub_id 10000 10 0.00261 0.00003 0.00194
58 | sub_di 10000 10 0.00263 0.00005 0.00196
59 | *test*: mul_ii 10000 10 0.00082 0.00005 0.00082
60 | mul_ii 10000 10 0.00811 0.00017 0.00728
61 | mul_id 10000 10 0.00590 0.00003 0.00507
62 | mul_di 10000 10 0.00593 0.00005 0.00511
63 | *test*: div_ii 10000 10 0.00069 0.00003 0.00069
64 | div_ii 10000 10 0.00515 0.00003 0.00446
65 | div_id 10000 10 0.00821 0.00006 0.00752
66 | div_di 10000 10 0.00577 0.00022 0.00507
67 | *test*: inv_i 10000 10 0.00050 0.00010 0.00050
68 | inv_i 10000 10 0.00445 0.00017 0.00395
69 | *test*: sqr_i 10000 10 0.00045 0.00001 0.00045
70 | sqr_i 10000 10 0.00348 0.00005 0.00303
71 | *test*: sqrt_i 10000 10 0.00042 0.00000 0.00042
72 | sqrt_i 10000 10 0.00412 0.00017 0.00371
73 | *test*: exp_i 10000 10 0.00061 0.00001 0.00061
74 | exp_i 10000 10 0.00167 0.00017 0.00106
75 | *test*: log_i 10000 10 0.00058 0.00001 0.00058
76 | log_i 10000 10 0.00178 0.00002 0.00119
77 | *test*: atan_i 10000 10 0.00085 0.00000 0.00085
78 | atan_i 10000 10 0.00194 0.00003 0.00110
79 | *test*: x^2 10000 10 0.00124 0.00003 0.00124
80 | pown_i(2) 10000 10 0.00404 0.00017 0.00280
81 | *test*: x^3 10000 10 0.00125 0.00005 0.00125
82 | pown_i(3) 10000 10 1.88934 0.00246 1.88809
83 | *test*: x^(-2) 10000 10 0.00125 0.00004 0.00125
84 | pown_i(-2) 10000 10 1.21381 0.01080 1.21256
85 | *test*: x^(-3) 10000 10 0.00124 0.00002 0.00124
86 | pown_i(-3) 10000 10 0.97121 0.00160 0.96997
87 |
--------------------------------------------------------------------------------
/tests/log2_opt.txt:
--------------------------------------------------------------------------------
1 | benchmark samples n mean sigma overhead
2 | empty 10000 10 0.00004 0.00000 0.00004
3 | empty2 10000 10 0.00005 0.00000 0.00005
4 | fsucc 10000 10 0.00005 0.00000 0.00001
5 | fpred 10000 10 0.00005 0.00000 0.00001
6 | +. 10000 10 0.00006 0.00000 0.00006
7 | fadd_low 10000 10 0.00015 0.00001 0.00010
8 | fadd_high 10000 10 0.00016 0.00002 0.00010
9 | -. 10000 10 0.00005 0.00000 0.00005
10 | fsub_low 10000 10 0.00017 0.00000 0.00012
11 | fsub_high 10000 10 0.00017 0.00000 0.00012
12 | *. 10000 10 0.00005 0.00000 0.00005
13 | fmul_low 10000 10 0.00024 0.00000 0.00019
14 | fmul_high 10000 10 0.00025 0.00001 0.00020
15 | /. 10000 10 0.00005 0.00000 0.00005
16 | fdiv_low 10000 10 0.00050 0.00004 0.00044
17 | fdiv_high 10000 10 0.00048 0.00000 0.00043
18 | sqr 10000 10 0.00004 0.00000 0.00004
19 | fsqr_low 10000 10 0.00021 0.00000 0.00017
20 | fsqr_high 10000 10 0.00024 0.00005 0.00019
21 | sqrt 10000 10 0.00005 0.00001 0.00005
22 | fsqrt_low 10000 10 0.00037 0.00000 0.00033
23 | fsqrt_high 10000 10 0.00037 0.00000 0.00033
24 | exp 10000 10 0.00015 0.00000 0.00015
25 | fexp_low 10000 10 0.00019 0.00003 0.00004
26 | fexp_high 10000 10 0.00018 0.00000 0.00003
27 | log 10000 10 0.00011 0.00001 0.00011
28 | flog_low 10000 10 0.00015 0.00000 0.00004
29 | flog_high 10000 10 0.00015 0.00000 0.00004
30 | atan 10000 10 0.00024 0.00001 0.00024
31 | fatan_low 10000 10 0.00028 0.00001 0.00004
32 | fatan_high 10000 10 0.00028 0.00000 0.00004
33 | x^2 10000 10 0.00039 0.00000 0.00039
34 | fpown_low(2) 10000 10 0.00022 0.00000 -0.00017
35 | fpown_high(2) 10000 10 0.00022 0.00000 -0.00017
36 | x^3 10000 10 0.00041 0.00003 0.00041
37 | fpown_low(3) 10000 10 0.35867 0.00138 0.35827
38 | fpown_high(3) 10000 10 0.36483 0.01232 0.36442
39 | x^(-2) 10000 10 0.00039 0.00001 0.00039
40 | fpown_low(-2) 10000 10 0.27738 0.00095 0.27699
41 | fpown_high(-2) 10000 10 0.27783 0.00098 0.27744
42 | x^(-3) 10000 10 0.00039 0.00000 0.00039
43 | fpown_low(-3) 10000 10 0.37389 0.00139 0.37350
44 | fpown_high(-3) 10000 10 0.37358 0.00126 0.37319
45 |
46 | benchmark samples n mean sigma overhead
47 | empty 10000 10 0.00003 0.00000 0.00003
48 | mid_i 10000 10 0.00006 0.00000 0.00003
49 | neg_i 10000 10 0.00006 0.00000 0.00003
50 | abs_i 10000 10 0.00025 0.00003 0.00022
51 | *test*: add_ii 10000 10 0.00007 0.00001 0.00007
52 | add_ii 10000 10 0.00038 0.00001 0.00031
53 | add_id 10000 10 0.00035 0.00000 0.00028
54 | add_di 10000 10 0.00035 0.00000 0.00028
55 | *test*: sub_ii 10000 10 0.00007 0.00001 0.00007
56 | sub_ii 10000 10 0.00038 0.00001 0.00031
57 | sub_id 10000 10 0.00037 0.00000 0.00030
58 | sub_di 10000 10 0.00038 0.00004 0.00031
59 | *test*: mul_ii 10000 10 0.00007 0.00001 0.00007
60 | mul_ii 10000 10 0.00096 0.00002 0.00089
61 | mul_id 10000 10 0.00061 0.00000 0.00054
62 | mul_di 10000 10 0.00061 0.00002 0.00054
63 | *test*: div_ii 10000 10 0.00007 0.00001 0.00007
64 | div_ii 10000 10 0.00062 0.00012 0.00055
65 | div_id 10000 10 0.00094 0.00001 0.00087
66 | div_di 10000 10 0.00057 0.00001 0.00050
67 | *test*: inv_i 10000 10 0.00005 0.00000 0.00005
68 | inv_i 10000 10 0.00052 0.00011 0.00047
69 | *test*: sqr_i 10000 10 0.00005 0.00000 0.00005
70 | sqr_i 10000 10 0.00056 0.00000 0.00051
71 | *test*: sqrt_i 10000 10 0.00013 0.00001 0.00013
72 | sqrt_i 10000 10 0.00067 0.00001 0.00054
73 | *test*: exp_i 10000 10 0.00022 0.00000 0.00022
74 | exp_i 10000 10 0.00037 0.00000 0.00015
75 | *test*: log_i 10000 10 0.00024 0.00007 0.00024
76 | log_i 10000 10 0.00033 0.00000 0.00009
77 | *test*: atan_i 10000 10 0.00036 0.00000 0.00036
78 | atan_i 10000 10 0.00055 0.00001 0.00019
79 | *test*: x^2 10000 10 0.00066 0.00001 0.00066
80 | pown_i(2) 10000 10 0.00066 0.00012 0.00001
81 | *test*: x^3 10000 10 0.00066 0.00000 0.00066
82 | pown_i(3) 10000 10 0.71876 0.00126 0.71811
83 | *test*: x^(-2) 10000 10 0.00067 0.00003 0.00067
84 | pown_i(-2) 10000 10 0.41871 0.00139 0.41805
85 | *test*: x^(-3) 10000 10 0.00066 0.00000 0.00066
86 | pown_i(-3) 10000 10 0.37928 0.00830 0.37862
87 |
--------------------------------------------------------------------------------
/tests/log1.txt:
--------------------------------------------------------------------------------
1 | benchmark samples n mean sigma overhead
2 | empty 1000000 10 0.02770 0.01043 0.02770
3 | empty2 1000000 10 0.03965 0.00064 0.03965
4 | fsucc 1000000 10 0.04742 0.00039 0.01972
5 | fpred 1000000 10 0.04763 0.00065 0.01993
6 | +. 1000000 10 0.04664 0.00057 0.04664
7 | fadd_low 1000000 10 0.09141 0.00053 0.04478
8 | fadd_high 1000000 10 0.09211 0.00067 0.04548
9 | -. 1000000 10 0.04602 0.00027 0.04602
10 | fsub_low 1000000 10 0.09171 0.00048 0.04569
11 | fsub_high 1000000 10 0.09224 0.00090 0.04623
12 | *. 1000000 10 0.04651 0.00038 0.04651
13 | fmul_low 1000000 10 0.10609 0.00047 0.05958
14 | fmul_high 1000000 10 0.10597 0.00044 0.05947
15 | /. 1000000 10 0.04671 0.00049 0.04671
16 | fdiv_low 1000000 10 0.09864 0.00109 0.05194
17 | fdiv_high 1000000 10 0.09883 0.00084 0.05213
18 | sqr 1000000 10 0.03016 0.00023 0.03016
19 | fsqr_low 1000000 10 0.07350 0.00057 0.04334
20 | fsqr_high 1000000 10 0.06525 0.00090 0.03509
21 | sqrt 1000000 10 0.02772 0.00016 0.02772
22 | fsqrt_low 1000000 10 0.07236 0.00051 0.04464
23 | fsqrt_high 1000000 10 0.06791 0.00986 0.04019
24 | exp 1000000 10 0.03974 0.00025 0.03974
25 | fexp_low 1000000 10 0.07603 0.00062 0.03629
26 | fexp_high 1000000 10 0.06985 0.00096 0.03011
27 | log 1000000 10 0.03424 0.00049 0.03424
28 | flog_low 1000000 10 0.07725 0.00059 0.04301
29 | flog_high 1000000 10 0.07723 0.00070 0.04299
30 | atan 1000000 10 0.05729 0.00041 0.05729
31 | fatan_low 1000000 10 0.09617 0.00062 0.03887
32 | fatan_high 1000000 10 0.09597 0.00070 0.03868
33 | x^2 1000000 10 0.06528 0.00070 0.06528
34 | fpown_low(2) 1000000 10 0.09409 0.00063 0.02881
35 | fpown_high(2) 1000000 10 0.08685 0.00045 0.02157
36 | x^3 1000000 10 0.06478 0.00051 0.06478
37 | fpown_low(3) 1000000 10 0.25235 0.00182 0.18756
38 | fpown_high(3) 1000000 10 0.24688 0.00102 0.18209
39 | x^(-2) 1000000 10 0.06585 0.00159 0.06585
40 | fpown_low(-2) 1000000 10 0.20540 0.00080 0.13955
41 | fpown_high(-2) 1000000 10 0.22608 0.00107 0.16023
42 | x^(-3) 1000000 10 0.06499 0.00057 0.06499
43 | fpown_low(-3) 1000000 10 0.35402 0.00129 0.28903
44 | fpown_high(-3) 1000000 10 0.34564 0.00095 0.28065
45 |
46 | benchmark samples n mean sigma overhead
47 | empty 1000000 10 0.02261 0.00021 0.02261
48 | mid_i_fast 1000000 10 0.04242 0.00044 0.01982
49 | mid_i 1000000 10 0.07288 0.00067 0.05028
50 | neg_i 1000000 10 0.04459 0.00028 0.02198
51 | abs_i 1000000 10 0.06943 0.00491 0.04682
52 | *test*: add_ii 1000000 10 0.06959 0.00054 0.06959
53 | add_ii 1000000 10 0.20975 0.00157 0.14017
54 | add_id 1000000 10 0.19837 0.00084 0.12878
55 | add_di 1000000 10 0.19624 0.00107 0.12665
56 | *test*: sub_ii 1000000 10 0.06976 0.00076 0.06976
57 | sub_ii 1000000 10 0.20970 0.00106 0.13993
58 | sub_id 1000000 10 0.20005 0.00236 0.13028
59 | sub_di 1000000 10 0.22009 0.00127 0.15033
60 | *test*: mul_ii 1000000 10 0.07037 0.00058 0.07037
61 | mul_ii 1000000 10 0.28831 0.00155 0.21794
62 | mul_id 1000000 10 0.25470 0.00146 0.18434
63 | mul_di 1000000 10 0.26183 0.00130 0.19147
64 | *test*: div_ii 1000000 10 0.06971 0.00097 0.06971
65 | div_ii 1000000 10 0.20905 0.00196 0.13935
66 | div_id 1000000 10 0.24034 0.00120 0.17064
67 | div_di 1000000 10 0.19208 0.00881 0.12237
68 | *test*: inv_i 1000000 10 0.04687 0.00052 0.04687
69 | inv_i 1000000 10 0.14517 0.00121 0.09830
70 | *test*: sqr_i 1000000 10 0.04652 0.00046 0.04652
71 | sqr_i 1000000 10 0.14969 0.00112 0.10316
72 | *test*: sqrt_i 1000000 10 0.04810 0.00045 0.04810
73 | sqrt_i 1000000 10 0.14025 0.00091 0.09215
74 | *test*: exp_i 1000000 10 0.06316 0.00070 0.06316
75 | exp_i 1000000 10 0.15119 0.00208 0.08803
76 | *test*: log_i 1000000 10 0.06766 0.00111 0.06766
77 | log_i 1000000 10 0.16333 0.00093 0.09567
78 | *test*: atan_i 1000000 10 0.08827 0.00072 0.08827
79 | atan_i 1000000 10 0.19972 0.00159 0.11146
80 | *test*: x^2 1000000 10 0.12782 0.00086 0.12782
81 | pown_i(2) 1000000 10 0.18920 0.00449 0.06138
82 | *test*: x^3 1000000 10 0.12798 0.00082 0.12798
83 | pown_i(3) 1000000 10 0.50952 0.00092 0.38153
84 | *test*: x^(-2) 1000000 10 0.12815 0.00104 0.12815
85 | pown_i(-2) 1000000 10 0.40901 0.00124 0.28086
86 | *test*: x^(-3) 1000000 10 0.12823 0.00086 0.12823
87 | pown_i(-3) 1000000 10 0.42399 0.00874 0.29576
88 |
--------------------------------------------------------------------------------
/tests/log1_opt.txt:
--------------------------------------------------------------------------------
1 | benchmark samples n mean sigma overhead
2 | empty 1000000 10 0.00383 0.00009 0.00383
3 | empty2 1000000 10 0.00503 0.00040 0.00503
4 | fsucc 1000000 10 0.00490 0.00027 0.00107
5 | fpred 1000000 10 0.00496 0.00021 0.00113
6 | +. 1000000 10 0.00799 0.00083 0.00799
7 | fadd_low 1000000 10 0.01030 0.00058 0.00231
8 | fadd_high 1000000 10 0.01017 0.00028 0.00218
9 | -. 1000000 10 0.00800 0.00074 0.00800
10 | fsub_low 1000000 10 0.01009 0.00018 0.00209
11 | fsub_high 1000000 10 0.01006 0.00021 0.00206
12 | *. 1000000 10 0.00740 0.00004 0.00740
13 | fmul_low 1000000 10 0.01079 0.00035 0.00339
14 | fmul_high 1000000 10 0.01106 0.00023 0.00366
15 | /. 1000000 10 0.00757 0.00015 0.00757
16 | fdiv_low 1000000 10 0.01061 0.00006 0.00303
17 | fdiv_high 1000000 10 0.01072 0.00021 0.00315
18 | sqr 1000000 10 0.00419 0.00009 0.00419
19 | fsqr_low 1000000 10 0.00763 0.00011 0.00343
20 | fsqr_high 1000000 10 0.00686 0.00023 0.00267
21 | sqrt 1000000 10 0.00431 0.00021 0.00431
22 | fsqrt_low 1000000 10 0.00796 0.00025 0.00365
23 | fsqrt_high 1000000 10 0.00721 0.00026 0.00290
24 | exp 1000000 10 0.01539 0.00027 0.01539
25 | fexp_low 1000000 10 0.01853 0.00021 0.00313
26 | fexp_high 1000000 10 0.01782 0.00024 0.00242
27 | log 1000000 10 0.01156 0.00032 0.01156
28 | flog_low 1000000 10 0.01509 0.00034 0.00353
29 | flog_high 1000000 10 0.01504 0.00028 0.00348
30 | atan 1000000 10 0.02453 0.00021 0.02453
31 | fatan_low 1000000 10 0.02855 0.00043 0.00402
32 | fatan_high 1000000 10 0.02850 0.00041 0.00397
33 | x^2 1000000 10 0.03967 0.00078 0.03967
34 | fpown_low(2) 1000000 10 0.00990 0.00005 -0.02977
35 | fpown_high(2) 1000000 10 0.00891 0.00022 -0.03075
36 | x^3 1000000 10 0.03950 0.00041 0.03950
37 | fpown_low(3) 1000000 10 0.02555 0.00025 -0.01395
38 | fpown_high(3) 1000000 10 0.02537 0.00027 -0.01412
39 | x^(-2) 1000000 10 0.03946 0.00045 0.03946
40 | fpown_low(-2) 1000000 10 0.01822 0.00026 -0.02124
41 | fpown_high(-2) 1000000 10 0.02179 0.00029 -0.01768
42 | x^(-3) 1000000 10 0.03970 0.00068 0.03970
43 | fpown_low(-3) 1000000 10 0.03315 0.00033 -0.00655
44 | fpown_high(-3) 1000000 10 0.03388 0.00032 -0.00582
45 |
46 | benchmark samples n mean sigma overhead
47 | empty 1000000 10 0.00301 0.00005 0.00301
48 | mid_i_fast 1000000 10 0.00533 0.00026 0.00232
49 | mid_i 1000000 10 0.00684 0.00073 0.00383
50 | neg_i 1000000 10 0.00653 0.00025 0.00353
51 | abs_i 1000000 10 0.01482 0.00022 0.01181
52 | *test*: add_ii 1000000 10 0.00932 0.00051 0.00932
53 | add_ii 1000000 10 0.02357 0.00105 0.01425
54 | add_id 1000000 10 0.02284 0.00256 0.01352
55 | add_di 1000000 10 0.02218 0.00201 0.01286
56 | *test*: sub_ii 1000000 10 0.00883 0.00029 0.00883
57 | sub_ii 1000000 10 0.02273 0.00010 0.01390
58 | sub_id 1000000 10 0.02109 0.00032 0.01226
59 | sub_di 1000000 10 0.02095 0.00039 0.01211
60 | *test*: mul_ii 1000000 10 0.00873 0.00006 0.00873
61 | mul_ii 1000000 10 0.03855 0.00045 0.02982
62 | mul_id 1000000 10 0.02885 0.00028 0.02012
63 | mul_di 1000000 10 0.03025 0.00233 0.02152
64 | *test*: div_ii 1000000 10 0.00910 0.00069 0.00910
65 | div_ii 1000000 10 0.02710 0.00051 0.01800
66 | div_id 1000000 10 0.02894 0.00032 0.01984
67 | div_di 1000000 10 0.02614 0.00133 0.01704
68 | *test*: inv_i 1000000 10 0.00663 0.00021 0.00663
69 | inv_i 1000000 10 0.01981 0.00018 0.01319
70 | *test*: sqr_i 1000000 10 0.00662 0.00026 0.00662
71 | sqr_i 1000000 10 0.02328 0.00093 0.01665
72 | *test*: sqrt_i 1000000 10 0.01388 0.00025 0.01388
73 | sqrt_i 1000000 10 0.02185 0.00072 0.00798
74 | *test*: exp_i 1000000 10 0.02320 0.00079 0.02320
75 | exp_i 1000000 10 0.03509 0.00053 0.01189
76 | *test*: log_i 1000000 10 0.02075 0.00020 0.02075
77 | log_i 1000000 10 0.03272 0.00037 0.01197
78 | *test*: atan_i 1000000 10 0.03768 0.00038 0.03768
79 | atan_i 1000000 10 0.05569 0.00050 0.01801
80 | *test*: x^2 1000000 10 0.06771 0.00065 0.06771
81 | pown_i(2) 1000000 10 0.02412 0.00034 -0.04359
82 | *test*: x^3 1000000 10 0.06726 0.00055 0.06726
83 | pown_i(3) 1000000 10 0.04720 0.00088 -0.02006
84 | *test*: x^(-2) 1000000 10 0.06792 0.00060 0.06792
85 | pown_i(-2) 1000000 10 0.04373 0.00062 -0.02419
86 | *test*: x^(-3) 1000000 10 0.06752 0.00046 0.06752
87 | pown_i(-3) 1000000 10 0.04030 0.00043 -0.02722
88 |
--------------------------------------------------------------------------------
/interval1.mli:
--------------------------------------------------------------------------------
1 | (* ========================================================================== *)
2 | (* A simple OCaml interval library *)
3 | (* https://github.com/monadius/ocaml_simple_interval *)
4 | (* *)
5 | (* Author: Alexey Solovyev *)
6 | (* https://github.com/monadius *)
7 | (* *)
8 | (* This file is distributed under the terms of the MIT license *)
9 | (* ========================================================================== *)
10 |
11 | (** A simple OCaml interval library.
12 |
13 | This interval library does not depend on any external files and libraries.
14 |
15 | It is assumed that all floating-point operations are IEEE 754
16 | compatible and the rounding mode is to nearest.
17 |
18 | It is also assumed that OCaml functions [exp], [log], [atan] compute results with
19 | less than 1 ulp error.
20 |
21 | Intervals computed with this library may be not the optimal
22 | floating-point intervals. But the error for each endpoint is at
23 | most 1 ulp (2 ulp for some exceptional cases near the subnormal
24 | range) for most functions (the error of [pown_i] can be larger).
25 | *)
26 |
27 | (** The interval type *)
28 | type interval = {
29 | low : float;
30 | high : float;
31 | }
32 |
33 | (** The empty interval *)
34 | val empty_interval : interval
35 |
36 | (** The entire interval representing (-infinity, infinity) *)
37 | val entire_interval : interval
38 |
39 | (** [[0., 0.]] *)
40 | val zero_interval : interval
41 |
42 | (** [[1., 1.]] *)
43 | val one_interval : interval
44 |
45 | (** {6 Interval operations} *)
46 |
47 | (** Creates an interval from given endpoints *)
48 | val make_interval : float -> float -> interval
49 |
50 | (** Tests if an interval is empty *)
51 | val is_empty : interval -> bool
52 |
53 | (** Tests if an interval is the entire interval *)
54 | val is_entire : interval -> bool
55 |
56 | (** Tests if an interval is valid. A valid interval is either empty
57 | or [[a, b]] with [a <= b], [a < infinity], [-infinity < b]. *)
58 | val is_valid : interval -> bool
59 |
60 | (** Computes a midpoint of an interval as [(a + b) / 2]. This function
61 | may return incorrect results when [a + b] overflows or for the entire
62 | interval. *)
63 | val mid_i_fast : interval -> float
64 |
65 | (** Computes a midpoint of an interval. This function returns finite
66 | values for all valid non-empty intervals. *)
67 | val mid_i : interval -> float
68 |
69 | (** Interval negation *)
70 | val neg_i : interval -> interval
71 |
72 | (** Interval absolute value *)
73 | val abs_i : interval -> interval
74 |
75 | (** Interval maximum *)
76 | val max_ii : interval -> interval -> interval
77 |
78 | (** Interval minimum *)
79 | val min_ii : interval -> interval -> interval
80 |
81 | (** Interval addition *)
82 | val add_ii : interval -> interval -> interval
83 |
84 | (** Addition of an interval and a number *)
85 | val add_id : interval -> float -> interval
86 |
87 | (** Addition of a number and an interval *)
88 | val add_di : float -> interval -> interval
89 |
90 | (** Interval subtraction *)
91 | val sub_ii : interval -> interval -> interval
92 |
93 | (** Subtraction of an interval and a number *)
94 | val sub_id : interval -> float -> interval
95 |
96 | (** Subtraction of a number and an interval *)
97 | val sub_di : float -> interval -> interval
98 |
99 | (** Interval multiplication *)
100 | val mul_ii : interval -> interval -> interval
101 |
102 | (** Multiplication of an interval and a number *)
103 | val mul_id : interval -> float -> interval
104 |
105 | (** Multiplication of a number and an interval *)
106 | val mul_di : float -> interval -> interval
107 |
108 | (** Interval division *)
109 | val div_ii : interval -> interval -> interval
110 |
111 | (** Division of an interval by a number *)
112 | val div_id : interval -> float -> interval
113 |
114 | (** Division of a number by an interval *)
115 | val div_di : float -> interval -> interval
116 |
117 | (** Interval reciprocal *)
118 | val inv_i : interval -> interval
119 |
120 | (** Interval square root *)
121 | val sqrt_i : interval -> interval
122 |
123 | (** Interval square *)
124 | val sqr_i : interval -> interval
125 |
126 | (** Interval integer power *)
127 | val pown_i : interval -> int -> interval
128 |
129 | (** Interval exponential function. It is assumed that the standard
130 | function [exp:float->float] has less than 1 ulp error. *)
131 | val exp_i : interval -> interval
132 |
133 | (** Interval natural logarithm. It is assumed that the standard
134 | function [log:float->float] has less than 1 ulp error. *)
135 | val log_i : interval -> interval
136 |
137 | (** Interval arctangent. It is assumed that the standard
138 | function [atan:float->float] has less than 1 ulp error. *)
139 | val atan_i : interval -> interval
140 |
141 | (** Interval sine (not implemented yet) *)
142 | val sin_i : interval -> interval
143 |
144 | (** Interval cosine (not implemented yet) *)
145 | val cos_i : interval -> interval
146 |
147 | (** {6 Floating-point operations with directed rounding} *)
148 |
149 | (** Computes a successor of a floating-point number *)
150 | val fsucc : float -> float
151 |
152 | (** Computes a predecessor of a floating-point number *)
153 | val fpred : float -> float
154 |
155 | (** Returns a lower bound of the sum of two floating-point numbers *)
156 | val fadd_low : float -> float -> float
157 |
158 | (** Returns an upper bound of the sum of two floating-point numbers *)
159 | val fadd_high : float -> float -> float
160 |
161 | (** Returns a lower bound of the difference of two floating-point numbers *)
162 | val fsub_low : float -> float -> float
163 |
164 | (** Returns an upper bound of the difference of two floating-point numbers *)
165 | val fsub_high : float -> float -> float
166 |
167 | (** Returns a lower bound of the product of two floating-point numbers *)
168 | val fmul_low : float -> float -> float
169 |
170 | (** Returns an upper bound of the product of two floating-point numbers *)
171 | val fmul_high : float -> float -> float
172 |
173 | (** Returns a lower bound of the ratio of two floating-point numbers *)
174 | val fdiv_low : float -> float -> float
175 |
176 | (** Returns an upper bound of the ratio of two floating-point numbers *)
177 | val fdiv_high : float -> float -> float
178 |
179 | (** Returns a lower bound of [x^2] *)
180 | val fsqr_low : float -> float
181 |
182 | (** Returns an upper bound of [x^2] *)
183 | val fsqr_high : float -> float
184 |
185 | (** Returns a lower bound of [sqrt x] *)
186 | val fsqrt_low : float -> float
187 |
188 | (** Returns an upper bound of [sqrt x] *)
189 | val fsqrt_high : float -> float
190 |
191 | (** Returns a lower bound of [exp x] *)
192 | val fexp_low : float -> float
193 |
194 | (** Returns an upper bound of [exp x] *)
195 | val fexp_high : float -> float
196 |
197 | (** Returns a lower bound of [log x] *)
198 | val flog_low : float -> float
199 |
200 | (** Returns an upper bound of [log x] *)
201 | val flog_high : float -> float
202 |
203 | (** Returns a lower bound of [atan x] *)
204 | val fatan_low : float -> float
205 |
206 | (** Returns an upper bound of [atan x] *)
207 | val fatan_high : float -> float
208 |
209 | (** Return a lower bound of [cos x] *)
210 | val fcos_low : float -> float
211 |
212 | (** Returns an upper bound of [cos x] *)
213 | val fcos_high : float -> float
214 |
215 | (** Returns a lower bound of [sin x] *)
216 | val fsin_low : float -> float
217 |
218 | (** Returns an upper bound of [sin x] *)
219 | val fsin_high : float -> float
220 |
221 | (** Returns a lower bound of [x^n] *)
222 | val fpown_low : float -> int -> float
223 |
224 | (** Returns an upper bound of [x^n] *)
225 | val fpown_high : float -> int -> float
226 |
--------------------------------------------------------------------------------
/interval2.mli:
--------------------------------------------------------------------------------
1 | (* ========================================================================== *)
2 | (* A simple OCaml interval library *)
3 | (* https://github.com/monadius/ocaml_simple_interval *)
4 | (* *)
5 | (* Author: Alexey Solovyev *)
6 | (* https://github.com/monadius *)
7 | (* *)
8 | (* This file is distributed under the terms of the MIT license *)
9 | (* ========================================================================== *)
10 |
11 | (** A simple OCaml interval library.
12 |
13 | This interval library needs the OCaml [Num] module.
14 |
15 | It is assumed that all floating-point operations are IEEE 754
16 | compatible and the rounding mode is to nearest.
17 |
18 | It is also assumed that OCaml functions [exp], [log], [atan] compute results with
19 | less than 1 ulp error.
20 |
21 | Intervals computed with this library are optimal floating-point
22 | intervals for basic arithmetic operations.
23 |
24 | {!Interval1} provides faster interval functions which are only
25 | slightly less optimal.
26 | *)
27 |
28 | (** The interval type *)
29 | type interval = {
30 | low : float;
31 | high : float;
32 | }
33 |
34 | (** The empty interval *)
35 | val empty_interval : interval
36 |
37 | (** The entire interval representing (-infinity, infinity) *)
38 | val entire_interval : interval
39 |
40 | (** [[0., 0.]] *)
41 | val zero_interval : interval
42 |
43 | (** [[1., 1.]] *)
44 | val one_interval : interval
45 |
46 | (** {6 Interval operations} *)
47 |
48 | (** Creates an interval from given endpoints *)
49 | val make_interval : float -> float -> interval
50 |
51 | (** Tests if an interval is empty *)
52 | val is_empty : interval -> bool
53 |
54 | (** Tests if an interval is the entire interval *)
55 | val is_entire : interval -> bool
56 |
57 | (** Tests if an interval is valid. A valid interval is either empty
58 | or [[a, b]] with [a <= b], [a < infinity], [-infinity < b]. *)
59 | val is_valid : interval -> bool
60 |
61 | (** Computes a midpoint of an interval. This function returns finite
62 | values for all valid non-empty intervals. *)
63 | val mid_i : interval -> float
64 |
65 | (** Interval negation {b (optimal)} *)
66 | val neg_i : interval -> interval
67 |
68 | (** Interval absolute value {b (optimal)} *)
69 | val abs_i : interval -> interval
70 |
71 | (** Interval maximum {b (optimal)} *)
72 | val max_ii : interval -> interval -> interval
73 |
74 | (** Interval minimum {b (optimal)} *)
75 | val min_ii : interval -> interval -> interval
76 |
77 | (** Interval addition {b (optimal)} *)
78 | val add_ii : interval -> interval -> interval
79 |
80 | (** Addition of an interval and a number {b (optimal)} *)
81 | val add_id : interval -> float -> interval
82 |
83 | (** Addition of a number and an interval {b (optimal)} *)
84 | val add_di : float -> interval -> interval
85 |
86 | (** Interval subtraction {b (optimal)} *)
87 | val sub_ii : interval -> interval -> interval
88 |
89 | (** Subtraction of an interval and a number {b (optimal)} *)
90 | val sub_id : interval -> float -> interval
91 |
92 | (** Subtraction of a number and an interval {b (optimal)} *)
93 | val sub_di : float -> interval -> interval
94 |
95 | (** Interval multiplication {b (optimal)} *)
96 | val mul_ii : interval -> interval -> interval
97 |
98 | (** Multiplication of an interval and a number {b (optimal)} *)
99 | val mul_id : interval -> float -> interval
100 |
101 | (** Multiplication of a number and an interval {b (optimal)} *)
102 | val mul_di : float -> interval -> interval
103 |
104 | (** Interval division {b (optimal)} *)
105 | val div_ii : interval -> interval -> interval
106 |
107 | (** Division of an interval by a number {b (optimal)} *)
108 | val div_id : interval -> float -> interval
109 |
110 | (** Division of a number by an interval {b (optimal)} *)
111 | val div_di : float -> interval -> interval
112 |
113 | (** Interval reciprocal {b (optimal)} *)
114 | val inv_i : interval -> interval
115 |
116 | (** Interval square root {b (optimal)} *)
117 | val sqrt_i : interval -> interval
118 |
119 | (** Interval square {b (optimal)} *)
120 | val sqr_i : interval -> interval
121 |
122 | (** Interval integer power. This function returns an optimal interval
123 | but this behavior may change in the future. *)
124 | val pown_i : interval -> int -> interval
125 |
126 | (** Interval exponential function. It is assumed that the standard
127 | function [exp:float->float] has less than 1 ulp error. *)
128 | val exp_i : interval -> interval
129 |
130 | (** Interval natural logarithm. It is assumed that the standard
131 | function [log:float->float] has less than 1 ulp error. *)
132 | val log_i : interval -> interval
133 |
134 | (** Interval arctangent. It is assumed that the standard
135 | function [atan:float->float] has less than 1 ulp error. *)
136 | val atan_i : interval -> interval
137 |
138 | (** Interval sine (not implemented yet) *)
139 | val sin_i : interval -> interval
140 |
141 | (** Interval cosine (not implemented yet) *)
142 | val cos_i : interval -> interval
143 |
144 | (** {6 Floating-point operations with directed rounding} *)
145 |
146 | (** Computes a successor of a floating-point number {b (optimal)} *)
147 | val fsucc : float -> float
148 |
149 | (** Computes a predecessor of a floating-point number {b (optimal)} *)
150 | val fpred : float -> float
151 |
152 | (** Returns a lower bound of the sum of two floating-point numbers {b
153 | (optimal)} *)
154 | val fadd_low : float -> float -> float
155 |
156 | (** Returns an upper bound of the sum of two floating-point numbers {b
157 | (optimal)} *)
158 | val fadd_high : float -> float -> float
159 |
160 | (** Returns a lower bound of the difference of two floating-point
161 | numbers {b (optimal)} *)
162 | val fsub_low : float -> float -> float
163 |
164 | (** Returns an upper bound of the difference of two floating-point
165 | numbers {b (optimal)} *)
166 | val fsub_high : float -> float -> float
167 |
168 | (** Returns a lower bound of the product of two floating-point numbers
169 | {b (optimal)} *)
170 | val fmul_low : float -> float -> float
171 |
172 | (** Returns an upper bound of the product of two floating-point
173 | numbers {b (optimal)} *)
174 | val fmul_high : float -> float -> float
175 |
176 | (** Returns a lower bound of the ratio of two floating-point numbers
177 | {b (optimal)} *)
178 | val fdiv_low : float -> float -> float
179 |
180 | (** Returns an upper bound of the ratio of two floating-point numbers
181 | {b (optimal)} *)
182 | val fdiv_high : float -> float -> float
183 |
184 | (** Returns a lower bound of [x^2] {b (optimal)} *)
185 | val fsqr_low : float -> float
186 |
187 | (** Returns an upper bound of [x^2] {b (optimal)} *)
188 | val fsqr_high : float -> float
189 |
190 | (** Returns a lower bound of [sqrt x] {b (optimal)} *)
191 | val fsqrt_low : float -> float
192 |
193 | (** Returns an upper bound of [sqrt x] {b (optimal)} *)
194 | val fsqrt_high : float -> float
195 |
196 | (** Returns a lower bound of [exp x] *)
197 | val fexp_low : float -> float
198 |
199 | (** Returns an upper bound of [exp x] *)
200 | val fexp_high : float -> float
201 |
202 | (** Returns a lower bound of [log x] *)
203 | val flog_low : float -> float
204 |
205 | (** Returns an upper bound of [log x] *)
206 | val flog_high : float -> float
207 |
208 | (** Returns a lower bound of [atan x] *)
209 | val fatan_low : float -> float
210 |
211 | (** Returns an upper bound of [atan x] *)
212 | val fatan_high : float -> float
213 |
214 | (*
215 | (** Return a lower bound of [cos x] *)
216 | val fcos_low : float -> float
217 |
218 | (** Returns an upper bound of [cos x] *)
219 | val fcos_high : float -> float
220 |
221 | (** Returns a lower bound of [sin x] *)
222 | val fsin_low : float -> float
223 |
224 | (** Returns an upper bound of [sin x] *)
225 | val fsin_high : float -> float
226 | *)
227 |
228 | (** Returns a lower bound of [x^n] *)
229 | val fpown_low : float -> int -> float
230 |
231 | (** Returns an upper bound of [x^n] *)
232 | val fpown_high : float -> int -> float
233 |
--------------------------------------------------------------------------------
/tests/p_interval2.ml:
--------------------------------------------------------------------------------
1 | open Test
2 | open Interval2
3 |
4 | let samples = 10000
5 | let repeats = 10
6 |
7 | let uncurry f (a, b) = f a b
8 |
9 | let uncurry_and_swap f (a, b) = f b a
10 |
11 | let interval_of_pair (a, b) =
12 | if is_nan a || is_nan b || (a = infinity && b = neg_infinity)
13 | || (a = infinity && b = infinity) || (a = neg_infinity && b = neg_infinity) then
14 | empty_interval
15 | else if a <= b then
16 | make_interval a b
17 | else
18 | make_interval b a
19 |
20 | let data_f = array_of_stream (performance_data_f ~n:samples ~sign:0)
21 |
22 | let data_f_pos = array_of_stream (performance_data_f ~n:samples ~sign:1)
23 |
24 | let data_f2 = array_of_stream (performance_data_f2 ~n:samples ~sign:0)
25 |
26 | let data_i = Array.map interval_of_pair data_f2
27 |
28 | let data_if = Array.init (Array.length data_i)
29 | (fun i -> data_i.(i), data_f.(i))
30 |
31 | let data_i_pos = Array.map abs_i data_i
32 |
33 | let data_i2 =
34 | let p (p1, p2) = interval_of_pair p1, interval_of_pair p2 in
35 | let s = performance_data_f2f2 ~n:samples ~sign:0 in
36 | array_of_stream (stream_map p s)
37 |
38 | let run_f ?base_mean name f =
39 | run_performance_test ~repeats ?base_mean ~name f data_f
40 |
41 | let run_f_pos ?base_mean name f =
42 | run_performance_test ~repeats ?base_mean ~name f data_f_pos
43 |
44 | let run_ff ?base_mean name f =
45 | run_performance_test ~repeats ?base_mean ~name (uncurry f) data_f2
46 |
47 | let run_i ?base_mean name f =
48 | run_performance_test ~repeats ?base_mean ~name f data_i
49 |
50 | let run_i_pos ?base_mean name f =
51 | run_performance_test ~repeats ?base_mean ~name f data_i_pos
52 |
53 | let run_if ?base_mean name f =
54 | run_performance_test ~repeats ?base_mean ~name (uncurry f) data_if
55 |
56 | let run_fi ?base_mean name f =
57 | run_performance_test ~repeats ?base_mean ~name (uncurry_and_swap f) data_if
58 |
59 | let run_ii ?base_mean name f =
60 | run_performance_test ~repeats ?base_mean ~name (uncurry f) data_i2
61 |
62 | let test_add_ii {low = a; high = b} {low = c; high = d} = {
63 | low = a +. c;
64 | high = b +. d;
65 | }
66 |
67 | let test_sub_ii {low = a; high = b} {low = c; high = d} = {
68 | low = a -. d;
69 | high = b -. c;
70 | }
71 |
72 | let test_mul_ii {low = a; high = b} {low = c; high = d} = {
73 | low = a *. c;
74 | high = b *. d;
75 | }
76 |
77 | let test_div_ii {low = a; high = b} {low = c; high = d} = {
78 | low = a /. d;
79 | high = b /. c;
80 | }
81 |
82 | let test_inv_i {low = a; high = b} = {
83 | low = 1. /. a;
84 | high = 1. /. b;
85 | }
86 |
87 | let test_sqr_i {low = a; high = b} = {
88 | low = a *. a;
89 | high = b *. b;
90 | }
91 |
92 | let test_sqrt_i {low = a; high = b} = {
93 | low = sqrt a;
94 | high = sqrt b;
95 | }
96 |
97 | let test_exp_i {low = a; high = b} = {
98 | low = exp a;
99 | high = exp b;
100 | }
101 |
102 | let test_log_i {low = a; high = b} = {
103 | low = log a;
104 | high = log b;
105 | }
106 |
107 | let test_atan_i {low = a; high = b} = {
108 | low = atan a;
109 | high = atan b;
110 | }
111 |
112 | let test_pow_i {low = a; high = b} x = {
113 | low = a ** x;
114 | high = b ** x;
115 | }
116 |
117 | (* Tests for floating-point functions *)
118 | let () =
119 | Gc.compact ();
120 | print_performance_header ();
121 | let base_mean, _ = run_f "empty" (fun a -> 0) in
122 | ignore @@ run_ff "empty2" (fun a b -> 0);
123 | ignore @@ run_f "fsucc" ~base_mean fsucc;
124 | ignore @@ run_f "fpred" ~base_mean fpred;
125 | let base_mean, _ = run_ff "+." ( +. ) in
126 | ignore @@ run_ff "fadd_low" ~base_mean fadd_low;
127 | ignore @@ run_ff "fadd_high" ~base_mean fadd_high;
128 | let base_mean, _ = run_ff "-." ( -. ) in
129 | ignore @@ run_ff "fsub_low" ~base_mean fsub_low;
130 | ignore @@ run_ff "fsub_high" ~base_mean fsub_high;
131 | let base_mean, _ = run_ff "*." ( *. ) in
132 | ignore @@ run_ff "fmul_low" ~base_mean fmul_low;
133 | ignore @@ run_ff "fmul_high" ~base_mean fmul_high;
134 | let base_mean, _ = run_ff "/." ( /. ) in
135 | ignore @@ run_ff "fdiv_low" ~base_mean fdiv_low;
136 | ignore @@ run_ff "fdiv_high" ~base_mean fdiv_high;
137 | let base_mean, _ = run_f "sqr" (fun x -> x *. x) in
138 | ignore @@ run_f "fsqr_low" ~base_mean fsqr_low;
139 | ignore @@ run_f "fsqr_high" ~base_mean fsqr_high;
140 | let base_mean, _ = run_f_pos "sqrt" sqrt in
141 | ignore @@ run_f_pos "fsqrt_low" ~base_mean fsqrt_low;
142 | ignore @@ run_f_pos "fsqrt_high" ~base_mean fsqrt_high;
143 | let base_mean, _ = run_f "exp" exp in
144 | ignore @@ run_f "fexp_low" ~base_mean fexp_low;
145 | ignore @@ run_f "fexp_high" ~base_mean fexp_high;
146 | let base_mean, _ = run_f_pos "log" log in
147 | ignore @@ run_f_pos "flog_low" ~base_mean flog_low;
148 | ignore @@ run_f_pos "flog_high" ~base_mean flog_high;
149 | let base_mean, _ = run_f "atan" atan in
150 | ignore @@ run_f "fatan_low" ~base_mean fatan_low;
151 | ignore @@ run_f "fatan_high" ~base_mean fatan_high;
152 | let base_mean, _ = run_f "x^2" (fun x -> x ** 2.) in
153 | ignore @@ run_f "fpown_low(2)" ~base_mean (fun x -> fpown_low x 2);
154 | ignore @@ run_f "fpown_high(2)" ~base_mean (fun x -> fpown_high x 2);
155 | let base_mean, _ = run_f "x^3" (fun x -> x ** 3.) in
156 | ignore @@ run_f "fpown_low(3)" ~base_mean (fun x -> fpown_low x 3);
157 | ignore @@ run_f "fpown_high(3)" ~base_mean (fun x -> fpown_high x 3);
158 | let base_mean, _ = run_f "x^(-2)" (fun x -> x ** (-2.)) in
159 | ignore @@ run_f "fpown_low(-2)" ~base_mean (fun x -> fpown_low x (-2));
160 | ignore @@ run_f "fpown_high(-2)" ~base_mean (fun x -> fpown_high x (-2));
161 | let base_mean, _ = run_f "x^(-3)" (fun x -> x ** (-3.)) in
162 | ignore @@ run_f "fpown_low(-3)" ~base_mean (fun x -> fpown_low x (-3));
163 | ignore @@ run_f "fpown_high(-3)" ~base_mean (fun x -> fpown_high x (-3))
164 |
165 |
166 | (* Tests for interval functions *)
167 | let () =
168 | Gc.compact ();
169 | Printf.printf "\n";
170 | print_performance_header ();
171 | let base_mean, _ = run_i "empty" (fun a -> 0) in
172 | ignore @@ run_i "mid_i" ~base_mean mid_i;
173 | ignore @@ run_i "neg_i" ~base_mean neg_i;
174 | ignore @@ run_i "abs_i" ~base_mean abs_i;
175 | let base_mean, _ = run_ii "*test*: add_ii" test_add_ii in
176 | ignore @@ run_ii "add_ii" ~base_mean add_ii;
177 | ignore @@ run_if "add_id" ~base_mean add_id;
178 | ignore @@ run_fi "add_di" ~base_mean add_di;
179 | let base_mean, _ = run_ii "*test*: sub_ii" test_sub_ii in
180 | ignore @@ run_ii "sub_ii" ~base_mean sub_ii;
181 | ignore @@ run_if "sub_id" ~base_mean sub_id;
182 | ignore @@ run_fi "sub_di" ~base_mean sub_di;
183 | let base_mean, _ = run_ii "*test*: mul_ii" test_mul_ii in
184 | ignore @@ run_ii "mul_ii" ~base_mean mul_ii;
185 | ignore @@ run_if "mul_id" ~base_mean mul_id;
186 | ignore @@ run_fi "mul_di" ~base_mean mul_di;
187 | let base_mean, _ = run_ii "*test*: div_ii" test_div_ii in
188 | ignore @@ run_ii "div_ii" ~base_mean div_ii;
189 | ignore @@ run_if "div_id" ~base_mean div_id;
190 | ignore @@ run_fi "div_di" ~base_mean div_di;
191 | let base_mean, _ = run_i "*test*: inv_i" test_inv_i in
192 | ignore @@ run_i "inv_i" ~base_mean inv_i;
193 | let base_mean, _ = run_i "*test*: sqr_i" test_sqr_i in
194 | ignore @@ run_i "sqr_i" ~base_mean sqr_i;
195 | let base_mean, _ = run_i_pos "*test*: sqrt_i" test_sqrt_i in
196 | ignore @@ run_i_pos "sqrt_i" ~base_mean sqrt_i;
197 | let base_mean, _ = run_i "*test*: exp_i" test_exp_i in
198 | ignore @@ run_i "exp_i" ~base_mean exp_i;
199 | let base_mean, _ = run_i_pos "*test*: log_i" test_log_i in
200 | ignore @@ run_i_pos "log_i" ~base_mean log_i;
201 | let base_mean, _ = run_i "*test*: atan_i" test_atan_i in
202 | ignore @@ run_i "atan_i" ~base_mean atan_i;
203 | let base_mean, _ = run_i "*test*: x^2" (fun v -> test_pow_i v 2.) in
204 | ignore @@ run_i "pown_i(2)" ~base_mean (fun v -> pown_i v 2);
205 | let base_mean, _ = run_i "*test*: x^3" (fun v -> test_pow_i v 3.) in
206 | ignore @@ run_i "pown_i(3)" ~base_mean (fun v -> pown_i v 3);
207 | let base_mean, _ = run_i "*test*: x^(-2)" (fun v -> test_pow_i v (-2.)) in
208 | ignore @@ run_i "pown_i(-2)" ~base_mean (fun v -> pown_i v (-2));
209 | let base_mean, _ = run_i "*test*: x^(-3)" (fun v -> test_pow_i v (-3.)) in
210 | ignore @@ run_i "pown_i(-3)" ~base_mean (fun v -> pown_i v (-3))
211 |
--------------------------------------------------------------------------------
/tests/p_interval1.ml:
--------------------------------------------------------------------------------
1 | open Test
2 | open Interval1
3 |
4 | let samples = 1000000
5 | let repeats = 10
6 |
7 | let uncurry f (a, b) = f a b
8 |
9 | let uncurry_and_swap f (a, b) = f b a
10 |
11 | let interval_of_pair (a, b) =
12 | if is_nan a || is_nan b || (a = infinity && b = neg_infinity)
13 | || (a = infinity && b = infinity) || (a = neg_infinity && b = neg_infinity) then
14 | empty_interval
15 | else if a <= b then
16 | make_interval a b
17 | else
18 | make_interval b a
19 |
20 | let data_f = array_of_stream (performance_data_f ~n:samples ~sign:0)
21 |
22 | let data_f_pos = array_of_stream (performance_data_f ~n:samples ~sign:1)
23 |
24 | let data_f2 = array_of_stream (performance_data_f2 ~n:samples ~sign:0)
25 |
26 | let data_i = Array.map interval_of_pair data_f2
27 |
28 | let data_if = Array.init (Array.length data_i)
29 | (fun i -> data_i.(i), data_f.(i))
30 |
31 | let data_i_pos = Array.map abs_i data_i
32 |
33 | let data_i2 =
34 | let p (p1, p2) = interval_of_pair p1, interval_of_pair p2 in
35 | let s = performance_data_f2f2 ~n:samples ~sign:0 in
36 | array_of_stream (stream_map p s)
37 |
38 | let run_f ?base_mean name f =
39 | run_performance_test ~repeats ?base_mean ~name f data_f
40 |
41 | let run_f_pos ?base_mean name f =
42 | run_performance_test ~repeats ?base_mean ~name f data_f_pos
43 |
44 | let run_ff ?base_mean name f =
45 | run_performance_test ~repeats ?base_mean ~name (uncurry f) data_f2
46 |
47 | let run_i ?base_mean name f =
48 | run_performance_test ~repeats ?base_mean ~name f data_i
49 |
50 | let run_i_pos ?base_mean name f =
51 | run_performance_test ~repeats ?base_mean ~name f data_i_pos
52 |
53 | let run_if ?base_mean name f =
54 | run_performance_test ~repeats ?base_mean ~name (uncurry f) data_if
55 |
56 | let run_fi ?base_mean name f =
57 | run_performance_test ~repeats ?base_mean ~name (uncurry_and_swap f) data_if
58 |
59 | let run_ii ?base_mean name f =
60 | run_performance_test ~repeats ?base_mean ~name (uncurry f) data_i2
61 |
62 | let test_add_ii {low = a; high = b} {low = c; high = d} = {
63 | low = a +. c;
64 | high = b +. d;
65 | }
66 |
67 | let test_sub_ii {low = a; high = b} {low = c; high = d} = {
68 | low = a -. d;
69 | high = b -. c;
70 | }
71 |
72 | let test_mul_ii {low = a; high = b} {low = c; high = d} = {
73 | low = a *. c;
74 | high = b *. d;
75 | }
76 |
77 | let test_div_ii {low = a; high = b} {low = c; high = d} = {
78 | low = a /. d;
79 | high = b /. c;
80 | }
81 |
82 | let test_inv_i {low = a; high = b} = {
83 | low = 1. /. a;
84 | high = 1. /. b;
85 | }
86 |
87 | let test_sqr_i {low = a; high = b} = {
88 | low = a *. a;
89 | high = b *. b;
90 | }
91 |
92 | let test_sqrt_i {low = a; high = b} = {
93 | low = sqrt a;
94 | high = sqrt b;
95 | }
96 |
97 | let test_exp_i {low = a; high = b} = {
98 | low = exp a;
99 | high = exp b;
100 | }
101 |
102 | let test_log_i {low = a; high = b} = {
103 | low = log a;
104 | high = log b;
105 | }
106 |
107 | let test_atan_i {low = a; high = b} = {
108 | low = atan a;
109 | high = atan b;
110 | }
111 |
112 | let test_pow_i {low = a; high = b} x = {
113 | low = a ** x;
114 | high = b ** x;
115 | }
116 |
117 | (* Tests for floating-point functions *)
118 | let () =
119 | Gc.compact ();
120 | print_performance_header ();
121 | let base_mean, _ = run_f "empty" (fun a -> 0) in
122 | ignore @@ run_ff "empty2" (fun a b -> 0);
123 | ignore @@ run_f "fsucc" ~base_mean fsucc;
124 | ignore @@ run_f "fpred" ~base_mean fpred;
125 | let base_mean, _ = run_ff "+." ( +. ) in
126 | ignore @@ run_ff "fadd_low" ~base_mean fadd_low;
127 | ignore @@ run_ff "fadd_high" ~base_mean fadd_high;
128 | let base_mean, _ = run_ff "-." ( -. ) in
129 | ignore @@ run_ff "fsub_low" ~base_mean fsub_low;
130 | ignore @@ run_ff "fsub_high" ~base_mean fsub_high;
131 | let base_mean, _ = run_ff "*." ( *. ) in
132 | ignore @@ run_ff "fmul_low" ~base_mean fmul_low;
133 | ignore @@ run_ff "fmul_high" ~base_mean fmul_high;
134 | let base_mean, _ = run_ff "/." ( /. ) in
135 | ignore @@ run_ff "fdiv_low" ~base_mean fdiv_low;
136 | ignore @@ run_ff "fdiv_high" ~base_mean fdiv_high;
137 | let base_mean, _ = run_f "sqr" (fun x -> x *. x) in
138 | ignore @@ run_f "fsqr_low" ~base_mean fsqr_low;
139 | ignore @@ run_f "fsqr_high" ~base_mean fsqr_high;
140 | let base_mean, _ = run_f_pos "sqrt" sqrt in
141 | ignore @@ run_f_pos "fsqrt_low" ~base_mean fsqrt_low;
142 | ignore @@ run_f_pos "fsqrt_high" ~base_mean fsqrt_high;
143 | let base_mean, _ = run_f "exp" exp in
144 | ignore @@ run_f "fexp_low" ~base_mean fexp_low;
145 | ignore @@ run_f "fexp_high" ~base_mean fexp_high;
146 | let base_mean, _ = run_f_pos "log" log in
147 | ignore @@ run_f_pos "flog_low" ~base_mean flog_low;
148 | ignore @@ run_f_pos "flog_high" ~base_mean flog_high;
149 | let base_mean, _ = run_f "atan" atan in
150 | ignore @@ run_f "fatan_low" ~base_mean fatan_low;
151 | ignore @@ run_f "fatan_high" ~base_mean fatan_high;
152 | let base_mean, _ = run_f "x^2" (fun x -> x ** 2.) in
153 | ignore @@ run_f "fpown_low(2)" ~base_mean (fun x -> fpown_low x 2);
154 | ignore @@ run_f "fpown_high(2)" ~base_mean (fun x -> fpown_high x 2);
155 | let base_mean, _ = run_f "x^3" (fun x -> x ** 3.) in
156 | ignore @@ run_f "fpown_low(3)" ~base_mean (fun x -> fpown_low x 3);
157 | ignore @@ run_f "fpown_high(3)" ~base_mean (fun x -> fpown_high x 3);
158 | let base_mean, _ = run_f "x^(-2)" (fun x -> x ** (-2.)) in
159 | ignore @@ run_f "fpown_low(-2)" ~base_mean (fun x -> fpown_low x (-2));
160 | ignore @@ run_f "fpown_high(-2)" ~base_mean (fun x -> fpown_high x (-2));
161 | let base_mean, _ = run_f "x^(-3)" (fun x -> x ** (-3.)) in
162 | ignore @@ run_f "fpown_low(-3)" ~base_mean (fun x -> fpown_low x (-3));
163 | ignore @@ run_f "fpown_high(-3)" ~base_mean (fun x -> fpown_high x (-3))
164 |
165 |
166 | (* Tests for interval functions *)
167 | let () =
168 | Gc.compact ();
169 | Printf.printf "\n";
170 | print_performance_header ();
171 | let base_mean, _ = run_i "empty" (fun a -> 0) in
172 | ignore @@ run_i "mid_i_fast" ~base_mean mid_i_fast;
173 | ignore @@ run_i "mid_i" ~base_mean mid_i;
174 | ignore @@ run_i "neg_i" ~base_mean neg_i;
175 | ignore @@ run_i "abs_i" ~base_mean abs_i;
176 | let base_mean, _ = run_ii "*test*: add_ii" test_add_ii in
177 | ignore @@ run_ii "add_ii" ~base_mean add_ii;
178 | ignore @@ run_if "add_id" ~base_mean add_id;
179 | ignore @@ run_fi "add_di" ~base_mean add_di;
180 | let base_mean, _ = run_ii "*test*: sub_ii" test_sub_ii in
181 | ignore @@ run_ii "sub_ii" ~base_mean sub_ii;
182 | ignore @@ run_if "sub_id" ~base_mean sub_id;
183 | ignore @@ run_fi "sub_di" ~base_mean sub_di;
184 | let base_mean, _ = run_ii "*test*: mul_ii" test_mul_ii in
185 | ignore @@ run_ii "mul_ii" ~base_mean mul_ii;
186 | ignore @@ run_if "mul_id" ~base_mean mul_id;
187 | ignore @@ run_fi "mul_di" ~base_mean mul_di;
188 | let base_mean, _ = run_ii "*test*: div_ii" test_div_ii in
189 | ignore @@ run_ii "div_ii" ~base_mean div_ii;
190 | ignore @@ run_if "div_id" ~base_mean div_id;
191 | ignore @@ run_fi "div_di" ~base_mean div_di;
192 | let base_mean, _ = run_i "*test*: inv_i" test_inv_i in
193 | ignore @@ run_i "inv_i" ~base_mean inv_i;
194 | let base_mean, _ = run_i "*test*: sqr_i" test_sqr_i in
195 | ignore @@ run_i "sqr_i" ~base_mean sqr_i;
196 | let base_mean, _ = run_i_pos "*test*: sqrt_i" test_sqrt_i in
197 | ignore @@ run_i_pos "sqrt_i" ~base_mean sqrt_i;
198 | let base_mean, _ = run_i "*test*: exp_i" test_exp_i in
199 | ignore @@ run_i "exp_i" ~base_mean exp_i;
200 | let base_mean, _ = run_i_pos "*test*: log_i" test_log_i in
201 | ignore @@ run_i_pos "log_i" ~base_mean log_i;
202 | let base_mean, _ = run_i "*test*: atan_i" test_atan_i in
203 | ignore @@ run_i "atan_i" ~base_mean atan_i;
204 | let base_mean, _ = run_i "*test*: x^2" (fun v -> test_pow_i v 2.) in
205 | ignore @@ run_i "pown_i(2)" ~base_mean (fun v -> pown_i v 2);
206 | let base_mean, _ = run_i "*test*: x^3" (fun v -> test_pow_i v 3.) in
207 | ignore @@ run_i "pown_i(3)" ~base_mean (fun v -> pown_i v 3);
208 | let base_mean, _ = run_i "*test*: x^(-2)" (fun v -> test_pow_i v (-2.)) in
209 | ignore @@ run_i "pown_i(-2)" ~base_mean (fun v -> pown_i v (-2));
210 | let base_mean, _ = run_i "*test*: x^(-3)" (fun v -> test_pow_i v (-3.)) in
211 | ignore @@ run_i "pown_i(-3)" ~base_mean (fun v -> pown_i v (-3))
212 |
213 |
214 |
--------------------------------------------------------------------------------
/tests/test.ml:
--------------------------------------------------------------------------------
1 | exception Bad_fact of string
2 |
3 | let errors, incr_errors, reset_errors =
4 | let errors = ref 0 in
5 | (fun () -> !errors),
6 | (fun () -> incr errors),
7 | (fun () -> errors := 0)
8 |
9 | (* |> is not defined before 4.01 *)
10 | let (|>) a f = f a
11 |
12 | let fact (str, b) = if not b then raise (Bad_fact str)
13 |
14 | let eta_float = ldexp 1.0 (-1074)
15 |
16 | let is_nan x = (compare x nan = 0)
17 |
18 | let is_finite x = neg_infinity < x && x < infinity && not (is_nan x)
19 |
20 | (* Returns a random floating-point number.
21 | sign: specifies the sign of the result (0 denotes a random sign)
22 | exp: the exponent of the result (does not always hold for very small results) *)
23 | let rand_float sign exp =
24 | let neg_flag = if sign = 0 then Random.bool() else (sign < 0) in
25 | let x = 1.0 +. Random.float (1.0 -. epsilon_float) in
26 | let x = if neg_flag then -.x else x in
27 | ldexp x exp
28 |
29 | (* Auxiliary stream and list functions *)
30 |
31 | let stream_map f stream =
32 | let next i =
33 | try Some (f (Stream.next stream))
34 | with Stream.Failure -> None in
35 | Stream.from next
36 |
37 | let stream_filter p stream =
38 | let rec next i =
39 | try
40 | let value = Stream.next stream in
41 | if p value then Some value else next i
42 | with Stream.Failure -> None in
43 | Stream.from next
44 |
45 | let stream_concat streams =
46 | let ss = ref streams in
47 | let rec next i =
48 | match !ss with
49 | | [] -> None
50 | | stream :: rest ->
51 | begin
52 | try Some (Stream.next stream)
53 | with Stream.Failure -> (ss := rest; next i)
54 | end in
55 | Stream.from next
56 |
57 | let stream_concat_random streams =
58 | let ss = Array.of_list streams in
59 | let n = ref (Array.length ss) in
60 | let rec next i =
61 | if !n <= 0 then None
62 | else begin
63 | let k = Random.int !n in
64 | try Some (Stream.next ss.(k))
65 | with Stream.Failure ->
66 | begin
67 | decr n;
68 | ss.(k) <- ss.(!n);
69 | next i
70 | end
71 | end in
72 | Stream.from next
73 |
74 | let all_pairs list =
75 | let rec pairs x s =
76 | match s with
77 | | [] -> []
78 | | y :: ys -> (x, y) :: pairs x ys in
79 | List.fold_left (fun r x -> List.rev_append (pairs x list) r) [] list
80 |
81 | let stream_pairs stream =
82 | let next i =
83 | try
84 | let x = Stream.next stream in
85 | let y = try Stream.next stream with Stream.Failure -> x in
86 | Some (x, y)
87 | with Stream.Failure -> None in
88 | Stream.from next
89 |
90 | let rev_list_of_stream stream =
91 | let result = ref [] in
92 | Stream.iter (fun x -> result := x :: !result) stream;
93 | !result
94 |
95 | let array_of_stream stream =
96 | rev_list_of_stream stream |> List.rev |> Array.of_list
97 |
98 | (* Streams of floating-point numbers *)
99 |
100 | (* Returns an n-element stream of random floating-point numbers
101 | with exponents in the range [e_min, e_max] *)
102 | let rand_floats ~n ~sign e_min e_max =
103 | assert (e_max >= e_min);
104 | let d = e_max - e_min + 1 in
105 | let next i =
106 | if i >= n then None
107 | else
108 | let e = e_min + Random.int d in
109 | Some (rand_float sign e) in
110 | Stream.from next
111 |
112 | (* Returns a stream of random floating-point numbers
113 | where first n elements have the exponent e_min and the
114 | last n elements have the exponent e_max *)
115 | let rand_floats_all ~n ~sign e_min e_max =
116 | assert (e_max >= e_min);
117 | let e = ref e_min in
118 | let k = ref 0 in
119 | let next i =
120 | if !k >= n then begin
121 | incr e;
122 | k := 0
123 | end;
124 | incr k;
125 | if !e > e_max then None
126 | else Some (rand_float sign !e) in
127 | Stream.from next
128 |
129 | (* Returns a stream of floating-point numbers in the form
130 | +/-2^e with e in [e_min, e_max] *)
131 | let p2_floats ~sign e_min e_max =
132 | assert (e_max >= e_min);
133 | let e = ref e_min in
134 | let next i =
135 | if !e > e_max then None
136 | else begin
137 | let exp = !e in
138 | let m =
139 | if sign > 0 then (incr e; 1.0)
140 | else if sign < 0 then (incr e; -1.0)
141 | else if i land 1 = 0 then 1.0
142 | else (incr e; -1.0) in
143 | Some (ldexp m exp)
144 | end in
145 | Stream.from next
146 |
147 | (* Returns a stream of random floating-point numbers in
148 | the form +/-2^e with e in [e_min, e_max] *)
149 | let rand_p2_floats ~n ~sign e_min e_max =
150 | assert (e_max >= e_min);
151 | let d = e_max - e_min + 1 in
152 | let next i =
153 | if i >= n then None
154 | else begin
155 | let neg_flag = if sign = 0 then Random.bool() else (sign < 0) in
156 | let e = e_min + Random.int d in
157 | let x = ldexp 1.0 e in
158 | if neg_flag then Some (-.x) else Some x
159 | end in
160 | Stream.from next
161 |
162 |
163 | (* Functions for running tests *)
164 |
165 | type 'a test = {
166 | test_name: string;
167 | test_arg_name: 'a -> string;
168 | test_func: 'a -> bool;
169 | }
170 |
171 | let mk_test name arg_name f = {
172 | test_name = name;
173 | test_arg_name = arg_name;
174 | test_func = f
175 | }
176 |
177 | let run_test (test: 'a test) (data: 'a Stream.t) =
178 | let new_line_flag = ref true in
179 | let run x =
180 | try
181 | let result = test.test_func x in
182 | assert result
183 | with
184 | | Bad_fact str ->
185 | incr_errors ();
186 | let msg = Printf.sprintf "\rFAIL (%s): %s"
187 | str (test.test_arg_name x) in
188 | let fmt = Format.err_formatter in
189 | if !new_line_flag then (Format.pp_print_newline fmt (); new_line_flag := false);
190 | Format.pp_print_string fmt msg;
191 | Format.pp_print_newline fmt ()
192 | | _ ->
193 | incr_errors ();
194 | let msg = Printf.sprintf "\rFAIL: %s" (test.test_arg_name x) in
195 | let fmt = Format.err_formatter in
196 | if !new_line_flag then (Format.pp_print_newline fmt (); new_line_flag := false);
197 | Format.pp_print_string fmt msg;
198 | Format.pp_print_newline fmt () in
199 | begin
200 | let fmt = Format.std_formatter in
201 | Format.pp_print_string fmt ("Running: " ^ test.test_name ^ " ...");
202 | Format.pp_print_flush fmt ();
203 | Stream.iter run data;
204 | Format.pp_print_string fmt " done";
205 | Format.pp_print_newline fmt ()
206 | end
207 |
208 | let print_performance_header () =
209 | Printf.printf "%-15s %12s %5s %12s %12s %12s\n%!"
210 | "benchmark" "samples" "n" "mean" "sigma" "overhead"
211 |
212 | let run_performance_test ?(repeats = 10) ?(base_mean = 0.)
213 | ~name (f: 'a -> 'b) (data: 'a array) =
214 | let run f data =
215 | let n = Array.length data in
216 | for i = 0 to n - 1 do
217 | ignore (f data.(i))
218 | done in
219 | let rec run_tests (n, mean, m2) f data k =
220 | if k > 0 then begin
221 | let time =
222 | let start = Unix.gettimeofday() in
223 | run f data;
224 | Unix.gettimeofday() -. start in
225 | let delta = time -. mean in
226 | let mean_new = mean +. delta /. (n +. 1.) in
227 | let delta2 = time -. mean_new in
228 | run_tests (n +. 1., mean_new, m2 +. delta *. delta2) f data (k - 1)
229 | end
230 | else (mean, if n < 2. then nan else m2 /. (n -. 1.)) in
231 | let samples = Array.length data in
232 | let mean, var = run_tests (0., 0., 0.) f data repeats in
233 | let sigma = sqrt var in
234 | Printf.printf "%-15s %12d %5d %12.5f %12.5f %12.5f\n%!"
235 | name samples repeats mean sigma (mean -. base_mean);
236 | mean, sigma
237 |
238 | let run_tests (test: 'a test) (data: 'a Stream.t list) =
239 | run_test test (stream_concat data)
240 |
241 | let name_f name x =
242 | Printf.sprintf "%s: %.20e" name x
243 |
244 | let name_f2 name (a, b) =
245 | Printf.sprintf "%s: [%.20e, %.20e]" name a b
246 |
247 | let name_f2f2 name ((a, b), (c, d)) =
248 | Printf.sprintf "%s: [%.20e, %.20e] [%.20e, %.20e]" name a b c d
249 |
250 | let name_f2f name ((a, b), c) =
251 | Printf.sprintf "%s: [%.20e, %.20e] %.20e" name a b c
252 |
253 | let name_ff2 name (a, (b, c)) =
254 | Printf.sprintf "%s: %.20e [%.20e, %.20e]" name a b c
255 |
256 | let test_f name f = mk_test name (name_f name) f
257 |
258 | let test_f2 name f = mk_test name (name_f2 name) f
259 |
260 | let test_f2f2 name f =
261 | mk_test name (name_f2f2 name) (fun (p1, p2) -> f p1 p2)
262 |
263 | let test_f2f name f =
264 | mk_test name (name_f2f name) (fun (p, x) -> f p x)
265 |
266 | let test_ff2 name f =
267 | mk_test name (name_ff2 name) (fun (x, p) -> f x p)
268 |
269 | let mk_eq_test ?(cmp = Pervasives.compare) name name_arg f =
270 | mk_test name
271 | (fun (arg, _) -> name_arg arg)
272 | (fun (arg, result) -> cmp (f arg) result = 0)
273 |
274 | let run_eq_f ?cmp name f data =
275 | let test = mk_eq_test ?cmp name (name_f name) f in
276 | let sd = Stream.of_list data in
277 | run_test test sd
278 |
279 | let run_eq_f2 ?cmp name f data =
280 | let test = mk_eq_test ?cmp name (name_f2 name) f in
281 | let sd = Stream.of_list data in
282 | run_test test sd
283 |
284 | let run_eq_f2f2 ?cmp name f data =
285 | let test = mk_eq_test ?cmp name (name_f2f2 name) (fun (p1, p2) -> f p1 p2) in
286 | let sd = Stream.of_list data in
287 | run_test test (stream_map (fun ((a, b), (c, d), r) -> ((a, b), (c, d)), r) sd)
288 |
289 | let run_eq_f2f ?cmp name f data =
290 | let test = mk_eq_test ?cmp name (name_f2f name) (fun (p, x) -> f p x) in
291 | let sd = Stream.of_list data in
292 | run_test test (stream_map (fun ((a, b), c, r) -> ((a, b), c), r) sd)
293 |
294 | let run_eq_ff2 ?cmp name f data =
295 | let test = mk_eq_test ?cmp name (name_ff2 name) (fun (x, p) -> f x p) in
296 | let sd = Stream.of_list data in
297 | run_test test (stream_map (fun (a, (b, c), r) -> (a, (b, c)), r) sd)
298 |
299 | (* Predefined test data *)
300 |
301 | let special_floats = [
302 | nan;
303 | neg_infinity;
304 | infinity;
305 | 0.0;
306 | -.0.0;
307 | max_float;
308 | -.max_float;
309 | min_float;
310 | -.min_float;
311 | min_float +. eta_float;
312 | min_float -. eta_float;
313 | -.min_float +. eta_float;
314 | -.min_float -. eta_float;
315 | 1.0;
316 | -.1.0;
317 | 1.0 +. epsilon_float;
318 | -.(1.0 +. epsilon_float);
319 | eta_float;
320 | -.eta_float;
321 | ldexp 1.0 (-1073);
322 | -.(ldexp 1.0 (-1073));
323 | ]
324 |
325 | let special_data_f () = Stream.of_list special_floats
326 |
327 | let special_data_f2 () =
328 | Stream.of_list (List.filter (fun (a, b) -> not (a > b))
329 | (all_pairs special_floats))
330 |
331 | let special_data_f2f2 () =
332 | let pairs = List.filter (fun (a, b) -> not (a > b))
333 | (all_pairs special_floats) in
334 | Stream.of_list (all_pairs pairs)
335 |
336 | let standard_data_f ~n ~sign =
337 | stream_concat [
338 | rand_floats_all 10 sign (-1074) 1023;
339 | p2_floats sign (-1075) 1023;
340 | stream_concat_random [
341 | rand_p2_floats (n / 2) sign (-30) 30;
342 | rand_floats (n / 2) sign (-30) 30;
343 | ];
344 | rand_floats n sign (-1074) 1023
345 | ]
346 |
347 | let standard_data_f2 ~n ~sign =
348 | stream_pairs (standard_data_f (2 * n) sign)
349 |
350 | let standard_data_f2f2 ~n ~sign =
351 | stream_pairs (standard_data_f2 (2 * n) sign)
352 |
353 | let performance_data_f ~n ~sign = rand_floats n sign (-30) (30)
354 |
355 | let performance_data_f2 ~n ~sign = stream_pairs (performance_data_f (2 * n) sign)
356 |
357 | let performance_data_f2f2 ~n ~sign = stream_pairs (performance_data_f2 (2 * n) sign)
358 |
--------------------------------------------------------------------------------
/docs/type_Interval2.html:
--------------------------------------------------------------------------------
1 |
2 | Interval2
11 |
12 |
13 | sig type interval = { low : float; high : float; }val empty_interval : Interval2 .intervalval entire_interval : Interval2 .intervalval zero_interval : Interval2 .intervalval one_interval : Interval2 .intervalval make_interval : float -> float -> Interval2 .intervalval is_empty : Interval2 .interval -> boolval is_entire : Interval2 .interval -> boolval is_valid : Interval2 .interval -> boolval mid_i : Interval2 .interval -> floatval neg_i : Interval2 .interval -> Interval2 .intervalval abs_i : Interval2 .interval -> Interval2 .intervalval max_ii : Interval2 .interval -> Interval2 .interval -> Interval2 .intervalval min_ii : Interval2 .interval -> Interval2 .interval -> Interval2 .intervalval add_ii : Interval2 .interval -> Interval2 .interval -> Interval2 .intervalval add_id : Interval2 .interval -> float -> Interval2 .intervalval add_di : float -> Interval2 .interval -> Interval2 .intervalval sub_ii : Interval2 .interval -> Interval2 .interval -> Interval2 .intervalval sub_id : Interval2 .interval -> float -> Interval2 .intervalval sub_di : float -> Interval2 .interval -> Interval2 .intervalval mul_ii : Interval2 .interval -> Interval2 .interval -> Interval2 .intervalval mul_id : Interval2 .interval -> float -> Interval2 .intervalval mul_di : float -> Interval2 .interval -> Interval2 .intervalval div_ii : Interval2 .interval -> Interval2 .interval -> Interval2 .intervalval div_id : Interval2 .interval -> float -> Interval2 .intervalval div_di : float -> Interval2 .interval -> Interval2 .intervalval inv_i : Interval2 .interval -> Interval2 .intervalval sqrt_i : Interval2 .interval -> Interval2 .intervalval sqr_i : Interval2 .interval -> Interval2 .intervalval pown_i : Interval2 .interval -> int -> Interval2 .intervalval exp_i : Interval2 .interval -> Interval2 .intervalval log_i : Interval2 .interval -> Interval2 .intervalval atan_i : Interval2 .interval -> Interval2 .intervalval sin_i : Interval2 .interval -> Interval2 .intervalval cos_i : Interval2 .interval -> Interval2 .intervalval fsucc : float -> floatval fpred : float -> floatval fadd_low : float -> float -> floatval fadd_high : float -> float -> floatval fsub_low : float -> float -> floatval fsub_high : float -> float -> floatval fmul_low : float -> float -> floatval fmul_high : float -> float -> floatval fdiv_low : float -> float -> floatval fdiv_high : float -> float -> floatval fsqr_low : float -> floatval fsqr_high : float -> floatval fsqrt_low : float -> floatval fsqrt_high : float -> floatval fexp_low : float -> floatval fexp_high : float -> floatval flog_low : float -> floatval flog_high : float -> floatval fatan_low : float -> floatval fatan_high : float -> floatval fpown_low : float -> int -> floatval fpown_high : float -> int -> floatend Interval1
11 |
12 |
13 | sig type interval = { low : float; high : float; }val empty_interval : Interval1 .intervalval entire_interval : Interval1 .intervalval zero_interval : Interval1 .intervalval one_interval : Interval1 .intervalval make_interval : float -> float -> Interval1 .intervalval is_empty : Interval1 .interval -> boolval is_entire : Interval1 .interval -> boolval is_valid : Interval1 .interval -> boolval mid_i_fast : Interval1 .interval -> floatval mid_i : Interval1 .interval -> floatval neg_i : Interval1 .interval -> Interval1 .intervalval abs_i : Interval1 .interval -> Interval1 .intervalval max_ii : Interval1 .interval -> Interval1 .interval -> Interval1 .intervalval min_ii : Interval1 .interval -> Interval1 .interval -> Interval1 .intervalval add_ii : Interval1 .interval -> Interval1 .interval -> Interval1 .intervalval add_id : Interval1 .interval -> float -> Interval1 .intervalval add_di : float -> Interval1 .interval -> Interval1 .intervalval sub_ii : Interval1 .interval -> Interval1 .interval -> Interval1 .intervalval sub_id : Interval1 .interval -> float -> Interval1 .intervalval sub_di : float -> Interval1 .interval -> Interval1 .intervalval mul_ii : Interval1 .interval -> Interval1 .interval -> Interval1 .intervalval mul_id : Interval1 .interval -> float -> Interval1 .intervalval mul_di : float -> Interval1 .interval -> Interval1 .intervalval div_ii : Interval1 .interval -> Interval1 .interval -> Interval1 .intervalval div_id : Interval1 .interval -> float -> Interval1 .intervalval div_di : float -> Interval1 .interval -> Interval1 .intervalval inv_i : Interval1 .interval -> Interval1 .intervalval sqrt_i : Interval1 .interval -> Interval1 .intervalval sqr_i : Interval1 .interval -> Interval1 .intervalval pown_i : Interval1 .interval -> int -> Interval1 .intervalval exp_i : Interval1 .interval -> Interval1 .intervalval log_i : Interval1 .interval -> Interval1 .intervalval atan_i : Interval1 .interval -> Interval1 .intervalval sin_i : Interval1 .interval -> Interval1 .intervalval cos_i : Interval1 .interval -> Interval1 .intervalval fsucc : float -> floatval fpred : float -> floatval fadd_low : float -> float -> floatval fadd_high : float -> float -> floatval fsub_low : float -> float -> floatval fsub_high : float -> float -> floatval fmul_low : float -> float -> floatval fmul_high : float -> float -> floatval fdiv_low : float -> float -> floatval fdiv_high : float -> float -> floatval fsqr_low : float -> floatval fsqr_high : float -> floatval fsqrt_low : float -> floatval fsqrt_high : float -> floatval fexp_low : float -> floatval fexp_high : float -> floatval flog_low : float -> floatval flog_high : float -> floatval fatan_low : float -> floatval fatan_high : float -> floatval fcos_low : float -> floatval fcos_high : float -> floatval fsin_low : float -> floatval fsin_high : float -> floatval fpown_low : float -> int -> floatval fpown_high : float -> int -> floatend Interval2
17 |
18 |
19 |
22 |
23 |
24 | module Interval2: sig .. end
25 | A simple OCaml interval library.
26 |
27 |
28 | This interval library needs the OCaml Num module.
29 |
30 |
31 | It is assumed that all floating-point operations are IEEE 754
32 | compatible and the rounding mode is to nearest.
33 |
34 |
35 | It is also assumed that OCaml functions exp, log, atan compute results with
36 | less than 1 ulp error.
37 |
38 |
39 | Intervals computed with this library are optimal floating-point
40 | intervals for basic arithmetic operations.
41 |
42 |
43 | Interval1
type
49 |
50 |
51 |
52 |
53 | low : float;
54 |
55 |
56 |
57 |
58 |
59 |
60 | high : float;
61 |
62 |
63 | }
64 |
65 |
66 | The interval type
68 |
69 |
70 | val empty_intervalinterval
71 | The empty interval
73 |
74 | val entire_intervalinterval
75 | The entire interval representing (-infinity, infinity)
77 |
78 | val zero_intervalinterval
79 | [0., 0.]
81 |
82 | val one_intervalinterval
83 | [1., 1.]
85 | Interval operations val make_intervalfloat -> float -> interval
89 | Creates an interval from given endpoints
91 |
92 | val is_emptyinterval -> bool
93 | Tests if an interval is empty
95 |
96 | val is_entireinterval -> bool
97 | Tests if an interval is the entire interval
99 |
100 | val is_validinterval -> bool
101 | Tests if an interval is valid. A valid interval is either empty
102 | or [a, b] with a <= b, a < infinity, -infinity < b.
104 |
105 | val mid_iinterval -> float
106 | Computes a midpoint of an interval. This function returns finite
107 | values for all valid non-empty intervals.
109 |
110 | val neg_iinterval -> interval
111 | Interval negation (optimal)
113 |
114 | val abs_iinterval -> interval
115 | Interval absolute value (optimal)
117 |
118 | val max_iiinterval -> interval -> interval
119 | Interval maximum (optimal)
121 |
122 | val min_iiinterval -> interval -> interval
123 | Interval minimum (optimal)
125 |
126 | val add_iiinterval -> interval -> interval
127 | Interval addition (optimal)
129 |
130 | val add_idinterval -> float -> interval
131 | Addition of an interval and a number (optimal)
133 |
134 | val add_difloat -> interval -> interval
135 | Addition of a number and an interval (optimal)
137 |
138 | val sub_iiinterval -> interval -> interval
139 | Interval subtraction (optimal)
141 |
142 | val sub_idinterval -> float -> interval
143 | Subtraction of an interval and a number (optimal)
145 |
146 | val sub_difloat -> interval -> interval
147 | Subtraction of a number and an interval (optimal)
149 |
150 | val mul_iiinterval -> interval -> interval
151 | Interval multiplication (optimal)
153 |
154 | val mul_idinterval -> float -> interval
155 | Multiplication of an interval and a number (optimal)
157 |
158 | val mul_difloat -> interval -> interval
159 | Multiplication of a number and an interval (optimal)
161 |
162 | val div_iiinterval -> interval -> interval
163 | Interval division (optimal)
165 |
166 | val div_idinterval -> float -> interval
167 | Division of an interval by a number (optimal)
169 |
170 | val div_difloat -> interval -> interval
171 | Division of a number by an interval (optimal)
173 |
174 | val inv_iinterval -> interval
175 | Interval reciprocal (optimal)
177 |
178 | val sqrt_iinterval -> interval
179 | Interval square root (optimal)
181 |
182 | val sqr_iinterval -> interval
183 | Interval square (optimal)
185 |
186 | val pown_iinterval -> int -> interval
187 | Interval integer power. This function returns an optimal interval
188 | but this behavior may change in the future.
190 |
191 | val exp_iinterval -> interval
192 | Interval exponential function. It is assumed that the standard
193 | function exp:float->float has less than 1 ulp error.
195 |
196 | val log_iinterval -> interval
197 | Interval natural logarithm. It is assumed that the standard
198 | function log:float->float has less than 1 ulp error.
200 |
201 | val atan_iinterval -> interval
202 | Interval arctangent. It is assumed that the standard
203 | function atan:float->float has less than 1 ulp error.
205 |
206 | val sin_iinterval -> interval
207 | Interval sine (not implemented yet)
209 |
210 | val cos_iinterval -> interval
211 | Interval cosine (not implemented yet)
213 | Floating-point operations with directed rounding val fsuccfloat -> float
217 | Computes a successor of a floating-point number (optimal)
219 |
220 | val fpredfloat -> float
221 | Computes a predecessor of a floating-point number (optimal)
223 |
224 | val fadd_lowfloat -> float -> float
225 | Returns a lower bound of the sum of two floating-point numbers (optimal)
227 |
228 | val fadd_highfloat -> float -> float
229 | Returns an upper bound of the sum of two floating-point numbers (optimal)
231 |
232 | val fsub_lowfloat -> float -> float
233 | Returns a lower bound of the difference of two floating-point
234 | numbers (optimal)
236 |
237 | val fsub_highfloat -> float -> float
238 | Returns an upper bound of the difference of two floating-point
239 | numbers (optimal)
241 |
242 | val fmul_lowfloat -> float -> float
243 | Returns a lower bound of the product of two floating-point numbers
244 | (optimal)
246 |
247 | val fmul_highfloat -> float -> float
248 | Returns an upper bound of the product of two floating-point
249 | numbers (optimal)
251 |
252 | val fdiv_lowfloat -> float -> float
253 | Returns a lower bound of the ratio of two floating-point numbers
254 | (optimal)
256 |
257 | val fdiv_highfloat -> float -> float
258 | Returns an upper bound of the ratio of two floating-point numbers
259 | (optimal)
261 |
262 | val fsqr_lowfloat -> float
263 | Returns a lower bound of x^2 (optimal)
265 |
266 | val fsqr_highfloat -> float
267 | Returns an upper bound of x^2 (optimal)
269 |
270 | val fsqrt_lowfloat -> float
271 | Returns a lower bound of sqrt x (optimal)
273 |
274 | val fsqrt_highfloat -> float
275 | Returns an upper bound of sqrt x (optimal)
277 |
278 | val fexp_lowfloat -> float
279 | Returns a lower bound of exp x
281 |
282 | val fexp_highfloat -> float
283 | Returns an upper bound of exp x
285 |
286 | val flog_lowfloat -> float
287 | Returns a lower bound of log x
289 |
290 | val flog_highfloat -> float
291 | Returns an upper bound of log x
293 |
294 | val fatan_lowfloat -> float
295 | Returns a lower bound of atan x
297 |
298 | val fatan_highfloat -> float
299 | Returns an upper bound of atan x
301 |
302 | val fpown_lowfloat -> int -> float
303 | Returns a lower bound of x^n
305 |
306 | val fpown_highfloat -> int -> float
307 | Returns an upper bound of x^n
309 |
--------------------------------------------------------------------------------
/docs/Interval1.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Interval1
17 |
18 |
19 |
22 |
23 |
24 | module Interval1: sig .. end
25 | A simple OCaml interval library.
26 |
27 |
28 | This interval library does not depend on any external files and libraries.
29 |
30 |
31 | It is assumed that all floating-point operations are IEEE 754
32 | compatible and the rounding mode is to nearest.
33 |
34 |
35 | It is also assumed that OCaml functions exp, log, atan compute results with
36 | less than 1 ulp error.
37 |
38 |
39 | Intervals computed with this library may be not the optimal
40 | floating-point intervals. But the error for each endpoint is at
41 | most 1 ulp (2 ulp for some exceptional cases near the subnormal
42 | range) for most functions (the error of pown_i can be larger).
type
47 |
48 |
49 |
50 |
51 | low : float;
52 |
53 |
54 |
55 |
56 |
57 |
58 | high : float;
59 |
60 |
61 | }
62 |
63 |
64 | The interval type
66 |
67 |
68 | val empty_intervalinterval
69 | The empty interval
71 |
72 | val entire_intervalinterval
73 | The entire interval representing (-infinity, infinity)
75 |
76 | val zero_intervalinterval
77 | [0., 0.]
79 |
80 | val one_intervalinterval
81 | [1., 1.]
83 | Interval operations val make_intervalfloat -> float -> interval
87 | Creates an interval from given endpoints
89 |
90 | val is_emptyinterval -> bool
91 | Tests if an interval is empty
93 |
94 | val is_entireinterval -> bool
95 | Tests if an interval is the entire interval
97 |
98 | val is_validinterval -> bool
99 | Tests if an interval is valid. A valid interval is either empty
100 | or [a, b] with a <= b, a < infinity, -infinity < b.
102 |
103 | val mid_i_fastinterval -> float
104 | Computes a midpoint of an interval as (a + b) / 2. This function
105 | may return incorrect results when a + b overflows or for the entire
106 | interval.
108 |
109 | val mid_iinterval -> float
110 | Computes a midpoint of an interval. This function returns finite
111 | values for all valid non-empty intervals.
113 |
114 | val neg_iinterval -> interval
115 | Interval negation
117 |
118 | val abs_iinterval -> interval
119 | Interval absolute value
121 |
122 | val max_iiinterval -> interval -> interval
123 | Interval maximum
125 |
126 | val min_iiinterval -> interval -> interval
127 | Interval minimum
129 |
130 | val add_iiinterval -> interval -> interval
131 | Interval addition
133 |
134 | val add_idinterval -> float -> interval
135 | Addition of an interval and a number
137 |
138 | val add_difloat -> interval -> interval
139 | Addition of a number and an interval
141 |
142 | val sub_iiinterval -> interval -> interval
143 | Interval subtraction
145 |
146 | val sub_idinterval -> float -> interval
147 | Subtraction of an interval and a number
149 |
150 | val sub_difloat -> interval -> interval
151 | Subtraction of a number and an interval
153 |
154 | val mul_iiinterval -> interval -> interval
155 | Interval multiplication
157 |
158 | val mul_idinterval -> float -> interval
159 | Multiplication of an interval and a number
161 |
162 | val mul_difloat -> interval -> interval
163 | Multiplication of a number and an interval
165 |
166 | val div_iiinterval -> interval -> interval
167 | Interval division
169 |
170 | val div_idinterval -> float -> interval
171 | Division of an interval by a number
173 |
174 | val div_difloat -> interval -> interval
175 | Division of a number by an interval
177 |
178 | val inv_iinterval -> interval
179 | Interval reciprocal
181 |
182 | val sqrt_iinterval -> interval
183 | Interval square root
185 |
186 | val sqr_iinterval -> interval
187 | Interval square
189 |
190 | val pown_iinterval -> int -> interval
191 | Interval integer power
193 |
194 | val exp_iinterval -> interval
195 | Interval exponential function. It is assumed that the standard
196 | function exp:float->float has less than 1 ulp error.
198 |
199 | val log_iinterval -> interval
200 | Interval natural logarithm. It is assumed that the standard
201 | function log:float->float has less than 1 ulp error.
203 |
204 | val atan_iinterval -> interval
205 | Interval arctangent. It is assumed that the standard
206 | function atan:float->float has less than 1 ulp error.
208 |
209 | val sin_iinterval -> interval
210 | Interval sine (not implemented yet)
212 |
213 | val cos_iinterval -> interval
214 | Interval cosine (not implemented yet)
216 | Floating-point operations with directed rounding val fsuccfloat -> float
220 | Computes a successor of a floating-point number
222 |
223 | val fpredfloat -> float
224 | Computes a predecessor of a floating-point number
226 |
227 | val fadd_lowfloat -> float -> float
228 | Returns a lower bound of the sum of two floating-point numbers
230 |
231 | val fadd_highfloat -> float -> float
232 | Returns an upper bound of the sum of two floating-point numbers
234 |
235 | val fsub_lowfloat -> float -> float
236 | Returns a lower bound of the difference of two floating-point numbers
238 |
239 | val fsub_highfloat -> float -> float
240 | Returns an upper bound of the difference of two floating-point numbers
242 |
243 | val fmul_lowfloat -> float -> float
244 | Returns a lower bound of the product of two floating-point numbers
246 |
247 | val fmul_highfloat -> float -> float
248 | Returns an upper bound of the product of two floating-point numbers
250 |
251 | val fdiv_lowfloat -> float -> float
252 | Returns a lower bound of the ratio of two floating-point numbers
254 |
255 | val fdiv_highfloat -> float -> float
256 | Returns an upper bound of the ratio of two floating-point numbers
258 |
259 | val fsqr_lowfloat -> float
260 | Returns a lower bound of x^2
262 |
263 | val fsqr_highfloat -> float
264 | Returns an upper bound of x^2
266 |
267 | val fsqrt_lowfloat -> float
268 | Returns a lower bound of sqrt x
270 |
271 | val fsqrt_highfloat -> float
272 | Returns an upper bound of sqrt x
274 |
275 | val fexp_lowfloat -> float
276 | Returns a lower bound of exp x
278 |
279 | val fexp_highfloat -> float
280 | Returns an upper bound of exp x
282 |
283 | val flog_lowfloat -> float
284 | Returns a lower bound of log x
286 |
287 | val flog_highfloat -> float
288 | Returns an upper bound of log x
290 |
291 | val fatan_lowfloat -> float
292 | Returns a lower bound of atan x
294 |
295 | val fatan_highfloat -> float
296 | Returns an upper bound of atan x
298 |
299 | val fcos_lowfloat -> float
300 | Return a lower bound of cos x
302 |
303 | val fcos_highfloat -> float
304 | Returns an upper bound of cos x
306 |
307 | val fsin_lowfloat -> float
308 | Returns a lower bound of sin x
310 |
311 | val fsin_highfloat -> float
312 | Returns an upper bound of sin x
314 |
315 | val fpown_lowfloat -> int -> float
316 | Returns a lower bound of x^n
318 |
319 | val fpown_highfloat -> int -> float
320 | Returns an upper bound of x^n
322 |
--------------------------------------------------------------------------------
/interval2.ml:
--------------------------------------------------------------------------------
1 | (* ========================================================================== *)
2 | (* A simple OCaml interval library *)
3 | (* https://github.com/monadius/ocaml_simple_interval *)
4 | (* *)
5 | (* Author: Alexey Solovyev *)
6 | (* https://github.com/monadius *)
7 | (* *)
8 | (* This file is distributed under the terms of the MIT license *)
9 | (* ========================================================================== *)
10 |
11 | open Num
12 |
13 | let u_float = ldexp 1.0 (-53)
14 |
15 | let eta_float = ldexp 1.0 (-1074)
16 |
17 | let phi_float = u_float *. (1.0 +. 2.0 *. u_float)
18 |
19 | let inv_u_float = 1.0 /. u_float
20 |
21 | let bound1_float = 0.5 *. (eta_float /. (u_float *. u_float))
22 |
23 | let bound2_float = eta_float /. u_float
24 |
25 | let min_float2 = 2.0 *. min_float
26 |
27 | let _ = assert (min_float = 0.5 *. (1.0 /. u_float) *. eta_float)
28 | let _ = assert (min_float2 = ldexp 1.0 (-1021))
29 | let _ = assert (bound1_float = ldexp 1.0 (-969))
30 | let _ = assert (bound2_float = ldexp 1.0 (-1021))
31 |
32 | (* fsucc and fpred from the RZBM09 paper *)
33 | (* Algorithm 2 *)
34 |
35 | let fsucc x =
36 | let c = abs_float x in
37 | if c >= bound1_float then
38 | x +. phi_float *. c
39 | else if c < bound2_float then
40 | x +. eta_float
41 | else
42 | let y = inv_u_float *. x in
43 | let e = phi_float *. abs_float y in
44 | (y +. e) *. u_float
45 |
46 | let fpred x =
47 | let c = abs_float x in
48 | if c >= bound1_float then
49 | x -. phi_float *. c
50 | else if c < bound2_float then
51 | x -. eta_float
52 | else
53 | let y = inv_u_float *. x in
54 | let e = phi_float *. abs_float y in
55 | (y -. e) *. u_float
56 |
57 | let is_finite x = neg_infinity < x && x < infinity
58 |
59 | let num_of_float x =
60 | if x = 0. then Int 0
61 | else if is_finite x then
62 | begin
63 | let m, e = frexp x in
64 | let t = Int64.of_float (ldexp m 53) in
65 | num_of_big_int (Big_int.big_int_of_int64 t) */ (Int 2 **/ Int (e - 53))
66 | end
67 | else
68 | failwith (Printf.sprintf "num_of_float: %e" x)
69 |
70 | (* Returns the integer binary logarithm of big_int *)
71 | (* Returns -1 for non-positive numbers *)
72 | let log2_big_int_simple =
73 | let rec log2 acc k =
74 | if Big_int.sign_big_int k <= 0 then acc
75 | else log2 (acc + 1) (Big_int.shift_right_big_int k 1) in
76 | log2 (-1)
77 |
78 | let log2_big_int =
79 | let p = 32 in
80 | let u = Big_int.power_int_positive_int 2 p in
81 | let rec log2 acc k =
82 | if Big_int.ge_big_int k u then
83 | log2 (acc + p) (Big_int.shift_right_big_int k p)
84 | else
85 | acc + log2_big_int_simple k in
86 | log2 0
87 |
88 | (* Returns the integer binary logarithm of the absolute value of num *)
89 | let log2_num r =
90 | let log2 r = log2_big_int (big_int_of_num (floor_num r)) in
91 | let r = abs_num r in
92 | if r = 0);
99 | if sign_num r = 0 then 0.0
100 | else begin
101 | let n = log2_num r in
102 | let k = min (n + 1074) 52 in
103 | if k < 0 then 0.0
104 | else
105 | let m = big_int_of_num (floor_num ((Int 2 **/ Int (k - n)) */ r)) in
106 | let f = Int64.to_float (Big_int.int64_of_big_int m) in
107 | let x = ldexp f (n - k) in
108 | if x = infinity then max_float else x
109 | end
110 |
111 | let float_of_pos_num_hi r =
112 | assert (sign_num r >= 0);
113 | if sign_num r = 0 then 0.0
114 | else begin
115 | let n = log2_num r in
116 | let k = min (n + 1074) 52 in
117 | if k < 0 then ldexp 1.0 (-1074)
118 | else
119 | let t = (Int 2 **/ Int (k - n)) */ r in
120 | let m0 = floor_num t in
121 | let m = if t =/ m0 then big_int_of_num m0
122 | else Big_int.succ_big_int (big_int_of_num m0) in
123 | let f = Int64.to_float (Big_int.int64_of_big_int m) in
124 | ldexp f (n - k)
125 | end
126 |
127 | let float_of_num_lo r =
128 | if sign_num r < 0 then
129 | -.float_of_pos_num_hi (minus_num r)
130 | else
131 | float_of_pos_num_lo r
132 |
133 | let float_of_num_hi r =
134 | if sign_num r < 0 then
135 | -.float_of_pos_num_lo (minus_num r)
136 | else
137 | float_of_pos_num_hi r
138 |
139 | let round_hi z r =
140 | if z = neg_infinity then -.max_float
141 | else if z = infinity then z
142 | else
143 | let rz = num_of_float z in
144 | if compare_num rz r >= 0 then z else fsucc z
145 |
146 | let round_lo z r =
147 | if z = infinity then max_float
148 | else if z = neg_infinity then z
149 | else
150 | let rz = num_of_float z in
151 | if compare_num rz r <= 0 then z else fpred z
152 |
153 | (* Correctly rounded fadd_low and fadd_high operations from JInterval *)
154 |
155 | let fadd_low x y =
156 | let z = x +. y in
157 | if z = infinity then max_float
158 | else
159 | if y < z -. x || x < z -. y then fpred z else z
160 |
161 | let fadd_high x y =
162 | let z = x +. y in
163 | if z = neg_infinity then -.max_float
164 | else
165 | if z -. x < y || z -. y < x then fsucc z else z
166 |
167 | let fsub_low x y = fadd_low x (-.y)
168 |
169 | let fsub_high x y = fadd_high x (-.y)
170 |
171 | (* Correctly rounded fmul_low and fmul_high are based on results from
172 | S. Boldo's formal verification of Dekker algorithm *)
173 |
174 | let factor = ldexp 1. 27 +. 1.
175 | let max_product = fpred (ldexp 1. 1021)
176 | let min_product = fsucc (ldexp 1. (-969))
177 | let max_factor = ldexp 1. 995
178 |
179 | let two_product_err x y xy =
180 | let px = x *. factor in
181 | let qx = x -. px in
182 | let hx = px +. qx in
183 | let tx = x -. hx in
184 | let py = y *. factor in
185 | let qy = y -. py in
186 | let hy = py +. qy in
187 | let ty = y -. hy in
188 | let r2 = hx *. hy -. xy in
189 | let r2 = r2 +. hx *. ty in
190 | let r2 = r2 +. hy *. tx in
191 | r2 +. tx *. ty
192 |
193 | let fmul_low x y =
194 | if x = 0. || y = 0. then 0.
195 | else
196 | let z = x *. y in
197 | let az = abs_float z in
198 | if abs_float x <= max_factor && abs_float y <= max_factor
199 | && min_product <= az && az <= max_product then
200 | begin
201 | let r = two_product_err x y z in
202 | if r >= 0. then z else fpred z
203 | end
204 | else if z = infinity then max_float
205 | else if z = neg_infinity then z
206 | else
207 | let r = num_of_float x */ num_of_float y in
208 | round_lo z r
209 |
210 | let fmul_high x y =
211 | if x = 0. || y = 0. then 0.
212 | else
213 | let z = x *. y in
214 | let az = abs_float z in
215 | if abs_float x <= max_factor && abs_float y <= max_factor
216 | && min_product <= az && az <= max_product then
217 | begin
218 | let r = two_product_err x y z in
219 | if r <= 0. then z else fsucc z
220 | end
221 | else if z = neg_infinity then -.max_float
222 | else if z = infinity then z
223 | else
224 | let r = num_of_float x */ num_of_float y in
225 | round_hi z r
226 |
227 | let fdiv_low_pos x y =
228 | assert (x >= 0. && y > 0.);
229 | let z = x /. y in
230 | if z = infinity then max_float
231 | else if z = 0. then 0.
232 | else
233 | if fmul_high y z <= x then z else fpred z
234 |
235 | let fdiv_high_pos x y =
236 | assert (x >= 0. && y > 0.);
237 | let z = x /. y in
238 | if z = infinity then infinity
239 | else if z = 0. then
240 | if x = 0. then 0. else eta_float
241 | else
242 | if x <= fmul_low y z then z else fsucc z
243 |
244 | let fdiv_low x y =
245 | if x >= 0. then
246 | if y >= 0. then
247 | fdiv_low_pos x y
248 | else
249 | -.fdiv_high_pos x (-.y)
250 | else
251 | if y <= 0. then
252 | fdiv_low_pos (-.x) (-.y)
253 | else
254 | -.fdiv_high_pos (-.x) y
255 |
256 | let fdiv_high x y =
257 | if x >= 0. then
258 | if y >= 0. then
259 | fdiv_high_pos x y
260 | else
261 | -.fdiv_low_pos x (-.y)
262 | else
263 | if y <= 0. then
264 | fdiv_high_pos (-.x) (-.y)
265 | else
266 | -.fdiv_low_pos (-.x) y
267 |
268 | let sqr_product_err x xx =
269 | let px = x *. factor in
270 | let qx = x -. px in
271 | let hx = px +. qx in
272 | let tx = x -. hx in
273 | let r2 = hx *. hx -. xx in
274 | let r2 = r2 +. hx *. tx in
275 | let r2 = r2 +. hx *. tx in
276 | r2 +. tx *. tx
277 |
278 | let fsqr_low x =
279 | let z = x *. x in
280 | if min_product <= z && z <= max_product then
281 | let r = sqr_product_err x z in
282 | if r >= 0. then z else fpred z
283 | else if z = 0. then 0.
284 | else if z = infinity then max_float
285 | else
286 | let t = num_of_float x in
287 | let r = t */ t in
288 | round_lo z r
289 |
290 | let fsqr_high x =
291 | let z = x *. x in
292 | if min_product <= z && z <= max_product then
293 | let r = sqr_product_err x z in
294 | if r <= 0. then z else fsucc z
295 | else if z = 0. then
296 | if x = 0. then 0. else eta_float
297 | else if z = infinity then z
298 | else
299 | let t = num_of_float x in
300 | let r = t */ t in
301 | round_hi z r
302 |
303 | let fsqrt_low x =
304 | if x < 0. then nan
305 | else if x = infinity then max_float
306 | else
307 | let z = sqrt x in
308 | if fsqr_high z <= x then z else fpred z
309 |
310 | let fsqrt_high x =
311 | if x < 0. then nan
312 | else if x = infinity then infinity
313 | else
314 | let z = sqrt x in
315 | if fsqr_low z >= x then z else fsucc z
316 |
317 | (* We assume that x^0 = 1 for any x *)
318 | let fpown_low x n =
319 | match n with
320 | | 0 -> 1.
321 | | 1 -> x
322 | | 2 -> fsqr_low x
323 | | n when x = 0. -> if n < 0 then nan else 0.
324 | | n when is_finite x ->
325 | let r = num_of_float x **/ Int n in
326 | float_of_num_lo r
327 | | _ -> begin
328 | if x = infinity then
329 | if n < 0 then 0. else max_float
330 | else if n land 1 = 0 then 0.
331 | else neg_infinity
332 | end
333 |
334 | let fpown_high x n =
335 | match n with
336 | | 0 -> 1.
337 | | 1 -> x
338 | | 2 -> fsqr_high x
339 | | n when x = 0. -> if n < 0 then nan else 0.
340 | | n when is_finite x ->
341 | let r = num_of_float x **/ Int n in
342 | float_of_num_hi r
343 | | _ -> begin
344 | if x = infinity then infinity
345 | else if n land 1 = 1 then 0.0
346 | else infinity
347 | end
348 |
349 | let fexp_low x =
350 | let r = exp x in
351 | if r = infinity then max_float
352 | else if r > 0. then fpred r
353 | else 0.
354 |
355 | let fexp_high x = fsucc (exp x)
356 |
357 | let flog_low x =
358 | if x = 1. then 0.
359 | else
360 | let r = log x in
361 | if r = infinity then max_float
362 | else fpred r
363 |
364 | let flog_high x =
365 | if x = 1. then 0.
366 | else
367 | let r = log x in
368 | if r = neg_infinity then -.max_float
369 | else fsucc r
370 |
371 | let fatan_low x =
372 | if x = 0. then 0.
373 | else
374 | fpred (atan x)
375 |
376 | let fatan_high x =
377 | if x = 0. then 0.
378 | else
379 | fsucc (atan x)
380 |
381 | (* Interval type and functions *)
382 |
383 | (* [0, +infinity] contains all finite positive numbers, etc. *)
384 | (* [+infinity, -infinity] represents the only valid empty interval *)
385 |
386 | type interval = {
387 | low : float;
388 | high : float
389 | }
390 |
391 | let empty_interval = {low = infinity; high = neg_infinity}
392 |
393 | let entire_interval = {low = neg_infinity; high = infinity}
394 |
395 | let zero_interval = {low = 0.0; high = 0.0}
396 |
397 | let one_interval = {low = 1.0; high = 1.0}
398 |
399 | let is_empty {low; high} = (low = infinity && high = neg_infinity)
400 |
401 | let is_entire {low; high} = (low = neg_infinity && high = infinity)
402 |
403 | let is_valid ({low; high} as v) =
404 | (low <= high && low < infinity && neg_infinity < high) || is_empty v
405 |
406 | let make_interval a b = {low = a; high = b}
407 |
408 | let mid_i {low = a; high = b} =
409 | if a = neg_infinity then
410 | if b = infinity then 0. else -.max_float
411 | else if b = infinity then max_float
412 | else
413 | let m = 0.5 *. (a +. b) in
414 | if m = infinity || m = neg_infinity then
415 | 0.5 *. a +. 0.5 *. b
416 | else m
417 |
418 | let neg_i {low = a; high = b} = {
419 | low = -.b;
420 | high = -.a;
421 | }
422 |
423 | let abs_i ({low = a; high = b} as v) =
424 | if 0. <= a || is_empty v then v
425 | else if b <= 0. then
426 | {low = -.b; high = -.a}
427 | else
428 | {low = 0.; high = max (-.a) b}
429 |
430 | let max_ii ({low = a; high = b} as v) ({low = c; high = d} as w) =
431 | if is_empty v || is_empty w then empty_interval
432 | else {
433 | low = if a <= c then c else a;
434 | high = if b <= d then d else b;
435 | }
436 |
437 | let min_ii ({low = a; high = b} as v) ({low = c; high = d} as w) =
438 | if is_empty v || is_empty w then empty_interval
439 | else {
440 | low = if a <= c then a else c;
441 | high = if b <= d then b else d;
442 | }
443 |
444 | let add_ii ({low = a; high = b} as v) ({low = c; high = d} as w) =
445 | if is_empty v || is_empty w then empty_interval
446 | else {
447 | low = fadd_low a c;
448 | high = fadd_high b d
449 | }
450 |
451 | let add_id ({low = a; high = b} as v) c =
452 | if is_empty v then empty_interval
453 | else {
454 | low = fadd_low a c;
455 | high = fadd_high b c;
456 | }
457 |
458 | let add_di c ({low = a; high = b} as v) =
459 | if is_empty v then empty_interval
460 | else {
461 | low = fadd_low c a;
462 | high = fadd_high c b;
463 | }
464 |
465 | let sub_ii ({low = a; high = b} as v) ({low = c; high = d} as w) =
466 | if is_empty v || is_empty w then empty_interval
467 | else {
468 | low = fsub_low a d;
469 | high = fsub_high b c;
470 | }
471 |
472 | let sub_id ({low = a; high = b} as v) c =
473 | if is_empty v then empty_interval
474 | else {
475 | low = fsub_low a c;
476 | high = fsub_high b c;
477 | }
478 |
479 | let sub_di c ({low = a; high = b} as v) =
480 | if is_empty v then empty_interval
481 | else {
482 | low = fsub_low c b;
483 | high = fsub_high c a;
484 | }
485 |
486 | let mul_ii ({low = a; high = b} as v) ({low = c; high = d} as w) =
487 | if is_empty v || is_empty w then empty_interval
488 | else if a >= 0.0 then {
489 | low = (if c >= 0.0 then fmul_low a c else fmul_low b c);
490 | high = (if d >= 0.0 then fmul_high b d else fmul_high a d);
491 | }
492 | else if b <= 0.0 then {
493 | low = (if d <= 0.0 then fmul_low b d else fmul_low a d);
494 | high = (if c <= 0.0 then fmul_high a c else fmul_high b c);
495 | }
496 | else if c >= 0.0 then {
497 | low = fmul_low a d;
498 | high = fmul_high b d;
499 | }
500 | else if d <= 0.0 then {
501 | low = fmul_low b c;
502 | high = fmul_high a c;
503 | }
504 | else {
505 | low = min (fmul_low a d) (fmul_low b c);
506 | high = max (fmul_high a c) (fmul_high b d);
507 | }
508 |
509 | let mul_id ({low = a; high = b} as v) c =
510 | if is_empty v then empty_interval
511 | else if c > 0.0 then {
512 | low = fmul_low a c;
513 | high = fmul_high b c;
514 | }
515 | else if c < 0.0 then {
516 | low = fmul_low b c;
517 | high = fmul_high a c;
518 | }
519 | else if c = 0.0 then {
520 | low = 0.0;
521 | high = 0.0;
522 | }
523 | else {
524 | low = nan;
525 | high = nan;
526 | }
527 |
528 | let mul_di c i = mul_id i c
529 |
530 | let div_ii ({low = a; high = b} as v) ({low = c; high = d} as w) =
531 | if is_empty v || is_empty w || (c = 0. && d = 0.) then
532 | empty_interval
533 | else if c > 0.0 then {
534 | low = (if a >= 0.0 then fdiv_low a d else fdiv_low a c);
535 | high = (if b <= 0.0 then fdiv_high b d else fdiv_high b c);
536 | }
537 | else if d < 0.0 then {
538 | low = (if b <= 0.0 then fdiv_low b c else fdiv_low b d);
539 | high = (if a >= 0.0 then fdiv_high a c else fdiv_high a d);
540 | }
541 | else if a = 0. && b = 0. then zero_interval
542 | else if c = 0. then {
543 | low = (if a >= 0. then fdiv_low a d else neg_infinity);
544 | high = (if b <= 0. then fdiv_high b d else infinity);
545 | }
546 | else if d = 0. then {
547 | low = (if b <= 0. then fdiv_low b c else neg_infinity);
548 | high = (if a >= 0. then fdiv_high a c else infinity);
549 | }
550 | else entire_interval
551 |
552 | let div_id ({low = a; high = b} as v) c =
553 | if is_empty v then empty_interval
554 | else if c > 0.0 then {
555 | low = fdiv_low a c;
556 | high = fdiv_high b c;
557 | }
558 | else if c < 0.0 then {
559 | low = fdiv_low b c;
560 | high = fdiv_high a c;
561 | }
562 | else empty_interval
563 |
564 | let div_di a w =
565 | if is_finite a then div_ii {low = a; high = a} w
566 | else {low = nan; high = nan}
567 |
568 | let inv_i ({low = a; high = b} as v) =
569 | if is_empty v then empty_interval
570 | else if 0. < a || b < 0. then {
571 | low = fdiv_low 1. b;
572 | high = fdiv_high 1. a;
573 | }
574 | else if a = 0. then begin
575 | if b = 0. then empty_interval
576 | else {
577 | low = fdiv_low 1. b;
578 | high = infinity;
579 | }
580 | end
581 | else if b = 0. then {
582 | low = neg_infinity;
583 | high = fdiv_high 1. a;
584 | }
585 | else entire_interval
586 |
587 | let sqrt_i ({low = a; high = b} as v) =
588 | if b < 0. || is_empty v then empty_interval
589 | else {
590 | low = if a <= 0. then 0. else fsqrt_low a;
591 | high = fsqrt_high b;
592 | }
593 |
594 | let sqr_i ({low = a; high = b} as v) =
595 | if is_empty v then empty_interval
596 | else if a >= 0. then
597 | {low = fsqr_low a; high = fsqr_high b}
598 | else if b <= 0. then
599 | {low = fsqr_low b; high = fsqr_high a}
600 | else
601 | let t = max (-.a) b in
602 | {low = 0.; high = fsqr_high t}
603 |
604 | let pown_i ({low = a; high = b} as v) n =
605 | if is_empty v then empty_interval
606 | else
607 | match n with
608 | | 0 -> one_interval
609 | | 1 -> v
610 | | 2 -> sqr_i v
611 | | -1 -> inv_i v
612 | | n when (n land 1 = 1) -> begin
613 | if n > 0 then
614 | {low = fpown_low a n; high = fpown_high b n}
615 | else begin
616 | if a = 0. && b = 0. then empty_interval
617 | else if a >= 0. then {
618 | low = fpown_low b n;
619 | high = if a = 0. then infinity else fpown_high a n;
620 | }
621 | else if b <= 0. then {
622 | low = if b = 0. then neg_infinity else fpown_low b n;
623 | high = fpown_high a n;
624 | }
625 | else entire_interval
626 | end
627 | end
628 | | _ -> begin
629 | if n > 0 then begin
630 | if a >= 0. then
631 | {low = fpown_low a n; high = fpown_high b n}
632 | else if b <= 0. then
633 | {low = fpown_low b n; high = fpown_high a n}
634 | else
635 | let t = max (-.a) b in
636 | {low = 0.; high = fpown_high t n}
637 | end
638 | else begin
639 | if a = 0. && b = 0. then empty_interval
640 | else if a >= 0. then {
641 | low = fpown_low b n;
642 | high = if a = 0. then infinity else fpown_high a n;
643 | }
644 | else if b <= 0. then {
645 | low = fpown_low a n;
646 | high = if b = 0. then infinity else fpown_high b n;
647 | }
648 | else {
649 | low = fpown_low (max (-.a) b) n;
650 | high = infinity;
651 | }
652 | end
653 | end
654 |
655 | let exp_i ({low = a; high = b} as v) =
656 | if is_empty v then empty_interval
657 | else {
658 | low = fexp_low a;
659 | high = fexp_high b;
660 | }
661 |
662 | let log_i ({low = a; high = b} as v) =
663 | if b < 0. || is_empty v then empty_interval
664 | else {
665 | low = if a <= 0. then neg_infinity else flog_low a;
666 | high = flog_high b;
667 | }
668 |
669 | let atan_i ({low = a; high = b} as v) =
670 | if is_empty v then empty_interval
671 | else {
672 | low = fatan_low a;
673 | high = fatan_high b;
674 | }
675 |
676 | let sin_i {low = a; high = b} =
677 | failwith "sin_i: Not implemented"
678 |
679 | let cos_i {low = a; high = b} =
680 | failwith "cos_i: Not implemented"
681 |
--------------------------------------------------------------------------------