| author | wenzelm | 
| Mon, 04 Apr 2016 17:02:34 +0200 | |
| changeset 62848 | e4140efe699e | 
| parent 62623 | dbc62f86a1a9 | 
| child 63331 | 247eac9758dd | 
| permissions | -rw-r--r-- | 
| 41959 | 1  | 
(* Title: HOL/Archimedean_Field.thy  | 
2  | 
Author: Brian Huffman  | 
|
| 30096 | 3  | 
*)  | 
4  | 
||
| 60758 | 5  | 
section \<open>Archimedean Fields, Floor and Ceiling Functions\<close>  | 
| 30096 | 6  | 
|
7  | 
theory Archimedean_Field  | 
|
8  | 
imports Main  | 
|
9  | 
begin  | 
|
10  | 
||
| 60758 | 11  | 
subsection \<open>Class of Archimedean fields\<close>  | 
| 30096 | 12  | 
|
| 60758 | 13  | 
text \<open>Archimedean fields have no infinite elements.\<close>  | 
| 30096 | 14  | 
|
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
15  | 
class archimedean_field = linordered_field +  | 
| 30096 | 16  | 
assumes ex_le_of_int: "\<exists>z. x \<le> of_int z"  | 
17  | 
||
18  | 
lemma ex_less_of_int:  | 
|
19  | 
fixes x :: "'a::archimedean_field" shows "\<exists>z. x < of_int z"  | 
|
20  | 
proof -  | 
|
21  | 
from ex_le_of_int obtain z where "x \<le> of_int z" ..  | 
|
22  | 
then have "x < of_int (z + 1)" by simp  | 
|
23  | 
then show ?thesis ..  | 
|
24  | 
qed  | 
|
25  | 
||
26  | 
lemma ex_of_int_less:  | 
|
27  | 
fixes x :: "'a::archimedean_field" shows "\<exists>z. of_int z < x"  | 
|
28  | 
proof -  | 
|
29  | 
from ex_less_of_int obtain z where "- x < of_int z" ..  | 
|
30  | 
then have "of_int (- z) < x" by simp  | 
|
31  | 
then show ?thesis ..  | 
|
32  | 
qed  | 
|
33  | 
||
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
34  | 
lemma reals_Archimedean2:  | 
| 30096 | 35  | 
fixes x :: "'a::archimedean_field" shows "\<exists>n. x < of_nat n"  | 
36  | 
proof -  | 
|
37  | 
obtain z where "x < of_int z" using ex_less_of_int ..  | 
|
38  | 
also have "\<dots> \<le> of_int (int (nat z))" by simp  | 
|
39  | 
also have "\<dots> = of_nat (nat z)" by (simp only: of_int_of_nat_eq)  | 
|
40  | 
finally show ?thesis ..  | 
|
41  | 
qed  | 
|
42  | 
||
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
43  | 
lemma real_arch_simple:  | 
| 30096 | 44  | 
fixes x :: "'a::archimedean_field" shows "\<exists>n. x \<le> of_nat n"  | 
45  | 
proof -  | 
|
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
46  | 
obtain n where "x < of_nat n" using reals_Archimedean2 ..  | 
| 30096 | 47  | 
then have "x \<le> of_nat n" by simp  | 
48  | 
then show ?thesis ..  | 
|
49  | 
qed  | 
|
50  | 
||
| 60758 | 51  | 
text \<open>Archimedean fields have no infinitesimal elements.\<close>  | 
| 30096 | 52  | 
|
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
53  | 
lemma reals_Archimedean:  | 
| 30096 | 54  | 
fixes x :: "'a::archimedean_field"  | 
55  | 
assumes "0 < x" shows "\<exists>n. inverse (of_nat (Suc n)) < x"  | 
|
56  | 
proof -  | 
|
| 60758 | 57  | 
from \<open>0 < x\<close> have "0 < inverse x"  | 
| 30096 | 58  | 
by (rule positive_imp_inverse_positive)  | 
59  | 
obtain n where "inverse x < of_nat n"  | 
|
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
60  | 
using reals_Archimedean2 ..  | 
| 30096 | 61  | 
then obtain m where "inverse x < of_nat (Suc m)"  | 
| 60758 | 62  | 
using \<open>0 < inverse x\<close> by (cases n) (simp_all del: of_nat_Suc)  | 
| 30096 | 63  | 
then have "inverse (of_nat (Suc m)) < inverse (inverse x)"  | 
| 60758 | 64  | 
using \<open>0 < inverse x\<close> by (rule less_imp_inverse_less)  | 
| 30096 | 65  | 
then have "inverse (of_nat (Suc m)) < x"  | 
| 60758 | 66  | 
using \<open>0 < x\<close> by (simp add: nonzero_inverse_inverse_eq)  | 
| 30096 | 67  | 
then show ?thesis ..  | 
68  | 
qed  | 
|
69  | 
||
70  | 
lemma ex_inverse_of_nat_less:  | 
|
71  | 
fixes x :: "'a::archimedean_field"  | 
|
72  | 
assumes "0 < x" shows "\<exists>n>0. inverse (of_nat n) < x"  | 
|
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
73  | 
using reals_Archimedean [OF \<open>0 < x\<close>] by auto  | 
| 30096 | 74  | 
|
75  | 
lemma ex_less_of_nat_mult:  | 
|
76  | 
fixes x :: "'a::archimedean_field"  | 
|
77  | 
assumes "0 < x" shows "\<exists>n. y < of_nat n * x"  | 
|
78  | 
proof -  | 
|
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
79  | 
obtain n where "y / x < of_nat n" using reals_Archimedean2 ..  | 
| 60758 | 80  | 
with \<open>0 < x\<close> have "y < of_nat n * x" by (simp add: pos_divide_less_eq)  | 
| 30096 | 81  | 
then show ?thesis ..  | 
82  | 
qed  | 
|
83  | 
||
84  | 
||
| 60758 | 85  | 
subsection \<open>Existence and uniqueness of floor function\<close>  | 
| 30096 | 86  | 
|
87  | 
lemma exists_least_lemma:  | 
|
88  | 
assumes "\<not> P 0" and "\<exists>n. P n"  | 
|
89  | 
shows "\<exists>n. \<not> P n \<and> P (Suc n)"  | 
|
90  | 
proof -  | 
|
| 60758 | 91  | 
from \<open>\<exists>n. P n\<close> have "P (Least P)" by (rule LeastI_ex)  | 
92  | 
with \<open>\<not> P 0\<close> obtain n where "Least P = Suc n"  | 
|
| 30096 | 93  | 
by (cases "Least P") auto  | 
94  | 
then have "n < Least P" by simp  | 
|
95  | 
then have "\<not> P n" by (rule not_less_Least)  | 
|
96  | 
then have "\<not> P n \<and> P (Suc n)"  | 
|
| 60758 | 97  | 
using \<open>P (Least P)\<close> \<open>Least P = Suc n\<close> by simp  | 
| 30096 | 98  | 
then show ?thesis ..  | 
99  | 
qed  | 
|
100  | 
||
101  | 
lemma floor_exists:  | 
|
102  | 
fixes x :: "'a::archimedean_field"  | 
|
103  | 
shows "\<exists>z. of_int z \<le> x \<and> x < of_int (z + 1)"  | 
|
104  | 
proof (cases)  | 
|
105  | 
assume "0 \<le> x"  | 
|
106  | 
then have "\<not> x < of_nat 0" by simp  | 
|
107  | 
then have "\<exists>n. \<not> x < of_nat n \<and> x < of_nat (Suc n)"  | 
|
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
108  | 
using reals_Archimedean2 by (rule exists_least_lemma)  | 
| 30096 | 109  | 
then obtain n where "\<not> x < of_nat n \<and> x < of_nat (Suc n)" ..  | 
110  | 
then have "of_int (int n) \<le> x \<and> x < of_int (int n + 1)" by simp  | 
|
111  | 
then show ?thesis ..  | 
|
112  | 
next  | 
|
113  | 
assume "\<not> 0 \<le> x"  | 
|
114  | 
then have "\<not> - x \<le> of_nat 0" by simp  | 
|
115  | 
then have "\<exists>n. \<not> - x \<le> of_nat n \<and> - x \<le> of_nat (Suc n)"  | 
|
| 
62623
 
