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