author | wenzelm |
Thu, 05 Nov 2015 10:39:49 +0100 | |
changeset 61585 | a9599d3d7610 |
parent 60868 | dd18c33c001e |
child 61609 | 77b453bd616f |
permissions | -rw-r--r-- |
47615 | 1 |
(* Title: HOL/Library/Float.thy |
2 |
Author: Johannes Hölzl, Fabian Immler |
|
3 |
Copyright 2012 TU München |
|
4 |
*) |
|
5 |
||
60500 | 6 |
section \<open>Floating-Point Numbers\<close> |
29988 | 7 |
|
20485 | 8 |
theory Float |
51542 | 9 |
imports Complex_Main Lattice_Algebras |
20485 | 10 |
begin |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
11 |
|
49812
e3945ddcb9aa
eliminated some remaining uses of typedef with implicit set definition;
wenzelm
parents:
47937
diff
changeset
|
12 |
definition "float = {m * 2 powr e | (m :: int) (e :: int). True}" |
e3945ddcb9aa
eliminated some remaining uses of typedef with implicit set definition;
wenzelm
parents:
47937
diff
changeset
|
13 |
|
49834 | 14 |
typedef float = float |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
15 |
morphisms real_of_float float_of |
49812
e3945ddcb9aa
eliminated some remaining uses of typedef with implicit set definition;
wenzelm
parents:
47937
diff
changeset
|
16 |
unfolding float_def by auto |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
17 |
|
58042
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
hoelzl
parents:
57862
diff
changeset
|
18 |
instantiation float :: real_of |
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
hoelzl
parents:
57862
diff
changeset
|
19 |
begin |
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
hoelzl
parents:
57862
diff
changeset
|
20 |
|
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
hoelzl
parents:
57862
diff
changeset
|
21 |
definition real_float :: "float \<Rightarrow> real" where |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
22 |
real_of_float_def[code_unfold]: "real \<equiv> real_of_float" |
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
23 |
|
58042
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
hoelzl
parents:
57862
diff
changeset
|
24 |
instance .. |
60698 | 25 |
|
58042
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
hoelzl
parents:
57862
diff
changeset
|
26 |
end |
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
hoelzl
parents:
57862
diff
changeset
|
27 |
|
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
28 |
lemma type_definition_float': "type_definition real float_of float" |
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
29 |
using type_definition_float unfolding real_of_float_def . |
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
30 |
|
59487
adaa430fc0f7
default abstypes and default abstract equations make technical (no_code) annotation superfluous
haftmann
parents:
58989
diff
changeset
|
31 |
setup_lifting type_definition_float' |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
32 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
33 |
lemmas float_of_inject[simp] |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
34 |
|
47600 | 35 |
declare [[coercion "real :: float \<Rightarrow> real"]] |
36 |
||
37 |
lemma real_of_float_eq: |
|
60698 | 38 |
fixes f1 f2 :: float |
39 |
shows "f1 = f2 \<longleftrightarrow> real f1 = real f2" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
40 |
unfolding real_of_float_def real_of_float_inject .. |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
41 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
42 |
lemma float_of_real[simp]: "float_of (real x) = x" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
43 |
unfolding real_of_float_def by (rule real_of_float_inverse) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
44 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
45 |
lemma real_float[simp]: "x \<in> float \<Longrightarrow> real (float_of x) = x" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
46 |
unfolding real_of_float_def by (rule float_of_inverse) |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
47 |
|
60698 | 48 |
|
60500 | 49 |
subsection \<open>Real operations preserving the representation as floating point number\<close> |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
50 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
51 |
lemma floatI: fixes m e :: int shows "m * 2 powr e = x \<Longrightarrow> x \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
52 |
by (auto simp: float_def) |
19765 | 53 |
|
60698 | 54 |
lemma zero_float[simp]: "0 \<in> float" |
55 |
by (auto simp: float_def) |
|
56 |
lemma one_float[simp]: "1 \<in> float" |
|
57 |
by (intro floatI[of 1 0]) simp |
|
58 |
lemma numeral_float[simp]: "numeral i \<in> float" |
|
59 |
by (intro floatI[of "numeral i" 0]) simp |
|
60 |
lemma neg_numeral_float[simp]: "- numeral i \<in> float" |
|
61 |
by (intro floatI[of "- numeral i" 0]) simp |
|
62 |
lemma real_of_int_float[simp]: "real (x :: int) \<in> float" |
|
63 |
by (intro floatI[of x 0]) simp |
|
64 |
lemma real_of_nat_float[simp]: "real (x :: nat) \<in> float" |
|
65 |
by (intro floatI[of x 0]) simp |
|
66 |
lemma two_powr_int_float[simp]: "2 powr (real (i::int)) \<in> float" |
|
67 |
by (intro floatI[of 1 i]) simp |
|
68 |
lemma two_powr_nat_float[simp]: "2 powr (real (i::nat)) \<in> float" |
|
69 |
by (intro floatI[of 1 i]) simp |
|
70 |
lemma two_powr_minus_int_float[simp]: "2 powr - (real (i::int)) \<in> float" |
|
71 |
by (intro floatI[of 1 "-i"]) simp |
|
72 |
lemma two_powr_minus_nat_float[simp]: "2 powr - (real (i::nat)) \<in> float" |
|
73 |
by (intro floatI[of 1 "-i"]) simp |
|
74 |
lemma two_powr_numeral_float[simp]: "2 powr numeral i \<in> float" |
|
75 |
by (intro floatI[of 1 "numeral i"]) simp |
|
76 |
lemma two_powr_neg_numeral_float[simp]: "2 powr - numeral i \<in> float" |
|
77 |
by (intro floatI[of 1 "- numeral i"]) simp |
|
78 |
lemma two_pow_float[simp]: "2 ^ n \<in> float" |
|
79 |
by (intro floatI[of 1 "n"]) (simp add: powr_realpow) |
|
80 |
lemma real_of_float_float[simp]: "real (f::float) \<in> float" |
|
81 |
by (cases f) simp |
|
45495
c55a07526dbe
cleaned up float theories; removed duplicate definitions and theorems
hoelzl
parents:
44766
diff
changeset
|
82 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
83 |
lemma plus_float[simp]: "r \<in> float \<Longrightarrow> p \<in> float \<Longrightarrow> r + p \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
84 |
unfolding float_def |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
85 |
proof (safe, simp) |
60698 | 86 |
have *: "\<exists>(m::int) (e::int). m1 * 2 powr e1 + m2 * 2 powr e2 = m * 2 powr e" |
87 |
if "e1 \<le> e2" for e1 m1 e2 m2 :: int |
|
88 |
proof - |
|
89 |
from that have "m1 * 2 powr e1 + m2 * 2 powr e2 = (m1 + m2 * 2 ^ nat (e2 - e1)) * 2 powr e1" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
90 |
by (simp add: powr_realpow[symmetric] powr_divide2[symmetric] field_simps) |
60698 | 91 |
then show ?thesis |
92 |
by blast |
|
93 |
qed |
|
94 |
fix e1 m1 e2 m2 :: int |
|
95 |
consider "e2 \<le> e1" | "e1 \<le> e2" by (rule linorder_le_cases) |
|
96 |
then show "\<exists>(m::int) (e::int). m1 * 2 powr e1 + m2 * 2 powr e2 = m * 2 powr e" |
|
97 |
proof cases |
|
98 |
case 1 |
|
99 |
from *[OF this, of m2 m1] show ?thesis |
|
100 |
by (simp add: ac_simps) |
|
101 |
next |
|
102 |
case 2 |
|
103 |
then show ?thesis by (rule *) |
|
104 |
qed |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
105 |
qed |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
106 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
107 |
lemma uminus_float[simp]: "x \<in> float \<Longrightarrow> -x \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
108 |
apply (auto simp: float_def) |
57492
74bf65a1910a
Hypsubst preserves equality hypotheses
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
56777
diff
changeset
|
109 |
apply hypsubst_thin |
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
110 |
apply (rename_tac m e) |
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
111 |
apply (rule_tac x="-m" in exI) |
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
112 |
apply (rule_tac x="e" in exI) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
113 |
apply (simp add: field_simps) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
114 |
done |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
115 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
116 |
lemma times_float[simp]: "x \<in> float \<Longrightarrow> y \<in> float \<Longrightarrow> x * y \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
117 |
apply (auto simp: float_def) |
57492
74bf65a1910a
Hypsubst preserves equality hypotheses
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
56777
diff
changeset
|
118 |
apply hypsubst_thin |
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
119 |
apply (rename_tac mx my ex ey) |
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
120 |
apply (rule_tac x="mx * my" in exI) |
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
121 |
apply (rule_tac x="ex + ey" in exI) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
122 |
apply (simp add: powr_add) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
123 |
done |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
124 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
125 |
lemma minus_float[simp]: "x \<in> float \<Longrightarrow> y \<in> float \<Longrightarrow> x - y \<in> float" |
54230
b1d955791529
more simplification rules on unary and binary minus
haftmann
parents:
53381
diff
changeset
|
126 |
using plus_float [of x "- y"] by simp |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
127 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
128 |
lemma abs_float[simp]: "x \<in> float \<Longrightarrow> abs x \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
129 |
by (cases x rule: linorder_cases[of 0]) auto |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
130 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
131 |
lemma sgn_of_float[simp]: "x \<in> float \<Longrightarrow> sgn x \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
132 |
by (cases x rule: linorder_cases[of 0]) (auto intro!: uminus_float) |
21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21256
diff
changeset
|
133 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
134 |
lemma div_power_2_float[simp]: "x \<in> float \<Longrightarrow> x / 2^d \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
135 |
apply (auto simp add: float_def) |
57492
74bf65a1910a
Hypsubst preserves equality hypotheses
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
56777
diff
changeset
|
136 |
apply hypsubst_thin |
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
137 |
apply (rename_tac m e) |
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
138 |
apply (rule_tac x="m" in exI) |
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
139 |
apply (rule_tac x="e - d" in exI) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
140 |
apply (simp add: powr_realpow[symmetric] field_simps powr_add[symmetric]) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
141 |
done |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
142 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
143 |
lemma div_power_2_int_float[simp]: "x \<in> float \<Longrightarrow> x / (2::int)^d \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
144 |
apply (auto simp add: float_def) |
57492
74bf65a1910a
Hypsubst preserves equality hypotheses
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
56777
diff
changeset
|
145 |
apply hypsubst_thin |
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
146 |
apply (rename_tac m e) |
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
147 |
apply (rule_tac x="m" in exI) |
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
148 |
apply (rule_tac x="e - d" in exI) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
149 |
apply (simp add: powr_realpow[symmetric] field_simps powr_add[symmetric]) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
150 |
done |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
151 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
152 |
lemma div_numeral_Bit0_float[simp]: |
60698 | 153 |
assumes x: "x / numeral n \<in> float" |
154 |
shows "x / (numeral (Num.Bit0 n)) \<in> float" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
155 |
proof - |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
156 |
have "(x / numeral n) / 2^1 \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
157 |
by (intro x div_power_2_float) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
158 |
also have "(x / numeral n) / 2^1 = x / (numeral (Num.Bit0 n))" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
159 |
by (induct n) auto |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
160 |
finally show ?thesis . |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
161 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
162 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
163 |
lemma div_neg_numeral_Bit0_float[simp]: |
60698 | 164 |
assumes x: "x / numeral n \<in> float" |
165 |
shows "x / (- numeral (Num.Bit0 n)) \<in> float" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
166 |
proof - |
60698 | 167 |
have "- (x / numeral (Num.Bit0 n)) \<in> float" |
168 |
using x by simp |
|
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54230
diff
changeset
|
169 |
also have "- (x / numeral (Num.Bit0 n)) = x / - numeral (Num.Bit0 n)" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54230
diff
changeset
|
170 |
by simp |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
171 |
finally show ?thesis . |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
172 |
qed |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
173 |
|
60698 | 174 |
lemma power_float[simp]: |
175 |
assumes "a \<in> float" |
|
176 |
shows "a ^ b \<in> float" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
177 |
proof - |
60698 | 178 |
from assms obtain m e :: int where "a = m * 2 powr e" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
179 |
by (auto simp: float_def) |
60698 | 180 |
then show ?thesis |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
181 |
by (auto intro!: floatI[where m="m^b" and e = "e*b"] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
182 |
simp: power_mult_distrib powr_realpow[symmetric] powr_powr) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
183 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
184 |
|
60698 | 185 |
lift_definition Float :: "int \<Rightarrow> int \<Rightarrow> float" is "\<lambda>(m::int) (e::int). m * 2 powr e" |
186 |
by simp |
|
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
187 |
declare Float.rep_eq[simp] |
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
188 |
|
47780 | 189 |
lemma compute_real_of_float[code]: |
190 |
"real_of_float (Float m e) = (if e \<ge> 0 then m * 2 ^ nat e else m / 2 ^ (nat (-e)))" |
|
60698 | 191 |
by (simp add: real_of_float_def[symmetric] powr_int) |
47780 | 192 |
|
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
193 |
code_datatype Float |
47600 | 194 |
|
60698 | 195 |
|
60500 | 196 |
subsection \<open>Arithmetic operations on floating point numbers\<close> |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
197 |
|
47600 | 198 |
instantiation float :: "{ring_1, linorder, linordered_ring, linordered_idom, numeral, equal}" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
199 |
begin |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
200 |
|
47600 | 201 |
lift_definition zero_float :: float is 0 by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
202 |
declare zero_float.rep_eq[simp] |
47600 | 203 |
lift_definition one_float :: float is 1 by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
204 |
declare one_float.rep_eq[simp] |
47600 | 205 |
lift_definition plus_float :: "float \<Rightarrow> float \<Rightarrow> float" is "op +" by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
206 |
declare plus_float.rep_eq[simp] |
47600 | 207 |
lift_definition times_float :: "float \<Rightarrow> float \<Rightarrow> float" is "op *" by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
208 |
declare times_float.rep_eq[simp] |
47600 | 209 |
lift_definition minus_float :: "float \<Rightarrow> float \<Rightarrow> float" is "op -" by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
210 |
declare minus_float.rep_eq[simp] |
47600 | 211 |
lift_definition uminus_float :: "float \<Rightarrow> float" is "uminus" by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
212 |
declare uminus_float.rep_eq[simp] |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
213 |
|
47600 | 214 |
lift_definition abs_float :: "float \<Rightarrow> float" is abs by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
215 |
declare abs_float.rep_eq[simp] |
47600 | 216 |
lift_definition sgn_float :: "float \<Rightarrow> float" is sgn by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
217 |
declare sgn_float.rep_eq[simp] |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
218 |
|
55565
f663fc1e653b
simplify proofs because of the stronger reflexivity prover
kuncar
parents:
54784
diff
changeset
|
219 |
lift_definition equal_float :: "float \<Rightarrow> float \<Rightarrow> bool" is "op = :: real \<Rightarrow> real \<Rightarrow> bool" . |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
220 |
|
55565
f663fc1e653b
simplify proofs because of the stronger reflexivity prover
kuncar
parents:
54784
diff
changeset
|
221 |
lift_definition less_eq_float :: "float \<Rightarrow> float \<Rightarrow> bool" is "op \<le>" . |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
222 |
declare less_eq_float.rep_eq[simp] |
55565
f663fc1e653b
simplify proofs because of the stronger reflexivity prover
kuncar
parents:
54784
diff
changeset
|
223 |
lift_definition less_float :: "float \<Rightarrow> float \<Rightarrow> bool" is "op <" . |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
224 |
declare less_float.rep_eq[simp] |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
225 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
226 |
instance |
60698 | 227 |
by (standard; transfer; fastforce simp add: field_simps intro: mult_left_mono mult_right_mono)+ |
228 |
||
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
229 |
end |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
230 |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
231 |
lemma Float_0_eq_0[simp]: "Float 0 e = 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
232 |
by transfer simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
233 |
|
60698 | 234 |
lemma real_of_float_power[simp]: |
235 |
fixes f :: float |
|
236 |
shows "real (f^n) = real f^n" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
237 |
by (induct n) simp_all |
45495
c55a07526dbe
cleaned up float theories; removed duplicate definitions and theorems
hoelzl
parents:
44766
diff
changeset
|
238 |
|
60698 | 239 |
lemma |
240 |
fixes x y :: float |
|
47600 | 241 |
shows real_of_float_min: "real (min x y) = min (real x) (real y)" |
242 |
and real_of_float_max: "real (max x y) = max (real x) (real y)" |
|
243 |
by (simp_all add: min_def max_def) |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
244 |
|
53215
5e47c31c6f7c
renamed typeclass dense_linorder to unbounded_dense_linorder
hoelzl
parents:
51542
diff
changeset
|
245 |
instance float :: unbounded_dense_linorder |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
246 |
proof |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
247 |
fix a b :: float |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
248 |
show "\<exists>c. a < c" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
249 |
apply (intro exI[of _ "a + 1"]) |
47600 | 250 |
apply transfer |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
251 |
apply simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
252 |
done |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
253 |
show "\<exists>c. c < a" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
254 |
apply (intro exI[of _ "a - 1"]) |
47600 | 255 |
apply transfer |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
256 |
apply simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
257 |
done |
60698 | 258 |
show "\<exists>c. a < c \<and> c < b" if "a < b" |
259 |
apply (rule exI[of _ "(a + b) * Float 1 (- 1)"]) |
|
260 |
using that |
|
47600 | 261 |
apply transfer |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54230
diff
changeset
|
262 |
apply (simp add: powr_minus) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
263 |
done |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
264 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
265 |
|
47600 | 266 |
instantiation float :: lattice_ab_group_add |
46573 | 267 |
begin |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
268 |
|
60698 | 269 |
definition inf_float :: "float \<Rightarrow> float \<Rightarrow> float" |
270 |
where "inf_float a b = min a b" |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
271 |
|
60698 | 272 |
definition sup_float :: "float \<Rightarrow> float \<Rightarrow> float" |
273 |
where "sup_float a b = max a b" |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
274 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
275 |
instance |
60679 | 276 |
by (standard; transfer; simp add: inf_float_def sup_float_def real_of_float_min real_of_float_max) |
277 |
||
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
278 |
end |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
279 |
|
47600 | 280 |
lemma float_numeral[simp]: "real (numeral x :: float) = numeral x" |
281 |
apply (induct x) |
|
282 |
apply simp |
|
283 |
apply (simp_all only: numeral_Bit0 numeral_Bit1 real_of_float_eq real_float |
|
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
284 |
plus_float.rep_eq one_float.rep_eq plus_float numeral_float one_float) |
47600 | 285 |
done |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
286 |
|
53381 | 287 |
lemma transfer_numeral [transfer_rule]: |
55945 | 288 |
"rel_fun (op =) pcr_float (numeral :: _ \<Rightarrow> real) (numeral :: _ \<Rightarrow> float)" |
60698 | 289 |
by (simp add: rel_fun_def float.pcr_cr_eq cr_float_def) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
290 |
|
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54230
diff
changeset
|
291 |
lemma float_neg_numeral[simp]: "real (- numeral x :: float) = - numeral x" |
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54230
diff
changeset
|
292 |
by simp |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46670
diff
changeset
|
293 |
|
53381 | 294 |
lemma transfer_neg_numeral [transfer_rule]: |
55945 | 295 |
"rel_fun (op =) pcr_float (- numeral :: _ \<Rightarrow> real) (- numeral :: _ \<Rightarrow> float)" |
60698 | 296 |
by (simp add: rel_fun_def float.pcr_cr_eq cr_float_def) |
47600 | 297 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
298 |
lemma |
47600 | 299 |
shows float_of_numeral[simp]: "numeral k = float_of (numeral k)" |
54489
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
haftmann
parents:
54230
diff
changeset
|
300 |
and float_of_neg_numeral[simp]: "- numeral k = float_of (- numeral k)" |
47600 | 301 |
unfolding real_of_float_eq by simp_all |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46670
diff
changeset
|
302 |
|
60698 | 303 |
|
60500 | 304 |
subsection \<open>Quickcheck\<close> |
58987
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
305 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
306 |
instantiation float :: exhaustive |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
307 |
begin |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
308 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
309 |
definition exhaustive_float where |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
310 |
"exhaustive_float f d = |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
311 |
Quickcheck_Exhaustive.exhaustive (%x. Quickcheck_Exhaustive.exhaustive (%y. f (Float x y)) d) d" |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
312 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
313 |
instance .. |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
314 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
315 |
end |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
316 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
317 |
definition (in term_syntax) [code_unfold]: |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
318 |
"valtermify_float x y = Code_Evaluation.valtermify Float {\<cdot>} x {\<cdot>} y" |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
319 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
320 |
instantiation float :: full_exhaustive |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
321 |
begin |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
322 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
323 |
definition full_exhaustive_float where |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
324 |
"full_exhaustive_float f d = |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
325 |
Quickcheck_Exhaustive.full_exhaustive |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
326 |
(\<lambda>x. Quickcheck_Exhaustive.full_exhaustive (\<lambda>y. f (valtermify_float x y)) d) d" |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
327 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
328 |
instance .. |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
329 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
330 |
end |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
331 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
332 |
instantiation float :: random |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
333 |
begin |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
334 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
335 |
definition "Quickcheck_Random.random i = |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
336 |
scomp (Quickcheck_Random.random (2 ^ nat_of_natural i)) |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
337 |
(\<lambda>man. scomp (Quickcheck_Random.random i) (\<lambda>exp. Pair (valtermify_float man exp)))" |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
338 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
339 |
instance .. |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
340 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
341 |
end |
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
342 |
|
119680ebf37c
quickcheck setup for float, inspired by rat::{exhaustive,full_exhaustive,random}
immler
parents:
58985
diff
changeset
|
343 |
|
60500 | 344 |
subsection \<open>Represent floats as unique mantissa and exponent\<close> |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
46670
diff
changeset
|
345 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
346 |
lemma int_induct_abs[case_names less]: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
347 |
fixes j :: int |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
348 |
assumes H: "\<And>n. (\<And>i. \<bar>i\<bar> < \<bar>n\<bar> \<Longrightarrow> P i) \<Longrightarrow> P n" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
349 |
shows "P j" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
350 |
proof (induct "nat \<bar>j\<bar>" arbitrary: j rule: less_induct) |
60698 | 351 |
case less |
352 |
show ?case by (rule H[OF less]) simp |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
353 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
354 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
355 |
lemma int_cancel_factors: |
60698 | 356 |
fixes n :: int |
357 |
assumes "1 < r" |
|
358 |
shows "n = 0 \<or> (\<exists>k i. n = k * r ^ i \<and> \<not> r dvd k)" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
359 |
proof (induct n rule: int_induct_abs) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
360 |
case (less n) |
60698 | 361 |
have "\<exists>k i. n = k * r ^ Suc i \<and> \<not> r dvd k" if "n \<noteq> 0" "n = m * r" for m |
362 |
proof - |
|
363 |
from that have "\<bar>m \<bar> < \<bar>n\<bar>" |
|
60500 | 364 |
using \<open>1 < r\<close> by (simp add: abs_mult) |
60698 | 365 |
from less[OF this] that show ?thesis by auto |
366 |
qed |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
367 |
then show ?case |
59554
4044f53326c9
inlined rules to free user-space from technical names
haftmann
parents:
59487
diff
changeset
|
368 |
by (metis dvd_def monoid_mult_class.mult.right_neutral mult.commute power_0) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
369 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
370 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
371 |
lemma mult_powr_eq_mult_powr_iff_asym: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
372 |
fixes m1 m2 e1 e2 :: int |
60698 | 373 |
assumes m1: "\<not> 2 dvd m1" |
374 |
and "e1 \<le> e2" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
375 |
shows "m1 * 2 powr e1 = m2 * 2 powr e2 \<longleftrightarrow> m1 = m2 \<and> e1 = e2" |
60698 | 376 |
(is "?lhs \<longleftrightarrow> ?rhs") |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
377 |
proof |
60698 | 378 |
show ?rhs if eq: ?lhs |
379 |
proof - |
|
380 |
have "m1 \<noteq> 0" |
|
381 |
using m1 unfolding dvd_def by auto |
|
382 |
from \<open>e1 \<le> e2\<close> eq have "m1 = m2 * 2 powr nat (e2 - e1)" |
|
383 |
by (simp add: powr_divide2[symmetric] field_simps) |
|
384 |
also have "\<dots> = m2 * 2^nat (e2 - e1)" |
|
385 |
by (simp add: powr_realpow) |
|
386 |
finally have m1_eq: "m1 = m2 * 2^nat (e2 - e1)" |
|
387 |
unfolding real_of_int_inject . |
|
388 |
with m1 have "m1 = m2" |
|
389 |
by (cases "nat (e2 - e1)") (auto simp add: dvd_def) |
|
390 |
then show ?thesis |
|
391 |
using eq \<open>m1 \<noteq> 0\<close> by (simp add: powr_inj) |
|
392 |
qed |
|
393 |
show ?lhs if ?rhs |
|
394 |
using that by simp |
|
395 |
qed |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
396 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
397 |
lemma mult_powr_eq_mult_powr_iff: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
398 |
fixes m1 m2 e1 e2 :: int |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
399 |
shows "\<not> 2 dvd m1 \<Longrightarrow> \<not> 2 dvd m2 \<Longrightarrow> m1 * 2 powr e1 = m2 * 2 powr e2 \<longleftrightarrow> m1 = m2 \<and> e1 = e2" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
400 |
using mult_powr_eq_mult_powr_iff_asym[of m1 e1 e2 m2] |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
401 |
using mult_powr_eq_mult_powr_iff_asym[of m2 e2 e1 m1] |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
402 |
by (cases e1 e2 rule: linorder_le_cases) auto |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
403 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
404 |
lemma floatE_normed: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
405 |
assumes x: "x \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
406 |
obtains (zero) "x = 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
407 |
| (powr) m e :: int where "x = m * 2 powr e" "\<not> 2 dvd m" "x \<noteq> 0" |
60698 | 408 |
proof - |
409 |
{ |
|
410 |
assume "x \<noteq> 0" |
|
411 |
from x obtain m e :: int where x: "x = m * 2 powr e" |
|
412 |
by (auto simp: float_def) |
|
60500 | 413 |
with \<open>x \<noteq> 0\<close> int_cancel_factors[of 2 m] obtain k i where "m = k * 2 ^ i" "\<not> 2 dvd k" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
414 |
by auto |
60500 | 415 |
with \<open>\<not> 2 dvd k\<close> x have "\<exists>(m::int) (e::int). x = m * 2 powr e \<and> \<not> (2::int) dvd m" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
416 |
by (rule_tac exI[of _ "k"], rule_tac exI[of _ "e + int i"]) |
60698 | 417 |
(simp add: powr_add powr_realpow) |
418 |
} |
|
419 |
with that show thesis by blast |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
420 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
421 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
422 |
lemma float_normed_cases: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
423 |
fixes f :: float |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
424 |
obtains (zero) "f = 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
425 |
| (powr) m e :: int where "real f = m * 2 powr e" "\<not> 2 dvd m" "f \<noteq> 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
426 |
proof (atomize_elim, induct f) |
60698 | 427 |
case (float_of y) |
428 |
then show ?case |
|
47600 | 429 |
by (cases rule: floatE_normed) (auto simp: zero_float_def) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
430 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
431 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
432 |
definition mantissa :: "float \<Rightarrow> int" where |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
433 |
"mantissa f = fst (SOME p::int \<times> int. (f = 0 \<and> fst p = 0 \<and> snd p = 0) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
434 |
\<or> (f \<noteq> 0 \<and> real f = real (fst p) * 2 powr real (snd p) \<and> \<not> 2 dvd fst p))" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
435 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
436 |
definition exponent :: "float \<Rightarrow> int" where |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
437 |
"exponent f = snd (SOME p::int \<times> int. (f = 0 \<and> fst p = 0 \<and> snd p = 0) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
438 |
\<or> (f \<noteq> 0 \<and> real f = real (fst p) * 2 powr real (snd p) \<and> \<not> 2 dvd fst p))" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
439 |
|
53381 | 440 |
lemma |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
441 |
shows exponent_0[simp]: "exponent (float_of 0) = 0" (is ?E) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
442 |
and mantissa_0[simp]: "mantissa (float_of 0) = 0" (is ?M) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
443 |
proof - |
60698 | 444 |
have "\<And>p::int \<times> int. fst p = 0 \<and> snd p = 0 \<longleftrightarrow> p = (0, 0)" |
445 |
by auto |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
446 |
then show ?E ?M |
47600 | 447 |
by (auto simp add: mantissa_def exponent_def zero_float_def) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
448 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
449 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
450 |
lemma |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
451 |
shows mantissa_exponent: "real f = mantissa f * 2 powr exponent f" (is ?E) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
452 |
and mantissa_not_dvd: "f \<noteq> (float_of 0) \<Longrightarrow> \<not> 2 dvd mantissa f" (is "_ \<Longrightarrow> ?D") |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
453 |
proof cases |
60698 | 454 |
assume [simp]: "f \<noteq> float_of 0" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
455 |
have "f = mantissa f * 2 powr exponent f \<and> \<not> 2 dvd mantissa f" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
456 |
proof (cases f rule: float_normed_cases) |
60698 | 457 |
case zero |
458 |
then show ?thesis by (simp add: zero_float_def) |
|
459 |
next |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
460 |
case (powr m e) |
60698 | 461 |
then have "\<exists>p::int \<times> int. (f = 0 \<and> fst p = 0 \<and> snd p = 0) \<or> |
462 |
(f \<noteq> 0 \<and> real f = real (fst p) * 2 powr real (snd p) \<and> \<not> 2 dvd fst p)" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
463 |
by auto |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
464 |
then show ?thesis |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
465 |
unfolding exponent_def mantissa_def |
47600 | 466 |
by (rule someI2_ex) (simp add: zero_float_def) |
60698 | 467 |
qed |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
468 |
then show ?E ?D by auto |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
469 |
qed simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
470 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
471 |
lemma mantissa_noteq_0: "f \<noteq> float_of 0 \<Longrightarrow> mantissa f \<noteq> 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
472 |
using mantissa_not_dvd[of f] by auto |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
473 |
|
53381 | 474 |
lemma |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
475 |
fixes m e :: int |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
476 |
defines "f \<equiv> float_of (m * 2 powr e)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
477 |
assumes dvd: "\<not> 2 dvd m" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
478 |
shows mantissa_float: "mantissa f = m" (is "?M") |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
479 |
and exponent_float: "m \<noteq> 0 \<Longrightarrow> exponent f = e" (is "_ \<Longrightarrow> ?E") |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
480 |
proof cases |
60698 | 481 |
assume "m = 0" |
482 |
with dvd show "mantissa f = m" by auto |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
483 |
next |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
484 |
assume "m \<noteq> 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
485 |
then have f_not_0: "f \<noteq> float_of 0" by (simp add: f_def) |
60698 | 486 |
from mantissa_exponent[of f] have "m * 2 powr e = mantissa f * 2 powr exponent f" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
487 |
by (auto simp add: f_def) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
488 |
then show "?M" "?E" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
489 |
using mantissa_not_dvd[OF f_not_0] dvd |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
490 |
by (auto simp: mult_powr_eq_mult_powr_iff) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
491 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
492 |
|
60698 | 493 |
|
60500 | 494 |
subsection \<open>Compute arithmetic operations\<close> |
47600 | 495 |
|
496 |
lemma Float_mantissa_exponent: "Float (mantissa f) (exponent f) = f" |
|
497 |
unfolding real_of_float_eq mantissa_exponent[of f] by simp |
|
498 |
||
60698 | 499 |
lemma Float_cases [cases type: float]: |
47600 | 500 |
fixes f :: float |
501 |
obtains (Float) m e :: int where "f = Float m e" |
|
502 |
using Float_mantissa_exponent[symmetric] |
|
503 |
by (atomize_elim) auto |
|
504 |
||
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
505 |
lemma denormalize_shift: |
60698 | 506 |
assumes f_def: "f \<equiv> Float m e" |
507 |
and not_0: "f \<noteq> float_of 0" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
508 |
obtains i where "m = mantissa f * 2 ^ i" "e = exponent f - i" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
509 |
proof |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
510 |
from mantissa_exponent[of f] f_def |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
511 |
have "m * 2 powr e = mantissa f * 2 powr exponent f" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
512 |
by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
513 |
then have eq: "m = mantissa f * 2 powr (exponent f - e)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
514 |
by (simp add: powr_divide2[symmetric] field_simps) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
515 |
moreover |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
516 |
have "e \<le> exponent f" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
517 |
proof (rule ccontr) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
518 |
assume "\<not> e \<le> exponent f" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
519 |
then have pos: "exponent f < e" by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
520 |
then have "2 powr (exponent f - e) = 2 powr - real (e - exponent f)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
521 |
by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
522 |
also have "\<dots> = 1 / 2^nat (e - exponent f)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
523 |
using pos by (simp add: powr_realpow[symmetric] powr_divide2[symmetric]) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
524 |
finally have "m * 2^nat (e - exponent f) = real (mantissa f)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
525 |
using eq by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
526 |
then have "mantissa f = m * 2^nat (e - exponent f)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
527 |
unfolding real_of_int_inject by simp |
60500 | 528 |
with \<open>exponent f < e\<close> have "2 dvd mantissa f" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
529 |
apply (intro dvdI[where k="m * 2^(nat (e-exponent f)) div 2"]) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
530 |
apply (cases "nat (e - exponent f)") |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
531 |
apply auto |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
532 |
done |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
533 |
then show False using mantissa_not_dvd[OF not_0] by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
534 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
535 |
ultimately have "real m = mantissa f * 2^nat (exponent f - e)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
536 |
by (simp add: powr_realpow[symmetric]) |
60500 | 537 |
with \<open>e \<le> exponent f\<close> |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
538 |
show "m = mantissa f * 2 ^ nat (exponent f - e)" "e = exponent f - nat (exponent f - e)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
539 |
unfolding real_of_int_inject by auto |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
540 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
541 |
|
60698 | 542 |
context |
543 |
begin |
|
47600 | 544 |
|
60698 | 545 |
qualified lemma compute_float_zero[code_unfold, code]: "0 = Float 0 0" |
47600 | 546 |
by transfer simp |
60698 | 547 |
|
548 |
qualified lemma compute_float_one[code_unfold, code]: "1 = Float 1 0" |
|
549 |
by transfer simp |
|
47600 | 550 |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
551 |
lift_definition normfloat :: "float \<Rightarrow> float" is "\<lambda>x. x" . |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
552 |
lemma normloat_id[simp]: "normfloat x = x" by transfer rule |
47600 | 553 |
|
60698 | 554 |
qualified lemma compute_normfloat[code]: "normfloat (Float m e) = |
47600 | 555 |
(if m mod 2 = 0 \<and> m \<noteq> 0 then normfloat (Float (m div 2) (e + 1)) |
556 |
else if m = 0 then 0 else Float m e)" |
|
557 |
by transfer (auto simp add: powr_add zmod_eq_0_iff) |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
558 |
|
60698 | 559 |
qualified lemma compute_float_numeral[code_abbrev]: "Float (numeral k) 0 = numeral k" |
47600 | 560 |
by transfer simp |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
561 |
|
60698 | 562 |
qualified lemma compute_float_neg_numeral[code_abbrev]: "Float (- numeral k) 0 = - numeral k" |
47600 | 563 |
by transfer simp |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
564 |
|
60698 | 565 |
qualified lemma compute_float_uminus[code]: "- Float m1 e1 = Float (- m1) e1" |
47600 | 566 |
by transfer simp |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
567 |
|
60698 | 568 |
qualified lemma compute_float_times[code]: "Float m1 e1 * Float m2 e2 = Float (m1 * m2) (e1 + e2)" |
47600 | 569 |
by transfer (simp add: field_simps powr_add) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
570 |
|
60698 | 571 |
qualified lemma compute_float_plus[code]: "Float m1 e1 + Float m2 e2 = |
54783
25860d89a044
Float: prevent unnecessary large numbers when adding 0
immler
parents:
54782
diff
changeset
|
572 |
(if m1 = 0 then Float m2 e2 else if m2 = 0 then Float m1 e1 else |
25860d89a044
Float: prevent unnecessary large numbers when adding 0
immler
parents:
54782
diff
changeset
|
573 |
if e1 \<le> e2 then Float (m1 + m2 * 2^nat (e2 - e1)) e1 |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
574 |
else Float (m2 + m1 * 2^nat (e1 - e2)) e2)" |
47600 | 575 |
by transfer (simp add: field_simps powr_realpow[symmetric] powr_divide2[symmetric]) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
576 |
|
60698 | 577 |
qualified lemma compute_float_minus[code]: fixes f g::float shows "f - g = f + (-g)" |
47600 | 578 |
by simp |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
579 |
|
60698 | 580 |
qualified lemma compute_float_sgn[code]: "sgn (Float m1 e1) = (if 0 < m1 then 1 else if m1 < 0 then -1 else 0)" |
47600 | 581 |
by transfer (simp add: sgn_times) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
582 |
|
55565
f663fc1e653b
simplify proofs because of the stronger reflexivity prover
kuncar
parents:
54784
diff
changeset
|
583 |
lift_definition is_float_pos :: "float \<Rightarrow> bool" is "op < 0 :: real \<Rightarrow> bool" . |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
584 |
|
60698 | 585 |
qualified lemma compute_is_float_pos[code]: "is_float_pos (Float m e) \<longleftrightarrow> 0 < m" |
47600 | 586 |
by transfer (auto simp add: zero_less_mult_iff not_le[symmetric, of _ 0]) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
587 |
|
60698 | 588 |
qualified lemma compute_float_less[code]: "a < b \<longleftrightarrow> is_float_pos (b - a)" |
47600 | 589 |
by transfer (simp add: field_simps) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
590 |
|
55565
f663fc1e653b
simplify proofs because of the stronger reflexivity prover
kuncar
parents:
54784
diff
changeset
|
591 |
lift_definition is_float_nonneg :: "float \<Rightarrow> bool" is "op \<le> 0 :: real \<Rightarrow> bool" . |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
592 |
|
60698 | 593 |
qualified lemma compute_is_float_nonneg[code]: "is_float_nonneg (Float m e) \<longleftrightarrow> 0 \<le> m" |
47600 | 594 |
by transfer (auto simp add: zero_le_mult_iff not_less[symmetric, of _ 0]) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
595 |
|
60698 | 596 |
qualified lemma compute_float_le[code]: "a \<le> b \<longleftrightarrow> is_float_nonneg (b - a)" |
47600 | 597 |
by transfer (simp add: field_simps) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
598 |
|
55565
f663fc1e653b
simplify proofs because of the stronger reflexivity prover
kuncar
parents:
54784
diff
changeset
|
599 |
lift_definition is_float_zero :: "float \<Rightarrow> bool" is "op = 0 :: real \<Rightarrow> bool" . |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
600 |
|
60698 | 601 |
qualified lemma compute_is_float_zero[code]: "is_float_zero (Float m e) \<longleftrightarrow> 0 = m" |
47600 | 602 |
by transfer (auto simp add: is_float_zero_def) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
603 |
|
60698 | 604 |
qualified lemma compute_float_abs[code]: "abs (Float m e) = Float (abs m) e" |
47600 | 605 |
by transfer (simp add: abs_mult) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
606 |
|
60698 | 607 |
qualified lemma compute_float_eq[code]: "equal_class.equal f g = is_float_zero (f - g)" |
47600 | 608 |
by transfer simp |
60698 | 609 |
|
610 |
end |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
611 |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
612 |
|
60500 | 613 |
subsection \<open>Lemmas for types @{typ real}, @{typ nat}, @{typ int}\<close> |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
614 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
615 |
lemmas real_of_ints = |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
616 |
real_of_int_zero |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
617 |
real_of_one |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
618 |
real_of_int_add |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
619 |
real_of_int_minus |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
620 |
real_of_int_diff |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
621 |
real_of_int_mult |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
622 |
real_of_int_power |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
623 |
real_numeral |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
624 |
lemmas real_of_nats = |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
625 |
real_of_nat_zero |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
626 |
real_of_nat_one |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
627 |
real_of_nat_1 |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
628 |
real_of_nat_add |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
629 |
real_of_nat_mult |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
630 |
real_of_nat_power |
58989 | 631 |
real_of_nat_numeral |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
632 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
633 |
lemmas int_of_reals = real_of_ints[symmetric] |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
634 |
lemmas nat_of_reals = real_of_nats[symmetric] |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
635 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
636 |
|
60500 | 637 |
subsection \<open>Rounding Real Numbers\<close> |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
638 |
|
60698 | 639 |
definition round_down :: "int \<Rightarrow> real \<Rightarrow> real" |
640 |
where "round_down prec x = floor (x * 2 powr prec) * 2 powr -prec" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
641 |
|
60698 | 642 |
definition round_up :: "int \<Rightarrow> real \<Rightarrow> real" |
643 |
where "round_up prec x = ceiling (x * 2 powr prec) * 2 powr -prec" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
644 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
645 |
lemma round_down_float[simp]: "round_down prec x \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
646 |
unfolding round_down_def |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
647 |
by (auto intro!: times_float simp: real_of_int_minus[symmetric] simp del: real_of_int_minus) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
648 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
649 |
lemma round_up_float[simp]: "round_up prec x \<in> float" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
650 |
unfolding round_up_def |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
651 |
by (auto intro!: times_float simp: real_of_int_minus[symmetric] simp del: real_of_int_minus) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
652 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
653 |
lemma round_up: "x \<le> round_up prec x" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
654 |
by (simp add: powr_minus_divide le_divide_eq round_up_def) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
655 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
656 |
lemma round_down: "round_down prec x \<le> x" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
657 |
by (simp add: powr_minus_divide divide_le_eq round_down_def) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
658 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
659 |
lemma round_up_0[simp]: "round_up p 0 = 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
660 |
unfolding round_up_def by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
661 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
662 |
lemma round_down_0[simp]: "round_down p 0 = 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
663 |
unfolding round_down_def by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
664 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
665 |
lemma round_up_diff_round_down: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
666 |
"round_up prec x - round_down prec x \<le> 2 powr -prec" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
667 |
proof - |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
668 |
have "round_up prec x - round_down prec x = |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
669 |
(ceiling (x * 2 powr prec) - floor (x * 2 powr prec)) * 2 powr -prec" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
670 |
by (simp add: round_up_def round_down_def field_simps) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
671 |
also have "\<dots> \<le> 1 * 2 powr -prec" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
672 |
by (rule mult_mono) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
673 |
(auto simp del: real_of_int_diff |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
674 |
simp: real_of_int_diff[symmetric] real_of_int_le_one_cancel_iff ceiling_diff_floor_le_1) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
675 |
finally show ?thesis by simp |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
676 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
677 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
678 |
lemma round_down_shift: "round_down p (x * 2 powr k) = 2 powr k * round_down (p + k) x" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
679 |
unfolding round_down_def |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
680 |
by (simp add: powr_add powr_mult field_simps powr_divide2[symmetric]) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
681 |
(simp add: powr_add[symmetric]) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
682 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
683 |
lemma round_up_shift: "round_up p (x * 2 powr k) = 2 powr k * round_up (p + k) x" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
684 |
unfolding round_up_def |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
685 |
by (simp add: powr_add powr_mult field_simps powr_divide2[symmetric]) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
686 |
(simp add: powr_add[symmetric]) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
687 |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
688 |
lemma round_up_uminus_eq: "round_up p (-x) = - round_down p x" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
689 |
and round_down_uminus_eq: "round_down p (-x) = - round_up p x" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
690 |
by (auto simp: round_up_def round_down_def ceiling_def) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
691 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
692 |
lemma round_up_mono: "x \<le> y \<Longrightarrow> round_up p x \<le> round_up p y" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
693 |
by (auto intro!: ceiling_mono simp: round_up_def) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
694 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
695 |
lemma round_up_le1: |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
696 |
assumes "x \<le> 1" "prec \<ge> 0" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
697 |
shows "round_up prec x \<le> 1" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
698 |
proof - |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
699 |
have "real \<lceil>x * 2 powr prec\<rceil> \<le> real \<lceil>2 powr real prec\<rceil>" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
700 |
using assms by (auto intro!: ceiling_mono) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
701 |
also have "\<dots> = 2 powr prec" using assms by (auto simp: powr_int intro!: exI[where x="2^nat prec"]) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
702 |
finally show ?thesis |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
703 |
by (simp add: round_up_def) (simp add: powr_minus inverse_eq_divide) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
704 |
qed |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
705 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
706 |
lemma round_up_less1: |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
707 |
assumes "x < 1 / 2" "p > 0" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
708 |
shows "round_up p x < 1" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
709 |
proof - |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
710 |
have "x * 2 powr p < 1 / 2 * 2 powr p" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
711 |
using assms by simp |
60500 | 712 |
also have "\<dots> \<le> 2 powr p - 1" using \<open>p > 0\<close> |
58989 | 713 |
by (auto simp: powr_divide2[symmetric] powr_int field_simps self_le_power) |
60500 | 714 |
finally show ?thesis using \<open>p > 0\<close> |
58989 | 715 |
by (simp add: round_up_def field_simps powr_minus powr_int ceiling_less_eq) |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
716 |
qed |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
717 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
718 |
lemma round_down_ge1: |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
719 |
assumes x: "x \<ge> 1" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
720 |
assumes prec: "p \<ge> - log 2 x" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
721 |
shows "1 \<le> round_down p x" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
722 |
proof cases |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
723 |
assume nonneg: "0 \<le> p" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
724 |
have "2 powr p = real \<lfloor>2 powr real p\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
725 |
using nonneg by (auto simp: powr_int) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
726 |
also have "\<dots> \<le> real \<lfloor>x * 2 powr p\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
727 |
using assms by (auto intro!: floor_mono) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
728 |
finally show ?thesis |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
729 |
by (simp add: round_down_def) (simp add: powr_minus inverse_eq_divide) |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
730 |
next |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
731 |
assume neg: "\<not> 0 \<le> p" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
732 |
have "x = 2 powr (log 2 x)" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
733 |
using x by simp |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
734 |
also have "2 powr (log 2 x) \<ge> 2 powr - p" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
735 |
using prec by auto |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
736 |
finally have x_le: "x \<ge> 2 powr -p" . |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
737 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
738 |
from neg have "2 powr real p \<le> 2 powr 0" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
739 |
by (intro powr_mono) auto |
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
740 |
also have "\<dots> \<le> \<lfloor>2 powr 0::real\<rfloor>" by simp |
60698 | 741 |
also have "\<dots> \<le> \<lfloor>x * 2 powr (real p)\<rfloor>" |
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
742 |
unfolding real_of_int_le_iff |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
743 |
using x x_le by (intro floor_mono) (simp add: powr_minus_divide field_simps) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
744 |
finally show ?thesis |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
745 |
using prec x |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
746 |
by (simp add: round_down_def powr_minus_divide pos_le_divide_eq) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
747 |
qed |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
748 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
749 |
lemma round_up_le0: "x \<le> 0 \<Longrightarrow> round_up p x \<le> 0" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
750 |
unfolding round_up_def |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
751 |
by (auto simp: field_simps mult_le_0_iff zero_le_mult_iff) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
752 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
753 |
|
60500 | 754 |
subsection \<open>Rounding Floats\<close> |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
755 |
|
60698 | 756 |
definition div_twopow :: "int \<Rightarrow> nat \<Rightarrow> int" |
757 |
where [simp]: "div_twopow x n = x div (2 ^ n)" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
758 |
|
60698 | 759 |
definition mod_twopow :: "int \<Rightarrow> nat \<Rightarrow> int" |
760 |
where [simp]: "mod_twopow x n = x mod (2 ^ n)" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
761 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
762 |
lemma compute_div_twopow[code]: |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
763 |
"div_twopow x n = (if x = 0 \<or> x = -1 \<or> n = 0 then x else div_twopow (x div 2) (n - 1))" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
764 |
by (cases n) (auto simp: zdiv_zmult2_eq div_eq_minus1) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
765 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
766 |
lemma compute_mod_twopow[code]: |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
767 |
"mod_twopow x n = (if n = 0 then 0 else x mod 2 + 2 * mod_twopow (x div 2) (n - 1))" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
768 |
by (cases n) (auto simp: zmod_zmult2_eq) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
769 |
|
47600 | 770 |
lift_definition float_up :: "int \<Rightarrow> float \<Rightarrow> float" is round_up by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
771 |
declare float_up.rep_eq[simp] |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
772 |
|
60698 | 773 |
lemma round_up_correct: "round_up e f - f \<in> {0..2 powr -e}" |
774 |
unfolding atLeastAtMost_iff |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
775 |
proof |
60698 | 776 |
have "round_up e f - f \<le> round_up e f - round_down e f" |
777 |
using round_down by simp |
|
778 |
also have "\<dots> \<le> 2 powr -e" |
|
779 |
using round_up_diff_round_down by simp |
|
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
780 |
finally show "round_up e f - f \<le> 2 powr - (real e)" |
47600 | 781 |
by simp |
782 |
qed (simp add: algebra_simps round_up) |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
783 |
|
60698 | 784 |
lemma float_up_correct: "real (float_up e f) - real f \<in> {0..2 powr -e}" |
54782 | 785 |
by transfer (rule round_up_correct) |
786 |
||
47600 | 787 |
lift_definition float_down :: "int \<Rightarrow> float \<Rightarrow> float" is round_down by simp |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
788 |
declare float_down.rep_eq[simp] |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
789 |
|
60698 | 790 |
lemma round_down_correct: "f - (round_down e f) \<in> {0..2 powr -e}" |
791 |
unfolding atLeastAtMost_iff |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
792 |
proof |
60698 | 793 |
have "f - round_down e f \<le> round_up e f - round_down e f" |
794 |
using round_up by simp |
|
795 |
also have "\<dots> \<le> 2 powr -e" |
|
796 |
using round_up_diff_round_down by simp |
|
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
797 |
finally show "f - round_down e f \<le> 2 powr - (real e)" |
47600 | 798 |
by simp |
799 |
qed (simp add: algebra_simps round_down) |
|
24301 | 800 |
|
60698 | 801 |
lemma float_down_correct: "real f - real (float_down e f) \<in> {0..2 powr -e}" |
54782 | 802 |
by transfer (rule round_down_correct) |
803 |
||
60698 | 804 |
context |
805 |
begin |
|
806 |
||
807 |
qualified lemma compute_float_down[code]: |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
808 |
"float_down p (Float m e) = |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
809 |
(if p + e < 0 then Float (div_twopow m (nat (-(p + e)))) (-p) else Float m e)" |
60698 | 810 |
proof (cases "p + e < 0") |
811 |
case True |
|
812 |
then have "real ((2::int) ^ nat (-(p + e))) = 2 powr (-(p + e))" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
813 |
using powr_realpow[of 2 "nat (-(p + e))"] by simp |
60698 | 814 |
also have "\<dots> = 1 / 2 powr p / 2 powr e" |
47600 | 815 |
unfolding powr_minus_divide real_of_int_minus by (simp add: powr_add) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
816 |
finally show ?thesis |
60500 | 817 |
using \<open>p + e < 0\<close> |
47600 | 818 |
by transfer (simp add: ac_simps round_down_def floor_divide_eq_div[symmetric]) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
819 |
next |
60698 | 820 |
case False |
47600 | 821 |
then have r: "real e + real p = real (nat (e + p))" by simp |
822 |
have r: "\<lfloor>(m * 2 powr e) * 2 powr real p\<rfloor> = (m * 2 powr e) * 2 powr real p" |
|
823 |
by (auto intro: exI[where x="m*2^nat (e+p)"] |
|
824 |
simp add: ac_simps powr_add[symmetric] r powr_realpow) |
|
60500 | 825 |
with \<open>\<not> p + e < 0\<close> show ?thesis |
57862 | 826 |
by transfer (auto simp add: round_down_def field_simps powr_add powr_minus) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
827 |
qed |
24301 | 828 |
|
54782 | 829 |
lemma abs_round_down_le: "\<bar>f - (round_down e f)\<bar> \<le> 2 powr -e" |
830 |
using round_down_correct[of f e] by simp |
|
831 |
||
832 |
lemma abs_round_up_le: "\<bar>f - (round_up e f)\<bar> \<le> 2 powr -e" |
|
833 |
using round_up_correct[of e f] by simp |
|
834 |
||
835 |
lemma round_down_nonneg: "0 \<le> s \<Longrightarrow> 0 \<le> round_down p s" |
|
56536 | 836 |
by (auto simp: round_down_def) |
54782 | 837 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
838 |
lemma ceil_divide_floor_conv: |
60698 | 839 |
assumes "b \<noteq> 0" |
840 |
shows "\<lceil>real a / real b\<rceil> = (if b dvd a then a div b else \<lfloor>real a / real b\<rfloor> + 1)" |
|
841 |
proof (cases "b dvd a") |
|
842 |
case True |
|
843 |
then show ?thesis |
|
844 |
by (simp add: ceiling_def real_of_int_minus[symmetric] divide_minus_left[symmetric] |
|
845 |
floor_divide_eq_div dvd_neg_div del: divide_minus_left real_of_int_minus) |
|
846 |
next |
|
847 |
case False |
|
848 |
then have "a mod b \<noteq> 0" |
|
849 |
by auto |
|
850 |
then have ne: "real (a mod b) / real b \<noteq> 0" |
|
851 |
using \<open>b \<noteq> 0\<close> by auto |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
852 |
have "\<lceil>real a / real b\<rceil> = \<lfloor>real a / real b\<rfloor> + 1" |
60698 | 853 |
apply (rule ceiling_eq) |
854 |
apply (auto simp: floor_divide_eq_div[symmetric]) |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
855 |
proof - |
60698 | 856 |
have "real \<lfloor>real a / real b\<rfloor> \<le> real a / real b" |
857 |
by simp |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
858 |
moreover have "real \<lfloor>real a / real b\<rfloor> \<noteq> real a / real b" |
60698 | 859 |
apply (subst (2) real_of_int_div_aux) |
860 |
unfolding floor_divide_eq_div |
|
861 |
using ne \<open>b \<noteq> 0\<close> apply auto |
|
862 |
done |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
863 |
ultimately show "real \<lfloor>real a / real b\<rfloor> < real a / real b" by arith |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
864 |
qed |
60698 | 865 |
then show ?thesis |
866 |
using \<open>\<not> b dvd a\<close> by simp |
|
867 |
qed |
|
19765 | 868 |
|
60698 | 869 |
qualified lemma compute_float_up[code]: "float_up p x = - float_down p (-x)" |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
870 |
by transfer (simp add: round_down_uminus_eq) |
60698 | 871 |
|
872 |
end |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
873 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
874 |
|
60500 | 875 |
subsection \<open>Compute bitlen of integers\<close> |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
876 |
|
60698 | 877 |
definition bitlen :: "int \<Rightarrow> int" |
878 |
where "bitlen a = (if a > 0 then \<lfloor>log 2 a\<rfloor> + 1 else 0)" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
879 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
880 |
lemma bitlen_nonneg: "0 \<le> bitlen x" |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
881 |
proof - |
60698 | 882 |
have "-1 < log 2 (-x)" if "0 > x" |
883 |
proof - |
|
884 |
have "-1 = log 2 (inverse 2)" |
|
885 |
by (subst log_inverse) simp_all |
|
886 |
also have "\<dots> < log 2 (-x)" |
|
887 |
using \<open>0 > x\<close> by auto |
|
888 |
finally show ?thesis . |
|
889 |
qed |
|
890 |
then show ?thesis |
|
891 |
unfolding bitlen_def by (auto intro!: add_nonneg_nonneg) |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
892 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
893 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
894 |
lemma bitlen_bounds: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
895 |
assumes "x > 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
896 |
shows "2 ^ nat (bitlen x - 1) \<le> x \<and> x < 2 ^ nat (bitlen x)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
897 |
proof |
60698 | 898 |
show "2 ^ nat (bitlen x - 1) \<le> x" |
899 |
proof - |
|
900 |
have "(2::real) ^ nat \<lfloor>log 2 (real x)\<rfloor> = 2 powr real (floor (log 2 (real x)))" |
|
901 |
using powr_realpow[symmetric, of 2 "nat \<lfloor>log 2 (real x)\<rfloor>"] \<open>x > 0\<close> |
|
902 |
using real_nat_eq_real[of "floor (log 2 (real x))"] |
|
903 |
by simp |
|
904 |
also have "\<dots> \<le> 2 powr log 2 (real x)" |
|
905 |
by simp |
|
906 |
also have "\<dots> = real x" |
|
907 |
using \<open>0 < x\<close> by simp |
|
908 |
finally have "2 ^ nat \<lfloor>log 2 (real x)\<rfloor> \<le> real x" |
|
909 |
by simp |
|
910 |
then show ?thesis |
|
911 |
using \<open>0 < x\<close> by (simp add: bitlen_def) |
|
912 |
qed |
|
913 |
show "x < 2 ^ nat (bitlen x)" |
|
914 |
proof - |
|
915 |
have "x \<le> 2 powr (log 2 x)" |
|
916 |
using \<open>x > 0\<close> by simp |
|
917 |
also have "\<dots> < 2 ^ nat (\<lfloor>log 2 (real x)\<rfloor> + 1)" |
|
918 |
apply (simp add: powr_realpow[symmetric]) |
|
919 |
using \<open>x > 0\<close> apply simp |
|
920 |
done |
|
921 |
finally show ?thesis |
|
922 |
using \<open>x > 0\<close> by (simp add: bitlen_def ac_simps) |
|
923 |
qed |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
924 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
925 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
926 |
lemma bitlen_pow2[simp]: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
927 |
assumes "b > 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
928 |
shows "bitlen (b * 2 ^ c) = bitlen b + c" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
929 |
proof - |
60698 | 930 |
from assms have "b * 2 ^ c > 0" |
931 |
by auto |
|
932 |
then show ?thesis |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
933 |
using floor_add[of "log 2 b" c] assms |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
934 |
by (auto simp add: log_mult log_nat_power bitlen_def) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
935 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
936 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
937 |
lemma bitlen_Float: |
53381 | 938 |
fixes m e |
939 |
defines "f \<equiv> Float m e" |
|
940 |
shows "bitlen (\<bar>mantissa f\<bar>) + exponent f = (if m = 0 then 0 else bitlen \<bar>m\<bar> + e)" |
|
941 |
proof (cases "m = 0") |
|
942 |
case True |
|
943 |
then show ?thesis by (simp add: f_def bitlen_def Float_def) |
|
944 |
next |
|
945 |
case False |
|
60698 | 946 |
then have "f \<noteq> float_of 0" |
47600 | 947 |
unfolding real_of_float_eq by (simp add: f_def) |
60698 | 948 |
then have "mantissa f \<noteq> 0" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
949 |
by (simp add: mantissa_noteq_0) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
950 |
moreover |
53381 | 951 |
obtain i where "m = mantissa f * 2 ^ i" "e = exponent f - int i" |
60500 | 952 |
by (rule f_def[THEN denormalize_shift, OF \<open>f \<noteq> float_of 0\<close>]) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
953 |
ultimately show ?thesis by (simp add: abs_mult) |
53381 | 954 |
qed |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
955 |
|
60698 | 956 |
context |
957 |
begin |
|
958 |
||
959 |
qualified lemma compute_bitlen[code]: "bitlen x = (if x > 0 then bitlen (x div 2) + 1 else 0)" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
960 |
proof - |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
961 |
{ assume "2 \<le> x" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
962 |
then have "\<lfloor>log 2 (x div 2)\<rfloor> + 1 = \<lfloor>log 2 (x - x mod 2)\<rfloor>" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
963 |
by (simp add: log_mult zmod_zdiv_equality') |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
964 |
also have "\<dots> = \<lfloor>log 2 (real x)\<rfloor>" |
60698 | 965 |
proof (cases "x mod 2 = 0") |
966 |
case True |
|
967 |
then show ?thesis by simp |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
968 |
next |
60698 | 969 |
case False |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
970 |
def n \<equiv> "\<lfloor>log 2 (real x)\<rfloor>" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
971 |
then have "0 \<le> n" |
60500 | 972 |
using \<open>2 \<le> x\<close> by simp |
60698 | 973 |
from \<open>2 \<le> x\<close> False have "x mod 2 = 1" "\<not> 2 dvd x" |
974 |
by (auto simp add: dvd_eq_mod_eq_0) |
|
975 |
with \<open>2 \<le> x\<close> have "x \<noteq> 2 ^ nat n" |
|
976 |
by (cases "nat n") auto |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
977 |
moreover |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
978 |
{ have "real (2^nat n :: int) = 2 powr (nat n)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
979 |
by (simp add: powr_realpow) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
980 |
also have "\<dots> \<le> 2 powr (log 2 x)" |
60500 | 981 |
using \<open>2 \<le> x\<close> by (simp add: n_def del: powr_log_cancel) |
982 |
finally have "2^nat n \<le> x" using \<open>2 \<le> x\<close> by simp } |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
983 |
ultimately have "2^nat n \<le> x - 1" by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
984 |
then have "2^nat n \<le> real (x - 1)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
985 |
unfolding real_of_int_le_iff[symmetric] by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
986 |
{ have "n = \<lfloor>log 2 (2^nat n)\<rfloor>" |
60500 | 987 |
using \<open>0 \<le> n\<close> by (simp add: log_nat_power) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
988 |
also have "\<dots> \<le> \<lfloor>log 2 (x - 1)\<rfloor>" |
60500 | 989 |
using \<open>2^nat n \<le> real (x - 1)\<close> \<open>0 \<le> n\<close> \<open>2 \<le> x\<close> by (auto intro: floor_mono) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
990 |
finally have "n \<le> \<lfloor>log 2 (x - 1)\<rfloor>" . } |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
991 |
moreover have "\<lfloor>log 2 (x - 1)\<rfloor> \<le> n" |
60500 | 992 |
using \<open>2 \<le> x\<close> by (auto simp add: n_def intro!: floor_mono) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
993 |
ultimately show "\<lfloor>log 2 (x - x mod 2)\<rfloor> = \<lfloor>log 2 x\<rfloor>" |
60500 | 994 |
unfolding n_def \<open>x mod 2 = 1\<close> by auto |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
995 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
996 |
finally have "\<lfloor>log 2 (x div 2)\<rfloor> + 1 = \<lfloor>log 2 x\<rfloor>" . } |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
997 |
moreover |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
998 |
{ assume "x < 2" "0 < x" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
999 |
then have "x = 1" by simp |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1000 |
then have "\<lfloor>log 2 (real x)\<rfloor> = 0" by simp } |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1001 |
ultimately show ?thesis |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1002 |
unfolding bitlen_def |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1003 |
by (auto simp: pos_imp_zdiv_pos_iff not_le) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1004 |
qed |
60698 | 1005 |
|
1006 |
end |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1007 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1008 |
lemma float_gt1_scale: assumes "1 \<le> Float m e" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1009 |
shows "0 \<le> e + (bitlen m - 1)" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1010 |
proof - |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1011 |
have "0 < Float m e" using assms by auto |
60698 | 1012 |
then have "0 < m" using powr_gt_zero[of 2 e] |
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
1013 |
apply (auto simp: zero_less_mult_iff) |
60698 | 1014 |
using not_le powr_ge_pzero apply blast |
1015 |
done |
|
1016 |
then have "m \<noteq> 0" by auto |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1017 |
show ?thesis |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1018 |
proof (cases "0 \<le> e") |
60698 | 1019 |
case True |
1020 |
then show ?thesis |
|
1021 |
using \<open>0 < m\<close> by (simp add: bitlen_def) |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1022 |
next |
60698 | 1023 |
case False |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1024 |
have "(1::int) < 2" by simp |
60698 | 1025 |
let ?S = "2^(nat (-e))" |
1026 |
have "inverse (2 ^ nat (- e)) = 2 powr e" |
|
1027 |
using assms False powr_realpow[of 2 "nat (-e)"] |
|
57862 | 1028 |
by (auto simp: powr_minus field_simps) |
60698 | 1029 |
then have "1 \<le> real m * inverse ?S" |
1030 |
using assms False powr_realpow[of 2 "nat (-e)"] |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1031 |
by (auto simp: powr_minus) |
60698 | 1032 |
then have "1 * ?S \<le> real m * inverse ?S * ?S" |
1033 |
by (rule mult_right_mono) auto |
|
1034 |
then have "?S \<le> real m" |
|
1035 |
unfolding mult.assoc by auto |
|
1036 |
then have "?S \<le> m" |
|
1037 |
unfolding real_of_int_le_iff[symmetric] by auto |
|
60500 | 1038 |
from this bitlen_bounds[OF \<open>0 < m\<close>, THEN conjunct2] |
60698 | 1039 |
have "nat (-e) < (nat (bitlen m))" |
1040 |
unfolding power_strict_increasing_iff[OF \<open>1 < 2\<close>, symmetric] |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1041 |
by (rule order_le_less_trans) |
60698 | 1042 |
then have "-e < bitlen m" |
1043 |
using False by auto |
|
1044 |
then show ?thesis |
|
1045 |
by auto |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1046 |
qed |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1047 |
qed |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1048 |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1049 |
lemma bitlen_div: |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1050 |
assumes "0 < m" |
60698 | 1051 |
shows "1 \<le> real m / 2^nat (bitlen m - 1)" |
1052 |
and "real m / 2^nat (bitlen m - 1) < 2" |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1053 |
proof - |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1054 |
let ?B = "2^nat(bitlen m - 1)" |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1055 |
|
60500 | 1056 |
have "?B \<le> m" using bitlen_bounds[OF \<open>0 <m\<close>] .. |
60698 | 1057 |
then have "1 * ?B \<le> real m" |
1058 |
unfolding real_of_int_le_iff[symmetric] by auto |
|
1059 |
then show "1 \<le> real m / ?B" |
|
1060 |
by auto |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1061 |
|
60698 | 1062 |
have "m \<noteq> 0" |
1063 |
using assms by auto |
|
1064 |
have "0 \<le> bitlen m - 1" |
|
1065 |
using \<open>0 < m\<close> by (auto simp: bitlen_def) |
|
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1066 |
|
60698 | 1067 |
have "m < 2^nat(bitlen m)" |
1068 |
using bitlen_bounds[OF \<open>0 <m\<close>] .. |
|
1069 |
also have "\<dots> = 2^nat(bitlen m - 1 + 1)" |
|
1070 |
using \<open>0 < m\<close> by (auto simp: bitlen_def) |
|
1071 |
also have "\<dots> = ?B * 2" |
|
1072 |
unfolding nat_add_distrib[OF \<open>0 \<le> bitlen m - 1\<close> zero_le_one] by auto |
|
1073 |
finally have "real m < 2 * ?B" |
|
1074 |
unfolding real_of_int_less_iff[symmetric] by auto |
|
1075 |
then have "real m / ?B < 2 * ?B / ?B" |
|
1076 |
by (rule divide_strict_right_mono) auto |
|
1077 |
then show "real m / ?B < 2" |
|
1078 |
by auto |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1079 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1080 |
|
60698 | 1081 |
|
60500 | 1082 |
subsection \<open>Truncating Real Numbers\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1083 |
|
60698 | 1084 |
definition truncate_down::"nat \<Rightarrow> real \<Rightarrow> real" |
1085 |
where "truncate_down prec x = round_down (prec - \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - 1) x" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1086 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1087 |
lemma truncate_down: "truncate_down prec x \<le> x" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1088 |
using round_down by (simp add: truncate_down_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1089 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1090 |
lemma truncate_down_le: "x \<le> y \<Longrightarrow> truncate_down prec x \<le> y" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1091 |
by (rule order_trans[OF truncate_down]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1092 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1093 |
lemma truncate_down_zero[simp]: "truncate_down prec 0 = 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1094 |
by (simp add: truncate_down_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1095 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1096 |
lemma truncate_down_float[simp]: "truncate_down p x \<in> float" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1097 |
by (auto simp: truncate_down_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1098 |
|
60698 | 1099 |
definition truncate_up::"nat \<Rightarrow> real \<Rightarrow> real" |
1100 |
where "truncate_up prec x = round_up (prec - \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - 1) x" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1101 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1102 |
lemma truncate_up: "x \<le> truncate_up prec x" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1103 |
using round_up by (simp add: truncate_up_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1104 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1105 |
lemma truncate_up_le: "x \<le> y \<Longrightarrow> x \<le> truncate_up prec y" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1106 |
by (rule order_trans[OF _ truncate_up]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1107 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1108 |
lemma truncate_up_zero[simp]: "truncate_up prec 0 = 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1109 |
by (simp add: truncate_up_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1110 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1111 |
lemma truncate_up_uminus_eq: "truncate_up prec (-x) = - truncate_down prec x" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1112 |
and truncate_down_uminus_eq: "truncate_down prec (-x) = - truncate_up prec x" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1113 |
by (auto simp: truncate_up_def round_up_def truncate_down_def round_down_def ceiling_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1114 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1115 |
lemma truncate_up_float[simp]: "truncate_up p x \<in> float" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1116 |
by (auto simp: truncate_up_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1117 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1118 |
lemma mult_powr_eq: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> x * b powr y = b powr (y + log b x)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1119 |
by (simp_all add: powr_add) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1120 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1121 |
lemma truncate_down_pos: |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1122 |
assumes "x > 0" "p > 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1123 |
shows "truncate_down p x > 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1124 |
proof - |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1125 |
have "0 \<le> log 2 x - real \<lfloor>log 2 x\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1126 |
by (simp add: algebra_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1127 |
from this assms |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1128 |
show ?thesis |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1129 |
by (auto simp: truncate_down_def round_down_def mult_powr_eq |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1130 |
intro!: ge_one_powr_ge_zero mult_pos_pos) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1131 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1132 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1133 |
lemma truncate_down_nonneg: "0 \<le> y \<Longrightarrow> 0 \<le> truncate_down prec y" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1134 |
by (auto simp: truncate_down_def round_down_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1135 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1136 |
lemma truncate_down_ge1: "1 \<le> x \<Longrightarrow> 1 \<le> p \<Longrightarrow> 1 \<le> truncate_down p x" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1137 |
by (auto simp: truncate_down_def algebra_simps intro!: round_down_ge1 add_mono) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1138 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1139 |
lemma truncate_up_nonpos: "x \<le> 0 \<Longrightarrow> truncate_up prec x \<le> 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1140 |
by (auto simp: truncate_up_def round_up_def intro!: mult_nonpos_nonneg) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1141 |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1142 |
lemma truncate_up_le1: |
60698 | 1143 |
assumes "x \<le> 1" "1 \<le> p" |
1144 |
shows "truncate_up p x \<le> 1" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1145 |
proof - |
60698 | 1146 |
consider "x \<le> 0" | "x > 0" |
1147 |
by arith |
|
1148 |
then show ?thesis |
|
1149 |
proof cases |
|
1150 |
case 1 |
|
1151 |
with truncate_up_nonpos[OF this, of p] show ?thesis |
|
1152 |
by simp |
|
1153 |
next |
|
1154 |
case 2 |
|
1155 |
then have le: "\<lfloor>log 2 \<bar>x\<bar>\<rfloor> \<le> 0" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1156 |
using assms by (auto simp: log_less_iff) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1157 |
from assms have "1 \<le> int p" by simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1158 |
from add_mono[OF this le] |
60698 | 1159 |
show ?thesis |
1160 |
using assms by (simp add: truncate_up_def round_up_le1 add_mono) |
|
1161 |
qed |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1162 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1163 |
|
60698 | 1164 |
|
60500 | 1165 |
subsection \<open>Truncating Floats\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1166 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1167 |
lift_definition float_round_up :: "nat \<Rightarrow> float \<Rightarrow> float" is truncate_up |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1168 |
by (simp add: truncate_up_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1169 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1170 |
lemma float_round_up: "real x \<le> real (float_round_up prec x)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1171 |
using truncate_up by transfer simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1172 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1173 |
lemma float_round_up_zero[simp]: "float_round_up prec 0 = 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1174 |
by transfer simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1175 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1176 |
lift_definition float_round_down :: "nat \<Rightarrow> float \<Rightarrow> float" is truncate_down |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1177 |
by (simp add: truncate_down_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1178 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1179 |
lemma float_round_down: "real (float_round_down prec x) \<le> real x" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1180 |
using truncate_down by transfer simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1181 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1182 |
lemma float_round_down_zero[simp]: "float_round_down prec 0 = 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1183 |
by transfer simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1184 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1185 |
lemmas float_round_up_le = order_trans[OF _ float_round_up] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1186 |
and float_round_down_le = order_trans[OF float_round_down] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1187 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1188 |
lemma minus_float_round_up_eq: "- float_round_up prec x = float_round_down prec (- x)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1189 |
and minus_float_round_down_eq: "- float_round_down prec x = float_round_up prec (- x)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1190 |
by (transfer, simp add: truncate_down_uminus_eq truncate_up_uminus_eq)+ |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1191 |
|
60698 | 1192 |
context |
1193 |
begin |
|
1194 |
||
1195 |
qualified lemma compute_float_round_down[code]: |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1196 |
"float_round_down prec (Float m e) = (let d = bitlen (abs m) - int prec in |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1197 |
if 0 < d then Float (div_twopow m (nat d)) (e + d) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1198 |
else Float m e)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1199 |
using Float.compute_float_down[of "prec - bitlen \<bar>m\<bar> - e" m e, symmetric] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1200 |
by transfer (simp add: field_simps abs_mult log_mult bitlen_def truncate_down_def |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1201 |
cong del: if_weak_cong) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1202 |
|
60698 | 1203 |
qualified lemma compute_float_round_up[code]: |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1204 |
"float_round_up prec x = - float_round_down prec (-x)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1205 |
by transfer (simp add: truncate_down_uminus_eq) |
60698 | 1206 |
|
1207 |
end |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1208 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1209 |
|
60500 | 1210 |
subsection \<open>Approximation of positive rationals\<close> |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1211 |
|
60698 | 1212 |
lemma div_mult_twopow_eq: |
1213 |
fixes a b :: nat |
|
1214 |
shows "a div ((2::nat) ^ n) div b = a div (b * 2 ^ n)" |
|
1215 |
by (cases "b = 0") (simp_all add: div_mult2_eq[symmetric] ac_simps) |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1216 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1217 |
lemma real_div_nat_eq_floor_of_divide: |
59984
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
haftmann
parents:
59554
diff
changeset
|
1218 |
fixes a b :: nat |
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
haftmann
parents:
59554
diff
changeset
|
1219 |
shows "a div b = real \<lfloor>a / b\<rfloor>" |
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
haftmann
parents:
59554
diff
changeset
|
1220 |
by (simp add: floor_divide_of_nat_eq [of a b] real_eq_of_nat) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1221 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1222 |
definition "rat_precision prec x y = int prec - (bitlen x - bitlen y)" |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1223 |
|
47600 | 1224 |
lift_definition lapprox_posrat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> float" |
60698 | 1225 |
is "\<lambda>prec (x::nat) (y::nat). round_down (rat_precision prec x y) (x / y)" |
1226 |
by simp |
|
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1227 |
|
60698 | 1228 |
context |
1229 |
begin |
|
1230 |
||
1231 |
qualified lemma compute_lapprox_posrat[code]: |
|
53381 | 1232 |
fixes prec x y |
1233 |
shows "lapprox_posrat prec x y = |
|
1234 |
(let |
|
60698 | 1235 |
l = rat_precision prec x y; |
1236 |
d = if 0 \<le> l then x * 2^nat l div y else x div 2^nat (- l) div y |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1237 |
in normfloat (Float d (- l)))" |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1238 |
unfolding div_mult_twopow_eq |
47600 | 1239 |
by transfer |
47615 | 1240 |
(simp add: round_down_def powr_int real_div_nat_eq_floor_of_divide field_simps Let_def |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1241 |
del: two_powr_minus_int_float) |
60698 | 1242 |
|
1243 |
end |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1244 |
|
47600 | 1245 |
lift_definition rapprox_posrat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> float" |
60698 | 1246 |
is "\<lambda>prec (x::nat) (y::nat). round_up (rat_precision prec x y) (x / y)" by |
1247 |
simp |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1248 |
|
60376 | 1249 |
context |
1250 |
begin |
|
1251 |
||
1252 |
qualified lemma compute_rapprox_posrat[code]: |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1253 |
fixes prec x y |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1254 |
defines "l \<equiv> rat_precision prec x y" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1255 |
shows "rapprox_posrat prec x y = (let |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1256 |
l = l ; |
60868
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60698
diff
changeset
|
1257 |
(r, s) = if 0 \<le> l then (x * 2^nat l, y) else (x, y * 2^nat(-l)) ; |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60698
diff
changeset
|
1258 |
d = r div s ; |
dd18c33c001e
direct bootstrap of integer division from natural division
haftmann
parents:
60698
diff
changeset
|
1259 |
m = r mod s |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1260 |
in normfloat (Float (d + (if m = 0 \<or> y = 0 then 0 else 1)) (- l)))" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1261 |
proof (cases "y = 0") |
60698 | 1262 |
assume "y = 0" |
1263 |
then show ?thesis by transfer simp |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1264 |
next |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1265 |
assume "y \<noteq> 0" |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1266 |
show ?thesis |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1267 |
proof (cases "0 \<le> l") |
60698 | 1268 |
case True |
56777 | 1269 |
def x' \<equiv> "x * 2 ^ nat l" |
60698 | 1270 |
have "int x * 2 ^ nat l = x'" |
1271 |
by (simp add: x'_def int_mult int_power) |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1272 |
moreover have "real x * 2 powr real l = real x'" |
60500 | 1273 |
by (simp add: powr_realpow[symmetric] \<open>0 \<le> l\<close> x'_def) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1274 |
ultimately show ?thesis |
60500 | 1275 |
using ceil_divide_floor_conv[of y x'] powr_realpow[of 2 "nat l"] \<open>0 \<le> l\<close> \<open>y \<noteq> 0\<close> |
47600 | 1276 |
l_def[symmetric, THEN meta_eq_to_obj_eq] |
58834 | 1277 |
by transfer (auto simp add: floor_divide_eq_div [symmetric] round_up_def) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1278 |
next |
60698 | 1279 |
case False |
56777 | 1280 |
def y' \<equiv> "y * 2 ^ nat (- l)" |
60500 | 1281 |
from \<open>y \<noteq> 0\<close> have "y' \<noteq> 0" by (simp add: y'_def) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1282 |
have "int y * 2 ^ nat (- l) = y'" by (simp add: y'_def int_mult int_power) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1283 |
moreover have "real x * real (2::int) powr real l / real y = x / real y'" |
60500 | 1284 |
using \<open>\<not> 0 \<le> l\<close> |
57862 | 1285 |
by (simp add: powr_realpow[symmetric] powr_minus y'_def field_simps) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1286 |
ultimately show ?thesis |
60500 | 1287 |
using ceil_divide_floor_conv[of y' x] \<open>\<not> 0 \<le> l\<close> \<open>y' \<noteq> 0\<close> \<open>y \<noteq> 0\<close> |
47600 | 1288 |
l_def[symmetric, THEN meta_eq_to_obj_eq] |
1289 |
by transfer |
|
58834 | 1290 |
(auto simp add: round_up_def ceil_divide_floor_conv floor_divide_eq_div [symmetric]) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1291 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1292 |
qed |
60376 | 1293 |
|
1294 |
end |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1295 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1296 |
lemma rat_precision_pos: |
60698 | 1297 |
assumes "0 \<le> x" |
1298 |
and "0 < y" |
|
1299 |
and "2 * x < y" |
|
1300 |
and "0 < n" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1301 |
shows "rat_precision n (int x) (int y) > 0" |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1302 |
proof - |
60698 | 1303 |
have "0 < x \<Longrightarrow> log 2 x + 1 = log 2 (2 * x)" |
1304 |
by (simp add: log_mult) |
|
1305 |
then have "bitlen (int x) < bitlen (int y)" |
|
1306 |
using assms |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1307 |
by (simp add: bitlen_def del: floor_add_one) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1308 |
(auto intro!: floor_mono simp add: floor_add_one[symmetric] simp del: floor_add floor_add_one) |
60698 | 1309 |
then show ?thesis |
1310 |
using assms |
|
1311 |
by (auto intro!: pos_add_strict simp add: field_simps rat_precision_def) |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1312 |
qed |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1313 |
|
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
1314 |
lemma rapprox_posrat_less1: |
60698 | 1315 |
"0 \<le> x \<Longrightarrow> 0 < y \<Longrightarrow> 2 * x < y \<Longrightarrow> 0 < n \<Longrightarrow> real (rapprox_posrat n x y) < 1" |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1316 |
by transfer (simp add: rat_precision_pos round_up_less1) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1317 |
|
47600 | 1318 |
lift_definition lapprox_rat :: "nat \<Rightarrow> int \<Rightarrow> int \<Rightarrow> float" is |
60698 | 1319 |
"\<lambda>prec (x::int) (y::int). round_down (rat_precision prec \<bar>x\<bar> \<bar>y\<bar>) (x / y)" |
1320 |
by simp |
|
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1321 |
|
60698 | 1322 |
context |
1323 |
begin |
|
1324 |
||
1325 |
qualified lemma compute_lapprox_rat[code]: |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1326 |
"lapprox_rat prec x y = |
60698 | 1327 |
(if y = 0 then 0 |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1328 |
else if 0 \<le> x then |
60698 | 1329 |
(if 0 < y then lapprox_posrat prec (nat x) (nat y) |
53381 | 1330 |
else - (rapprox_posrat prec (nat x) (nat (-y)))) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1331 |
else (if 0 < y |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1332 |
then - (rapprox_posrat prec (nat (-x)) (nat y)) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1333 |
else lapprox_posrat prec (nat (-x)) (nat (-y))))" |
56479
91958d4b30f7
revert c1bbd3e22226, a14831ac3023, and 36489d77c484: divide_minus_left/right are again simp rules
hoelzl
parents:
56410
diff
changeset
|
1334 |
by transfer (auto simp: round_up_def round_down_def ceiling_def ac_simps) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1335 |
|
47600 | 1336 |
lift_definition rapprox_rat :: "nat \<Rightarrow> int \<Rightarrow> int \<Rightarrow> float" is |
60698 | 1337 |
"\<lambda>prec (x::int) (y::int). round_up (rat_precision prec \<bar>x\<bar> \<bar>y\<bar>) (x / y)" |
1338 |
by simp |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1339 |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1340 |
lemma "rapprox_rat = rapprox_posrat" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1341 |
by transfer auto |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1342 |
|
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1343 |
lemma "lapprox_rat = lapprox_posrat" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1344 |
by transfer auto |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1345 |
|
60698 | 1346 |
qualified lemma compute_rapprox_rat[code]: |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1347 |
"rapprox_rat prec x y = - lapprox_rat prec (-x) y" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1348 |
by transfer (simp add: round_down_uminus_eq) |
60698 | 1349 |
|
1350 |
end |
|
1351 |
||
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1352 |
|
60500 | 1353 |
subsection \<open>Division\<close> |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1354 |
|
54782 | 1355 |
definition "real_divl prec a b = round_down (int prec + \<lfloor> log 2 \<bar>b\<bar> \<rfloor> - \<lfloor> log 2 \<bar>a\<bar> \<rfloor>) (a / b)" |
1356 |
||
1357 |
definition "real_divr prec a b = round_up (int prec + \<lfloor> log 2 \<bar>b\<bar> \<rfloor> - \<lfloor> log 2 \<bar>a\<bar> \<rfloor>) (a / b)" |
|
1358 |
||
1359 |
lift_definition float_divl :: "nat \<Rightarrow> float \<Rightarrow> float \<Rightarrow> float" is real_divl |
|
1360 |
by (simp add: real_divl_def) |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1361 |
|
60698 | 1362 |
context |
1363 |
begin |
|
1364 |
||
1365 |
qualified lemma compute_float_divl[code]: |
|
47600 | 1366 |
"float_divl prec (Float m1 s1) (Float m2 s2) = lapprox_rat prec m1 m2 * Float 1 (s1 - s2)" |
60698 | 1367 |
proof (cases "m1 \<noteq> 0 \<and> m2 \<noteq> 0") |
1368 |
case True |
|
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
1369 |
let ?f1 = "real m1 * 2 powr real s1" and ?f2 = "real m2 * 2 powr real s2" |
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
1370 |
let ?m = "real m1 / real m2" and ?s = "2 powr real (s1 - s2)" |
60698 | 1371 |
from True have eq2: "(int prec + \<lfloor>log 2 \<bar>?f2\<bar>\<rfloor> - \<lfloor>log 2 \<bar>?f1\<bar>\<rfloor>) = |
1372 |
rat_precision prec \<bar>m1\<bar> \<bar>m2\<bar> + (s2 - s1)" |
|
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
1373 |
by (simp add: abs_mult log_mult rat_precision_def bitlen_def) |
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
1374 |
have eq1: "real m1 * 2 powr real s1 / (real m2 * 2 powr real s2) = ?m * ?s" |
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
1375 |
by (simp add: field_simps powr_divide2[symmetric]) |
60698 | 1376 |
from True show ?thesis |
54782 | 1377 |
by (transfer fixing: m1 s1 m2 s2 prec) (unfold eq1 eq2 round_down_shift real_divl_def, |
1378 |
simp add: field_simps) |
|
60698 | 1379 |
next |
1380 |
case False |
|
1381 |
then show ?thesis by transfer (auto simp: real_divl_def) |
|
1382 |
qed |
|
47600 | 1383 |
|
54782 | 1384 |
lift_definition float_divr :: "nat \<Rightarrow> float \<Rightarrow> float \<Rightarrow> float" is real_divr |
1385 |
by (simp add: real_divr_def) |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1386 |
|
60698 | 1387 |
qualified lemma compute_float_divr[code]: |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1388 |
"float_divr prec x y = - float_divl prec (-x) y" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1389 |
by transfer (simp add: real_divr_def real_divl_def round_down_uminus_eq) |
60698 | 1390 |
|
1391 |
end |
|
47600 | 1392 |
|
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1393 |
|
60500 | 1394 |
subsection \<open>Approximate Power\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1395 |
|
60698 | 1396 |
lemma div2_less_self[termination_simp]: |
1397 |
fixes n :: nat |
|
1398 |
shows "odd n \<Longrightarrow> n div 2 < n" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1399 |
by (simp add: odd_pos) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1400 |
|
60698 | 1401 |
fun power_down :: "nat \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> real" |
1402 |
where |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1403 |
"power_down p x 0 = 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1404 |
| "power_down p x (Suc n) = |
60698 | 1405 |
(if odd n then truncate_down (Suc p) ((power_down p x (Suc n div 2))\<^sup>2) |
1406 |
else truncate_down (Suc p) (x * power_down p x n))" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1407 |
|
60698 | 1408 |
fun power_up :: "nat \<Rightarrow> real \<Rightarrow> nat \<Rightarrow> real" |
1409 |
where |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1410 |
"power_up p x 0 = 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1411 |
| "power_up p x (Suc n) = |
60698 | 1412 |
(if odd n then truncate_up p ((power_up p x (Suc n div 2))\<^sup>2) |
1413 |
else truncate_up p (x * power_up p x n))" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1414 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1415 |
lift_definition power_up_fl :: "nat \<Rightarrow> float \<Rightarrow> nat \<Rightarrow> float" is power_up |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1416 |
by (induct_tac rule: power_up.induct) simp_all |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1417 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1418 |
lift_definition power_down_fl :: "nat \<Rightarrow> float \<Rightarrow> nat \<Rightarrow> float" is power_down |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1419 |
by (induct_tac rule: power_down.induct) simp_all |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1420 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1421 |
lemma power_float_transfer[transfer_rule]: |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1422 |
"(rel_fun pcr_float (rel_fun op = pcr_float)) op ^ op ^" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1423 |
unfolding power_def |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1424 |
by transfer_prover |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1425 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1426 |
lemma compute_power_up_fl[code]: |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1427 |
"power_up_fl p x 0 = 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1428 |
"power_up_fl p x (Suc n) = |
60698 | 1429 |
(if odd n then float_round_up p ((power_up_fl p x (Suc n div 2))\<^sup>2) |
1430 |
else float_round_up p (x * power_up_fl p x n))" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1431 |
and compute_power_down_fl[code]: |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1432 |
"power_down_fl p x 0 = 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1433 |
"power_down_fl p x (Suc n) = |
60698 | 1434 |
(if odd n then float_round_down (Suc p) ((power_down_fl p x (Suc n div 2))\<^sup>2) |
1435 |
else float_round_down (Suc p) (x * power_down_fl p x n))" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1436 |
unfolding atomize_conj |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1437 |
by transfer simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1438 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1439 |
lemma power_down_pos: "0 < x \<Longrightarrow> 0 < power_down p x n" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1440 |
by (induct p x n rule: power_down.induct) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1441 |
(auto simp del: odd_Suc_div_two intro!: truncate_down_pos) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1442 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1443 |
lemma power_down_nonneg: "0 \<le> x \<Longrightarrow> 0 \<le> power_down p x n" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1444 |
by (induct p x n rule: power_down.induct) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1445 |
(auto simp del: odd_Suc_div_two intro!: truncate_down_nonneg mult_nonneg_nonneg) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1446 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1447 |
lemma power_down: "0 \<le> x \<Longrightarrow> power_down p x n \<le> x ^ n" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1448 |
proof (induct p x n rule: power_down.induct) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1449 |
case (2 p x n) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1450 |
{ |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1451 |
assume "odd n" |
60698 | 1452 |
then have "(power_down p x (Suc n div 2)) ^ 2 \<le> (x ^ (Suc n div 2)) ^ 2" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1453 |
using 2 |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1454 |
by (auto intro: power_mono power_down_nonneg simp del: odd_Suc_div_two) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1455 |
also have "\<dots> = x ^ (Suc n div 2 * 2)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1456 |
by (simp add: power_mult[symmetric]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1457 |
also have "Suc n div 2 * 2 = Suc n" |
60500 | 1458 |
using \<open>odd n\<close> by presburger |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1459 |
finally have ?case |
60500 | 1460 |
using \<open>odd n\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1461 |
by (auto intro!: truncate_down_le simp del: odd_Suc_div_two) |
60698 | 1462 |
} |
1463 |
then show ?case |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1464 |
by (auto intro!: truncate_down_le mult_left_mono 2 mult_nonneg_nonneg power_down_nonneg) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1465 |
qed simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1466 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1467 |
lemma power_up: "0 \<le> x \<Longrightarrow> x ^ n \<le> power_up p x n" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1468 |
proof (induct p x n rule: power_up.induct) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1469 |
case (2 p x n) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1470 |
{ |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1471 |
assume "odd n" |
60698 | 1472 |
then have "Suc n = Suc n div 2 * 2" |
60500 | 1473 |
using \<open>odd n\<close> even_Suc by presburger |
60698 | 1474 |
then have "x ^ Suc n \<le> (x ^ (Suc n div 2))\<^sup>2" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1475 |
by (simp add: power_mult[symmetric]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1476 |
also have "\<dots> \<le> (power_up p x (Suc n div 2))\<^sup>2" |
60500 | 1477 |
using 2 \<open>odd n\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1478 |
by (auto intro: power_mono simp del: odd_Suc_div_two ) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1479 |
finally have ?case |
60500 | 1480 |
using \<open>odd n\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1481 |
by (auto intro!: truncate_up_le simp del: odd_Suc_div_two ) |
60698 | 1482 |
} |
1483 |
then show ?case |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1484 |
by (auto intro!: truncate_up_le mult_left_mono 2) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1485 |
qed simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1486 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1487 |
lemmas power_up_le = order_trans[OF _ power_up] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1488 |
and power_up_less = less_le_trans[OF _ power_up] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1489 |
and power_down_le = order_trans[OF power_down] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1490 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1491 |
lemma power_down_fl: "0 \<le> x \<Longrightarrow> power_down_fl p x n \<le> x ^ n" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1492 |
by transfer (rule power_down) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1493 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1494 |
lemma power_up_fl: "0 \<le> x \<Longrightarrow> x ^ n \<le> power_up_fl p x n" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1495 |
by transfer (rule power_up) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1496 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1497 |
lemma real_power_up_fl: "real (power_up_fl p x n) = power_up p x n" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1498 |
by transfer simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1499 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1500 |
lemma real_power_down_fl: "real (power_down_fl p x n) = power_down p x n" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1501 |
by transfer simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1502 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1503 |
|
60500 | 1504 |
subsection \<open>Approximate Addition\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1505 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1506 |
definition "plus_down prec x y = truncate_down prec (x + y)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1507 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1508 |
definition "plus_up prec x y = truncate_up prec (x + y)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1509 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1510 |
lemma float_plus_down_float[intro, simp]: "x \<in> float \<Longrightarrow> y \<in> float \<Longrightarrow> plus_down p x y \<in> float" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1511 |
by (simp add: plus_down_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1512 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1513 |
lemma float_plus_up_float[intro, simp]: "x \<in> float \<Longrightarrow> y \<in> float \<Longrightarrow> plus_up p x y \<in> float" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1514 |
by (simp add: plus_up_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1515 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1516 |
lift_definition float_plus_down::"nat \<Rightarrow> float \<Rightarrow> float \<Rightarrow> float" is plus_down .. |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1517 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1518 |
lift_definition float_plus_up::"nat \<Rightarrow> float \<Rightarrow> float \<Rightarrow> float" is plus_up .. |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1519 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1520 |
lemma plus_down: "plus_down prec x y \<le> x + y" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1521 |
and plus_up: "x + y \<le> plus_up prec x y" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1522 |
by (auto simp: plus_down_def truncate_down plus_up_def truncate_up) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1523 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1524 |
lemma float_plus_down: "real (float_plus_down prec x y) \<le> x + y" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1525 |
and float_plus_up: "x + y \<le> real (float_plus_up prec x y)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1526 |
by (transfer, rule plus_down plus_up)+ |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1527 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1528 |
lemmas plus_down_le = order_trans[OF plus_down] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1529 |
and plus_up_le = order_trans[OF _ plus_up] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1530 |
and float_plus_down_le = order_trans[OF float_plus_down] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1531 |
and float_plus_up_le = order_trans[OF _ float_plus_up] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1532 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1533 |
lemma compute_plus_up[code]: "plus_up p x y = - plus_down p (-x) (-y)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1534 |
using truncate_down_uminus_eq[of p "x + y"] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1535 |
by (auto simp: plus_down_def plus_up_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1536 |
|
60698 | 1537 |
lemma truncate_down_log2_eqI: |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1538 |
assumes "\<lfloor>log 2 \<bar>x\<bar>\<rfloor> = \<lfloor>log 2 \<bar>y\<bar>\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1539 |
assumes "\<lfloor>x * 2 powr (p - \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - 1)\<rfloor> = \<lfloor>y * 2 powr (p - \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - 1)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1540 |
shows "truncate_down p x = truncate_down p y" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1541 |
using assms by (auto simp: truncate_down_def round_down_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1542 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1543 |
lemma bitlen_eq_zero_iff: "bitlen x = 0 \<longleftrightarrow> x \<le> 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1544 |
by (clarsimp simp add: bitlen_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1545 |
(metis Float.compute_bitlen add.commute bitlen_def bitlen_nonneg less_add_same_cancel2 not_less |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1546 |
zero_less_one) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1547 |
|
60698 | 1548 |
lemma sum_neq_zeroI: |
1549 |
fixes a k :: real |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1550 |
shows "abs a \<ge> k \<Longrightarrow> abs b < k \<Longrightarrow> a + b \<noteq> 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1551 |
and "abs a > k \<Longrightarrow> abs b \<le> k \<Longrightarrow> a + b \<noteq> 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1552 |
by auto |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1553 |
|
60698 | 1554 |
lemma abs_real_le_2_powr_bitlen[simp]: "\<bar>real m2\<bar> < 2 powr real (bitlen \<bar>m2\<bar>)" |
1555 |
proof (cases "m2 = 0") |
|
1556 |
case True |
|
1557 |
then show ?thesis by simp |
|
1558 |
next |
|
1559 |
case False |
|
1560 |
then have "\<bar>m2\<bar> < 2 ^ nat (bitlen \<bar>m2\<bar>)" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1561 |
using bitlen_bounds[of "\<bar>m2\<bar>"] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1562 |
by (auto simp: powr_add bitlen_nonneg) |
60698 | 1563 |
then show ?thesis |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1564 |
by (simp add: powr_int bitlen_nonneg real_of_int_less_iff[symmetric]) |
60698 | 1565 |
qed |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1566 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1567 |
lemma floor_sum_times_2_powr_sgn_eq: |
60698 | 1568 |
fixes ai p q :: int |
1569 |
and a b :: real |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1570 |
assumes "a * 2 powr p = ai" |
60698 | 1571 |
and b_le_1: "abs (b * 2 powr (p + 1)) \<le> 1" |
1572 |
and leqp: "q \<le> p" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1573 |
shows "\<lfloor>(a + b) * 2 powr q\<rfloor> = \<lfloor>(2 * ai + sgn b) * 2 powr (q - p - 1)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1574 |
proof - |
60698 | 1575 |
consider "b = 0" | "b > 0" | "b < 0" by arith |
1576 |
then show ?thesis |
|
1577 |
proof cases |
|
1578 |
case 1 |
|
1579 |
then show ?thesis |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1580 |
by (simp add: assms(1)[symmetric] powr_add[symmetric] algebra_simps powr_mult_base) |
60698 | 1581 |
next |
1582 |
case 2 |
|
1583 |
then have "b * 2 powr p < abs (b * 2 powr (p + 1))" |
|
1584 |
by simp |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1585 |
also note b_le_1 |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1586 |
finally have b_less_1: "b * 2 powr real p < 1" . |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1587 |
|
60500 | 1588 |
from b_less_1 \<open>b > 0\<close> have floor_eq: "\<lfloor>b * 2 powr real p\<rfloor> = 0" "\<lfloor>sgn b / 2\<rfloor> = 0" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1589 |
by (simp_all add: floor_eq_iff) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1590 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1591 |
have "\<lfloor>(a + b) * 2 powr q\<rfloor> = \<lfloor>(a + b) * 2 powr p * 2 powr (q - p)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1592 |
by (simp add: algebra_simps powr_realpow[symmetric] powr_add[symmetric]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1593 |
also have "\<dots> = \<lfloor>(ai + b * 2 powr p) * 2 powr (q - p)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1594 |
by (simp add: assms algebra_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1595 |
also have "\<dots> = \<lfloor>(ai + b * 2 powr p) / real ((2::int) ^ nat (p - q))\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1596 |
using assms |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1597 |
by (simp add: algebra_simps powr_realpow[symmetric] divide_powr_uminus powr_add[symmetric]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1598 |
also have "\<dots> = \<lfloor>ai / real ((2::int) ^ nat (p - q))\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1599 |
by (simp del: real_of_int_power add: floor_divide_real_eq_div floor_eq) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1600 |
finally have "\<lfloor>(a + b) * 2 powr real q\<rfloor> = \<lfloor>real ai / real ((2::int) ^ nat (p - q))\<rfloor>" . |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1601 |
moreover |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1602 |
{ |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1603 |
have "\<lfloor>(2 * ai + sgn b) * 2 powr (real (q - p) - 1)\<rfloor> = \<lfloor>(ai + sgn b / 2) * 2 powr (q - p)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1604 |
by (subst powr_divide2[symmetric]) (simp add: field_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1605 |
also have "\<dots> = \<lfloor>(ai + sgn b / 2) / real ((2::int) ^ nat (p - q))\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1606 |
using leqp by (simp add: powr_realpow[symmetric] powr_divide2[symmetric]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1607 |
also have "\<dots> = \<lfloor>ai / real ((2::int) ^ nat (p - q))\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1608 |
by (simp del: real_of_int_power add: floor_divide_real_eq_div floor_eq) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1609 |
finally |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1610 |
have "\<lfloor>(2 * ai + (sgn b)) * 2 powr (real (q - p) - 1)\<rfloor> = |
60698 | 1611 |
\<lfloor>real ai / real ((2::int) ^ nat (p - q))\<rfloor>" . |
1612 |
} |
|
1613 |
ultimately show ?thesis by simp |
|
1614 |
next |
|
1615 |
case 3 |
|
1616 |
then have floor_eq: "\<lfloor>b * 2 powr (real p + 1)\<rfloor> = -1" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1617 |
using b_le_1 |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1618 |
by (auto simp: floor_eq_iff algebra_simps pos_divide_le_eq[symmetric] abs_if divide_powr_uminus |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1619 |
intro!: mult_neg_pos split: split_if_asm) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1620 |
have "\<lfloor>(a + b) * 2 powr q\<rfloor> = \<lfloor>(2*a + 2*b) * 2 powr p * 2 powr (q - p - 1)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1621 |
by (simp add: algebra_simps powr_realpow[symmetric] powr_add[symmetric] powr_mult_base) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1622 |
also have "\<dots> = \<lfloor>(2 * (a * 2 powr p) + 2 * b * 2 powr p) * 2 powr (q - p - 1)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1623 |
by (simp add: algebra_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1624 |
also have "\<dots> = \<lfloor>(2 * ai + b * 2 powr (p + 1)) / 2 powr (1 - q + p)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1625 |
using assms by (simp add: algebra_simps powr_mult_base divide_powr_uminus) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1626 |
also have "\<dots> = \<lfloor>(2 * ai + b * 2 powr (p + 1)) / real ((2::int) ^ nat (p - q + 1))\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1627 |
using assms by (simp add: algebra_simps powr_realpow[symmetric]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1628 |
also have "\<dots> = \<lfloor>(2 * ai - 1) / real ((2::int) ^ nat (p - q + 1))\<rfloor>" |
60500 | 1629 |
using \<open>b < 0\<close> assms |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1630 |
by (simp add: floor_divide_eq_div floor_eq floor_divide_real_eq_div |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1631 |
del: real_of_int_mult real_of_int_power real_of_int_diff) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1632 |
also have "\<dots> = \<lfloor>(2 * ai - 1) * 2 powr (q - p - 1)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1633 |
using assms by (simp add: algebra_simps divide_powr_uminus powr_realpow[symmetric]) |
60698 | 1634 |
finally show ?thesis |
1635 |
using \<open>b < 0\<close> by simp |
|
1636 |
qed |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1637 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1638 |
|
60698 | 1639 |
lemma log2_abs_int_add_less_half_sgn_eq: |
1640 |
fixes ai :: int |
|
1641 |
and b :: real |
|
1642 |
assumes "abs b \<le> 1/2" |
|
1643 |
and "ai \<noteq> 0" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1644 |
shows "\<lfloor>log 2 \<bar>real ai + b\<bar>\<rfloor> = \<lfloor>log 2 \<bar>ai + sgn b / 2\<bar>\<rfloor>" |
60698 | 1645 |
proof (cases "b = 0") |
1646 |
case True |
|
1647 |
then show ?thesis by simp |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1648 |
next |
60698 | 1649 |
case False |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1650 |
def k \<equiv> "\<lfloor>log 2 \<bar>ai\<bar>\<rfloor>" |
60698 | 1651 |
then have "\<lfloor>log 2 \<bar>ai\<bar>\<rfloor> = k" |
1652 |
by simp |
|
1653 |
then have k: "2 powr k \<le> \<bar>ai\<bar>" "\<bar>ai\<bar> < 2 powr (k + 1)" |
|
60500 | 1654 |
by (simp_all add: floor_log_eq_powr_iff \<open>ai \<noteq> 0\<close>) |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1655 |
have "k \<ge> 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1656 |
using assms by (auto simp: k_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1657 |
def r \<equiv> "\<bar>ai\<bar> - 2 ^ nat k" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1658 |
have r: "0 \<le> r" "r < 2 powr k" |
60500 | 1659 |
using \<open>k \<ge> 0\<close> k |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1660 |
by (auto simp: r_def k_def algebra_simps powr_add abs_if powr_int) |
60698 | 1661 |
then have "r \<le> (2::int) ^ nat k - 1" |
60500 | 1662 |
using \<open>k \<ge> 0\<close> by (auto simp: powr_int) |
1663 |
from this[simplified real_of_int_le_iff[symmetric]] \<open>0 \<le> k\<close> |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1664 |
have r_le: "r \<le> 2 powr k - 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1665 |
by (auto simp: algebra_simps powr_int simp del: real_of_int_le_iff) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1666 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1667 |
have "\<bar>ai\<bar> = 2 powr k + r" |
60500 | 1668 |
using \<open>k \<ge> 0\<close> by (auto simp: k_def r_def powr_realpow[symmetric]) |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1669 |
|
60698 | 1670 |
have pos: "abs b < 1 \<Longrightarrow> 0 < 2 powr k + (r + b)" for b :: real |
60500 | 1671 |
using \<open>0 \<le> k\<close> \<open>ai \<noteq> 0\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1672 |
by (auto simp add: r_def powr_realpow[symmetric] abs_if sgn_if algebra_simps |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1673 |
split: split_if_asm) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1674 |
have less: "\<bar>sgn ai * b\<bar> < 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1675 |
and less': "\<bar>sgn (sgn ai * b) / 2\<bar> < 1" |
60500 | 1676 |
using \<open>abs b \<le> _\<close> by (auto simp: abs_if sgn_if split: split_if_asm) |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1677 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1678 |
have floor_eq: "\<And>b::real. abs b \<le> 1 / 2 \<Longrightarrow> |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1679 |
\<lfloor>log 2 (1 + (r + b) / 2 powr k)\<rfloor> = (if r = 0 \<and> b < 0 then -1 else 0)" |
60500 | 1680 |
using \<open>k \<ge> 0\<close> r r_le |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1681 |
by (auto simp: floor_log_eq_powr_iff powr_minus_divide field_simps sgn_if) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1682 |
|
60500 | 1683 |
from \<open>real \<bar>ai\<bar> = _\<close> have "\<bar>ai + b\<bar> = 2 powr k + (r + sgn ai * b)" |
1684 |
using \<open>abs b <= _\<close> \<open>0 \<le> k\<close> r |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1685 |
by (auto simp add: sgn_if abs_if) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1686 |
also have "\<lfloor>log 2 \<dots>\<rfloor> = \<lfloor>log 2 (2 powr k + r + sgn (sgn ai * b) / 2)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1687 |
proof - |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1688 |
have "2 powr k + (r + (sgn ai) * b) = 2 powr k * (1 + (r + sgn ai * b) / 2 powr k)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1689 |
by (simp add: field_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1690 |
also have "\<lfloor>log 2 \<dots>\<rfloor> = k + \<lfloor>log 2 (1 + (r + sgn ai * b) / 2 powr k)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1691 |
using pos[OF less] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1692 |
by (subst log_mult) (simp_all add: log_mult powr_mult field_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1693 |
also |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1694 |
let ?if = "if r = 0 \<and> sgn ai * b < 0 then -1 else 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1695 |
have "\<lfloor>log 2 (1 + (r + sgn ai * b) / 2 powr k)\<rfloor> = ?if" |
60500 | 1696 |
using \<open>abs b <= _\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1697 |
by (intro floor_eq) (auto simp: abs_mult sgn_if) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1698 |
also |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1699 |
have "\<dots> = \<lfloor>log 2 (1 + (r + sgn (sgn ai * b) / 2) / 2 powr k)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1700 |
by (subst floor_eq) (auto simp: sgn_if) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1701 |
also have "k + \<dots> = \<lfloor>log 2 (2 powr k * (1 + (r + sgn (sgn ai * b) / 2) / 2 powr k))\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1702 |
unfolding floor_add2[symmetric] |
60500 | 1703 |
using pos[OF less'] \<open>abs b \<le> _\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1704 |
by (simp add: field_simps add_log_eq_powr) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1705 |
also have "2 powr k * (1 + (r + sgn (sgn ai * b) / 2) / 2 powr k) = |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1706 |
2 powr k + r + sgn (sgn ai * b) / 2" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1707 |
by (simp add: sgn_if field_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1708 |
finally show ?thesis . |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1709 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1710 |
also have "2 powr k + r + sgn (sgn ai * b) / 2 = \<bar>ai + sgn b / 2\<bar>" |
60500 | 1711 |
unfolding \<open>real \<bar>ai\<bar> = _\<close>[symmetric] using \<open>ai \<noteq> 0\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1712 |
by (auto simp: abs_if sgn_if algebra_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1713 |
finally show ?thesis . |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1714 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1715 |
|
60698 | 1716 |
context |
1717 |
begin |
|
1718 |
||
1719 |
qualified lemma compute_far_float_plus_down: |
|
1720 |
fixes m1 e1 m2 e2 :: int |
|
1721 |
and p :: nat |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1722 |
defines "k1 \<equiv> p - nat (bitlen \<bar>m1\<bar>)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1723 |
assumes H: "bitlen \<bar>m2\<bar> \<le> e1 - e2 - k1 - 2" "m1 \<noteq> 0" "m2 \<noteq> 0" "e1 \<ge> e2" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1724 |
shows "float_plus_down p (Float m1 e1) (Float m2 e2) = |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1725 |
float_round_down p (Float (m1 * 2 ^ (Suc (Suc k1)) + sgn m2) (e1 - int k1 - 2))" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1726 |
proof - |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1727 |
let ?a = "real (Float m1 e1)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1728 |
let ?b = "real (Float m2 e2)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1729 |
let ?sum = "?a + ?b" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1730 |
let ?shift = "real e2 - real e1 + real k1 + 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1731 |
let ?m1 = "m1 * 2 ^ Suc k1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1732 |
let ?m2 = "m2 * 2 powr ?shift" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1733 |
let ?m2' = "sgn m2 / 2" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1734 |
let ?e = "e1 - int k1 - 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1735 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1736 |
have sum_eq: "?sum = (?m1 + ?m2) * 2 powr ?e" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1737 |
by (auto simp: powr_add[symmetric] powr_mult[symmetric] algebra_simps |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1738 |
powr_realpow[symmetric] powr_mult_base) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1739 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1740 |
have "\<bar>?m2\<bar> * 2 < 2 powr (bitlen \<bar>m2\<bar> + ?shift + 1)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1741 |
by (auto simp: field_simps powr_add powr_mult_base powr_numeral powr_divide2[symmetric] abs_mult) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1742 |
also have "\<dots> \<le> 2 powr 0" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1743 |
using H by (intro powr_mono) auto |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1744 |
finally have abs_m2_less_half: "\<bar>?m2\<bar> < 1 / 2" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1745 |
by simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1746 |
|
60698 | 1747 |
then have "\<bar>real m2\<bar> < 2 powr -(?shift + 1)" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1748 |
unfolding powr_minus_divide by (auto simp: bitlen_def field_simps powr_mult_base abs_mult) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1749 |
also have "\<dots> \<le> 2 powr real (e1 - e2 - 2)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1750 |
by simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1751 |
finally have b_less_quarter: "\<bar>?b\<bar> < 1/4 * 2 powr real e1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1752 |
by (simp add: powr_add field_simps powr_divide2[symmetric] powr_numeral abs_mult) |
60500 | 1753 |
also have "1/4 < \<bar>real m1\<bar> / 2" using \<open>m1 \<noteq> 0\<close> by simp |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1754 |
finally have b_less_half_a: "\<bar>?b\<bar> < 1/2 * \<bar>?a\<bar>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1755 |
by (simp add: algebra_simps powr_mult_base abs_mult) |
60698 | 1756 |
then have a_half_less_sum: "\<bar>?a\<bar> / 2 < \<bar>?sum\<bar>" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1757 |
by (auto simp: field_simps abs_if split: split_if_asm) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1758 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1759 |
from b_less_half_a have "\<bar>?b\<bar> < \<bar>?a\<bar>" "\<bar>?b\<bar> \<le> \<bar>?a\<bar>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1760 |
by simp_all |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1761 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1762 |
have "\<bar>real (Float m1 e1)\<bar> \<ge> 1/4 * 2 powr real e1" |
60500 | 1763 |
using \<open>m1 \<noteq> 0\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1764 |
by (auto simp: powr_add powr_int bitlen_nonneg divide_right_mono abs_mult) |
60698 | 1765 |
then have "?sum \<noteq> 0" using b_less_quarter |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1766 |
by (rule sum_neq_zeroI) |
60698 | 1767 |
then have "?m1 + ?m2 \<noteq> 0" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1768 |
unfolding sum_eq by (simp add: abs_mult zero_less_mult_iff) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1769 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1770 |
have "\<bar>real ?m1\<bar> \<ge> 2 ^ Suc k1" "\<bar>?m2'\<bar> < 2 ^ Suc k1" |
60500 | 1771 |
using \<open>m1 \<noteq> 0\<close> \<open>m2 \<noteq> 0\<close> by (auto simp: sgn_if less_1_mult abs_mult simp del: power.simps) |
60698 | 1772 |
then have sum'_nz: "?m1 + ?m2' \<noteq> 0" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1773 |
by (intro sum_neq_zeroI) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1774 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1775 |
have "\<lfloor>log 2 \<bar>real (Float m1 e1) + real (Float m2 e2)\<bar>\<rfloor> = \<lfloor>log 2 \<bar>?m1 + ?m2\<bar>\<rfloor> + ?e" |
60500 | 1776 |
using \<open>?m1 + ?m2 \<noteq> 0\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1777 |
unfolding floor_add[symmetric] sum_eq |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1778 |
by (simp add: abs_mult log_mult) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1779 |
also have "\<lfloor>log 2 \<bar>?m1 + ?m2\<bar>\<rfloor> = \<lfloor>log 2 \<bar>?m1 + sgn (real m2 * 2 powr ?shift) / 2\<bar>\<rfloor>" |
60500 | 1780 |
using abs_m2_less_half \<open>m1 \<noteq> 0\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1781 |
by (intro log2_abs_int_add_less_half_sgn_eq) (auto simp: abs_mult) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1782 |
also have "sgn (real m2 * 2 powr ?shift) = sgn m2" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1783 |
by (auto simp: sgn_if zero_less_mult_iff less_not_sym) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1784 |
also |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1785 |
have "\<bar>?m1 + ?m2'\<bar> * 2 powr ?e = \<bar>?m1 * 2 + sgn m2\<bar> * 2 powr (?e - 1)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1786 |
by (auto simp: field_simps powr_minus[symmetric] powr_divide2[symmetric] powr_mult_base) |
60698 | 1787 |
then have "\<lfloor>log 2 \<bar>?m1 + ?m2'\<bar>\<rfloor> + ?e = \<lfloor>log 2 \<bar>real (Float (?m1 * 2 + sgn m2) (?e - 1))\<bar>\<rfloor>" |
60500 | 1788 |
using \<open>?m1 + ?m2' \<noteq> 0\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1789 |
unfolding floor_add[symmetric] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1790 |
by (simp add: log_add_eq_powr abs_mult_pos) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1791 |
finally |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1792 |
have "\<lfloor>log 2 \<bar>?sum\<bar>\<rfloor> = \<lfloor>log 2 \<bar>real (Float (?m1*2 + sgn m2) (?e - 1))\<bar>\<rfloor>" . |
60698 | 1793 |
then have "plus_down p (Float m1 e1) (Float m2 e2) = |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1794 |
truncate_down p (Float (?m1*2 + sgn m2) (?e - 1))" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1795 |
unfolding plus_down_def |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1796 |
proof (rule truncate_down_log2_eqI) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1797 |
let ?f = "(int p - \<lfloor>log 2 \<bar>real (Float m1 e1) + real (Float m2 e2)\<bar>\<rfloor> - 1)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1798 |
let ?ai = "m1 * 2 ^ (Suc k1)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1799 |
have "\<lfloor>(?a + ?b) * 2 powr real ?f\<rfloor> = \<lfloor>(real (2 * ?ai) + sgn ?b) * 2 powr real (?f - - ?e - 1)\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1800 |
proof (rule floor_sum_times_2_powr_sgn_eq) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1801 |
show "?a * 2 powr real (-?e) = real ?ai" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1802 |
by (simp add: powr_add powr_realpow[symmetric] powr_divide2[symmetric]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1803 |
show "\<bar>?b * 2 powr real (-?e + 1)\<bar> \<le> 1" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1804 |
using abs_m2_less_half |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1805 |
by (simp add: abs_mult powr_add[symmetric] algebra_simps powr_mult_base) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1806 |
next |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1807 |
have "e1 + \<lfloor>log 2 \<bar>real m1\<bar>\<rfloor> - 1 = \<lfloor>log 2 \<bar>?a\<bar>\<rfloor> - 1" |
60500 | 1808 |
using \<open>m1 \<noteq> 0\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1809 |
by (simp add: floor_add2[symmetric] algebra_simps log_mult abs_mult del: floor_add2) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1810 |
also have "\<dots> \<le> \<lfloor>log 2 \<bar>?a + ?b\<bar>\<rfloor>" |
60500 | 1811 |
using a_half_less_sum \<open>m1 \<noteq> 0\<close> \<open>?sum \<noteq> 0\<close> |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1812 |
unfolding floor_subtract[symmetric] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1813 |
by (auto simp add: log_minus_eq_powr powr_minus_divide |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1814 |
intro!: floor_mono) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1815 |
finally |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1816 |
have "int p - \<lfloor>log 2 \<bar>?a + ?b\<bar>\<rfloor> \<le> p - (bitlen \<bar>m1\<bar>) - e1 + 2" |
60500 | 1817 |
by (auto simp: algebra_simps bitlen_def \<open>m1 \<noteq> 0\<close>) |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1818 |
also have "\<dots> \<le> 1 - ?e" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1819 |
using bitlen_nonneg[of "\<bar>m1\<bar>"] by (simp add: k1_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1820 |
finally show "?f \<le> - ?e" by simp |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1821 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1822 |
also have "sgn ?b = sgn m2" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1823 |
using powr_gt_zero[of 2 e2] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1824 |
by (auto simp add: sgn_if zero_less_mult_iff simp del: powr_gt_zero) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1825 |
also have "\<lfloor>(real (2 * ?m1) + real (sgn m2)) * 2 powr real (?f - - ?e - 1)\<rfloor> = |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1826 |
\<lfloor>Float (?m1 * 2 + sgn m2) (?e - 1) * 2 powr ?f\<rfloor>" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1827 |
by (simp add: powr_add[symmetric] algebra_simps powr_realpow[symmetric]) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1828 |
finally |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1829 |
show "\<lfloor>(?a + ?b) * 2 powr ?f\<rfloor> = \<lfloor>real (Float (?m1 * 2 + sgn m2) (?e - 1)) * 2 powr ?f\<rfloor>" . |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1830 |
qed |
60698 | 1831 |
then show ?thesis |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1832 |
by transfer (simp add: plus_down_def ac_simps Let_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1833 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1834 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1835 |
lemma compute_float_plus_down_naive[code]: "float_plus_down p x y = float_round_down p (x + y)" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1836 |
by transfer (auto simp: plus_down_def) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1837 |
|
60698 | 1838 |
qualified lemma compute_float_plus_down[code]: |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1839 |
fixes p::nat and m1 e1 m2 e2::int |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1840 |
shows "float_plus_down p (Float m1 e1) (Float m2 e2) = |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1841 |
(if m1 = 0 then float_round_down p (Float m2 e2) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1842 |
else if m2 = 0 then float_round_down p (Float m1 e1) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1843 |
else (if e1 \<ge> e2 then |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1844 |
(let |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1845 |
k1 = p - nat (bitlen \<bar>m1\<bar>) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1846 |
in |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1847 |
if bitlen \<bar>m2\<bar> > e1 - e2 - k1 - 2 then float_round_down p ((Float m1 e1) + (Float m2 e2)) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1848 |
else float_round_down p (Float (m1 * 2 ^ (Suc (Suc k1)) + sgn m2) (e1 - int k1 - 2))) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1849 |
else float_plus_down p (Float m2 e2) (Float m1 e1)))" |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1850 |
proof - |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1851 |
{ |
60698 | 1852 |
assume "bitlen \<bar>m2\<bar> \<le> e1 - e2 - (p - nat (bitlen \<bar>m1\<bar>)) - 2" "m1 \<noteq> 0" "m2 \<noteq> 0" "e1 \<ge> e2" |
1853 |
note compute_far_float_plus_down[OF this] |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1854 |
} |
60698 | 1855 |
then show ?thesis |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1856 |
by transfer (simp add: Let_def plus_down_def ac_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1857 |
qed |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1858 |
|
60698 | 1859 |
qualified lemma compute_float_plus_up[code]: "float_plus_up p x y = - float_plus_down p (-x) (-y)" |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1860 |
using truncate_down_uminus_eq[of p "x + y"] |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1861 |
by transfer (simp add: plus_down_def plus_up_def ac_simps) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1862 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1863 |
lemma mantissa_zero[simp]: "mantissa 0 = 0" |
60698 | 1864 |
by (metis mantissa_0 zero_float.abs_eq) |
1865 |
||
1866 |
end |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1867 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
1868 |
|
60500 | 1869 |
subsection \<open>Lemmas needed by Approximate\<close> |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1870 |
|
60698 | 1871 |
lemma Float_num[simp]: |
1872 |
"real (Float 1 0) = 1" |
|
1873 |
"real (Float 1 1) = 2" |
|
1874 |
"real (Float 1 2) = 4" |
|
1875 |
"real (Float 1 (- 1)) = 1/2" |
|
1876 |
"real (Float 1 (- 2)) = 1/4" |
|
1877 |
"real (Float 1 (- 3)) = 1/8" |
|
1878 |
"real (Float (- 1) 0) = -1" |
|
1879 |
"real (Float (number_of n) 0) = number_of n" |
|
1880 |
using two_powr_int_float[of 2] two_powr_int_float[of "-1"] two_powr_int_float[of "-2"] |
|
1881 |
two_powr_int_float[of "-3"] |
|
1882 |
using powr_realpow[of 2 2] powr_realpow[of 2 3] |
|
1883 |
using powr_minus[of 2 1] powr_minus[of 2 2] powr_minus[of 2 3] |
|
1884 |
by auto |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1885 |
|
60698 | 1886 |
lemma real_of_Float_int[simp]: "real (Float n 0) = real n" |
1887 |
by simp |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1888 |
|
60698 | 1889 |
lemma float_zero[simp]: "real (Float 0 e) = 0" |
1890 |
by simp |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1891 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1892 |
lemma abs_div_2_less: "a \<noteq> 0 \<Longrightarrow> a \<noteq> -1 \<Longrightarrow> abs((a::int) div 2) < abs a" |
60698 | 1893 |
by arith |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1894 |
|
60698 | 1895 |
lemma lapprox_rat: "real (lapprox_rat prec x y) \<le> real x / real y" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1896 |
using round_down by (simp add: lapprox_rat_def) |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1897 |
|
60698 | 1898 |
lemma mult_div_le: |
1899 |
fixes a b :: int |
|
1900 |
assumes "b > 0" |
|
1901 |
shows "a \<ge> b * (a div b)" |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1902 |
proof - |
60698 | 1903 |
from zmod_zdiv_equality'[of a b] have "a = b * (a div b) + a mod b" |
1904 |
by simp |
|
1905 |
also have "\<dots> \<ge> b * (a div b) + 0" |
|
1906 |
apply (rule add_left_mono) |
|
1907 |
apply (rule pos_mod_sign) |
|
1908 |
using assms apply simp |
|
1909 |
done |
|
1910 |
finally show ?thesis |
|
1911 |
by simp |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1912 |
qed |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1913 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1914 |
lemma lapprox_rat_nonneg: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1915 |
fixes n x y |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1916 |
assumes "0 \<le> x" and "0 \<le> y" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1917 |
shows "0 \<le> real (lapprox_rat n x y)" |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1918 |
using assms by (auto simp: lapprox_rat_def simp: round_down_nonneg) |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1919 |
|
31098
73dd67adf90a
replaced Ifloat => real_of_float and real, renamed ApproxEq => inequality, uneq => interpret_inequality, uneq' => approx_inequality, Ifloatarith => interpret_floatarith
hoelzl
parents:
31021
diff
changeset
|
1920 |
lemma rapprox_rat: "real x / real y \<le> real (rapprox_rat prec x y)" |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1921 |
using round_up by (simp add: rapprox_rat_def) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1922 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1923 |
lemma rapprox_rat_le1: |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1924 |
fixes n x y |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1925 |
assumes xy: "0 \<le> x" "0 < y" "x \<le> y" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1926 |
shows "real (rapprox_rat n x y) \<le> 1" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1927 |
proof - |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1928 |
have "bitlen \<bar>x\<bar> \<le> bitlen \<bar>y\<bar>" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1929 |
using xy unfolding bitlen_def by (auto intro!: floor_mono) |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1930 |
from this assms show ?thesis |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1931 |
by transfer (auto intro!: round_up_le1 simp: rat_precision_def) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1932 |
qed |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1933 |
|
60698 | 1934 |
lemma rapprox_rat_nonneg_nonpos: "0 \<le> x \<Longrightarrow> y \<le> 0 \<Longrightarrow> real (rapprox_rat n x y) \<le> 0" |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1935 |
by transfer (simp add: round_up_le0 divide_nonneg_nonpos) |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1936 |
|
60698 | 1937 |
lemma rapprox_rat_nonpos_nonneg: "x \<le> 0 \<Longrightarrow> 0 \<le> y \<Longrightarrow> real (rapprox_rat n x y) \<le> 0" |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1938 |
by transfer (simp add: round_up_le0 divide_nonpos_nonneg) |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1939 |
|
54782 | 1940 |
lemma real_divl: "real_divl prec x y \<le> x / y" |
1941 |
by (simp add: real_divl_def round_down) |
|
1942 |
||
1943 |
lemma real_divr: "x / y \<le> real_divr prec x y" |
|
1944 |
using round_up by (simp add: real_divr_def) |
|
1945 |
||
31098
73dd67adf90a
replaced Ifloat => real_of_float and real, renamed ApproxEq => inequality, uneq => interpret_inequality, uneq' => approx_inequality, Ifloatarith => interpret_floatarith
hoelzl
parents:
31021
diff
changeset
|
1946 |
lemma float_divl: "real (float_divl prec x y) \<le> real x / real y" |
54782 | 1947 |
by transfer (rule real_divl) |
1948 |
||
1949 |
lemma real_divl_lower_bound: |
|
1950 |
"0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> 0 \<le> real_divl prec x y" |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1951 |
by (simp add: real_divl_def round_down_nonneg) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1952 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1953 |
lemma float_divl_lower_bound: |
54782 | 1954 |
"0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> 0 \<le> real (float_divl prec x y)" |
1955 |
by transfer (rule real_divl_lower_bound) |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1956 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1957 |
lemma exponent_1: "exponent 1 = 0" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1958 |
using exponent_float[of 1 0] by (simp add: one_float_def) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1959 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1960 |
lemma mantissa_1: "mantissa 1 = 1" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1961 |
using mantissa_float[of 1 0] by (simp add: one_float_def) |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1962 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1963 |
lemma bitlen_1: "bitlen 1 = 1" |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1964 |
by (simp add: bitlen_def) |
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1965 |
|
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1966 |
lemma mantissa_eq_zero_iff: "mantissa x = 0 \<longleftrightarrow> x = 0" |
60698 | 1967 |
(is "?lhs \<longleftrightarrow> ?rhs") |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1968 |
proof |
60698 | 1969 |
show ?rhs if ?lhs |
1970 |
proof - |
|
1971 |
from that have z: "0 = real x" |
|
1972 |
using mantissa_exponent by simp |
|
1973 |
show ?thesis |
|
1974 |
by (simp add: zero_float_def z) |
|
1975 |
qed |
|
1976 |
show ?lhs if ?rhs |
|
1977 |
using that by (simp add: zero_float_def) |
|
1978 |
qed |
|
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
1979 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1980 |
lemma float_upper_bound: "x \<le> 2 powr (bitlen \<bar>mantissa x\<bar> + exponent x)" |
60698 | 1981 |
proof (cases "x = 0") |
1982 |
case True |
|
1983 |
then show ?thesis by simp |
|
1984 |
next |
|
1985 |
case False |
|
1986 |
then have "mantissa x \<noteq> 0" |
|
1987 |
using mantissa_eq_zero_iff by auto |
|
1988 |
have "x = mantissa x * 2 powr (exponent x)" |
|
1989 |
by (rule mantissa_exponent) |
|
1990 |
also have "mantissa x \<le> \<bar>mantissa x\<bar>" |
|
1991 |
by simp |
|
1992 |
also have "\<dots> \<le> 2 powr (bitlen \<bar>mantissa x\<bar>)" |
|
60500 | 1993 |
using bitlen_bounds[of "\<bar>mantissa x\<bar>"] bitlen_nonneg \<open>mantissa x \<noteq> 0\<close> |
58989 | 1994 |
by (auto simp del: real_of_int_abs simp add: powr_int) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
1995 |
finally show ?thesis by (simp add: powr_add) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1996 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
1997 |
|
54782 | 1998 |
lemma real_divl_pos_less1_bound: |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
1999 |
assumes "0 < x" "x \<le> 1" "prec \<ge> 1" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2000 |
shows "1 \<le> real_divl prec 1 x" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2001 |
proof - |
60698 | 2002 |
have "log 2 x \<le> real prec + real \<lfloor>log 2 x\<rfloor>" |
2003 |
using \<open>prec \<ge> 1\<close> by arith |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2004 |
from this assms show ?thesis |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2005 |
by (simp add: real_divl_def log_divide round_down_ge1) |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
2006 |
qed |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
2007 |
|
54782 | 2008 |
lemma float_divl_pos_less1_bound: |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2009 |
"0 < real x \<Longrightarrow> real x \<le> 1 \<Longrightarrow> prec \<ge> 1 \<Longrightarrow> 1 \<le> real (float_divl prec 1 x)" |
60698 | 2010 |
by transfer (rule real_divl_pos_less1_bound) |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
2011 |
|
54782 | 2012 |
lemma float_divr: "real x / real y \<le> real (float_divr prec x y)" |
2013 |
by transfer (rule real_divr) |
|
2014 |
||
60698 | 2015 |
lemma real_divr_pos_less1_lower_bound: |
2016 |
assumes "0 < x" |
|
2017 |
and "x \<le> 1" |
|
2018 |
shows "1 \<le> real_divr prec 1 x" |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
2019 |
proof - |
60698 | 2020 |
have "1 \<le> 1 / x" |
2021 |
using \<open>0 < x\<close> and \<open>x <= 1\<close> by auto |
|
2022 |
also have "\<dots> \<le> real_divr prec 1 x" |
|
2023 |
using real_divr[where x=1 and y=x] by auto |
|
47600 | 2024 |
finally show ?thesis by auto |
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
2025 |
qed |
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
2026 |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2027 |
lemma float_divr_pos_less1_lower_bound: "0 < x \<Longrightarrow> x \<le> 1 \<Longrightarrow> 1 \<le> float_divr prec 1 x" |
54782 | 2028 |
by transfer (rule real_divr_pos_less1_lower_bound) |
2029 |
||
2030 |
lemma real_divr_nonpos_pos_upper_bound: |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2031 |
"x \<le> 0 \<Longrightarrow> 0 \<le> y \<Longrightarrow> real_divr prec x y \<le> 0" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2032 |
by (simp add: real_divr_def round_up_le0 divide_le_0_iff) |
54782 | 2033 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2034 |
lemma float_divr_nonpos_pos_upper_bound: |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2035 |
"real x \<le> 0 \<Longrightarrow> 0 \<le> real y \<Longrightarrow> real (float_divr prec x y) \<le> 0" |
54782 | 2036 |
by transfer (rule real_divr_nonpos_pos_upper_bound) |
2037 |
||
2038 |
lemma real_divr_nonneg_neg_upper_bound: |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2039 |
"0 \<le> x \<Longrightarrow> y \<le> 0 \<Longrightarrow> real_divr prec x y \<le> 0" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2040 |
by (simp add: real_divr_def round_up_le0 divide_le_0_iff) |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
2041 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2042 |
lemma float_divr_nonneg_neg_upper_bound: |
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2043 |
"0 \<le> real x \<Longrightarrow> real y \<le> 0 \<Longrightarrow> real (float_divr prec x y) \<le> 0" |
54782 | 2044 |
by transfer (rule real_divr_nonneg_neg_upper_bound) |
2045 |
||
54784 | 2046 |
lemma truncate_up_nonneg_mono: |
2047 |
assumes "0 \<le> x" "x \<le> y" |
|
2048 |
shows "truncate_up prec x \<le> truncate_up prec y" |
|
2049 |
proof - |
|
60698 | 2050 |
consider "\<lfloor>log 2 x\<rfloor> = \<lfloor>log 2 y\<rfloor>" | "\<lfloor>log 2 x\<rfloor> \<noteq> \<lfloor>log 2 y\<rfloor>" "0 < x" | "x \<le> 0" |
2051 |
by arith |
|
2052 |
then show ?thesis |
|
2053 |
proof cases |
|
2054 |
case 1 |
|
2055 |
then show ?thesis |
|
54784 | 2056 |
using assms |
2057 |
by (auto simp: truncate_up_def round_up_def intro!: ceiling_mono) |
|
60698 | 2058 |
next |
2059 |
case 2 |
|
2060 |
from assms \<open>0 < x\<close> have "log 2 x \<le> log 2 y" |
|
2061 |
by auto |
|
2062 |
with \<open>\<lfloor>log 2 x\<rfloor> \<noteq> \<lfloor>log 2 y\<rfloor>\<close> |
|
2063 |
have logless: "log 2 x < log 2 y" and flogless: "\<lfloor>log 2 x\<rfloor> < \<lfloor>log 2 y\<rfloor>" |
|
2064 |
by (metis floor_less_cancel linorder_cases not_le)+ |
|
54784 | 2065 |
have "truncate_up prec x = |
2066 |
real \<lceil>x * 2 powr real (int prec - \<lfloor>log 2 x\<rfloor> - 1)\<rceil> * 2 powr - real (int prec - \<lfloor>log 2 x\<rfloor> - 1)" |
|
2067 |
using assms by (simp add: truncate_up_def round_up_def) |
|
2068 |
also have "\<lceil>x * 2 powr real (int prec - \<lfloor>log 2 x\<rfloor> - 1)\<rceil> \<le> (2 ^ prec)" |
|
2069 |
proof (unfold ceiling_le_eq) |
|
2070 |
have "x * 2 powr real (int prec - \<lfloor>log 2 x\<rfloor> - 1) \<le> x * (2 powr real prec / (2 powr log 2 x))" |
|
2071 |
using real_of_int_floor_add_one_ge[of "log 2 x"] assms |
|
2072 |
by (auto simp add: algebra_simps powr_divide2 intro!: mult_left_mono) |
|
60698 | 2073 |
then show "x * 2 powr real (int prec - \<lfloor>log 2 x\<rfloor> - 1) \<le> real ((2::int) ^ prec)" |
60500 | 2074 |
using \<open>0 < x\<close> by (simp add: powr_realpow) |
54784 | 2075 |
qed |
60698 | 2076 |
then have "real \<lceil>x * 2 powr real (int prec - \<lfloor>log 2 x\<rfloor> - 1)\<rceil> \<le> 2 powr int prec" |
54784 | 2077 |
by (auto simp: powr_realpow) |
2078 |
also |
|
2079 |
have "2 powr - real (int prec - \<lfloor>log 2 x\<rfloor> - 1) \<le> 2 powr - real (int prec - \<lfloor>log 2 y\<rfloor>)" |
|
2080 |
using logless flogless by (auto intro!: floor_mono) |
|
2081 |
also have "2 powr real (int prec) \<le> 2 powr (log 2 y + real (int prec - \<lfloor>log 2 y\<rfloor>))" |
|
60500 | 2082 |
using assms \<open>0 < x\<close> |
54784 | 2083 |
by (auto simp: algebra_simps) |
2084 |
finally have "truncate_up prec x \<le> 2 powr (log 2 y + real (int prec - \<lfloor>log 2 y\<rfloor>)) * 2 powr - real (int prec - \<lfloor>log 2 y\<rfloor>)" |
|
2085 |
by simp |
|
2086 |
also have "\<dots> = 2 powr (log 2 y + real (int prec - \<lfloor>log 2 y\<rfloor>) - real (int prec - \<lfloor>log 2 y\<rfloor>))" |
|
2087 |
by (subst powr_add[symmetric]) simp |
|
2088 |
also have "\<dots> = y" |
|
60500 | 2089 |
using \<open>0 < x\<close> assms |
54784 | 2090 |
by (simp add: powr_add) |
2091 |
also have "\<dots> \<le> truncate_up prec y" |
|
2092 |
by (rule truncate_up) |
|
60698 | 2093 |
finally show ?thesis . |
2094 |
next |
|
2095 |
case 3 |
|
2096 |
then show ?thesis |
|
54784 | 2097 |
using assms |
2098 |
by (auto intro!: truncate_up_le) |
|
60698 | 2099 |
qed |
54784 | 2100 |
qed |
2101 |
||
2102 |
lemma truncate_up_switch_sign_mono: |
|
2103 |
assumes "x \<le> 0" "0 \<le> y" |
|
2104 |
shows "truncate_up prec x \<le> truncate_up prec y" |
|
2105 |
proof - |
|
60500 | 2106 |
note truncate_up_nonpos[OF \<open>x \<le> 0\<close>] |
2107 |
also note truncate_up_le[OF \<open>0 \<le> y\<close>] |
|
54784 | 2108 |
finally show ?thesis . |
2109 |
qed |
|
2110 |
||
2111 |
lemma truncate_down_zeroprec_mono: |
|
2112 |
assumes "0 < x" "x \<le> y" |
|
2113 |
shows "truncate_down 0 x \<le> truncate_down 0 y" |
|
2114 |
proof - |
|
2115 |
have "x * 2 powr (- real \<lfloor>log 2 x\<rfloor> - 1) = x * inverse (2 powr ((real \<lfloor>log 2 x\<rfloor> + 1)))" |
|
2116 |
by (simp add: powr_divide2[symmetric] powr_add powr_minus inverse_eq_divide) |
|
2117 |
also have "\<dots> = 2 powr (log 2 x - (real \<lfloor>log 2 x\<rfloor>) - 1)" |
|
60500 | 2118 |
using \<open>0 < x\<close> |
57862 | 2119 |
by (auto simp: field_simps powr_add powr_divide2[symmetric]) |
54784 | 2120 |
also have "\<dots> < 2 powr 0" |
2121 |
using real_of_int_floor_add_one_gt |
|
2122 |
unfolding neg_less_iff_less |
|
2123 |
by (intro powr_less_mono) (auto simp: algebra_simps) |
|
2124 |
finally have "\<lfloor>x * 2 powr (- real \<lfloor>log 2 x\<rfloor> - 1)\<rfloor> < 1" |
|
2125 |
unfolding less_ceiling_eq real_of_int_minus real_of_one |
|
2126 |
by simp |
|
60698 | 2127 |
moreover have "0 \<le> \<lfloor>x * 2 powr (- real \<lfloor>log 2 x\<rfloor> - 1)\<rfloor>" |
60500 | 2128 |
using \<open>x > 0\<close> by auto |
54784 | 2129 |
ultimately have "\<lfloor>x * 2 powr (- real \<lfloor>log 2 x\<rfloor> - 1)\<rfloor> \<in> {0 ..< 1}" |
2130 |
by simp |
|
60698 | 2131 |
also have "\<dots> \<subseteq> {0}" |
2132 |
by auto |
|
2133 |
finally have "\<lfloor>x * 2 powr (- real \<lfloor>log 2 x\<rfloor> - 1)\<rfloor> = 0" |
|
2134 |
by simp |
|
54784 | 2135 |
with assms show ?thesis |
56536 | 2136 |
by (auto simp: truncate_down_def round_down_def) |
54784 | 2137 |
qed |
2138 |
||
2139 |
lemma truncate_down_switch_sign_mono: |
|
60698 | 2140 |
assumes "x \<le> 0" |
2141 |
and "0 \<le> y" |
|
2142 |
and "x \<le> y" |
|
54784 | 2143 |
shows "truncate_down prec x \<le> truncate_down prec y" |
2144 |
proof - |
|
60500 | 2145 |
note truncate_down_le[OF \<open>x \<le> 0\<close>] |
2146 |
also note truncate_down_nonneg[OF \<open>0 \<le> y\<close>] |
|
54784 | 2147 |
finally show ?thesis . |
2148 |
qed |
|
2149 |
||
2150 |
lemma truncate_down_nonneg_mono: |
|
2151 |
assumes "0 \<le> x" "x \<le> y" |
|
2152 |
shows "truncate_down prec x \<le> truncate_down prec y" |
|
2153 |
proof - |
|
60698 | 2154 |
consider "0 < x" "prec = 0" | "x \<le> 0" | "\<lfloor>log 2 \<bar>x\<bar>\<rfloor> = \<lfloor>log 2 \<bar>y\<bar>\<rfloor>" | |
2155 |
"0 < x" "\<lfloor>log 2 \<bar>x\<bar>\<rfloor> \<noteq> \<lfloor>log 2 \<bar>y\<bar>\<rfloor>" "prec \<noteq> 0" |
|
2156 |
by arith |
|
2157 |
then show ?thesis |
|
2158 |
proof cases |
|
2159 |
case 1 |
|
2160 |
with assms show ?thesis |
|
54784 | 2161 |
by (simp add: truncate_down_zeroprec_mono) |
60698 | 2162 |
next |
2163 |
case 2 |
|
54784 | 2164 |
with assms have "x = 0" "0 \<le> y" by simp_all |
60698 | 2165 |
then show ?thesis |
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
2166 |
by (auto intro!: truncate_down_nonneg) |
60698 | 2167 |
next |
2168 |
case 3 |
|
2169 |
then show ?thesis |
|
54784 | 2170 |
using assms |
2171 |
by (auto simp: truncate_down_def round_down_def intro!: floor_mono) |
|
60698 | 2172 |
next |
2173 |
case 4 |
|
2174 |
from \<open>0 < x\<close> have "log 2 x \<le> log 2 y" "0 < y" "0 \<le> y" |
|
2175 |
using assms by auto |
|
2176 |
with \<open>\<lfloor>log 2 \<bar>x\<bar>\<rfloor> \<noteq> \<lfloor>log 2 \<bar>y\<bar>\<rfloor>\<close> |
|
2177 |
have logless: "log 2 x < log 2 y" and flogless: "\<lfloor>log 2 x\<rfloor> < \<lfloor>log 2 y\<rfloor>" |
|
60500 | 2178 |
unfolding atomize_conj abs_of_pos[OF \<open>0 < x\<close>] abs_of_pos[OF \<open>0 < y\<close>] |
54784 | 2179 |
by (metis floor_less_cancel linorder_cases not_le) |
60698 | 2180 |
from \<open>prec \<noteq> 0\<close> have [simp]: "prec \<ge> Suc 0" |
2181 |
by auto |
|
54784 | 2182 |
have "2 powr (prec - 1) \<le> y * 2 powr real (prec - 1) / (2 powr log 2 y)" |
60698 | 2183 |
using \<open>0 < y\<close> by simp |
54784 | 2184 |
also have "\<dots> \<le> y * 2 powr real prec / (2 powr (real \<lfloor>log 2 y\<rfloor> + 1))" |
60500 | 2185 |
using \<open>0 \<le> y\<close> \<open>0 \<le> x\<close> assms(2) |
56544 | 2186 |
by (auto intro!: powr_mono divide_left_mono |
54784 | 2187 |
simp: real_of_nat_diff powr_add |
2188 |
powr_divide2[symmetric]) |
|
2189 |
also have "\<dots> = y * 2 powr real prec / (2 powr real \<lfloor>log 2 y\<rfloor> * 2)" |
|
2190 |
by (auto simp: powr_add) |
|
2191 |
finally have "(2 ^ (prec - 1)) \<le> \<lfloor>y * 2 powr real (int prec - \<lfloor>log 2 \<bar>y\<bar>\<rfloor> - 1)\<rfloor>" |
|
60500 | 2192 |
using \<open>0 \<le> y\<close> |
54784 | 2193 |
by (auto simp: powr_divide2[symmetric] le_floor_eq powr_realpow) |
60698 | 2194 |
then have "(2 ^ (prec - 1)) * 2 powr - real (int prec - \<lfloor>log 2 \<bar>y\<bar>\<rfloor> - 1) \<le> truncate_down prec y" |
54784 | 2195 |
by (auto simp: truncate_down_def round_down_def) |
2196 |
moreover |
|
2197 |
{ |
|
60500 | 2198 |
have "x = 2 powr (log 2 \<bar>x\<bar>)" using \<open>0 < x\<close> by simp |
54784 | 2199 |
also have "\<dots> \<le> (2 ^ (prec )) * 2 powr - real (int prec - \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - 1)" |
2200 |
using real_of_int_floor_add_one_ge[of "log 2 \<bar>x\<bar>"] |
|
2201 |
by (auto simp: powr_realpow[symmetric] powr_add[symmetric] algebra_simps) |
|
2202 |
also |
|
2203 |
have "2 powr - real (int prec - \<lfloor>log 2 \<bar>x\<bar>\<rfloor> - 1) \<le> 2 powr - real (int prec - \<lfloor>log 2 \<bar>y\<bar>\<rfloor>)" |
|
60500 | 2204 |
using logless flogless \<open>x > 0\<close> \<open>y > 0\<close> |
54784 | 2205 |
by (auto intro!: floor_mono) |
2206 |
finally have "x \<le> (2 ^ (prec - 1)) * 2 powr - real (int prec - \<lfloor>log 2 \<bar>y\<bar>\<rfloor> - 1)" |
|
2207 |
by (auto simp: powr_realpow[symmetric] powr_divide2[symmetric] assms real_of_nat_diff) |
|
60698 | 2208 |
} |
2209 |
ultimately show ?thesis |
|
54784 | 2210 |
by (metis dual_order.trans truncate_down) |
60698 | 2211 |
qed |
54784 | 2212 |
qed |
2213 |
||
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2214 |
lemma truncate_down_eq_truncate_up: "truncate_down p x = - truncate_up p (-x)" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2215 |
and truncate_up_eq_truncate_down: "truncate_up p x = - truncate_down p (-x)" |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2216 |
by (auto simp: truncate_up_uminus_eq truncate_down_uminus_eq) |
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2217 |
|
54784 | 2218 |
lemma truncate_down_mono: "x \<le> y \<Longrightarrow> truncate_down p x \<le> truncate_down p y" |
2219 |
apply (cases "0 \<le> x") |
|
2220 |
apply (rule truncate_down_nonneg_mono, assumption+) |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2221 |
apply (simp add: truncate_down_eq_truncate_up) |
54784 | 2222 |
apply (cases "0 \<le> y") |
2223 |
apply (auto intro: truncate_up_nonneg_mono truncate_up_switch_sign_mono) |
|
2224 |
done |
|
2225 |
||
2226 |
lemma truncate_up_mono: "x \<le> y \<Longrightarrow> truncate_up p x \<le> truncate_up p y" |
|
58982
27e7e3f9e665
simplified computations based on round_up by reducing to round_down;
immler
parents:
58881
diff
changeset
|
2227 |
by (simp add: truncate_up_eq_truncate_down truncate_down_mono) |
54784 | 2228 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2229 |
lemma Float_le_zero_iff: "Float a b \<le> 0 \<longleftrightarrow> a \<le> 0" |
60017
b785d6d06430
Overloading of ln and powr, but "approximation" no longer works for powr. Code generation also fails due to type ambiguity in scala.
paulson <lp15@cam.ac.uk>
parents:
59984
diff
changeset
|
2230 |
by (auto simp: zero_float_def mult_le_0_iff) (simp add: not_less [symmetric]) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2231 |
|
60698 | 2232 |
lemma real_of_float_pprt[simp]: |
2233 |
fixes a :: float |
|
2234 |
shows "real (pprt a) = pprt (real a)" |
|
47600 | 2235 |
unfolding pprt_def sup_float_def max_def sup_real_def by auto |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2236 |
|
60698 | 2237 |
lemma real_of_float_nprt[simp]: |
2238 |
fixes a :: float |
|
2239 |
shows "real (nprt a) = nprt (real a)" |
|
47600 | 2240 |
unfolding nprt_def inf_float_def min_def inf_real_def by auto |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2241 |
|
60698 | 2242 |
context |
2243 |
begin |
|
2244 |
||
55565
f663fc1e653b
simplify proofs because of the stronger reflexivity prover
kuncar
parents:
54784
diff
changeset
|
2245 |
lift_definition int_floor_fl :: "float \<Rightarrow> int" is floor . |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
2246 |
|
60698 | 2247 |
qualified lemma compute_int_floor_fl[code]: |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
2248 |
"int_floor_fl (Float m e) = (if 0 \<le> e then m * 2 ^ nat e else m div (2 ^ (nat (-e))))" |
47600 | 2249 |
by transfer (simp add: powr_int int_of_reals floor_divide_eq_div del: real_of_ints) |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2250 |
|
47600 | 2251 |
lift_definition floor_fl :: "float \<Rightarrow> float" is "\<lambda>x. real (floor x)" by simp |
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2252 |
|
60698 | 2253 |
qualified lemma compute_floor_fl[code]: |
47601
050718fe6eee
use real :: float => real as lifting-morphism so we can directlry use the rep_eq theorems
hoelzl
parents:
47600
diff
changeset
|
2254 |
"floor_fl (Float m e) = (if 0 \<le> e then Float m e else Float (m div (2 ^ (nat (-e)))) 0)" |
47600 | 2255 |
by transfer (simp add: powr_int int_of_reals floor_divide_eq_div del: real_of_ints) |
60698 | 2256 |
|
2257 |
end |
|
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
2258 |
|
60698 | 2259 |
lemma floor_fl: "real (floor_fl x) \<le> real x" |
2260 |
by transfer simp |
|
47600 | 2261 |
|
60698 | 2262 |
lemma int_floor_fl: "real (int_floor_fl x) \<le> real x" |
2263 |
by transfer simp |
|
29804
e15b74577368
Added new Float theory and moved old Library/Float.thy to ComputeFloat
hoelzl
parents:
29667
diff
changeset
|
2264 |
|
47599
400b158f1589
replace the float datatype by a type with unique representation
hoelzl
parents:
47230
diff
changeset
|
2265 |
lemma floor_pos_exp: "exponent (floor_fl x) \<ge> 0" |
53381 | 2266 |
proof (cases "floor_fl x = float_of 0") |
2267 |
case True |
|
60698 | 2268 |
then show ?thesis |
2269 |
by (simp add: floor_fl_def) |
|
53381 | 2270 |
next |
2271 |
case False |
|
60698 | 2272 |
have eq: "floor_fl x = Float \<lfloor>real x\<rfloor> 0" |
2273 |
by transfer simp |
|
53381 | 2274 |
obtain i where "\<lfloor>real x\<rfloor> = mantissa (floor_fl x) * 2 ^ i" "0 = exponent (floor_fl x) - int i" |
2275 |
by (rule denormalize_shift[OF eq[THEN eq_reflection] False]) |
|
60698 | 2276 |
then show ?thesis |
2277 |
by simp |
|
53381 | 2278 |
qed |
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
2279 |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
2280 |
lemma compute_mantissa[code]: |
60698 | 2281 |
"mantissa (Float m e) = |
2282 |
(if m = 0 then 0 else if 2 dvd m then mantissa (normfloat (Float m e)) else m)" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
2283 |
by (auto simp: mantissa_float Float.abs_eq) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
2284 |
|
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
2285 |
lemma compute_exponent[code]: |
60698 | 2286 |
"exponent (Float m e) = |
2287 |
(if m = 0 then 0 else if 2 dvd m then exponent (normfloat (Float m e)) else e)" |
|
58985
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
2288 |
by (auto simp: exponent_float Float.abs_eq) |
bf498e0af9e3
truncate intermediate results in horner to improve performance of approximate;
immler
parents:
58982
diff
changeset
|
2289 |
|
16782
b214f21ae396
- use TableFun instead of homebrew binary tree in am_interpreter.ML
obua
parents:
diff
changeset
|
2290 |
end |