dbc62f86a1a9
rationalisation of theorem names esp about "real Archimedian" etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
62348 
diff
changeset
 | 
116  | 
using real_arch_simple by (rule exists_least_lemma)  | 
| 30096 | 117  | 
then obtain n where "\<not> - x \<le> of_nat n \<and> - x \<le> of_nat (Suc n)" ..  | 
118  | 
then have "of_int (- int n - 1) \<le> x \<and> x < of_int (- int n - 1 + 1)" by simp  | 
|
119  | 
then show ?thesis ..  | 
|
120  | 
qed  | 
|
121  | 
||
122  | 
lemma floor_exists1:  | 
|
123  | 
fixes x :: "'a::archimedean_field"  | 
|
124  | 
shows "\<exists>!z. of_int z \<le> x \<and> x < of_int (z + 1)"  | 
|
125  | 
proof (rule ex_ex1I)  | 
|
126  | 
show "\<exists>z. of_int z \<le> x \<and> x < of_int (z + 1)"  | 
|
127  | 
by (rule floor_exists)  | 
|
128  | 
next  | 
|
129  | 
fix y z assume  | 
|
130  | 
"of_int y \<le> x \<and> x < of_int (y + 1)"  | 
|
131  | 
"of_int z \<le> x \<and> x < of_int (z + 1)"  | 
|
| 54281 | 132  | 
with le_less_trans [of "of_int y" "x" "of_int (z + 1)"]  | 
133  | 
le_less_trans [of "of_int z" "x" "of_int (y + 1)"]  | 
|
| 30096 | 134  | 
show "y = z" by (simp del: of_int_add)  | 
135  | 
qed  | 
|
136  | 
||
137  | 
||
| 60758 | 138  | 
subsection \<open>Floor function\<close>  | 
| 30096 | 139  | 
|
| 
43732
 
6b2bdc57155b
adding a floor_ceiling type class for different instantiations of floor (changeset from Brian Huffman)
 
bulwahn 
parents: 
43704 
diff
changeset
 | 
140  | 
class floor_ceiling = archimedean_field +  | 
| 61942 | 141  | 
  fixes floor :: "'a \<Rightarrow> int"  ("\<lfloor>_\<rfloor>")
 | 
142  | 
assumes floor_correct: "of_int \<lfloor>x\<rfloor> \<le> x \<and> x < of_int (\<lfloor>x\<rfloor> + 1)"  | 
|
| 30096 | 143  | 
|
| 61942 | 144  | 
lemma floor_unique: "\<lbrakk>of_int z \<le> x; x < of_int z + 1\<rbrakk> \<Longrightarrow> \<lfloor>x\<rfloor> = z"  | 
| 30096 | 145  | 
using floor_correct [of x] floor_exists1 [of x] by auto  | 
146  | 
||
| 
59613
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
147  | 
lemma floor_unique_iff:  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
148  | 
fixes x :: "'a::floor_ceiling"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
149  | 
shows "\<lfloor>x\<rfloor> = a \<longleftrightarrow> of_int a \<le> x \<and> x < of_int a + 1"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
150  | 
using floor_correct floor_unique by auto  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
151  | 
|
| 61942 | 152  | 
lemma of_int_floor_le [simp]: "of_int \<lfloor>x\<rfloor> \<le> x"  | 
| 30096 | 153  | 
using floor_correct ..  | 
154  | 
||
| 61942 | 155  | 
lemma le_floor_iff: "z \<le> \<lfloor>x\<rfloor> \<longleftrightarrow> of_int z \<le> x"  | 
| 30096 | 156  | 
proof  | 
| 61942 | 157  | 
assume "z \<le> \<lfloor>x\<rfloor>"  | 
158  | 
then have "(of_int z :: 'a) \<le> of_int \<lfloor>x\<rfloor>" by simp  | 
|
159  | 
also have "of_int \<lfloor>x\<rfloor> \<le> x" by (rule of_int_floor_le)  | 
|
| 30096 | 160  | 
finally show "of_int z \<le> x" .  | 
161  | 
next  | 
|
162  | 
assume "of_int z \<le> x"  | 
|
| 61942 | 163  | 
also have "x < of_int (\<lfloor>x\<rfloor> + 1)" using floor_correct ..  | 
164  | 
finally show "z \<le> \<lfloor>x\<rfloor>" by (simp del: of_int_add)  | 
|
| 30096 | 165  | 
qed  | 
166  | 
||
| 61942 | 167  | 
lemma floor_less_iff: "\<lfloor>x\<rfloor> < z \<longleftrightarrow> x < of_int z"  | 
| 30096 | 168  | 
by (simp add: not_le [symmetric] le_floor_iff)  | 
169  | 
||
| 61942 | 170  | 
lemma less_floor_iff: "z < \<lfloor>x\<rfloor> \<longleftrightarrow> of_int z + 1 \<le> x"  | 
| 30096 | 171  | 
using le_floor_iff [of "z + 1" x] by auto  | 
172  | 
||
| 61942 | 173  | 
lemma floor_le_iff: "\<lfloor>x\<rfloor> \<le> z \<longleftrightarrow> x < of_int z + 1"  | 
| 30096 | 174  | 
by (simp add: not_less [symmetric] less_floor_iff)  | 
175  | 
||
| 61942 | 176  | 
lemma floor_split[arith_split]: "P \<lfloor>t\<rfloor> \<longleftrightarrow> (\<forall>i. of_int i \<le> t \<and> t < of_int i + 1 \<longrightarrow> P i)"  | 
| 
58040
 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 
hoelzl 
parents: 
54489 
diff
changeset
 | 
177  | 
by (metis floor_correct floor_unique less_floor_iff not_le order_refl)  | 
| 
 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 
hoelzl 
parents: 
54489 
diff
changeset
 | 
