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