178  | 
|
| 61942 | 179  | 
lemma floor_mono:  | 
180  | 
assumes "x \<le> y"  | 
|
181  | 
shows "\<lfloor>x\<rfloor> \<le> \<lfloor>y\<rfloor>"  | 
|
| 30096 | 182  | 
proof -  | 
| 61942 | 183  | 
have "of_int \<lfloor>x\<rfloor> \<le> x" by (rule of_int_floor_le)  | 
| 60758 | 184  | 
also note \<open>x \<le> y\<close>  | 
| 30096 | 185  | 
finally show ?thesis by (simp add: le_floor_iff)  | 
186  | 
qed  | 
|
187  | 
||
| 61942 | 188  | 
lemma floor_less_cancel: "\<lfloor>x\<rfloor> < \<lfloor>y\<rfloor> \<Longrightarrow> x < y"  | 
| 30096 | 189  | 
by (auto simp add: not_le [symmetric] floor_mono)  | 
190  | 
||
| 61942 | 191  | 
lemma floor_of_int [simp]: "\<lfloor>of_int z\<rfloor> = z"  | 
| 30096 | 192  | 
by (rule floor_unique) simp_all  | 
193  | 
||
| 61942 | 194  | 
lemma floor_of_nat [simp]: "\<lfloor>of_nat n\<rfloor> = int n"  | 
| 30096 | 195  | 
using floor_of_int [of "of_nat n"] by simp  | 
196  | 
||
| 61942 | 197  | 
lemma le_floor_add: "\<lfloor>x\<rfloor> + \<lfloor>y\<rfloor> \<le> \<lfloor>x + y\<rfloor>"  | 
| 
47307
 
5e5ca36692b3
add floor/ceiling lemmas suggested by René Thiemann
 
huffman 
parents: 
47108 
diff
changeset
 | 
198  | 
by (simp only: le_floor_iff of_int_add add_mono of_int_floor_le)  | 
| 
 
5e5ca36692b3
add floor/ceiling lemmas suggested by René Thiemann
 
huffman 
parents: 
47108 
diff
changeset
 | 
199  | 
|
| 60758 | 200  | 
text \<open>Floor with numerals\<close>  | 
| 30096 | 201  | 
|
| 61942 | 202  | 
lemma floor_zero [simp]: "\<lfloor>0\<rfloor> = 0"  | 
| 30096 | 203  | 
using floor_of_int [of 0] by simp  | 
204  | 
||
| 61942 | 205  | 
lemma floor_one [simp]: "\<lfloor>1\<rfloor> = 1"  | 
| 30096 | 206  | 
using floor_of_int [of 1] by simp  | 
207  | 
||
| 61942 | 208  | 
lemma floor_numeral [simp]: "\<lfloor>numeral v\<rfloor> = numeral v"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
209  | 
using floor_of_int [of "numeral v"] by simp  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
210  | 
|
| 61942 | 211  | 
lemma floor_neg_numeral [simp]: "\<lfloor>- numeral v\<rfloor> = - numeral v"  | 
| 
54489
 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 
haftmann 
parents: 
54281 
diff
changeset
 | 
212  | 
using floor_of_int [of "- numeral v"] by simp  | 
| 30096 | 213  | 
|
| 61942 | 214  | 
lemma zero_le_floor [simp]: "0 \<le> \<lfloor>x\<rfloor> \<longleftrightarrow> 0 \<le> x"  | 
| 30096 | 215  | 
by (simp add: le_floor_iff)  | 
216  | 
||
| 61942 | 217  | 
lemma one_le_floor [simp]: "1 \<le> \<lfloor>x\<rfloor> \<longleftrightarrow> 1 \<le> x"  | 
| 30096 | 218  | 
by (simp add: le_floor_iff)  | 
219  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
220  | 
lemma numeral_le_floor [simp]:  | 
| 61942 | 221  | 
"numeral v \<le> \<lfloor>x\<rfloor> \<longleftrightarrow> numeral v \<le> x"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
222  | 
by (simp add: le_floor_iff)  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
223  | 
|
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
224  | 
lemma neg_numeral_le_floor [simp]:  | 
| 61942 | 225  | 
"- numeral v \<le> \<lfloor>x\<rfloor> \<longleftrightarrow> - numeral v \<le> x"  | 
| 30096 | 226  | 
by (simp add: le_floor_iff)  | 
227  | 
||
| 61942 | 228  | 
lemma zero_less_floor [simp]: "0 < \<lfloor>x\<rfloor> \<longleftrightarrow> 1 \<le> x"  | 
| 30096 | 229  | 
by (simp add: less_floor_iff)  | 
230  | 
||
| 61942 | 231  | 
lemma one_less_floor [simp]: "1 < \<lfloor>x\<rfloor> \<longleftrightarrow> 2 \<le> x"  | 
| 30096 | 232  | 
by (simp add: less_floor_iff)  | 
233  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
234  | 
lemma numeral_less_floor [simp]:  | 
| 61942 | 235  | 
"numeral v < \<lfloor>x\<rfloor> \<longleftrightarrow> numeral v + 1 \<le> x"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
236  | 
by (simp add: less_floor_iff)  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
237  | 
|
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
238  | 
lemma neg_numeral_less_floor [simp]:  | 
| 61942 | 239  | 
"- numeral v < \<lfloor>x\<rfloor> \<longleftrightarrow> - numeral v + 1 \<le> x"  | 
| 30096 | 240  | 
by (simp add: less_floor_iff)  | 
241  | 
||
| 61942 | 242  | 
lemma floor_le_zero [simp]: "\<lfloor>x\<rfloor> \<le> 0 \<longleftrightarrow> x < 1"  | 
| 30096 | 243  | 
by (simp add: floor_le_iff)  | 
244  | 
||
| 61942 | 245  | 
lemma floor_le_one [simp]: "\<lfloor>x\<rfloor> \<le> 1 \<longleftrightarrow> x < 2"  | 
| 30096 | 246  | 
by (simp add: floor_le_iff)  | 
247  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
248  | 
lemma floor_le_numeral [simp]:  | 
| 61942 | 249  | 
"\<lfloor>x\<rfloor> \<le> numeral v \<longleftrightarrow> x < numeral v + 1"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
250  | 
by (simp add: floor_le_iff)  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
251  | 
|
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
252  | 
lemma floor_le_neg_numeral [simp]:  | 
| 61942 | 253  | 
"\<lfloor>x\<rfloor> \<le> - numeral v \<longleftrightarrow> x < - numeral v + 1"  | 
| 30096 | 254  | 
by (simp add: floor_le_iff)  | 
255  | 
||
| 61942 | 256  | 
lemma floor_less_zero [simp]: "\<lfloor>x\<rfloor> < 0 \<longleftrightarrow> x < 0"  | 
| 30096 | 257  | 
by (simp add: floor_less_iff)  | 
258  | 
||
| 61942 | 259  | 
lemma floor_less_one [simp]: "\<lfloor>x\<rfloor> < 1 \<longleftrightarrow> x < 1"  | 
| 30096 | 260  | 
by (simp add: floor_less_iff)  | 
261  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
262  | 
lemma floor_less_numeral [simp]:  | 
| 61942 | 263  | 
"\<lfloor>x\<rfloor> < numeral v \<longleftrightarrow> x < numeral v"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
264  | 
by (simp add: floor_less_iff)  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
265  | 
|
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
266  | 
lemma floor_less_neg_numeral [simp]:  | 
| 61942 | 267  | 
"\<lfloor>x\<rfloor> < - numeral v \<longleftrightarrow> x < - numeral v"  | 
| 30096 | 268  | 
by (simp add: floor_less_iff)  | 
269  | 
||
| 60758 | 270  | 
text \<open>Addition and subtraction of integers\<close>  | 
| 30096 | 271  | 
|
| 61942 | 272  | 
lemma floor_add_of_int [simp]: "\<lfloor>x + of_int z\<rfloor> = \<lfloor>x\<rfloor> + z"  | 
| 30096 | 273  | 
using floor_correct [of x] by (simp add: floor_unique)  | 
274  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
275  | 
lemma floor_add_numeral [simp]:  | 
| 61942 | 276  | 
"\<lfloor>x + numeral v\<rfloor> = \<lfloor>x\<rfloor> + numeral v"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
277  | 
using floor_add_of_int [of x "numeral v"] by simp  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
278  | 
|
| 61942 | 279  | 
lemma floor_add_one [simp]: "\<lfloor>x + 1\<rfloor> = \<lfloor>x\<rfloor> + 1"  | 
| 30096 | 280  | 
using floor_add_of_int [of x 1] by simp  | 
281  | 
||
| 61942 | 282  | 
lemma floor_diff_of_int [simp]: "\<lfloor>x - of_int z\<rfloor> = \<lfloor>x\<rfloor> - z"  | 
| 30096 | 283  | 
using floor_add_of_int [of x "- z"] by (simp add: algebra_simps)  | 
284  | 
||
| 61942 | 285  | 
lemma floor_uminus_of_int [simp]: "\<lfloor>- (of_int z)\<rfloor> = - z"  | 
| 
59613
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
286  | 
by (metis floor_diff_of_int [of 0] diff_0 floor_zero)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
287  | 
|
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
288  | 
lemma floor_diff_numeral [simp]:  | 
| 61942 | 289  | 
"\<lfloor>x - numeral v\<rfloor> = \<lfloor>x\<rfloor> - numeral v"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
290  | 
using floor_diff_of_int [of x "numeral v"] by simp  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
291  | 
|
| 61942 | 292  | 
lemma floor_diff_one [simp]: "\<lfloor>x - 1\<rfloor> = \<lfloor>x\<rfloor> - 1"  | 
| 30096 | 293  | 
using floor_diff_of_int [of x 1] by simp  | 
294  | 
||
| 
58097
 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 
hoelzl 
parents: 
58040 
diff
changeset
 | 
295  | 
lemma le_mult_floor:  | 
| 
 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 
hoelzl 
parents: 
58040 
diff
changeset
 | 
296  | 
assumes "0 \<le> a" and "0 \<le> b"  | 
| 61942 | 297  | 
shows "\<lfloor>a\<rfloor> * \<lfloor>b\<rfloor> \<le> \<lfloor>a * b\<rfloor>"  | 
| 
58097
 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 
hoelzl 
parents: 
58040 
diff
changeset
 | 
298  | 
proof -  | 
| 61942 | 299  | 
have "of_int \<lfloor>a\<rfloor> \<le> a"  | 
300  | 
and "of_int \<lfloor>b\<rfloor> \<le> b" by (auto intro: of_int_floor_le)  | 
|
301  | 
hence "of_int (\<lfloor>a\<rfloor> * \<lfloor>b\<rfloor>) \<le> a * b"  | 
|
| 
58097
 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 
hoelzl 
parents: 
58040 
diff
changeset
 | 
302  | 
using assms by (auto intro!: mult_mono)  | 
| 61942 | 303  | 
also have "a * b < of_int (\<lfloor>a * b\<rfloor> + 1)"  | 
| 
58097
 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 
hoelzl 
parents: 
58040 
diff
changeset
 | 
304  | 
using floor_correct[of "a * b"] by auto  | 
| 
 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 
hoelzl 
parents: 
58040 
diff
changeset
 | 
305  | 
finally show ?thesis unfolding of_int_less_iff by simp  | 
| 
 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 
hoelzl 
parents: 
58040 
diff
changeset
 | 
306  | 
qed  | 
| 
 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 
hoelzl 
parents: 
58040 
diff
changeset
 | 
307  | 
|
| 
59984
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
308  | 
lemma floor_divide_of_int_eq:  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
309  | 
fixes k l :: int  | 
| 60128 | 310  | 
shows "\<lfloor>of_int k / of_int l\<rfloor> = k div l"  | 
| 
59984
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
311  | 
proof (cases "l = 0")  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
312  | 
case True then show ?thesis by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
313  | 
next  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
314  | 
case False  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
315  | 
have *: "\<lfloor>of_int (k mod l) / of_int l :: 'a\<rfloor> = 0"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
316  | 
proof (cases "l > 0")  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
317  | 
case True then show ?thesis  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
318  | 
by (auto intro: floor_unique)  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
319  | 
next  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
320  | 
case False  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
321  | 
obtain r where "r = - l" by blast  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
322  | 
then have l: "l = - r" by simp  | 
| 60758 | 323  | 
moreover with \<open>l \<noteq> 0\<close> False have "r > 0" by simp  | 
| 
59984
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
324  | 
ultimately show ?thesis using pos_mod_bound [of r]  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
325  | 
by (auto simp add: zmod_zminus2_eq_if less_le field_simps intro: floor_unique)  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
326  | 
qed  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
327  | 
have "(of_int k :: 'a) = of_int (k div l * l + k mod l)"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
328  | 
by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
329  | 
also have "\<dots> = (of_int (k div l) + of_int (k mod l) / of_int l) * of_int l"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
330  | 
using False by (simp only: of_int_add) (simp add: field_simps)  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
331  | 
finally have "(of_int k / of_int l :: 'a) = \<dots> / of_int l"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
332  | 
by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
333  | 
then have "(of_int k / of_int l :: 'a) = of_int (k div l) + of_int (k mod l) / of_int l"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
334  | 
using False by (simp only:) (simp add: field_simps)  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
335  | 
then have "\<lfloor>of_int k / of_int l :: 'a\<rfloor> = \<lfloor>of_int (k div l) + of_int (k mod l) / of_int l :: 'a\<rfloor>"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
336  | 
by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
337  | 
then have "\<lfloor>of_int k / of_int l :: 'a\<rfloor> = \<lfloor>of_int (k mod l) / of_int l + of_int (k div l) :: 'a\<rfloor>"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
338  | 
by (simp add: ac_simps)  | 
| 60128 | 339  | 
then have "\<lfloor>of_int k / of_int l :: 'a\<rfloor> = \<lfloor>of_int (k mod l) / of_int l :: 'a\<rfloor> + k div l"  | 
| 
59984
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
340  | 
by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
341  | 
with * show ?thesis by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
342  | 
qed  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
343  | 
|
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
344  | 
lemma floor_divide_of_nat_eq:  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
345  | 
fixes m n :: nat  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
346  | 
shows "\<lfloor>of_nat m / of_nat n\<rfloor> = of_nat (m div n)"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
347  | 
proof (cases "n = 0")  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
348  | 
case True then show ?thesis by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
349  | 
next  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
350  | 
case False  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
351  | 
then have *: "\<lfloor>of_nat (m mod n) / of_nat n :: 'a\<rfloor> = 0"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
352  | 
by (auto intro: floor_unique)  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
353  | 
have "(of_nat m :: 'a) = of_nat (m div n * n + m mod n)"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
354  | 
by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
355  | 
also have "\<dots> = (of_nat (m div n) + of_nat (m mod n) / of_nat n) * of_nat n"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
356  | 
using False by (simp only: of_nat_add) (simp add: field_simps of_nat_mult)  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
357  | 
finally have "(of_nat m / of_nat n :: 'a) = \<dots> / of_nat n"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
358  | 
by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
359  | 
then have "(of_nat m / of_nat n :: 'a) = of_nat (m div n) + of_nat (m mod n) / of_nat n"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
360  | 
using False by (simp only:) simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
361  | 
then have "\<lfloor>of_nat m / of_nat n :: 'a\<rfloor> = \<lfloor>of_nat (m div n) + of_nat (m mod n) / of_nat n :: 'a\<rfloor>"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
362  | 
by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
363  | 
then have "\<lfloor>of_nat m / of_nat n :: 'a\<rfloor> = \<lfloor>of_nat (m mod n) / of_nat n + of_nat (m div n) :: 'a\<rfloor>"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
364  | 
by (simp add: ac_simps)  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
365  | 
moreover have "(of_nat (m div n) :: 'a) = of_int (of_nat (m div n))"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
366  | 
by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
367  | 
ultimately have "\<lfloor>of_nat m / of_nat n :: 'a\<rfloor> = \<lfloor>of_nat (m mod n) / of_nat n :: 'a\<rfloor> + of_nat (m div n)"  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
368  | 
by (simp only: floor_add_of_int)  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
369  | 
with * show ?thesis by simp  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
370  | 
qed  | 
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
371  | 
|
| 
 
4f1eccec320c
conversion between division on nat/int and division in archmedean fields
 
haftmann 
parents: 
59613 
diff
changeset
 | 
372  | 
|
| 60758 | 373  | 
subsection \<open>Ceiling function\<close>  | 
| 30096 | 374  | 
|
| 61942 | 375  | 
definition ceiling :: "'a::floor_ceiling \<Rightarrow> int"  ("\<lceil>_\<rceil>")
 | 
376  | 
where "\<lceil>x\<rceil> = - \<lfloor>- x\<rfloor>"  | 
|
| 30096 | 377  | 
|
| 61942 | 378  | 
lemma ceiling_correct: "of_int \<lceil>x\<rceil> - 1 < x \<and> x \<le> of_int \<lceil>x\<rceil>"  | 
| 
61649
 
268d88ec9087
Tweaks for "real": Removal of [iff] status for some lemmas, adding [simp] for others. Plus fixes.
 
paulson <lp15@cam.ac.uk> 
parents: 
61531 
diff
changeset
 | 
379  | 
unfolding ceiling_def using floor_correct [of "- x"] by (simp add: le_minus_iff)  | 
| 30096 | 380  | 
|
| 61942 | 381  | 
lemma ceiling_unique: "\<lbrakk>of_int z - 1 < x; x \<le> of_int z\<rbrakk> \<Longrightarrow> \<lceil>x\<rceil> = z"  | 
| 30096 | 382  | 
unfolding ceiling_def using floor_unique [of "- z" "- x"] by simp  | 
383  | 
||
| 61942 | 384  | 
lemma le_of_int_ceiling [simp]: "x \<le> of_int \<lceil>x\<rceil>"  | 
| 30096 | 385  | 
using ceiling_correct ..  | 
386  | 
||
| 61942 | 387  | 
lemma ceiling_le_iff: "\<lceil>x\<rceil> \<le> z \<longleftrightarrow> x \<le> of_int z"  | 
| 30096 | 388  | 
unfolding ceiling_def using le_floor_iff [of "- z" "- x"] by auto  | 
389  | 
||
| 61942 | 390  | 
lemma less_ceiling_iff: "z < \<lceil>x\<rceil> \<longleftrightarrow> of_int z < x"  | 
| 30096 | 391  | 
by (simp add: not_le [symmetric] ceiling_le_iff)  | 
392  | 
||
| 61942 | 393  | 
lemma ceiling_less_iff: "\<lceil>x\<rceil> < z \<longleftrightarrow> x \<le> of_int z - 1"  | 
| 30096 | 394  | 
using ceiling_le_iff [of x "z - 1"] by simp  | 
395  | 
||
| 61942 | 396  | 
lemma le_ceiling_iff: "z \<le> \<lceil>x\<rceil> \<longleftrightarrow> of_int z - 1 < x"  | 
| 30096 | 397  | 
by (simp add: not_less [symmetric] ceiling_less_iff)  | 
398  | 
||
| 61942 | 399  | 
lemma ceiling_mono: "x \<ge> y \<Longrightarrow> \<lceil>x\<rceil> \<ge> \<lceil>y\<rceil>"  | 
| 30096 | 400  | 
unfolding ceiling_def by (simp add: floor_mono)  | 
401  | 
||
| 61942 | 402  | 
lemma ceiling_less_cancel: "\<lceil>x\<rceil> < \<lceil>y\<rceil> \<Longrightarrow> x < y"  | 
| 30096 | 403  | 
by (auto simp add: not_le [symmetric] ceiling_mono)  | 
404  | 
||
| 61942 | 405  | 
lemma ceiling_of_int [simp]: "\<lceil>of_int z\<rceil> = z"  | 
| 30096 | 406  | 
by (rule ceiling_unique) simp_all  | 
407  | 
||
| 61942 | 408  | 
lemma ceiling_of_nat [simp]: "\<lceil>of_nat n\<rceil> = int n"  | 
| 30096 | 409  | 
using ceiling_of_int [of "of_nat n"] by simp  | 
410  | 
||
| 61942 | 411  | 
lemma ceiling_add_le: "\<lceil>x + y\<rceil> \<le> \<lceil>x\<rceil> + \<lceil>y\<rceil>"  | 
| 
47307
 
5e5ca36692b3
add floor/ceiling lemmas suggested by René Thiemann
 
huffman 
parents: 
47108 
diff
changeset
 | 
412  | 
by (simp only: ceiling_le_iff of_int_add add_mono le_of_int_ceiling)  | 
| 
 
5e5ca36692b3
add floor/ceiling lemmas suggested by René Thiemann
 
huffman 
parents: 
47108 
diff
changeset
 | 
413  | 
|
| 60758 | 414  | 
text \<open>Ceiling with numerals\<close>  | 
| 30096 | 415  | 
|
| 61942 | 416  | 
lemma ceiling_zero [simp]: "\<lceil>0\<rceil> = 0"  | 
| 30096 | 417  | 
using ceiling_of_int [of 0] by simp  | 
418  | 
||
| 61942 | 419  | 
lemma ceiling_one [simp]: "\<lceil>1\<rceil> = 1"  | 
| 30096 | 420  | 
using ceiling_of_int [of 1] by simp  | 
421  | 
||
| 61942 | 422  | 
lemma ceiling_numeral [simp]: "\<lceil>numeral v\<rceil> = numeral v"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
423  | 
using ceiling_of_int [of "numeral v"] by simp  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
424  | 
|
| 61942 | 425  | 
lemma ceiling_neg_numeral [simp]: "\<lceil>- numeral v\<rceil> = - numeral v"  | 
| 
54489
 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 
haftmann 
parents: 
54281 
diff
changeset
 | 
426  | 
using ceiling_of_int [of "- numeral v"] by simp  | 
| 30096 | 427  | 
|
| 61942 | 428  | 
lemma ceiling_le_zero [simp]: "\<lceil>x\<rceil> \<le> 0 \<longleftrightarrow> x \<le> 0"  | 
| 30096 | 429  | 
by (simp add: ceiling_le_iff)  | 
430  | 
||
| 61942 | 431  | 
lemma ceiling_le_one [simp]: "\<lceil>x\<rceil> \<le> 1 \<longleftrightarrow> x \<le> 1"  | 
| 30096 | 432  | 
by (simp add: ceiling_le_iff)  | 
433  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
434  | 
lemma ceiling_le_numeral [simp]:  | 
| 61942 | 435  | 
"\<lceil>x\<rceil> \<le> numeral v \<longleftrightarrow> x \<le> numeral v"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
436  | 
by (simp add: ceiling_le_iff)  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
437  | 
|
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
438  | 
lemma ceiling_le_neg_numeral [simp]:  | 
| 61942 | 439  | 
"\<lceil>x\<rceil> \<le> - numeral v \<longleftrightarrow> x \<le> - numeral v"  | 
| 30096 | 440  | 
by (simp add: ceiling_le_iff)  | 
441  | 
||
| 61942 | 442  | 
lemma ceiling_less_zero [simp]: "\<lceil>x\<rceil> < 0 \<longleftrightarrow> x \<le> -1"  | 
| 30096 | 443  | 
by (simp add: ceiling_less_iff)  | 
444  | 
||
| 61942 | 445  | 
lemma ceiling_less_one [simp]: "\<lceil>x\<rceil> < 1 \<longleftrightarrow> x \<le> 0"  | 
| 30096 | 446  | 
by (simp add: ceiling_less_iff)  | 
447  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
448  | 
lemma ceiling_less_numeral [simp]:  | 
| 61942 | 449  | 
"\<lceil>x\<rceil> < numeral v \<longleftrightarrow> x \<le> numeral v - 1"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
450  | 
by (simp add: ceiling_less_iff)  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
451  | 
|
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
452  | 
lemma ceiling_less_neg_numeral [simp]:  | 
| 61942 | 453  | 
"\<lceil>x\<rceil> < - numeral v \<longleftrightarrow> x \<le> - numeral v - 1"  | 
| 30096 | 454  | 
by (simp add: ceiling_less_iff)  | 
455  | 
||
| 61942 | 456  | 
lemma zero_le_ceiling [simp]: "0 \<le> \<lceil>x\<rceil> \<longleftrightarrow> -1 < x"  | 
| 30096 | 457  | 
by (simp add: le_ceiling_iff)  | 
458  | 
||
| 61942 | 459  | 
lemma one_le_ceiling [simp]: "1 \<le> \<lceil>x\<rceil> \<longleftrightarrow> 0 < x"  | 
| 30096 | 460  | 
by (simp add: le_ceiling_iff)  | 
461  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
462  | 
lemma numeral_le_ceiling [simp]:  | 
| 61942 | 463  | 
"numeral v \<le> \<lceil>x\<rceil> \<longleftrightarrow> numeral v - 1 < x"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
464  | 
by (simp add: le_ceiling_iff)  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
465  | 
|
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
466  | 
lemma neg_numeral_le_ceiling [simp]:  | 
| 61942 | 467  | 
"- numeral v \<le> \<lceil>x\<rceil> \<longleftrightarrow> - numeral v - 1 < x"  | 
| 30096 | 468  | 
by (simp add: le_ceiling_iff)  | 
469  | 
||
| 61942 | 470  | 
lemma zero_less_ceiling [simp]: "0 < \<lceil>x\<rceil> \<longleftrightarrow> 0 < x"  | 
| 30096 | 471  | 
by (simp add: less_ceiling_iff)  | 
472  | 
||
| 61942 | 473  | 
lemma one_less_ceiling [simp]: "1 < \<lceil>x\<rceil> \<longleftrightarrow> 1 < x"  | 
| 30096 | 474  | 
by (simp add: less_ceiling_iff)  | 
475  | 
||
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
476  | 
lemma numeral_less_ceiling [simp]:  | 
| 61942 | 477  | 
"numeral v < \<lceil>x\<rceil> \<longleftrightarrow> numeral v < x"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
478  | 
by (simp add: less_ceiling_iff)  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
479  | 
|
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
480  | 
lemma neg_numeral_less_ceiling [simp]:  | 
| 61942 | 481  | 
"- numeral v < \<lceil>x\<rceil> \<longleftrightarrow> - numeral v < x"  | 
| 30096 | 482  | 
by (simp add: less_ceiling_iff)  | 
483  | 
||
| 61942 | 484  | 
lemma ceiling_altdef: "\<lceil>x\<rceil> = (if x = of_int \<lfloor>x\<rfloor> then \<lfloor>x\<rfloor> else \<lfloor>x\<rfloor> + 1)"  | 
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
485  | 
by (intro ceiling_unique, (simp, linarith?)+)  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
486  | 
|
| 61942 | 487  | 
lemma floor_le_ceiling [simp]: "\<lfloor>x\<rfloor> \<le> \<lceil>x\<rceil>"  | 
488  | 
by (simp add: ceiling_altdef)  | 
|
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
489  | 
|
| 60758 | 490  | 
text \<open>Addition and subtraction of integers\<close>  | 
| 30096 | 491  | 
|
| 61942 | 492  | 
lemma ceiling_add_of_int [simp]: "\<lceil>x + of_int z\<rceil> = \<lceil>x\<rceil> + z"  | 
| 
61649
 
268d88ec9087
Tweaks for "real": Removal of [iff] status for some lemmas, adding [simp] for others. Plus fixes.
 
paulson <lp15@cam.ac.uk> 
parents: 
61531 
diff
changeset
 | 
493  | 
using ceiling_correct [of x] by (simp add: ceiling_def)  | 
| 30096 | 494  | 
|
| 61942 | 495  | 
lemma ceiling_add_numeral [simp]: "\<lceil>x + numeral v\<rceil> = \<lceil>x\<rceil> + numeral v"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
496  | 
using ceiling_add_of_int [of x "numeral v"] by simp  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
497  | 
|
| 61942 | 498  | 
lemma ceiling_add_one [simp]: "\<lceil>x + 1\<rceil> = \<lceil>x\<rceil> + 1"  | 
| 30096 | 499  | 
using ceiling_add_of_int [of x 1] by simp  | 
500  | 
||
| 61942 | 501  | 
lemma ceiling_diff_of_int [simp]: "\<lceil>x - of_int z\<rceil> = \<lceil>x\<rceil> - z"  | 
| 30096 | 502  | 
using ceiling_add_of_int [of x "- z"] by (simp add: algebra_simps)  | 
503  | 
||
| 61942 | 504  | 
lemma ceiling_diff_numeral [simp]: "\<lceil>x - numeral v\<rceil> = \<lceil>x\<rceil> - numeral v"  | 
| 
47108
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
505  | 
using ceiling_diff_of_int [of x "numeral v"] by simp  | 
| 
 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 
huffman 
parents: 
43733 
diff
changeset
 | 
506  | 
|
| 61942 | 507  | 
lemma ceiling_diff_one [simp]: "\<lceil>x - 1\<rceil> = \<lceil>x\<rceil> - 1"  | 
| 30096 | 508  | 
using ceiling_diff_of_int [of x 1] by simp  | 
509  | 
||
| 61942 | 510  | 
lemma ceiling_split[arith_split]: "P \<lceil>t\<rceil> \<longleftrightarrow> (\<forall>i. of_int i - 1 < t \<and> t \<le> of_int i \<longrightarrow> P i)"  | 
| 
58040
 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 
hoelzl 
parents: 
54489 
diff
changeset
 | 
511  | 
by (auto simp add: ceiling_unique ceiling_correct)  | 
| 
 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 
hoelzl 
parents: 
54489 
diff
changeset
 | 
512  | 
|
| 61942 | 513  | 
lemma ceiling_diff_floor_le_1: "\<lceil>x\<rceil> - \<lfloor>x\<rfloor> \<le> 1"  | 
| 47592 | 514  | 
proof -  | 
515  | 
have "of_int \<lceil>x\<rceil> - 1 < x"  | 
|
516  | 
using ceiling_correct[of x] by simp  | 
|
517  | 
also have "x < of_int \<lfloor>x\<rfloor> + 1"  | 
|
518  | 
using floor_correct[of x] by simp_all  | 
|
519  | 
finally have "of_int (\<lceil>x\<rceil> - \<lfloor>x\<rfloor>) < (of_int 2::'a)"  | 
|
520  | 
by simp  | 
|
521  | 
then show ?thesis  | 
|
522  | 
unfolding of_int_less_iff by simp  | 
|
523  | 
qed  | 
|
| 30096 | 524  | 
|
| 60758 | 525  | 
subsection \<open>Negation\<close>  | 
| 30096 | 526  | 
|
| 61942 | 527  | 
lemma floor_minus: "\<lfloor>- x\<rfloor> = - \<lceil>x\<rceil>"  | 
| 30096 | 528  | 
unfolding ceiling_def by simp  | 
529  | 
||
| 61942 | 530  | 
lemma ceiling_minus: "\<lceil>- x\<rceil> = - \<lfloor>x\<rfloor>"  | 
| 30096 | 531  | 
unfolding ceiling_def by simp  | 
532  | 
||
| 61942 | 533  | 
|
| 60758 | 534  | 
subsection \<open>Frac Function\<close>  | 
| 
59613
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
535  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
536  | 
definition frac :: "'a \<Rightarrow> 'a::floor_ceiling" where  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
537  | 
"frac x \<equiv> x - of_int \<lfloor>x\<rfloor>"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
538  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
539  | 
lemma frac_lt_1: "frac x < 1"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
540  | 
by (simp add: frac_def) linarith  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
541  | 
|
| 61070 | 542  | 
lemma frac_eq_0_iff [simp]: "frac x = 0 \<longleftrightarrow> x \<in> \<int>"  | 
| 
59613
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
543  | 
by (simp add: frac_def) (metis Ints_cases Ints_of_int floor_of_int )  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
544  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
545  | 
lemma frac_ge_0 [simp]: "frac x \<ge> 0"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
546  | 
unfolding frac_def  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
547  | 
by linarith  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
548  | 
|
| 61070 | 549  | 
lemma frac_gt_0_iff [simp]: "frac x > 0 \<longleftrightarrow> x \<notin> \<int>"  | 
| 
59613
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
550  | 
by (metis frac_eq_0_iff frac_ge_0 le_less less_irrefl)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
551  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
552  | 
lemma frac_of_int [simp]: "frac (of_int z) = 0"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
553  | 
by (simp add: frac_def)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
554  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
555  | 
lemma floor_add: "\<lfloor>x + y\<rfloor> = (if frac x + frac y < 1 then \<lfloor>x\<rfloor> + \<lfloor>y\<rfloor> else (\<lfloor>x\<rfloor> + \<lfloor>y\<rfloor>) + 1)"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
556  | 
proof -  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
557  | 
  {assume "x + y < 1 + (of_int \<lfloor>x\<rfloor> + of_int \<lfloor>y\<rfloor>)"
 | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
558  | 
then have "\<lfloor>x + y\<rfloor> = \<lfloor>x\<rfloor> + \<lfloor>y\<rfloor>"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
559  | 
by (metis add.commute floor_unique le_floor_add le_floor_iff of_int_add)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
560  | 
}  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
561  | 
moreover  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
562  | 
  { assume "\<not> x + y < 1 + (of_int \<lfloor>x\<rfloor> + of_int \<lfloor>y\<rfloor>)"
 | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
563  | 
then have "\<lfloor>x + y\<rfloor> = 1 + (\<lfloor>x\<rfloor> + \<lfloor>y\<rfloor>)"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
564  | 
apply (simp add: floor_unique_iff)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
565  | 
apply (auto simp add: algebra_simps)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
566  | 
by linarith  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
567  | 
}  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
568  | 
ultimately show ?thesis  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
569  | 
by (auto simp add: frac_def algebra_simps)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
570  | 
qed  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
571  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
572  | 
lemma frac_add: "frac (x + y) = (if frac x + frac y < 1 then frac x + frac y  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
573  | 
else (frac x + frac y) - 1)"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
574  | 
by (simp add: frac_def floor_add)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
575  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
576  | 
lemma frac_unique_iff:  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
577  | 
fixes x :: "'a::floor_ceiling"  | 
| 62348 | 578  | 
shows "frac x = a \<longleftrightarrow> x - a \<in> \<int> \<and> 0 \<le> a \<and> a < 1"  | 
579  | 
apply (auto simp: Ints_def frac_def algebra_simps floor_unique)  | 
|
580  | 
apply linarith+  | 
|
581  | 
done  | 
|
| 
59613
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
582  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
583  | 
lemma frac_eq: "(frac x) = x \<longleftrightarrow> 0 \<le> x \<and> x < 1"  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
584  | 
by (simp add: frac_unique_iff)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
585  | 
|
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
586  | 
lemma frac_neg:  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
587  | 
fixes x :: "'a::floor_ceiling"  | 
| 61070 | 588  | 
shows "frac (-x) = (if x \<in> \<int> then 0 else 1 - frac x)"  | 
| 
59613
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
589  | 
apply (auto simp add: frac_unique_iff)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
590  | 
apply (simp add: frac_def)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
591  | 
by (meson frac_lt_1 less_iff_diff_less_0 not_le not_less_iff_gr_or_eq)  | 
| 
 
7103019278f0
The function frac. Various lemmas about limits, series, the exp function, etc.
 
paulson <lp15@cam.ac.uk> 
parents: 
58889 
diff
changeset
 | 
592  | 
|
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
593  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
594  | 
subsection \<open>Rounding to the nearest integer\<close>  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
595  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
596  | 
definition round where "round x = \<lfloor>x + 1/2\<rfloor>"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
597  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
598  | 
lemma of_int_round_ge: "of_int (round x) \<ge> x - 1/2"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
599  | 
and of_int_round_le: "of_int (round x) \<le> x + 1/2"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
600  | 
and of_int_round_abs_le: "\<bar>of_int (round x) - x\<bar> \<le> 1/2"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
601  | 
and of_int_round_gt: "of_int (round x) > x - 1/2"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
602  | 
proof -  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
603  | 
from floor_correct[of "x + 1/2"] have "x + 1/2 < of_int (round x) + 1" by (simp add: round_def)  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
604  | 
from add_strict_right_mono[OF this, of "-1"] show A: "of_int (round x) > x - 1/2" by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
605  | 
thus "of_int (round x) \<ge> x - 1/2" by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
606  | 
from floor_correct[of "x + 1/2"] show "of_int (round x) \<le> x + 1/2" by (simp add: round_def)  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
607  | 
with A show "\<bar>of_int (round x) - x\<bar> \<le> 1/2" by linarith  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
608  | 
qed  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
609  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
610  | 
lemma round_of_int [simp]: "round (of_int n) = n"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
611  | 
unfolding round_def by (subst floor_unique_iff) force  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
612  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
613  | 
lemma round_0 [simp]: "round 0 = 0"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
614  | 
using round_of_int[of 0] by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
615  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
616  | 
lemma round_1 [simp]: "round 1 = 1"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
617  | 
using round_of_int[of 1] by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
618  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
619  | 
lemma round_numeral [simp]: "round (numeral n) = numeral n"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
620  | 
using round_of_int[of "numeral n"] by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
621  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
622  | 
lemma round_neg_numeral [simp]: "round (-numeral n) = -numeral n"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
623  | 
using round_of_int[of "-numeral n"] by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
624  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
625  | 
lemma round_of_nat [simp]: "round (of_nat n) = of_nat n"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
626  | 
using round_of_int[of "int n"] by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
627  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
628  | 
lemma round_mono: "x \<le> y \<Longrightarrow> round x \<le> round y"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
629  | 
unfolding round_def by (intro floor_mono) simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
630  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
631  | 
lemma round_unique: "of_int y > x - 1/2 \<Longrightarrow> of_int y \<le> x + 1/2 \<Longrightarrow> round x = y"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
632  | 
unfolding round_def  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
633  | 
proof (rule floor_unique)  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
634  | 
assume "x - 1 / 2 < of_int y"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
635  | 
from add_strict_left_mono[OF this, of 1] show "x + 1 / 2 < of_int y + 1" by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
636  | 
qed  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
637  | 
|
| 61942 | 638  | 
lemma round_altdef: "round x = (if frac x \<ge> 1/2 then \<lceil>x\<rceil> else \<lfloor>x\<rfloor>)"  | 
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
639  | 
by (cases "frac x \<ge> 1/2")  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
640  | 
(rule round_unique, ((simp add: frac_def field_simps ceiling_altdef, linarith?)+)[2])+  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
641  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
642  | 
lemma floor_le_round: "\<lfloor>x\<rfloor> \<le> round x"  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
643  | 
unfolding round_def by (intro floor_mono) simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
644  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
645  | 
lemma ceiling_ge_round: "\<lceil>x\<rceil> \<ge> round x" unfolding round_altdef by simp  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
646  | 
|
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
647  | 
lemma round_diff_minimal:  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
648  | 
fixes z :: "'a :: floor_ceiling"  | 
| 61944 | 649  | 
shows "\<bar>z - of_int (round z)\<bar> \<le> \<bar>z - of_int m\<bar>"  | 
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
650  | 
proof (cases "of_int m \<ge> z")  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
651  | 
case True  | 
| 61942 | 652  | 
hence "\<bar>z - of_int (round z)\<bar> \<le> \<bar>of_int \<lceil>z\<rceil> - z\<bar>"  | 
| 
61738
 
c4f6031f1310
New material about paths, winding numbers, etc. Added lemmas to divide_const_simps. Misc tuning.
 
paulson <lp15@cam.ac.uk> 
parents: 
61649 
diff
changeset
 | 
653  | 
unfolding round_altdef by (simp add: field_simps ceiling_altdef frac_def) linarith?  | 
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
654  | 
also have "of_int \<lceil>z\<rceil> - z \<ge> 0" by linarith  | 
| 61942 | 655  | 
with True have "\<bar>of_int \<lceil>z\<rceil> - z\<bar> \<le> \<bar>z - of_int m\<bar>"  | 
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
656  | 
by (simp add: ceiling_le_iff)  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
657  | 
finally show ?thesis .  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
658  | 
next  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
659  | 
case False  | 
| 61942 | 660  | 
hence "\<bar>z - of_int (round z)\<bar> \<le> \<bar>of_int \<lfloor>z\<rfloor> - z\<bar>"  | 
| 
61738
 
c4f6031f1310
New material about paths, winding numbers, etc. Added lemmas to divide_const_simps. Misc tuning.
 
paulson <lp15@cam.ac.uk> 
parents: 
61649 
diff
changeset
 | 
661  | 
unfolding round_altdef by (simp add: field_simps ceiling_altdef frac_def) linarith?  | 
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
662  | 
also have "z - of_int \<lfloor>z\<rfloor> \<ge> 0" by linarith  | 
| 61942 | 663  | 
with False have "\<bar>of_int \<lfloor>z\<rfloor> - z\<bar> \<le> \<bar>z - of_int m\<bar>"  | 
| 
61531
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
664  | 
by (simp add: le_floor_iff)  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
665  | 
finally show ?thesis .  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
666  | 
qed  | 
| 
 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 
eberlm 
parents: 
61378 
diff
changeset
 | 
667  | 
|
| 30096 | 668  | 
end  |