| author | wenzelm | 
| Mon, 23 Feb 2015 14:50:30 +0100 | |
| changeset 59564 | fdc03c8daacc | 
| parent 59000 | 6eb0725503fc | 
| child 59587 | 8ea7b22525cb | 
| permissions | -rw-r--r-- | 
| 51523 | 1 | (* Title: HOL/Real.thy | 
| 2 | Author: Jacques D. Fleuriot, University of Edinburgh, 1998 | |
| 3 | Author: Larry Paulson, University of Cambridge | |
| 4 | Author: Jeremy Avigad, Carnegie Mellon University | |
| 5 | Author: Florian Zuleger, Johannes Hoelzl, and Simon Funke, TU Muenchen | |
| 6 | Conversion to Isar and new proofs by Lawrence C Paulson, 2003/4 | |
| 7 | Construction of Cauchy Reals by Brian Huffman, 2010 | |
| 8 | *) | |
| 9 | ||
| 58889 | 10 | section {* Development of the Reals using Cauchy Sequences *}
 | 
| 51523 | 11 | |
| 12 | theory Real | |
| 51773 | 13 | imports Rat Conditionally_Complete_Lattices | 
| 51523 | 14 | begin | 
| 15 | ||
| 16 | text {*
 | |
| 17 | This theory contains a formalization of the real numbers as | |
| 18 | equivalence classes of Cauchy sequences of rationals. See | |
| 19 |   @{file "~~/src/HOL/ex/Dedekind_Real.thy"} for an alternative
 | |
| 20 | construction using Dedekind cuts. | |
| 21 | *} | |
| 22 | ||
| 23 | subsection {* Preliminary lemmas *}
 | |
| 24 | ||
| 25 | lemma add_diff_add: | |
| 26 | fixes a b c d :: "'a::ab_group_add" | |
| 27 | shows "(a + c) - (b + d) = (a - b) + (c - d)" | |
| 28 | by simp | |
| 29 | ||
| 30 | lemma minus_diff_minus: | |
| 31 | fixes a b :: "'a::ab_group_add" | |
| 32 | shows "- a - - b = - (a - b)" | |
| 33 | by simp | |
| 34 | ||
| 35 | lemma mult_diff_mult: | |
| 36 | fixes x y a b :: "'a::ring" | |
| 37 | shows "(x * y - a * b) = x * (y - b) + (x - a) * b" | |
| 38 | by (simp add: algebra_simps) | |
| 39 | ||
| 40 | lemma inverse_diff_inverse: | |
| 41 | fixes a b :: "'a::division_ring" | |
| 42 | assumes "a \<noteq> 0" and "b \<noteq> 0" | |
| 43 | shows "inverse a - inverse b = - (inverse a * (a - b) * inverse b)" | |
| 44 | using assms by (simp add: algebra_simps) | |
| 45 | ||
| 46 | lemma obtain_pos_sum: | |
| 47 | fixes r :: rat assumes r: "0 < r" | |
| 48 | obtains s t where "0 < s" and "0 < t" and "r = s + t" | |
| 49 | proof | |
| 50 | from r show "0 < r/2" by simp | |
| 51 | from r show "0 < r/2" by simp | |
| 52 | show "r = r/2 + r/2" by simp | |
| 53 | qed | |
| 54 | ||
| 55 | subsection {* Sequences that converge to zero *}
 | |
| 56 | ||
| 57 | definition | |
| 58 | vanishes :: "(nat \<Rightarrow> rat) \<Rightarrow> bool" | |
| 59 | where | |
| 60 | "vanishes X = (\<forall>r>0. \<exists>k. \<forall>n\<ge>k. \<bar>X n\<bar> < r)" | |
| 61 | ||
| 62 | lemma vanishesI: "(\<And>r. 0 < r \<Longrightarrow> \<exists>k. \<forall>n\<ge>k. \<bar>X n\<bar> < r) \<Longrightarrow> vanishes X" | |
| 63 | unfolding vanishes_def by simp | |
| 64 | ||
| 65 | lemma vanishesD: "\<lbrakk>vanishes X; 0 < r\<rbrakk> \<Longrightarrow> \<exists>k. \<forall>n\<ge>k. \<bar>X n\<bar> < r" | |
| 66 | unfolding vanishes_def by simp | |
| 67 | ||
| 68 | lemma vanishes_const [simp]: "vanishes (\<lambda>n. c) \<longleftrightarrow> c = 0" | |
| 69 | unfolding vanishes_def | |
| 70 | apply (cases "c = 0", auto) | |
| 71 | apply (rule exI [where x="\<bar>c\<bar>"], auto) | |
| 72 | done | |
| 73 | ||
| 74 | lemma vanishes_minus: "vanishes X \<Longrightarrow> vanishes (\<lambda>n. - X n)" | |
| 75 | unfolding vanishes_def by simp | |
| 76 | ||
| 77 | lemma vanishes_add: | |
| 78 | assumes X: "vanishes X" and Y: "vanishes Y" | |
| 79 | shows "vanishes (\<lambda>n. X n + Y n)" | |
| 80 | proof (rule vanishesI) | |
| 81 | fix r :: rat assume "0 < r" | |
| 82 | then obtain s t where s: "0 < s" and t: "0 < t" and r: "r = s + t" | |
| 83 | by (rule obtain_pos_sum) | |
| 84 | obtain i where i: "\<forall>n\<ge>i. \<bar>X n\<bar> < s" | |
| 85 | using vanishesD [OF X s] .. | |
| 86 | obtain j where j: "\<forall>n\<ge>j. \<bar>Y n\<bar> < t" | |
| 87 | using vanishesD [OF Y t] .. | |
| 88 | have "\<forall>n\<ge>max i j. \<bar>X n + Y n\<bar> < r" | |
| 89 | proof (clarsimp) | |
| 90 | fix n assume n: "i \<le> n" "j \<le> n" | |
| 91 | have "\<bar>X n + Y n\<bar> \<le> \<bar>X n\<bar> + \<bar>Y n\<bar>" by (rule abs_triangle_ineq) | |
| 92 | also have "\<dots> < s + t" by (simp add: add_strict_mono i j n) | |
| 93 | finally show "\<bar>X n + Y n\<bar> < r" unfolding r . | |
| 94 | qed | |
| 95 | thus "\<exists>k. \<forall>n\<ge>k. \<bar>X n + Y n\<bar> < r" .. | |
| 96 | qed | |
| 97 | ||
| 98 | lemma vanishes_diff: | |
| 99 | assumes X: "vanishes X" and Y: "vanishes Y" | |
| 100 | shows "vanishes (\<lambda>n. X n - Y n)" | |
| 54230 
b1d955791529
more simplification rules on unary and binary minus
 haftmann parents: 
53652diff
changeset | 101 | unfolding diff_conv_add_uminus by (intro vanishes_add vanishes_minus X Y) | 
| 51523 | 102 | |
| 103 | lemma vanishes_mult_bounded: | |
| 104 | assumes X: "\<exists>a>0. \<forall>n. \<bar>X n\<bar> < a" | |
| 105 | assumes Y: "vanishes (\<lambda>n. Y n)" | |
| 106 | shows "vanishes (\<lambda>n. X n * Y n)" | |
| 107 | proof (rule vanishesI) | |
| 108 | fix r :: rat assume r: "0 < r" | |
| 109 | obtain a where a: "0 < a" "\<forall>n. \<bar>X n\<bar> < a" | |
| 110 | using X by fast | |
| 111 | obtain b where b: "0 < b" "r = a * b" | |
| 112 | proof | |
| 56541 | 113 | show "0 < r / a" using r a by simp | 
| 51523 | 114 | show "r = a * (r / a)" using a by simp | 
| 115 | qed | |
| 116 | obtain k where k: "\<forall>n\<ge>k. \<bar>Y n\<bar> < b" | |
| 117 | using vanishesD [OF Y b(1)] .. | |
| 118 | have "\<forall>n\<ge>k. \<bar>X n * Y n\<bar> < r" | |
| 119 | by (simp add: b(2) abs_mult mult_strict_mono' a k) | |
| 120 | thus "\<exists>k. \<forall>n\<ge>k. \<bar>X n * Y n\<bar> < r" .. | |
| 121 | qed | |
| 122 | ||
| 123 | subsection {* Cauchy sequences *}
 | |
| 124 | ||
| 125 | definition | |
| 126 | cauchy :: "(nat \<Rightarrow> rat) \<Rightarrow> bool" | |
| 127 | where | |
| 128 | "cauchy X \<longleftrightarrow> (\<forall>r>0. \<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < r)" | |
| 129 | ||
| 130 | lemma cauchyI: | |
| 131 | "(\<And>r. 0 < r \<Longrightarrow> \<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < r) \<Longrightarrow> cauchy X" | |
| 132 | unfolding cauchy_def by simp | |
| 133 | ||
| 134 | lemma cauchyD: | |
| 135 | "\<lbrakk>cauchy X; 0 < r\<rbrakk> \<Longrightarrow> \<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < r" | |
| 136 | unfolding cauchy_def by simp | |
| 137 | ||
| 138 | lemma cauchy_const [simp]: "cauchy (\<lambda>n. x)" | |
| 139 | unfolding cauchy_def by simp | |
| 140 | ||
| 141 | lemma cauchy_add [simp]: | |
| 142 | assumes X: "cauchy X" and Y: "cauchy Y" | |
| 143 | shows "cauchy (\<lambda>n. X n + Y n)" | |
| 144 | proof (rule cauchyI) | |
| 145 | fix r :: rat assume "0 < r" | |
| 146 | then obtain s t where s: "0 < s" and t: "0 < t" and r: "r = s + t" | |
| 147 | by (rule obtain_pos_sum) | |
| 148 | obtain i where i: "\<forall>m\<ge>i. \<forall>n\<ge>i. \<bar>X m - X n\<bar> < s" | |
| 149 | using cauchyD [OF X s] .. | |
| 150 | obtain j where j: "\<forall>m\<ge>j. \<forall>n\<ge>j. \<bar>Y m - Y n\<bar> < t" | |
| 151 | using cauchyD [OF Y t] .. | |
| 152 | have "\<forall>m\<ge>max i j. \<forall>n\<ge>max i j. \<bar>(X m + Y m) - (X n + Y n)\<bar> < r" | |
| 153 | proof (clarsimp) | |
| 154 | fix m n assume *: "i \<le> m" "j \<le> m" "i \<le> n" "j \<le> n" | |
| 155 | have "\<bar>(X m + Y m) - (X n + Y n)\<bar> \<le> \<bar>X m - X n\<bar> + \<bar>Y m - Y n\<bar>" | |
| 156 | unfolding add_diff_add by (rule abs_triangle_ineq) | |
| 157 | also have "\<dots> < s + t" | |
| 158 | by (rule add_strict_mono, simp_all add: i j *) | |
| 159 | finally show "\<bar>(X m + Y m) - (X n + Y n)\<bar> < r" unfolding r . | |
| 160 | qed | |
| 161 | thus "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>(X m + Y m) - (X n + Y n)\<bar> < r" .. | |
| 162 | qed | |
| 163 | ||
| 164 | lemma cauchy_minus [simp]: | |
| 165 | assumes X: "cauchy X" | |
| 166 | shows "cauchy (\<lambda>n. - X n)" | |
| 167 | using assms unfolding cauchy_def | |
| 168 | unfolding minus_diff_minus abs_minus_cancel . | |
| 169 | ||
| 170 | lemma cauchy_diff [simp]: | |
| 171 | assumes X: "cauchy X" and Y: "cauchy Y" | |
| 172 | shows "cauchy (\<lambda>n. X n - Y n)" | |
| 54230 
b1d955791529
more simplification rules on unary and binary minus
 haftmann parents: 
53652diff
changeset | 173 | using assms unfolding diff_conv_add_uminus by (simp del: add_uminus_conv_diff) | 
| 51523 | 174 | |
| 175 | lemma cauchy_imp_bounded: | |
| 176 | assumes "cauchy X" shows "\<exists>b>0. \<forall>n. \<bar>X n\<bar> < b" | |
| 177 | proof - | |
| 178 | obtain k where k: "\<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m - X n\<bar> < 1" | |
| 179 | using cauchyD [OF assms zero_less_one] .. | |
| 180 | show "\<exists>b>0. \<forall>n. \<bar>X n\<bar> < b" | |
| 181 | proof (intro exI conjI allI) | |
| 182 | have "0 \<le> \<bar>X 0\<bar>" by simp | |
| 183 |     also have "\<bar>X 0\<bar> \<le> Max (abs ` X ` {..k})" by simp
 | |
| 184 |     finally have "0 \<le> Max (abs ` X ` {..k})" .
 | |
| 185 |     thus "0 < Max (abs ` X ` {..k}) + 1" by simp
 | |
| 186 | next | |
| 187 | fix n :: nat | |
| 188 |     show "\<bar>X n\<bar> < Max (abs ` X ` {..k}) + 1"
 | |
| 189 | proof (rule linorder_le_cases) | |
| 190 | assume "n \<le> k" | |
| 191 |       hence "\<bar>X n\<bar> \<le> Max (abs ` X ` {..k})" by simp
 | |
| 192 |       thus "\<bar>X n\<bar> < Max (abs ` X ` {..k}) + 1" by simp
 | |
| 193 | next | |
| 194 | assume "k \<le> n" | |
| 195 | have "\<bar>X n\<bar> = \<bar>X k + (X n - X k)\<bar>" by simp | |
| 196 | also have "\<bar>X k + (X n - X k)\<bar> \<le> \<bar>X k\<bar> + \<bar>X n - X k\<bar>" | |
| 197 | by (rule abs_triangle_ineq) | |
| 198 |       also have "\<dots> < Max (abs ` X ` {..k}) + 1"
 | |
| 199 | by (rule add_le_less_mono, simp, simp add: k `k \<le> n`) | |
| 200 |       finally show "\<bar>X n\<bar> < Max (abs ` X ` {..k}) + 1" .
 | |
| 201 | qed | |
| 202 | qed | |
| 203 | qed | |
| 204 | ||
| 205 | lemma cauchy_mult [simp]: | |
| 206 | assumes X: "cauchy X" and Y: "cauchy Y" | |
| 207 | shows "cauchy (\<lambda>n. X n * Y n)" | |
| 208 | proof (rule cauchyI) | |
| 209 | fix r :: rat assume "0 < r" | |
| 210 | then obtain u v where u: "0 < u" and v: "0 < v" and "r = u + v" | |
| 211 | by (rule obtain_pos_sum) | |
| 212 | obtain a where a: "0 < a" "\<forall>n. \<bar>X n\<bar> < a" | |
| 213 | using cauchy_imp_bounded [OF X] by fast | |
| 214 | obtain b where b: "0 < b" "\<forall>n. \<bar>Y n\<bar> < b" | |
| 215 | using cauchy_imp_bounded [OF Y] by fast | |
| 216 | obtain s t where s: "0 < s" and t: "0 < t" and r: "r = a * t + s * b" | |
| 217 | proof | |
| 56541 | 218 | show "0 < v/b" using v b(1) by simp | 
| 219 | show "0 < u/a" using u a(1) by simp | |
| 51523 | 220 | show "r = a * (u/a) + (v/b) * b" | 
| 221 | using a(1) b(1) `r = u + v` by simp | |
| 222 | qed | |
| 223 | obtain i where i: "\<forall>m\<ge>i. \<forall>n\<ge>i. \<bar>X m - X n\<bar> < s" | |
| 224 | using cauchyD [OF X s] .. | |
| 225 | obtain j where j: "\<forall>m\<ge>j. \<forall>n\<ge>j. \<bar>Y m - Y n\<bar> < t" | |
| 226 | using cauchyD [OF Y t] .. | |
| 227 | have "\<forall>m\<ge>max i j. \<forall>n\<ge>max i j. \<bar>X m * Y m - X n * Y n\<bar> < r" | |
| 228 | proof (clarsimp) | |
| 229 | fix m n assume *: "i \<le> m" "j \<le> m" "i \<le> n" "j \<le> n" | |
| 230 | have "\<bar>X m * Y m - X n * Y n\<bar> = \<bar>X m * (Y m - Y n) + (X m - X n) * Y n\<bar>" | |
| 231 | unfolding mult_diff_mult .. | |
| 232 | also have "\<dots> \<le> \<bar>X m * (Y m - Y n)\<bar> + \<bar>(X m - X n) * Y n\<bar>" | |
| 233 | by (rule abs_triangle_ineq) | |
| 234 | also have "\<dots> = \<bar>X m\<bar> * \<bar>Y m - Y n\<bar> + \<bar>X m - X n\<bar> * \<bar>Y n\<bar>" | |
| 235 | unfolding abs_mult .. | |
| 236 | also have "\<dots> < a * t + s * b" | |
| 237 | by (simp_all add: add_strict_mono mult_strict_mono' a b i j *) | |
| 238 | finally show "\<bar>X m * Y m - X n * Y n\<bar> < r" unfolding r . | |
| 239 | qed | |
| 240 | thus "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>X m * Y m - X n * Y n\<bar> < r" .. | |
| 241 | qed | |
| 242 | ||
| 243 | lemma cauchy_not_vanishes_cases: | |
| 244 | assumes X: "cauchy X" | |
| 245 | assumes nz: "\<not> vanishes X" | |
| 246 | shows "\<exists>b>0. \<exists>k. (\<forall>n\<ge>k. b < - X n) \<or> (\<forall>n\<ge>k. b < X n)" | |
| 247 | proof - | |
| 248 | obtain r where "0 < r" and r: "\<forall>k. \<exists>n\<ge>k. r \<le> \<bar>X n\<bar>" | |
| 249 | using nz unfolding vanishes_def by (auto simp add: not_less) | |
| 250 | obtain s t where s: "0 < s" and t: "0 < t" and "r = s + t" | |
| 251 | using `0 < r` by (rule obtain_pos_sum) | |
| 252 | obtain i where i: "\<forall>m\<ge>i. \<forall>n\<ge>i. \<bar>X m - X n\<bar> < s" | |
| 253 | using cauchyD [OF X s] .. | |
| 254 | obtain k where "i \<le> k" and "r \<le> \<bar>X k\<bar>" | |
| 255 | using r by fast | |
| 256 | have k: "\<forall>n\<ge>k. \<bar>X n - X k\<bar> < s" | |
| 257 | using i `i \<le> k` by auto | |
| 258 | have "X k \<le> - r \<or> r \<le> X k" | |
| 259 | using `r \<le> \<bar>X k\<bar>` by auto | |
| 260 | hence "(\<forall>n\<ge>k. t < - X n) \<or> (\<forall>n\<ge>k. t < X n)" | |
| 261 | unfolding `r = s + t` using k by auto | |
| 262 | hence "\<exists>k. (\<forall>n\<ge>k. t < - X n) \<or> (\<forall>n\<ge>k. t < X n)" .. | |
| 263 | thus "\<exists>t>0. \<exists>k. (\<forall>n\<ge>k. t < - X n) \<or> (\<forall>n\<ge>k. t < X n)" | |
| 264 | using t by auto | |
| 265 | qed | |
| 266 | ||
| 267 | lemma cauchy_not_vanishes: | |
| 268 | assumes X: "cauchy X" | |
| 269 | assumes nz: "\<not> vanishes X" | |
| 270 | shows "\<exists>b>0. \<exists>k. \<forall>n\<ge>k. b < \<bar>X n\<bar>" | |
| 271 | using cauchy_not_vanishes_cases [OF assms] | |
| 272 | by clarify (rule exI, erule conjI, rule_tac x=k in exI, auto) | |
| 273 | ||
| 274 | lemma cauchy_inverse [simp]: | |
| 275 | assumes X: "cauchy X" | |
| 276 | assumes nz: "\<not> vanishes X" | |
| 277 | shows "cauchy (\<lambda>n. inverse (X n))" | |
| 278 | proof (rule cauchyI) | |
| 279 | fix r :: rat assume "0 < r" | |
| 280 | obtain b i where b: "0 < b" and i: "\<forall>n\<ge>i. b < \<bar>X n\<bar>" | |
| 281 | using cauchy_not_vanishes [OF X nz] by fast | |
| 282 | from b i have nz: "\<forall>n\<ge>i. X n \<noteq> 0" by auto | |
| 283 | obtain s where s: "0 < s" and r: "r = inverse b * s * inverse b" | |
| 284 | proof | |
| 56544 | 285 | show "0 < b * r * b" by (simp add: `0 < r` b) | 
| 51523 | 286 | show "r = inverse b * (b * r * b) * inverse b" | 
| 287 | using b by simp | |
| 288 | qed | |
| 289 | obtain j where j: "\<forall>m\<ge>j. \<forall>n\<ge>j. \<bar>X m - X n\<bar> < s" | |
| 290 | using cauchyD [OF X s] .. | |
| 291 | have "\<forall>m\<ge>max i j. \<forall>n\<ge>max i j. \<bar>inverse (X m) - inverse (X n)\<bar> < r" | |
| 292 | proof (clarsimp) | |
| 293 | fix m n assume *: "i \<le> m" "j \<le> m" "i \<le> n" "j \<le> n" | |
| 294 | have "\<bar>inverse (X m) - inverse (X n)\<bar> = | |
| 295 | inverse \<bar>X m\<bar> * \<bar>X m - X n\<bar> * inverse \<bar>X n\<bar>" | |
| 296 | by (simp add: inverse_diff_inverse nz * abs_mult) | |
| 297 | also have "\<dots> < inverse b * s * inverse b" | |
| 298 | by (simp add: mult_strict_mono less_imp_inverse_less | |
| 56544 | 299 | i j b * s) | 
| 51523 | 300 | finally show "\<bar>inverse (X m) - inverse (X n)\<bar> < r" unfolding r . | 
| 301 | qed | |
| 302 | thus "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. \<bar>inverse (X m) - inverse (X n)\<bar> < r" .. | |
| 303 | qed | |
| 304 | ||
| 305 | lemma vanishes_diff_inverse: | |
| 306 | assumes X: "cauchy X" "\<not> vanishes X" | |
| 307 | assumes Y: "cauchy Y" "\<not> vanishes Y" | |
| 308 | assumes XY: "vanishes (\<lambda>n. X n - Y n)" | |
| 309 | shows "vanishes (\<lambda>n. inverse (X n) - inverse (Y n))" | |
| 310 | proof (rule vanishesI) | |
| 311 | fix r :: rat assume r: "0 < r" | |
| 312 | obtain a i where a: "0 < a" and i: "\<forall>n\<ge>i. a < \<bar>X n\<bar>" | |
| 313 | using cauchy_not_vanishes [OF X] by fast | |
| 314 | obtain b j where b: "0 < b" and j: "\<forall>n\<ge>j. b < \<bar>Y n\<bar>" | |
| 315 | using cauchy_not_vanishes [OF Y] by fast | |
| 316 | obtain s where s: "0 < s" and "inverse a * s * inverse b = r" | |
| 317 | proof | |
| 318 | show "0 < a * r * b" | |
| 56544 | 319 | using a r b by simp | 
| 51523 | 320 | show "inverse a * (a * r * b) * inverse b = r" | 
| 321 | using a r b by simp | |
| 322 | qed | |
| 323 | obtain k where k: "\<forall>n\<ge>k. \<bar>X n - Y n\<bar> < s" | |
| 324 | using vanishesD [OF XY s] .. | |
| 325 | have "\<forall>n\<ge>max (max i j) k. \<bar>inverse (X n) - inverse (Y n)\<bar> < r" | |
| 326 | proof (clarsimp) | |
| 327 | fix n assume n: "i \<le> n" "j \<le> n" "k \<le> n" | |
| 328 | have "X n \<noteq> 0" and "Y n \<noteq> 0" | |
| 329 | using i j a b n by auto | |
| 330 | hence "\<bar>inverse (X n) - inverse (Y n)\<bar> = | |
| 331 | inverse \<bar>X n\<bar> * \<bar>X n - Y n\<bar> * inverse \<bar>Y n\<bar>" | |
| 332 | by (simp add: inverse_diff_inverse abs_mult) | |
| 333 | also have "\<dots> < inverse a * s * inverse b" | |
| 334 | apply (intro mult_strict_mono' less_imp_inverse_less) | |
| 56536 | 335 | apply (simp_all add: a b i j k n) | 
| 51523 | 336 | done | 
| 337 | also note `inverse a * s * inverse b = r` | |
| 338 | finally show "\<bar>inverse (X n) - inverse (Y n)\<bar> < r" . | |
| 339 | qed | |
| 340 | thus "\<exists>k. \<forall>n\<ge>k. \<bar>inverse (X n) - inverse (Y n)\<bar> < r" .. | |
| 341 | qed | |
| 342 | ||
| 343 | subsection {* Equivalence relation on Cauchy sequences *}
 | |
| 344 | ||
| 345 | definition realrel :: "(nat \<Rightarrow> rat) \<Rightarrow> (nat \<Rightarrow> rat) \<Rightarrow> bool" | |
| 346 | where "realrel = (\<lambda>X Y. cauchy X \<and> cauchy Y \<and> vanishes (\<lambda>n. X n - Y n))" | |
| 347 | ||
| 348 | lemma realrelI [intro?]: | |
| 349 | assumes "cauchy X" and "cauchy Y" and "vanishes (\<lambda>n. X n - Y n)" | |
| 350 | shows "realrel X Y" | |
| 351 | using assms unfolding realrel_def by simp | |
| 352 | ||
| 353 | lemma realrel_refl: "cauchy X \<Longrightarrow> realrel X X" | |
| 354 | unfolding realrel_def by simp | |
| 355 | ||
| 356 | lemma symp_realrel: "symp realrel" | |
| 357 | unfolding realrel_def | |
| 358 | by (rule sympI, clarify, drule vanishes_minus, simp) | |
| 359 | ||
| 360 | lemma transp_realrel: "transp realrel" | |
| 361 | unfolding realrel_def | |
| 362 | apply (rule transpI, clarify) | |
| 363 | apply (drule (1) vanishes_add) | |
| 364 | apply (simp add: algebra_simps) | |
| 365 | done | |
| 366 | ||
| 367 | lemma part_equivp_realrel: "part_equivp realrel" | |
| 368 | by (fast intro: part_equivpI symp_realrel transp_realrel | |
| 369 | realrel_refl cauchy_const) | |
| 370 | ||
| 371 | subsection {* The field of real numbers *}
 | |
| 372 | ||
| 373 | quotient_type real = "nat \<Rightarrow> rat" / partial: realrel | |
| 374 | morphisms rep_real Real | |
| 375 | by (rule part_equivp_realrel) | |
| 376 | ||
| 377 | lemma cr_real_eq: "pcr_real = (\<lambda>x y. cauchy x \<and> Real x = y)" | |
| 378 | unfolding real.pcr_cr_eq cr_real_def realrel_def by auto | |
| 379 | ||
| 380 | lemma Real_induct [induct type: real]: (* TODO: generate automatically *) | |
| 381 | assumes "\<And>X. cauchy X \<Longrightarrow> P (Real X)" shows "P x" | |
| 382 | proof (induct x) | |
| 383 | case (1 X) | |
| 384 | hence "cauchy X" by (simp add: realrel_def) | |
| 385 | thus "P (Real X)" by (rule assms) | |
| 386 | qed | |
| 387 | ||
| 388 | lemma eq_Real: | |
| 389 | "cauchy X \<Longrightarrow> cauchy Y \<Longrightarrow> Real X = Real Y \<longleftrightarrow> vanishes (\<lambda>n. X n - Y n)" | |
| 390 | using real.rel_eq_transfer | |
| 55945 | 391 | unfolding real.pcr_cr_eq cr_real_def rel_fun_def realrel_def by simp | 
| 51523 | 392 | |
| 51956 
a4d81cdebf8b
better support for domains in Lifting/Transfer = replace Domainp T by the actual invariant in a transferred goal
 kuncar parents: 
51775diff
changeset | 393 | lemma Domainp_pcr_real [transfer_domain_rule]: "Domainp pcr_real = cauchy" | 
| 
a4d81cdebf8b
better support for domains in Lifting/Transfer = replace Domainp T by the actual invariant in a transferred goal
 kuncar parents: 
51775diff
changeset | 394 | by (simp add: real.domain_eq realrel_def) | 
| 51523 | 395 | |
| 396 | instantiation real :: field_inverse_zero | |
| 397 | begin | |
| 398 | ||
| 399 | lift_definition zero_real :: "real" is "\<lambda>n. 0" | |
| 400 | by (simp add: realrel_refl) | |
| 401 | ||
| 402 | lift_definition one_real :: "real" is "\<lambda>n. 1" | |
| 403 | by (simp add: realrel_refl) | |
| 404 | ||
| 405 | lift_definition plus_real :: "real \<Rightarrow> real \<Rightarrow> real" is "\<lambda>X Y n. X n + Y n" | |
| 406 | unfolding realrel_def add_diff_add | |
| 407 | by (simp only: cauchy_add vanishes_add simp_thms) | |
| 408 | ||
| 409 | lift_definition uminus_real :: "real \<Rightarrow> real" is "\<lambda>X n. - X n" | |
| 410 | unfolding realrel_def minus_diff_minus | |
| 411 | by (simp only: cauchy_minus vanishes_minus simp_thms) | |
| 412 | ||
| 413 | lift_definition times_real :: "real \<Rightarrow> real \<Rightarrow> real" is "\<lambda>X Y n. X n * Y n" | |
| 414 | unfolding realrel_def mult_diff_mult | |
| 57512 
cc97b347b301
reduced name variants for assoc and commute on plus and mult
 haftmann parents: 
57447diff
changeset | 415 | by (subst (4) mult.commute, simp only: cauchy_mult vanishes_add | 
| 51523 | 416 | vanishes_mult_bounded cauchy_imp_bounded simp_thms) | 
| 417 | ||
| 418 | lift_definition inverse_real :: "real \<Rightarrow> real" | |
| 419 | is "\<lambda>X. if vanishes X then (\<lambda>n. 0) else (\<lambda>n. inverse (X n))" | |
| 420 | proof - | |
| 421 | fix X Y assume "realrel X Y" | |
| 422 | hence X: "cauchy X" and Y: "cauchy Y" and XY: "vanishes (\<lambda>n. X n - Y n)" | |
| 423 | unfolding realrel_def by simp_all | |
| 424 | have "vanishes X \<longleftrightarrow> vanishes Y" | |
| 425 | proof | |
| 426 | assume "vanishes X" | |
| 427 | from vanishes_diff [OF this XY] show "vanishes Y" by simp | |
| 428 | next | |
| 429 | assume "vanishes Y" | |
| 430 | from vanishes_add [OF this XY] show "vanishes X" by simp | |
| 431 | qed | |
| 432 | thus "?thesis X Y" | |
| 433 | unfolding realrel_def | |
| 434 | by (simp add: vanishes_diff_inverse X Y XY) | |
| 435 | qed | |
| 436 | ||
| 437 | definition | |
| 438 | "x - y = (x::real) + - y" | |
| 439 | ||
| 440 | definition | |
| 441 | "x / y = (x::real) * inverse y" | |
| 442 | ||
| 443 | lemma add_Real: | |
| 444 | assumes X: "cauchy X" and Y: "cauchy Y" | |
| 445 | shows "Real X + Real Y = Real (\<lambda>n. X n + Y n)" | |
| 446 | using assms plus_real.transfer | |
| 55945 | 447 | unfolding cr_real_eq rel_fun_def by simp | 
| 51523 | 448 | |
| 449 | lemma minus_Real: | |
| 450 | assumes X: "cauchy X" | |
| 451 | shows "- Real X = Real (\<lambda>n. - X n)" | |
| 452 | using assms uminus_real.transfer | |
| 55945 | 453 | unfolding cr_real_eq rel_fun_def by simp | 
| 51523 | 454 | |
| 455 | lemma diff_Real: | |
| 456 | assumes X: "cauchy X" and Y: "cauchy Y" | |
| 457 | shows "Real X - Real Y = Real (\<lambda>n. X n - Y n)" | |
| 54230 
b1d955791529
more simplification rules on unary and binary minus
 haftmann parents: 
53652diff
changeset | 458 | unfolding minus_real_def | 
| 51523 | 459 | by (simp add: minus_Real add_Real X Y) | 
| 460 | ||
| 461 | lemma mult_Real: | |
| 462 | assumes X: "cauchy X" and Y: "cauchy Y" | |
| 463 | shows "Real X * Real Y = Real (\<lambda>n. X n * Y n)" | |
| 464 | using assms times_real.transfer | |
| 55945 | 465 | unfolding cr_real_eq rel_fun_def by simp | 
| 51523 | 466 | |
| 467 | lemma inverse_Real: | |
| 468 | assumes X: "cauchy X" | |
| 469 | shows "inverse (Real X) = | |
| 470 | (if vanishes X then 0 else Real (\<lambda>n. inverse (X n)))" | |
| 471 | using assms inverse_real.transfer zero_real.transfer | |
| 55945 | 472 | unfolding cr_real_eq rel_fun_def by (simp split: split_if_asm, metis) | 
| 51523 | 473 | |
| 474 | instance proof | |
| 475 | fix a b c :: real | |
| 476 | show "a + b = b + a" | |
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 477 | by transfer (simp add: ac_simps realrel_def) | 
| 51523 | 478 | show "(a + b) + c = a + (b + c)" | 
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 479 | by transfer (simp add: ac_simps realrel_def) | 
| 51523 | 480 | show "0 + a = a" | 
| 481 | by transfer (simp add: realrel_def) | |
| 482 | show "- a + a = 0" | |
| 483 | by transfer (simp add: realrel_def) | |
| 484 | show "a - b = a + - b" | |
| 485 | by (rule minus_real_def) | |
| 486 | show "(a * b) * c = a * (b * c)" | |
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 487 | by transfer (simp add: ac_simps realrel_def) | 
| 51523 | 488 | show "a * b = b * a" | 
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 489 | by transfer (simp add: ac_simps realrel_def) | 
| 51523 | 490 | show "1 * a = a" | 
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 491 | by transfer (simp add: ac_simps realrel_def) | 
| 51523 | 492 | show "(a + b) * c = a * c + b * c" | 
| 493 | by transfer (simp add: distrib_right realrel_def) | |
| 494 | show "(0\<Colon>real) \<noteq> (1\<Colon>real)" | |
| 495 | by transfer (simp add: realrel_def) | |
| 496 | show "a \<noteq> 0 \<Longrightarrow> inverse a * a = 1" | |
| 497 | apply transfer | |
| 498 | apply (simp add: realrel_def) | |
| 499 | apply (rule vanishesI) | |
| 500 | apply (frule (1) cauchy_not_vanishes, clarify) | |
| 501 | apply (rule_tac x=k in exI, clarify) | |
| 502 | apply (drule_tac x=n in spec, simp) | |
| 503 | done | |
| 504 | show "a / b = a * inverse b" | |
| 505 | by (rule divide_real_def) | |
| 506 | show "inverse (0::real) = 0" | |
| 507 | by transfer (simp add: realrel_def) | |
| 508 | qed | |
| 509 | ||
| 510 | end | |
| 511 | ||
| 512 | subsection {* Positive reals *}
 | |
| 513 | ||
| 514 | lift_definition positive :: "real \<Rightarrow> bool" | |
| 515 | is "\<lambda>X. \<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < X n" | |
| 516 | proof - | |
| 517 |   { fix X Y
 | |
| 518 | assume "realrel X Y" | |
| 519 | hence XY: "vanishes (\<lambda>n. X n - Y n)" | |
| 520 | unfolding realrel_def by simp_all | |
| 521 | assume "\<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < X n" | |
| 522 | then obtain r i where "0 < r" and i: "\<forall>n\<ge>i. r < X n" | |
| 523 | by fast | |
| 524 | obtain s t where s: "0 < s" and t: "0 < t" and r: "r = s + t" | |
| 525 | using `0 < r` by (rule obtain_pos_sum) | |
| 526 | obtain j where j: "\<forall>n\<ge>j. \<bar>X n - Y n\<bar> < s" | |
| 527 | using vanishesD [OF XY s] .. | |
| 528 | have "\<forall>n\<ge>max i j. t < Y n" | |
| 529 | proof (clarsimp) | |
| 530 | fix n assume n: "i \<le> n" "j \<le> n" | |
| 531 | have "\<bar>X n - Y n\<bar> < s" and "r < X n" | |
| 532 | using i j n by simp_all | |
| 533 | thus "t < Y n" unfolding r by simp | |
| 534 | qed | |
| 535 | hence "\<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < Y n" using t by fast | |
| 536 | } note 1 = this | |
| 537 | fix X Y assume "realrel X Y" | |
| 538 | hence "realrel X Y" and "realrel Y X" | |
| 539 | using symp_realrel unfolding symp_def by auto | |
| 540 | thus "?thesis X Y" | |
| 541 | by (safe elim!: 1) | |
| 542 | qed | |
| 543 | ||
| 544 | lemma positive_Real: | |
| 545 | assumes X: "cauchy X" | |
| 546 | shows "positive (Real X) \<longleftrightarrow> (\<exists>r>0. \<exists>k. \<forall>n\<ge>k. r < X n)" | |
| 547 | using assms positive.transfer | |
| 55945 | 548 | unfolding cr_real_eq rel_fun_def by simp | 
| 51523 | 549 | |
| 550 | lemma positive_zero: "\<not> positive 0" | |
| 551 | by transfer auto | |
| 552 | ||
| 553 | lemma positive_add: | |
| 554 | "positive x \<Longrightarrow> positive y \<Longrightarrow> positive (x + y)" | |
| 555 | apply transfer | |
| 556 | apply (clarify, rename_tac a b i j) | |
| 557 | apply (rule_tac x="a + b" in exI, simp) | |
| 558 | apply (rule_tac x="max i j" in exI, clarsimp) | |
| 559 | apply (simp add: add_strict_mono) | |
| 560 | done | |
| 561 | ||
| 562 | lemma positive_mult: | |
| 563 | "positive x \<Longrightarrow> positive y \<Longrightarrow> positive (x * y)" | |
| 564 | apply transfer | |
| 565 | apply (clarify, rename_tac a b i j) | |
| 56544 | 566 | apply (rule_tac x="a * b" in exI, simp) | 
| 51523 | 567 | apply (rule_tac x="max i j" in exI, clarsimp) | 
| 568 | apply (rule mult_strict_mono, auto) | |
| 569 | done | |
| 570 | ||
| 571 | lemma positive_minus: | |
| 572 | "\<not> positive x \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> positive (- x)" | |
| 573 | apply transfer | |
| 574 | apply (simp add: realrel_def) | |
| 575 | apply (drule (1) cauchy_not_vanishes_cases, safe, fast, fast) | |
| 576 | done | |
| 577 | ||
| 578 | instantiation real :: linordered_field_inverse_zero | |
| 579 | begin | |
| 580 | ||
| 581 | definition | |
| 582 | "x < y \<longleftrightarrow> positive (y - x)" | |
| 583 | ||
| 584 | definition | |
| 585 | "x \<le> (y::real) \<longleftrightarrow> x < y \<or> x = y" | |
| 586 | ||
| 587 | definition | |
| 588 | "abs (a::real) = (if a < 0 then - a else a)" | |
| 589 | ||
| 590 | definition | |
| 591 | "sgn (a::real) = (if a = 0 then 0 else if 0 < a then 1 else - 1)" | |
| 592 | ||
| 593 | instance proof | |
| 594 | fix a b c :: real | |
| 595 | show "\<bar>a\<bar> = (if a < 0 then - a else a)" | |
| 596 | by (rule abs_real_def) | |
| 597 | show "a < b \<longleftrightarrow> a \<le> b \<and> \<not> b \<le> a" | |
| 598 | unfolding less_eq_real_def less_real_def | |
| 599 | by (auto, drule (1) positive_add, simp_all add: positive_zero) | |
| 600 | show "a \<le> a" | |
| 601 | unfolding less_eq_real_def by simp | |
| 602 | show "a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> a \<le> c" | |
| 603 | unfolding less_eq_real_def less_real_def | |
| 604 | by (auto, drule (1) positive_add, simp add: algebra_simps) | |
| 605 | show "a \<le> b \<Longrightarrow> b \<le> a \<Longrightarrow> a = b" | |
| 606 | unfolding less_eq_real_def less_real_def | |
| 607 | by (auto, drule (1) positive_add, simp add: positive_zero) | |
| 608 | show "a \<le> b \<Longrightarrow> c + a \<le> c + b" | |
| 54230 
b1d955791529
more simplification rules on unary and binary minus
 haftmann parents: 
53652diff
changeset | 609 | unfolding less_eq_real_def less_real_def by auto | 
| 51523 | 610 | (* FIXME: Procedure int_combine_numerals: c + b - (c + a) \<equiv> b + - a *) | 
| 611 | (* Should produce c + b - (c + a) \<equiv> b - a *) | |
| 612 | show "sgn a = (if a = 0 then 0 else if 0 < a then 1 else - 1)" | |
| 613 | by (rule sgn_real_def) | |
| 614 | show "a \<le> b \<or> b \<le> a" | |
| 615 | unfolding less_eq_real_def less_real_def | |
| 616 | by (auto dest!: positive_minus) | |
| 617 | show "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b" | |
| 618 | unfolding less_real_def | |
| 619 | by (drule (1) positive_mult, simp add: algebra_simps) | |
| 620 | qed | |
| 621 | ||
| 622 | end | |
| 623 | ||
| 624 | instantiation real :: distrib_lattice | |
| 625 | begin | |
| 626 | ||
| 627 | definition | |
| 628 | "(inf :: real \<Rightarrow> real \<Rightarrow> real) = min" | |
| 629 | ||
| 630 | definition | |
| 631 | "(sup :: real \<Rightarrow> real \<Rightarrow> real) = max" | |
| 632 | ||
| 633 | instance proof | |
| 54863 
82acc20ded73
prefer more canonical names for lemmas on min/max
 haftmann parents: 
54489diff
changeset | 634 | qed (auto simp add: inf_real_def sup_real_def max_min_distrib2) | 
| 51523 | 635 | |
| 636 | end | |
| 637 | ||
| 638 | lemma of_nat_Real: "of_nat x = Real (\<lambda>n. of_nat x)" | |
| 639 | apply (induct x) | |
| 640 | apply (simp add: zero_real_def) | |
| 641 | apply (simp add: one_real_def add_Real) | |
| 642 | done | |
| 643 | ||
| 644 | lemma of_int_Real: "of_int x = Real (\<lambda>n. of_int x)" | |
| 645 | apply (cases x rule: int_diff_cases) | |
| 646 | apply (simp add: of_nat_Real diff_Real) | |
| 647 | done | |
| 648 | ||
| 649 | lemma of_rat_Real: "of_rat x = Real (\<lambda>n. x)" | |
| 650 | apply (induct x) | |
| 651 | apply (simp add: Fract_of_int_quotient of_rat_divide) | |
| 652 | apply (simp add: of_int_Real divide_inverse) | |
| 653 | apply (simp add: inverse_Real mult_Real) | |
| 654 | done | |
| 655 | ||
| 656 | instance real :: archimedean_field | |
| 657 | proof | |
| 658 | fix x :: real | |
| 659 | show "\<exists>z. x \<le> of_int z" | |
| 660 | apply (induct x) | |
| 661 | apply (frule cauchy_imp_bounded, clarify) | |
| 662 | apply (rule_tac x="ceiling b + 1" in exI) | |
| 663 | apply (rule less_imp_le) | |
| 664 | apply (simp add: of_int_Real less_real_def diff_Real positive_Real) | |
| 665 | apply (rule_tac x=1 in exI, simp add: algebra_simps) | |
| 666 | apply (rule_tac x=0 in exI, clarsimp) | |
| 667 | apply (rule le_less_trans [OF abs_ge_self]) | |
| 668 | apply (rule less_le_trans [OF _ le_of_int_ceiling]) | |
| 669 | apply simp | |
| 670 | done | |
| 671 | qed | |
| 672 | ||
| 673 | instantiation real :: floor_ceiling | |
| 674 | begin | |
| 675 | ||
| 676 | definition [code del]: | |
| 677 | "floor (x::real) = (THE z. of_int z \<le> x \<and> x < of_int (z + 1))" | |
| 678 | ||
| 679 | instance proof | |
| 680 | fix x :: real | |
| 681 | show "of_int (floor x) \<le> x \<and> x < of_int (floor x + 1)" | |
| 682 | unfolding floor_real_def using floor_exists1 by (rule theI') | |
| 683 | qed | |
| 684 | ||
| 685 | end | |
| 686 | ||
| 687 | subsection {* Completeness *}
 | |
| 688 | ||
| 689 | lemma not_positive_Real: | |
| 690 | assumes X: "cauchy X" | |
| 691 | shows "\<not> positive (Real X) \<longleftrightarrow> (\<forall>r>0. \<exists>k. \<forall>n\<ge>k. X n \<le> r)" | |
| 692 | unfolding positive_Real [OF X] | |
| 693 | apply (auto, unfold not_less) | |
| 694 | apply (erule obtain_pos_sum) | |
| 695 | apply (drule_tac x=s in spec, simp) | |
| 696 | apply (drule_tac r=t in cauchyD [OF X], clarify) | |
| 697 | apply (drule_tac x=k in spec, clarsimp) | |
| 698 | apply (rule_tac x=n in exI, clarify, rename_tac m) | |
| 699 | apply (drule_tac x=m in spec, simp) | |
| 700 | apply (drule_tac x=n in spec, simp) | |
| 701 | apply (drule spec, drule (1) mp, clarify, rename_tac i) | |
| 702 | apply (rule_tac x="max i k" in exI, simp) | |
| 703 | done | |
| 704 | ||
| 705 | lemma le_Real: | |
| 706 | assumes X: "cauchy X" and Y: "cauchy Y" | |
| 707 | shows "Real X \<le> Real Y = (\<forall>r>0. \<exists>k. \<forall>n\<ge>k. X n \<le> Y n + r)" | |
| 708 | unfolding not_less [symmetric, where 'a=real] less_real_def | |
| 709 | apply (simp add: diff_Real not_positive_Real X Y) | |
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 710 | apply (simp add: diff_le_eq ac_simps) | 
| 51523 | 711 | done | 
| 712 | ||
| 713 | lemma le_RealI: | |
| 714 | assumes Y: "cauchy Y" | |
| 715 | shows "\<forall>n. x \<le> of_rat (Y n) \<Longrightarrow> x \<le> Real Y" | |
| 716 | proof (induct x) | |
| 717 | fix X assume X: "cauchy X" and "\<forall>n. Real X \<le> of_rat (Y n)" | |
| 718 | hence le: "\<And>m r. 0 < r \<Longrightarrow> \<exists>k. \<forall>n\<ge>k. X n \<le> Y m + r" | |
| 719 | by (simp add: of_rat_Real le_Real) | |
| 720 |   {
 | |
| 721 | fix r :: rat assume "0 < r" | |
| 722 | then obtain s t where s: "0 < s" and t: "0 < t" and r: "r = s + t" | |
| 723 | by (rule obtain_pos_sum) | |
| 724 | obtain i where i: "\<forall>m\<ge>i. \<forall>n\<ge>i. \<bar>Y m - Y n\<bar> < s" | |
| 725 | using cauchyD [OF Y s] .. | |
| 726 | obtain j where j: "\<forall>n\<ge>j. X n \<le> Y i + t" | |
| 727 | using le [OF t] .. | |
| 728 | have "\<forall>n\<ge>max i j. X n \<le> Y n + r" | |
| 729 | proof (clarsimp) | |
| 730 | fix n assume n: "i \<le> n" "j \<le> n" | |
| 731 | have "X n \<le> Y i + t" using n j by simp | |
| 732 | moreover have "\<bar>Y i - Y n\<bar> < s" using n i by simp | |
| 733 | ultimately show "X n \<le> Y n + r" unfolding r by simp | |
| 734 | qed | |
| 735 | hence "\<exists>k. \<forall>n\<ge>k. X n \<le> Y n + r" .. | |
| 736 | } | |
| 737 | thus "Real X \<le> Real Y" | |
| 738 | by (simp add: of_rat_Real le_Real X Y) | |
| 739 | qed | |
| 740 | ||
| 741 | lemma Real_leI: | |
| 742 | assumes X: "cauchy X" | |
| 743 | assumes le: "\<forall>n. of_rat (X n) \<le> y" | |
| 744 | shows "Real X \<le> y" | |
| 745 | proof - | |
| 746 | have "- y \<le> - Real X" | |
| 747 | by (simp add: minus_Real X le_RealI of_rat_minus le) | |
| 748 | thus ?thesis by simp | |
| 749 | qed | |
| 750 | ||
| 751 | lemma less_RealD: | |
| 752 | assumes Y: "cauchy Y" | |
| 753 | shows "x < Real Y \<Longrightarrow> \<exists>n. x < of_rat (Y n)" | |
| 754 | by (erule contrapos_pp, simp add: not_less, erule Real_leI [OF Y]) | |
| 755 | ||
| 756 | lemma of_nat_less_two_power: | |
| 757 | "of_nat n < (2::'a::linordered_idom) ^ n" | |
| 758 | apply (induct n) | |
| 759 | apply simp | |
| 760 | apply (subgoal_tac "(1::'a) \<le> 2 ^ n") | |
| 761 | apply (drule (1) add_le_less_mono, simp) | |
| 762 | apply simp | |
| 763 | done | |
| 764 | ||
| 765 | lemma complete_real: | |
| 766 | fixes S :: "real set" | |
| 767 | assumes "\<exists>x. x \<in> S" and "\<exists>z. \<forall>x\<in>S. x \<le> z" | |
| 768 | shows "\<exists>y. (\<forall>x\<in>S. x \<le> y) \<and> (\<forall>z. (\<forall>x\<in>S. x \<le> z) \<longrightarrow> y \<le> z)" | |
| 769 | proof - | |
| 770 | obtain x where x: "x \<in> S" using assms(1) .. | |
| 771 | obtain z where z: "\<forall>x\<in>S. x \<le> z" using assms(2) .. | |
| 772 | ||
| 773 | def P \<equiv> "\<lambda>x. \<forall>y\<in>S. y \<le> of_rat x" | |
| 774 | obtain a where a: "\<not> P a" | |
| 775 | proof | |
| 776 | have "of_int (floor (x - 1)) \<le> x - 1" by (rule of_int_floor_le) | |
| 777 | also have "x - 1 < x" by simp | |
| 778 | finally have "of_int (floor (x - 1)) < x" . | |
| 779 | hence "\<not> x \<le> of_int (floor (x - 1))" by (simp only: not_le) | |
| 780 | then show "\<not> P (of_int (floor (x - 1)))" | |
| 781 | unfolding P_def of_rat_of_int_eq using x by fast | |
| 782 | qed | |
| 783 | obtain b where b: "P b" | |
| 784 | proof | |
| 785 | show "P (of_int (ceiling z))" | |
| 786 | unfolding P_def of_rat_of_int_eq | |
| 787 | proof | |
| 788 | fix y assume "y \<in> S" | |
| 789 | hence "y \<le> z" using z by simp | |
| 790 | also have "z \<le> of_int (ceiling z)" by (rule le_of_int_ceiling) | |
| 791 | finally show "y \<le> of_int (ceiling z)" . | |
| 792 | qed | |
| 793 | qed | |
| 794 | ||
| 795 | def avg \<equiv> "\<lambda>x y :: rat. x/2 + y/2" | |
| 796 | def bisect \<equiv> "\<lambda>(x, y). if P (avg x y) then (x, avg x y) else (avg x y, y)" | |
| 797 | def A \<equiv> "\<lambda>n. fst ((bisect ^^ n) (a, b))" | |
| 798 | def B \<equiv> "\<lambda>n. snd ((bisect ^^ n) (a, b))" | |
| 799 | def C \<equiv> "\<lambda>n. avg (A n) (B n)" | |
| 800 | have A_0 [simp]: "A 0 = a" unfolding A_def by simp | |
| 801 | have B_0 [simp]: "B 0 = b" unfolding B_def by simp | |
| 802 | have A_Suc [simp]: "\<And>n. A (Suc n) = (if P (C n) then A n else C n)" | |
| 803 | unfolding A_def B_def C_def bisect_def split_def by simp | |
| 804 | have B_Suc [simp]: "\<And>n. B (Suc n) = (if P (C n) then C n else B n)" | |
| 805 | unfolding A_def B_def C_def bisect_def split_def by simp | |
| 806 | ||
| 807 | have width: "\<And>n. B n - A n = (b - a) / 2^n" | |
| 808 | apply (simp add: eq_divide_eq) | |
| 809 | apply (induct_tac n, simp) | |
| 810 | apply (simp add: C_def avg_def algebra_simps) | |
| 811 | done | |
| 812 | ||
| 813 | have twos: "\<And>y r :: rat. 0 < r \<Longrightarrow> \<exists>n. y / 2 ^ n < r" | |
| 814 | apply (simp add: divide_less_eq) | |
| 57512 
cc97b347b301
reduced name variants for assoc and commute on plus and mult
 haftmann parents: 
57447diff
changeset | 815 | apply (subst mult.commute) | 
| 51523 | 816 | apply (frule_tac y=y in ex_less_of_nat_mult) | 
| 817 | apply clarify | |
| 818 | apply (rule_tac x=n in exI) | |
| 819 | apply (erule less_trans) | |
| 820 | apply (rule mult_strict_right_mono) | |
| 821 | apply (rule le_less_trans [OF _ of_nat_less_two_power]) | |
| 822 | apply simp | |
| 823 | apply assumption | |
| 824 | done | |
| 825 | ||
| 826 | have PA: "\<And>n. \<not> P (A n)" | |
| 827 | by (induct_tac n, simp_all add: a) | |
| 828 | have PB: "\<And>n. P (B n)" | |
| 829 | by (induct_tac n, simp_all add: b) | |
| 830 | have ab: "a < b" | |
| 831 | using a b unfolding P_def | |
| 832 | apply (clarsimp simp add: not_le) | |
| 833 | apply (drule (1) bspec) | |
| 834 | apply (drule (1) less_le_trans) | |
| 835 | apply (simp add: of_rat_less) | |
| 836 | done | |
| 837 | have AB: "\<And>n. A n < B n" | |
| 838 | by (induct_tac n, simp add: ab, simp add: C_def avg_def) | |
| 839 | have A_mono: "\<And>i j. i \<le> j \<Longrightarrow> A i \<le> A j" | |
| 840 | apply (auto simp add: le_less [where 'a=nat]) | |
| 841 | apply (erule less_Suc_induct) | |
| 842 | apply (clarsimp simp add: C_def avg_def) | |
| 843 | apply (simp add: add_divide_distrib [symmetric]) | |
| 844 | apply (rule AB [THEN less_imp_le]) | |
| 845 | apply simp | |
| 846 | done | |
| 847 | have B_mono: "\<And>i j. i \<le> j \<Longrightarrow> B j \<le> B i" | |
| 848 | apply (auto simp add: le_less [where 'a=nat]) | |
| 849 | apply (erule less_Suc_induct) | |
| 850 | apply (clarsimp simp add: C_def avg_def) | |
| 851 | apply (simp add: add_divide_distrib [symmetric]) | |
| 852 | apply (rule AB [THEN less_imp_le]) | |
| 853 | apply simp | |
| 854 | done | |
| 855 | have cauchy_lemma: | |
| 856 | "\<And>X. \<forall>n. \<forall>i\<ge>n. A n \<le> X i \<and> X i \<le> B n \<Longrightarrow> cauchy X" | |
| 857 | apply (rule cauchyI) | |
| 858 | apply (drule twos [where y="b - a"]) | |
| 859 | apply (erule exE) | |
| 860 | apply (rule_tac x=n in exI, clarify, rename_tac i j) | |
| 861 | apply (rule_tac y="B n - A n" in le_less_trans) defer | |
| 862 | apply (simp add: width) | |
| 863 | apply (drule_tac x=n in spec) | |
| 864 | apply (frule_tac x=i in spec, drule (1) mp) | |
| 865 | apply (frule_tac x=j in spec, drule (1) mp) | |
| 866 | apply (frule A_mono, drule B_mono) | |
| 867 | apply (frule A_mono, drule B_mono) | |
| 868 | apply arith | |
| 869 | done | |
| 870 | have "cauchy A" | |
| 871 | apply (rule cauchy_lemma [rule_format]) | |
| 872 | apply (simp add: A_mono) | |
| 873 | apply (erule order_trans [OF less_imp_le [OF AB] B_mono]) | |
| 874 | done | |
| 875 | have "cauchy B" | |
| 876 | apply (rule cauchy_lemma [rule_format]) | |
| 877 | apply (simp add: B_mono) | |
| 878 | apply (erule order_trans [OF A_mono less_imp_le [OF AB]]) | |
| 879 | done | |
| 880 | have 1: "\<forall>x\<in>S. x \<le> Real B" | |
| 881 | proof | |
| 882 | fix x assume "x \<in> S" | |
| 883 | then show "x \<le> Real B" | |
| 884 | using PB [unfolded P_def] `cauchy B` | |
| 885 | by (simp add: le_RealI) | |
| 886 | qed | |
| 887 | have 2: "\<forall>z. (\<forall>x\<in>S. x \<le> z) \<longrightarrow> Real A \<le> z" | |
| 888 | apply clarify | |
| 889 | apply (erule contrapos_pp) | |
| 890 | apply (simp add: not_le) | |
| 891 | apply (drule less_RealD [OF `cauchy A`], clarify) | |
| 892 | apply (subgoal_tac "\<not> P (A n)") | |
| 893 | apply (simp add: P_def not_le, clarify) | |
| 894 | apply (erule rev_bexI) | |
| 895 | apply (erule (1) less_trans) | |
| 896 | apply (simp add: PA) | |
| 897 | done | |
| 898 | have "vanishes (\<lambda>n. (b - a) / 2 ^ n)" | |
| 899 | proof (rule vanishesI) | |
| 900 | fix r :: rat assume "0 < r" | |
| 901 | then obtain k where k: "\<bar>b - a\<bar> / 2 ^ k < r" | |
| 902 | using twos by fast | |
| 903 | have "\<forall>n\<ge>k. \<bar>(b - a) / 2 ^ n\<bar> < r" | |
| 904 | proof (clarify) | |
| 905 | fix n assume n: "k \<le> n" | |
| 906 | have "\<bar>(b - a) / 2 ^ n\<bar> = \<bar>b - a\<bar> / 2 ^ n" | |
| 907 | by simp | |
| 908 | also have "\<dots> \<le> \<bar>b - a\<bar> / 2 ^ k" | |
| 56544 | 909 | using n by (simp add: divide_left_mono) | 
| 51523 | 910 | also note k | 
| 911 | finally show "\<bar>(b - a) / 2 ^ n\<bar> < r" . | |
| 912 | qed | |
| 913 | thus "\<exists>k. \<forall>n\<ge>k. \<bar>(b - a) / 2 ^ n\<bar> < r" .. | |
| 914 | qed | |
| 915 | hence 3: "Real B = Real A" | |
| 916 | by (simp add: eq_Real `cauchy A` `cauchy B` width) | |
| 917 | show "\<exists>y. (\<forall>x\<in>S. x \<le> y) \<and> (\<forall>z. (\<forall>x\<in>S. x \<le> z) \<longrightarrow> y \<le> z)" | |
| 918 | using 1 2 3 by (rule_tac x="Real B" in exI, simp) | |
| 919 | qed | |
| 920 | ||
| 51775 
408d937c9486
revert #916271d52466; add non-topological linear_continuum type class; show linear_continuum_topology is a perfect_space
 hoelzl parents: 
51773diff
changeset | 921 | instantiation real :: linear_continuum | 
| 51523 | 922 | begin | 
| 923 | ||
| 924 | subsection{*Supremum of a set of reals*}
 | |
| 925 | ||
| 54281 | 926 | definition "Sup X = (LEAST z::real. \<forall>x\<in>X. x \<le> z)" | 
| 927 | definition "Inf (X::real set) = - Sup (uminus ` X)" | |
| 51523 | 928 | |
| 929 | instance | |
| 930 | proof | |
| 54258 
adfc759263ab
use bdd_above and bdd_below for conditionally complete lattices
 hoelzl parents: 
54230diff
changeset | 931 |   { fix x :: real and X :: "real set"
 | 
| 
adfc759263ab
use bdd_above and bdd_below for conditionally complete lattices
 hoelzl parents: 
54230diff
changeset | 932 | assume x: "x \<in> X" "bdd_above X" | 
| 51523 | 933 | then obtain s where s: "\<forall>y\<in>X. y \<le> s" "\<And>z. \<forall>y\<in>X. y \<le> z \<Longrightarrow> s \<le> z" | 
| 54258 
adfc759263ab
use bdd_above and bdd_below for conditionally complete lattices
 hoelzl parents: 
54230diff
changeset | 934 | using complete_real[of X] unfolding bdd_above_def by blast | 
| 51523 | 935 | then show "x \<le> Sup X" | 
| 936 | unfolding Sup_real_def by (rule LeastI2_order) (auto simp: x) } | |
| 937 | note Sup_upper = this | |
| 938 | ||
| 939 |   { fix z :: real and X :: "real set"
 | |
| 940 |     assume x: "X \<noteq> {}" and z: "\<And>x. x \<in> X \<Longrightarrow> x \<le> z"
 | |
| 941 | then obtain s where s: "\<forall>y\<in>X. y \<le> s" "\<And>z. \<forall>y\<in>X. y \<le> z \<Longrightarrow> s \<le> z" | |
| 942 | using complete_real[of X] by blast | |
| 943 | then have "Sup X = s" | |
| 944 | unfolding Sup_real_def by (best intro: Least_equality) | |
| 53374 
a14d2a854c02
tuned proofs -- clarified flow of facts wrt. calculation;
 wenzelm parents: 
53076diff
changeset | 945 | also from s z have "... \<le> z" | 
| 51523 | 946 | by blast | 
| 947 | finally show "Sup X \<le> z" . } | |
| 948 | note Sup_least = this | |
| 949 | ||
| 54281 | 950 |   { fix x :: real and X :: "real set" assume x: "x \<in> X" "bdd_below X" then show "Inf X \<le> x"
 | 
| 951 | using Sup_upper[of "-x" "uminus ` X"] by (auto simp: Inf_real_def) } | |
| 952 |   { fix z :: real and X :: "real set" assume "X \<noteq> {}" "\<And>x. x \<in> X \<Longrightarrow> z \<le> x" then show "z \<le> Inf X"
 | |
| 953 | using Sup_least[of "uminus ` X" "- z"] by (force simp: Inf_real_def) } | |
| 51775 
408d937c9486
revert #916271d52466; add non-topological linear_continuum type class; show linear_continuum_topology is a perfect_space
 hoelzl parents: 
51773diff
changeset | 954 | show "\<exists>a b::real. a \<noteq> b" | 
| 
408d937c9486
revert #916271d52466; add non-topological linear_continuum type class; show linear_continuum_topology is a perfect_space
 hoelzl parents: 
51773diff
changeset | 955 | using zero_neq_one by blast | 
| 51523 | 956 | qed | 
| 957 | end | |
| 958 | ||
| 959 | ||
| 960 | subsection {* Hiding implementation details *}
 | |
| 961 | ||
| 962 | hide_const (open) vanishes cauchy positive Real | |
| 963 | ||
| 964 | declare Real_induct [induct del] | |
| 965 | declare Abs_real_induct [induct del] | |
| 966 | declare Abs_real_cases [cases del] | |
| 967 | ||
| 53652 
18fbca265e2e
use lifting_forget for deregistering numeric types as a quotient type
 kuncar parents: 
53374diff
changeset | 968 | lifting_update real.lifting | 
| 
18fbca265e2e
use lifting_forget for deregistering numeric types as a quotient type
 kuncar parents: 
53374diff
changeset | 969 | lifting_forget real.lifting | 
| 51956 
a4d81cdebf8b
better support for domains in Lifting/Transfer = replace Domainp T by the actual invariant in a transferred goal
 kuncar parents: 
51775diff
changeset | 970 | |
| 51523 | 971 | subsection{*More Lemmas*}
 | 
| 972 | ||
| 973 | text {* BH: These lemmas should not be necessary; they should be
 | |
| 974 | covered by existing simp rules and simplification procedures. *} | |
| 975 | ||
| 976 | lemma real_mult_less_iff1 [simp]: "(0::real) < z ==> (x*z < y*z) = (x < y)" | |
| 977 | by simp (* solved by linordered_ring_less_cancel_factor simproc *) | |
| 978 | ||
| 979 | lemma real_mult_le_cancel_iff1 [simp]: "(0::real) < z ==> (x*z \<le> y*z) = (x\<le>y)" | |
| 980 | by simp (* solved by linordered_ring_le_cancel_factor simproc *) | |
| 981 | ||
| 982 | lemma real_mult_le_cancel_iff2 [simp]: "(0::real) < z ==> (z*x \<le> z*y) = (x\<le>y)" | |
| 983 | by simp (* solved by linordered_ring_le_cancel_factor simproc *) | |
| 984 | ||
| 985 | ||
| 986 | subsection {* Embedding numbers into the Reals *}
 | |
| 987 | ||
| 988 | abbreviation | |
| 989 | real_of_nat :: "nat \<Rightarrow> real" | |
| 990 | where | |
| 991 | "real_of_nat \<equiv> of_nat" | |
| 992 | ||
| 993 | abbreviation | |
| 994 | real_of_int :: "int \<Rightarrow> real" | |
| 995 | where | |
| 996 | "real_of_int \<equiv> of_int" | |
| 997 | ||
| 998 | abbreviation | |
| 999 | real_of_rat :: "rat \<Rightarrow> real" | |
| 1000 | where | |
| 1001 | "real_of_rat \<equiv> of_rat" | |
| 1002 | ||
| 58042 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1003 | class real_of = | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1004 | fixes real :: "'a \<Rightarrow> real" | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1005 | |
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1006 | instantiation nat :: real_of | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1007 | begin | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1008 | |
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1009 | definition real_nat :: "nat \<Rightarrow> real" where real_of_nat_def [code_unfold]: "real \<equiv> of_nat" | 
| 51523 | 1010 | |
| 58042 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1011 | instance .. | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1012 | end | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1013 | |
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1014 | instantiation int :: real_of | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1015 | begin | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1016 | |
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1017 | definition real_int :: "int \<Rightarrow> real" where real_of_int_def [code_unfold]: "real \<equiv> of_int" | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1018 | |
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1019 | instance .. | 
| 
ffa9e39763e3
introduce real_of typeclass for real :: 'a => real
 hoelzl parents: 
58040diff
changeset | 1020 | end | 
| 51523 | 1021 | |
| 1022 | declare [[coercion_enabled]] | |
| 59000 | 1023 | |
| 1024 | declare [[coercion "of_nat :: nat \<Rightarrow> int"]] | |
| 1025 | declare [[coercion "real :: nat \<Rightarrow> real"]] | |
| 1026 | declare [[coercion "real :: int \<Rightarrow> real"]] | |
| 1027 | ||
| 1028 | (* We do not add rat to the coerced types, this has often unpleasant side effects when writing | |
| 1029 | inverse (Suc n) which sometimes gets two coercions: of_rat (inverse (of_nat (Suc n))) *) | |
| 51523 | 1030 | |
| 1031 | declare [[coercion_map map]] | |
| 59000 | 1032 | declare [[coercion_map "\<lambda>f g h x. g (h (f x))"]] | 
| 1033 | declare [[coercion_map "\<lambda>f g (x,y). (f x, g y)"]] | |
| 51523 | 1034 | |
| 1035 | lemma real_eq_of_nat: "real = of_nat" | |
| 1036 | unfolding real_of_nat_def .. | |
| 1037 | ||
| 1038 | lemma real_eq_of_int: "real = of_int" | |
| 1039 | unfolding real_of_int_def .. | |
| 1040 | ||
| 1041 | lemma real_of_int_zero [simp]: "real (0::int) = 0" | |
| 1042 | by (simp add: real_of_int_def) | |
| 1043 | ||
| 1044 | lemma real_of_one [simp]: "real (1::int) = (1::real)" | |
| 1045 | by (simp add: real_of_int_def) | |
| 1046 | ||
| 1047 | lemma real_of_int_add [simp]: "real(x + y) = real (x::int) + real y" | |
| 1048 | by (simp add: real_of_int_def) | |
| 1049 | ||
| 1050 | lemma real_of_int_minus [simp]: "real(-x) = -real (x::int)" | |
| 1051 | by (simp add: real_of_int_def) | |
| 1052 | ||
| 1053 | lemma real_of_int_diff [simp]: "real(x - y) = real (x::int) - real y" | |
| 1054 | by (simp add: real_of_int_def) | |
| 1055 | ||
| 1056 | lemma real_of_int_mult [simp]: "real(x * y) = real (x::int) * real y" | |
| 1057 | by (simp add: real_of_int_def) | |
| 1058 | ||
| 1059 | lemma real_of_int_power [simp]: "real (x ^ n) = real (x::int) ^ n" | |
| 1060 | by (simp add: real_of_int_def of_int_power) | |
| 1061 | ||
| 1062 | lemmas power_real_of_int = real_of_int_power [symmetric] | |
| 1063 | ||
| 1064 | lemma real_of_int_setsum [simp]: "real ((SUM x:A. f x)::int) = (SUM x:A. real(f x))" | |
| 1065 | apply (subst real_eq_of_int)+ | |
| 1066 | apply (rule of_int_setsum) | |
| 1067 | done | |
| 1068 | ||
| 1069 | lemma real_of_int_setprod [simp]: "real ((PROD x:A. f x)::int) = | |
| 1070 | (PROD x:A. real(f x))" | |
| 1071 | apply (subst real_eq_of_int)+ | |
| 1072 | apply (rule of_int_setprod) | |
| 1073 | done | |
| 1074 | ||
| 1075 | lemma real_of_int_zero_cancel [simp, algebra, presburger]: "(real x = 0) = (x = (0::int))" | |
| 1076 | by (simp add: real_of_int_def) | |
| 1077 | ||
| 1078 | lemma real_of_int_inject [iff, algebra, presburger]: "(real (x::int) = real y) = (x = y)" | |
| 1079 | by (simp add: real_of_int_def) | |
| 1080 | ||
| 1081 | lemma real_of_int_less_iff [iff, presburger]: "(real (x::int) < real y) = (x < y)" | |
| 1082 | by (simp add: real_of_int_def) | |
| 1083 | ||
| 1084 | lemma real_of_int_le_iff [simp, presburger]: "(real (x::int) \<le> real y) = (x \<le> y)" | |
| 1085 | by (simp add: real_of_int_def) | |
| 1086 | ||
| 1087 | lemma real_of_int_gt_zero_cancel_iff [simp, presburger]: "(0 < real (n::int)) = (0 < n)" | |
| 1088 | by (simp add: real_of_int_def) | |
| 1089 | ||
| 1090 | lemma real_of_int_ge_zero_cancel_iff [simp, presburger]: "(0 <= real (n::int)) = (0 <= n)" | |
| 1091 | by (simp add: real_of_int_def) | |
| 1092 | ||
| 1093 | lemma real_of_int_lt_zero_cancel_iff [simp, presburger]: "(real (n::int) < 0) = (n < 0)" | |
| 1094 | by (simp add: real_of_int_def) | |
| 1095 | ||
| 1096 | lemma real_of_int_le_zero_cancel_iff [simp, presburger]: "(real (n::int) <= 0) = (n <= 0)" | |
| 1097 | by (simp add: real_of_int_def) | |
| 1098 | ||
| 1099 | lemma one_less_real_of_int_cancel_iff: "1 < real (i :: int) \<longleftrightarrow> 1 < i" | |
| 1100 | unfolding real_of_one[symmetric] real_of_int_less_iff .. | |
| 1101 | ||
| 1102 | lemma one_le_real_of_int_cancel_iff: "1 \<le> real (i :: int) \<longleftrightarrow> 1 \<le> i" | |
| 1103 | unfolding real_of_one[symmetric] real_of_int_le_iff .. | |
| 1104 | ||
| 1105 | lemma real_of_int_less_one_cancel_iff: "real (i :: int) < 1 \<longleftrightarrow> i < 1" | |
| 1106 | unfolding real_of_one[symmetric] real_of_int_less_iff .. | |
| 1107 | ||
| 1108 | lemma real_of_int_le_one_cancel_iff: "real (i :: int) \<le> 1 \<longleftrightarrow> i \<le> 1" | |
| 1109 | unfolding real_of_one[symmetric] real_of_int_le_iff .. | |
| 1110 | ||
| 1111 | lemma real_of_int_abs [simp]: "real (abs x) = abs(real (x::int))" | |
| 1112 | by (auto simp add: abs_if) | |
| 1113 | ||
| 1114 | lemma int_less_real_le: "((n::int) < m) = (real n + 1 <= real m)" | |
| 1115 | apply (subgoal_tac "real n + 1 = real (n + 1)") | |
| 1116 | apply (simp del: real_of_int_add) | |
| 1117 | apply auto | |
| 1118 | done | |
| 1119 | ||
| 1120 | lemma int_le_real_less: "((n::int) <= m) = (real n < real m + 1)" | |
| 1121 | apply (subgoal_tac "real m + 1 = real (m + 1)") | |
| 1122 | apply (simp del: real_of_int_add) | |
| 1123 | apply simp | |
| 1124 | done | |
| 1125 | ||
| 1126 | lemma real_of_int_div_aux: "(real (x::int)) / (real d) = | |
| 1127 | real (x div d) + (real (x mod d)) / (real d)" | |
| 1128 | proof - | |
| 1129 | have "x = (x div d) * d + x mod d" | |
| 1130 | by auto | |
| 1131 | then have "real x = real (x div d) * real d + real(x mod d)" | |
| 1132 | by (simp only: real_of_int_mult [THEN sym] real_of_int_add [THEN sym]) | |
| 1133 | then have "real x / real d = ... / real d" | |
| 1134 | by simp | |
| 1135 | then show ?thesis | |
| 1136 | by (auto simp add: add_divide_distrib algebra_simps) | |
| 1137 | qed | |
| 1138 | ||
| 58834 | 1139 | lemma real_of_int_div: | 
| 1140 | fixes d n :: int | |
| 1141 | shows "d dvd n \<Longrightarrow> real (n div d) = real n / real d" | |
| 1142 | by (simp add: real_of_int_div_aux) | |
| 51523 | 1143 | |
| 1144 | lemma real_of_int_div2: | |
| 1145 | "0 <= real (n::int) / real (x) - real (n div x)" | |
| 1146 | apply (case_tac "x = 0") | |
| 1147 | apply simp | |
| 1148 | apply (case_tac "0 < x") | |
| 1149 | apply (simp add: algebra_simps) | |
| 1150 | apply (subst real_of_int_div_aux) | |
| 1151 | apply simp | |
| 1152 | apply (simp add: algebra_simps) | |
| 1153 | apply (subst real_of_int_div_aux) | |
| 1154 | apply simp | |
| 1155 | apply (subst zero_le_divide_iff) | |
| 1156 | apply auto | |
| 1157 | done | |
| 1158 | ||
| 1159 | lemma real_of_int_div3: | |
| 1160 | "real (n::int) / real (x) - real (n div x) <= 1" | |
| 1161 | apply (simp add: algebra_simps) | |
| 1162 | apply (subst real_of_int_div_aux) | |
| 1163 | apply (auto simp add: divide_le_eq intro: order_less_imp_le) | |
| 1164 | done | |
| 1165 | ||
| 1166 | lemma real_of_int_div4: "real (n div x) <= real (n::int) / real x" | |
| 1167 | by (insert real_of_int_div2 [of n x], simp) | |
| 1168 | ||
| 1169 | lemma Ints_real_of_int [simp]: "real (x::int) \<in> Ints" | |
| 1170 | unfolding real_of_int_def by (rule Ints_of_int) | |
| 1171 | ||
| 1172 | ||
| 1173 | subsection{*Embedding the Naturals into the Reals*}
 | |
| 1174 | ||
| 1175 | lemma real_of_nat_zero [simp]: "real (0::nat) = 0" | |
| 1176 | by (simp add: real_of_nat_def) | |
| 1177 | ||
| 1178 | lemma real_of_nat_1 [simp]: "real (1::nat) = 1" | |
| 1179 | by (simp add: real_of_nat_def) | |
| 1180 | ||
| 1181 | lemma real_of_nat_one [simp]: "real (Suc 0) = (1::real)" | |
| 1182 | by (simp add: real_of_nat_def) | |
| 1183 | ||
| 1184 | lemma real_of_nat_add [simp]: "real (m + n) = real (m::nat) + real n" | |
| 1185 | by (simp add: real_of_nat_def) | |
| 1186 | ||
| 1187 | (*Not for addsimps: often the LHS is used to represent a positive natural*) | |
| 1188 | lemma real_of_nat_Suc: "real (Suc n) = real n + (1::real)" | |
| 1189 | by (simp add: real_of_nat_def) | |
| 1190 | ||
| 1191 | lemma real_of_nat_less_iff [iff]: | |
| 1192 | "(real (n::nat) < real m) = (n < m)" | |
| 1193 | by (simp add: real_of_nat_def) | |
| 1194 | ||
| 1195 | lemma real_of_nat_le_iff [iff]: "(real (n::nat) \<le> real m) = (n \<le> m)" | |
| 1196 | by (simp add: real_of_nat_def) | |
| 1197 | ||
| 1198 | lemma real_of_nat_ge_zero [iff]: "0 \<le> real (n::nat)" | |
| 1199 | by (simp add: real_of_nat_def) | |
| 1200 | ||
| 1201 | lemma real_of_nat_Suc_gt_zero: "0 < real (Suc n)" | |
| 1202 | by (simp add: real_of_nat_def del: of_nat_Suc) | |
| 1203 | ||
| 1204 | lemma real_of_nat_mult [simp]: "real (m * n) = real (m::nat) * real n" | |
| 1205 | by (simp add: real_of_nat_def of_nat_mult) | |
| 1206 | ||
| 1207 | lemma real_of_nat_power [simp]: "real (m ^ n) = real (m::nat) ^ n" | |
| 1208 | by (simp add: real_of_nat_def of_nat_power) | |
| 1209 | ||
| 1210 | lemmas power_real_of_nat = real_of_nat_power [symmetric] | |
| 1211 | ||
| 1212 | lemma real_of_nat_setsum [simp]: "real ((SUM x:A. f x)::nat) = | |
| 1213 | (SUM x:A. real(f x))" | |
| 1214 | apply (subst real_eq_of_nat)+ | |
| 1215 | apply (rule of_nat_setsum) | |
| 1216 | done | |
| 1217 | ||
| 1218 | lemma real_of_nat_setprod [simp]: "real ((PROD x:A. f x)::nat) = | |
| 1219 | (PROD x:A. real(f x))" | |
| 1220 | apply (subst real_eq_of_nat)+ | |
| 1221 | apply (rule of_nat_setprod) | |
| 1222 | done | |
| 1223 | ||
| 1224 | lemma real_of_card: "real (card A) = setsum (%x.1) A" | |
| 1225 | apply (subst card_eq_setsum) | |
| 1226 | apply (subst real_of_nat_setsum) | |
| 1227 | apply simp | |
| 1228 | done | |
| 1229 | ||
| 1230 | lemma real_of_nat_inject [iff]: "(real (n::nat) = real m) = (n = m)" | |
| 1231 | by (simp add: real_of_nat_def) | |
| 1232 | ||
| 1233 | lemma real_of_nat_zero_iff [iff]: "(real (n::nat) = 0) = (n = 0)" | |
| 1234 | by (simp add: real_of_nat_def) | |
| 1235 | ||
| 1236 | lemma real_of_nat_diff: "n \<le> m ==> real (m - n) = real (m::nat) - real n" | |
| 1237 | by (simp add: add: real_of_nat_def of_nat_diff) | |
| 1238 | ||
| 1239 | lemma real_of_nat_gt_zero_cancel_iff [simp]: "(0 < real (n::nat)) = (0 < n)" | |
| 1240 | by (auto simp: real_of_nat_def) | |
| 1241 | ||
| 1242 | lemma real_of_nat_le_zero_cancel_iff [simp]: "(real (n::nat) \<le> 0) = (n = 0)" | |
| 1243 | by (simp add: add: real_of_nat_def) | |
| 1244 | ||
| 1245 | lemma not_real_of_nat_less_zero [simp]: "~ real (n::nat) < 0" | |
| 1246 | by (simp add: add: real_of_nat_def) | |
| 1247 | ||
| 1248 | lemma nat_less_real_le: "((n::nat) < m) = (real n + 1 <= real m)" | |
| 1249 | apply (subgoal_tac "real n + 1 = real (Suc n)") | |
| 1250 | apply simp | |
| 1251 | apply (auto simp add: real_of_nat_Suc) | |
| 1252 | done | |
| 1253 | ||
| 1254 | lemma nat_le_real_less: "((n::nat) <= m) = (real n < real m + 1)" | |
| 1255 | apply (subgoal_tac "real m + 1 = real (Suc m)") | |
| 1256 | apply (simp add: less_Suc_eq_le) | |
| 1257 | apply (simp add: real_of_nat_Suc) | |
| 1258 | done | |
| 1259 | ||
| 1260 | lemma real_of_nat_div_aux: "(real (x::nat)) / (real d) = | |
| 1261 | real (x div d) + (real (x mod d)) / (real d)" | |
| 1262 | proof - | |
| 1263 | have "x = (x div d) * d + x mod d" | |
| 1264 | by auto | |
| 1265 | then have "real x = real (x div d) * real d + real(x mod d)" | |
| 1266 | by (simp only: real_of_nat_mult [THEN sym] real_of_nat_add [THEN sym]) | |
| 1267 | then have "real x / real d = \<dots> / real d" | |
| 1268 | by simp | |
| 1269 | then show ?thesis | |
| 1270 | by (auto simp add: add_divide_distrib algebra_simps) | |
| 1271 | qed | |
| 1272 | ||
| 1273 | lemma real_of_nat_div: "(d :: nat) dvd n ==> | |
| 1274 | real(n div d) = real n / real d" | |
| 1275 | by (subst real_of_nat_div_aux) | |
| 1276 | (auto simp add: dvd_eq_mod_eq_0 [symmetric]) | |
| 1277 | ||
| 1278 | lemma real_of_nat_div2: | |
| 1279 | "0 <= real (n::nat) / real (x) - real (n div x)" | |
| 1280 | apply (simp add: algebra_simps) | |
| 1281 | apply (subst real_of_nat_div_aux) | |
| 1282 | apply simp | |
| 1283 | done | |
| 1284 | ||
| 1285 | lemma real_of_nat_div3: | |
| 1286 | "real (n::nat) / real (x) - real (n div x) <= 1" | |
| 1287 | apply(case_tac "x = 0") | |
| 1288 | apply (simp) | |
| 1289 | apply (simp add: algebra_simps) | |
| 1290 | apply (subst real_of_nat_div_aux) | |
| 1291 | apply simp | |
| 1292 | done | |
| 1293 | ||
| 1294 | lemma real_of_nat_div4: "real (n div x) <= real (n::nat) / real x" | |
| 1295 | by (insert real_of_nat_div2 [of n x], simp) | |
| 1296 | ||
| 1297 | lemma real_of_int_of_nat_eq [simp]: "real (of_nat n :: int) = real n" | |
| 1298 | by (simp add: real_of_int_def real_of_nat_def) | |
| 1299 | ||
| 1300 | lemma real_nat_eq_real [simp]: "0 <= x ==> real(nat x) = real x" | |
| 1301 | apply (subgoal_tac "real(int(nat x)) = real(nat x)") | |
| 1302 | apply force | |
| 1303 | apply (simp only: real_of_int_of_nat_eq) | |
| 1304 | done | |
| 1305 | ||
| 1306 | lemma Nats_real_of_nat [simp]: "real (n::nat) \<in> Nats" | |
| 1307 | unfolding real_of_nat_def by (rule of_nat_in_Nats) | |
| 1308 | ||
| 1309 | lemma Ints_real_of_nat [simp]: "real (n::nat) \<in> Ints" | |
| 1310 | unfolding real_of_nat_def by (rule Ints_of_nat) | |
| 1311 | ||
| 1312 | subsection {* The Archimedean Property of the Reals *}
 | |
| 1313 | ||
| 1314 | theorem reals_Archimedean: | |
| 1315 | assumes x_pos: "0 < x" | |
| 1316 | shows "\<exists>n. inverse (real (Suc n)) < x" | |
| 1317 | unfolding real_of_nat_def using x_pos | |
| 1318 | by (rule ex_inverse_of_nat_Suc_less) | |
| 1319 | ||
| 1320 | lemma reals_Archimedean2: "\<exists>n. (x::real) < real (n::nat)" | |
| 1321 | unfolding real_of_nat_def by (rule ex_less_of_nat) | |
| 1322 | ||
| 1323 | lemma reals_Archimedean3: | |
| 1324 | assumes x_greater_zero: "0 < x" | |
| 1325 | shows "\<forall>(y::real). \<exists>(n::nat). y < real n * x" | |
| 1326 | unfolding real_of_nat_def using `0 < x` | |
| 1327 | by (auto intro: ex_less_of_nat_mult) | |
| 1328 | ||
| 1329 | ||
| 1330 | subsection{* Rationals *}
 | |
| 1331 | ||
| 1332 | lemma Rats_real_nat[simp]: "real(n::nat) \<in> \<rat>" | |
| 1333 | by (simp add: real_eq_of_nat) | |
| 1334 | ||
| 1335 | lemma Rats_eq_int_div_int: | |
| 1336 |   "\<rat> = { real(i::int)/real(j::int) |i j. j \<noteq> 0}" (is "_ = ?S")
 | |
| 1337 | proof | |
| 1338 | show "\<rat> \<subseteq> ?S" | |
| 1339 | proof | |
| 1340 | fix x::real assume "x : \<rat>" | |
| 1341 | then obtain r where "x = of_rat r" unfolding Rats_def .. | |
| 1342 | have "of_rat r : ?S" | |
| 1343 | by (cases r)(auto simp add:of_rat_rat real_eq_of_int) | |
| 1344 | thus "x : ?S" using `x = of_rat r` by simp | |
| 1345 | qed | |
| 1346 | next | |
| 1347 | show "?S \<subseteq> \<rat>" | |
| 1348 | proof(auto simp:Rats_def) | |
| 1349 | fix i j :: int assume "j \<noteq> 0" | |
| 1350 | hence "real i / real j = of_rat(Fract i j)" | |
| 1351 | by (simp add:of_rat_rat real_eq_of_int) | |
| 1352 | thus "real i / real j \<in> range of_rat" by blast | |
| 1353 | qed | |
| 1354 | qed | |
| 1355 | ||
| 1356 | lemma Rats_eq_int_div_nat: | |
| 1357 |   "\<rat> = { real(i::int)/real(n::nat) |i n. n \<noteq> 0}"
 | |
| 1358 | proof(auto simp:Rats_eq_int_div_int) | |
| 1359 | fix i j::int assume "j \<noteq> 0" | |
| 1360 | show "EX (i'::int) (n::nat). real i/real j = real i'/real n \<and> 0<n" | |
| 1361 | proof cases | |
| 1362 | assume "j>0" | |
| 1363 | hence "real i/real j = real i/real(nat j) \<and> 0<nat j" | |
| 1364 | by (simp add: real_eq_of_int real_eq_of_nat of_nat_nat) | |
| 1365 | thus ?thesis by blast | |
| 1366 | next | |
| 1367 | assume "~ j>0" | |
| 1368 | hence "real i/real j = real(-i)/real(nat(-j)) \<and> 0<nat(-j)" using `j\<noteq>0` | |
| 1369 | by (simp add: real_eq_of_int real_eq_of_nat of_nat_nat) | |
| 1370 | thus ?thesis by blast | |
| 1371 | qed | |
| 1372 | next | |
| 1373 | fix i::int and n::nat assume "0 < n" | |
| 1374 | hence "real i/real n = real i/real(int n) \<and> int n \<noteq> 0" by simp | |
| 1375 | thus "\<exists>(i'::int) j::int. real i/real n = real i'/real j \<and> j \<noteq> 0" by blast | |
| 1376 | qed | |
| 1377 | ||
| 1378 | lemma Rats_abs_nat_div_natE: | |
| 1379 | assumes "x \<in> \<rat>" | |
| 1380 | obtains m n :: nat | |
| 1381 | where "n \<noteq> 0" and "\<bar>x\<bar> = real m / real n" and "gcd m n = 1" | |
| 1382 | proof - | |
| 1383 | from `x \<in> \<rat>` obtain i::int and n::nat where "n \<noteq> 0" and "x = real i / real n" | |
| 1384 | by(auto simp add: Rats_eq_int_div_nat) | |
| 1385 | hence "\<bar>x\<bar> = real(nat(abs i)) / real n" by simp | |
| 1386 | then obtain m :: nat where x_rat: "\<bar>x\<bar> = real m / real n" by blast | |
| 1387 | let ?gcd = "gcd m n" | |
| 1388 | from `n\<noteq>0` have gcd: "?gcd \<noteq> 0" by simp | |
| 1389 | let ?k = "m div ?gcd" | |
| 1390 | let ?l = "n div ?gcd" | |
| 1391 | let ?gcd' = "gcd ?k ?l" | |
| 1392 | have "?gcd dvd m" .. then have gcd_k: "?gcd * ?k = m" | |
| 1393 | by (rule dvd_mult_div_cancel) | |
| 1394 | have "?gcd dvd n" .. then have gcd_l: "?gcd * ?l = n" | |
| 1395 | by (rule dvd_mult_div_cancel) | |
| 58834 | 1396 | from `n \<noteq> 0` and gcd_l | 
| 1397 | have "?gcd * ?l \<noteq> 0" by simp | |
| 1398 | then have "?l \<noteq> 0" by (blast dest!: mult_not_zero) | |
| 51523 | 1399 | moreover | 
| 1400 | have "\<bar>x\<bar> = real ?k / real ?l" | |
| 1401 | proof - | |
| 1402 | from gcd have "real ?k / real ?l = | |
| 58834 | 1403 | real (?gcd * ?k) / real (?gcd * ?l)" | 
| 1404 | by (simp only: real_of_nat_mult) simp | |
| 51523 | 1405 | also from gcd_k and gcd_l have "\<dots> = real m / real n" by simp | 
| 1406 | also from x_rat have "\<dots> = \<bar>x\<bar>" .. | |
| 1407 | finally show ?thesis .. | |
| 1408 | qed | |
| 1409 | moreover | |
| 1410 | have "?gcd' = 1" | |
| 1411 | proof - | |
| 1412 | have "?gcd * ?gcd' = gcd (?gcd * ?k) (?gcd * ?l)" | |
| 1413 | by (rule gcd_mult_distrib_nat) | |
| 1414 | with gcd_k gcd_l have "?gcd * ?gcd' = ?gcd" by simp | |
| 1415 | with gcd show ?thesis by auto | |
| 1416 | qed | |
| 1417 | ultimately show ?thesis .. | |
| 1418 | qed | |
| 1419 | ||
| 1420 | subsection{*Density of the Rational Reals in the Reals*}
 | |
| 1421 | ||
| 1422 | text{* This density proof is due to Stefan Richter and was ported by TN.  The
 | |
| 1423 | original source is \emph{Real Analysis} by H.L. Royden.
 | |
| 1424 | It employs the Archimedean property of the reals. *} | |
| 1425 | ||
| 1426 | lemma Rats_dense_in_real: | |
| 1427 | fixes x :: real | |
| 1428 | assumes "x < y" shows "\<exists>r\<in>\<rat>. x < r \<and> r < y" | |
| 1429 | proof - | |
| 1430 | from `x<y` have "0 < y-x" by simp | |
| 1431 | with reals_Archimedean obtain q::nat | |
| 1432 | where q: "inverse (real q) < y-x" and "0 < q" by auto | |
| 1433 | def p \<equiv> "ceiling (y * real q) - 1" | |
| 1434 | def r \<equiv> "of_int p / real q" | |
| 1435 | from q have "x < y - inverse (real q)" by simp | |
| 1436 | also have "y - inverse (real q) \<le> r" | |
| 1437 | unfolding r_def p_def | |
| 1438 | by (simp add: le_divide_eq left_diff_distrib le_of_int_ceiling `0 < q`) | |
| 1439 | finally have "x < r" . | |
| 1440 | moreover have "r < y" | |
| 1441 | unfolding r_def p_def | |
| 1442 | by (simp add: divide_less_eq diff_less_eq `0 < q` | |
| 1443 | less_ceiling_iff [symmetric]) | |
| 1444 | moreover from r_def have "r \<in> \<rat>" by simp | |
| 1445 | ultimately show ?thesis by fast | |
| 1446 | qed | |
| 1447 | ||
| 57447 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 1448 | lemma of_rat_dense: | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 1449 | fixes x y :: real | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 1450 | assumes "x < y" | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 1451 | shows "\<exists>q :: rat. x < of_rat q \<and> of_rat q < y" | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 1452 | using Rats_dense_in_real [OF `x < y`] | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 1453 | by (auto elim: Rats_cases) | 
| 51523 | 1454 | |
| 1455 | ||
| 1456 | subsection{*Numerals and Arithmetic*}
 | |
| 1457 | ||
| 1458 | lemma [code_abbrev]: | |
| 1459 | "real_of_int (numeral k) = numeral k" | |
| 54489 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 haftmann parents: 
54281diff
changeset | 1460 | "real_of_int (- numeral k) = - numeral k" | 
| 51523 | 1461 | by simp_all | 
| 1462 | ||
| 54489 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 haftmann parents: 
54281diff
changeset | 1463 | text{*Collapse applications of @{const real} to @{const numeral}*}
 | 
| 51523 | 1464 | lemma real_numeral [simp]: | 
| 1465 | "real (numeral v :: int) = numeral v" | |
| 54489 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 haftmann parents: 
54281diff
changeset | 1466 | "real (- numeral v :: int) = - numeral v" | 
| 51523 | 1467 | by (simp_all add: real_of_int_def) | 
| 1468 | ||
| 57447 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 1469 | lemma real_of_nat_numeral [simp]: | 
| 51523 | 1470 | "real (numeral v :: nat) = numeral v" | 
| 1471 | by (simp add: real_of_nat_def) | |
| 1472 | ||
| 1473 | declaration {*
 | |
| 1474 |   K (Lin_Arith.add_inj_thms [@{thm real_of_nat_le_iff} RS iffD2, @{thm real_of_nat_inject} RS iffD2]
 | |
| 1475 | (* not needed because x < (y::nat) can be rewritten as Suc x <= y: real_of_nat_less_iff RS iffD2 *) | |
| 1476 |   #> Lin_Arith.add_inj_thms [@{thm real_of_int_le_iff} RS iffD2, @{thm real_of_int_inject} RS iffD2]
 | |
| 1477 | (* not needed because x < (y::int) can be rewritten as x + 1 <= y: real_of_int_less_iff RS iffD2 *) | |
| 1478 |   #> Lin_Arith.add_simps [@{thm real_of_nat_zero}, @{thm real_of_nat_Suc}, @{thm real_of_nat_add},
 | |
| 1479 |       @{thm real_of_nat_mult}, @{thm real_of_int_zero}, @{thm real_of_one},
 | |
| 1480 |       @{thm real_of_int_add}, @{thm real_of_int_minus}, @{thm real_of_int_diff},
 | |
| 1481 |       @{thm real_of_int_mult}, @{thm real_of_int_of_nat_eq},
 | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1482 |       @{thm real_of_nat_numeral}, @{thm real_numeral(1)}, @{thm real_numeral(2)},
 | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1483 |       @{thm real_of_int_def[symmetric]}, @{thm real_of_nat_def[symmetric]}]
 | 
| 51523 | 1484 |   #> Lin_Arith.add_inj_const (@{const_name real}, @{typ "nat \<Rightarrow> real"})
 | 
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1485 |   #> Lin_Arith.add_inj_const (@{const_name real}, @{typ "int \<Rightarrow> real"})
 | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1486 |   #> Lin_Arith.add_inj_const (@{const_name of_nat}, @{typ "nat \<Rightarrow> real"})
 | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1487 |   #> Lin_Arith.add_inj_const (@{const_name of_int}, @{typ "int \<Rightarrow> real"}))
 | 
| 51523 | 1488 | *} | 
| 1489 | ||
| 1490 | subsection{* Simprules combining x+y and 0: ARE THEY NEEDED?*}
 | |
| 1491 | ||
| 1492 | lemma real_add_minus_iff [simp]: "(x + - a = (0::real)) = (x=a)" | |
| 1493 | by arith | |
| 1494 | ||
| 1495 | text {* FIXME: redundant with @{text add_eq_0_iff} below *}
 | |
| 1496 | lemma real_add_eq_0_iff: "(x+y = (0::real)) = (y = -x)" | |
| 1497 | by auto | |
| 1498 | ||
| 1499 | lemma real_add_less_0_iff: "(x+y < (0::real)) = (y < -x)" | |
| 1500 | by auto | |
| 1501 | ||
| 1502 | lemma real_0_less_add_iff: "((0::real) < x+y) = (-x < y)" | |
| 1503 | by auto | |
| 1504 | ||
| 1505 | lemma real_add_le_0_iff: "(x+y \<le> (0::real)) = (y \<le> -x)" | |
| 1506 | by auto | |
| 1507 | ||
| 1508 | lemma real_0_le_add_iff: "((0::real) \<le> x+y) = (-x \<le> y)" | |
| 1509 | by auto | |
| 1510 | ||
| 1511 | subsection {* Lemmas about powers *}
 | |
| 1512 | ||
| 1513 | text {* FIXME: declare this in Rings.thy or not at all *}
 | |
| 1514 | declare abs_mult_self [simp] | |
| 1515 | ||
| 1516 | (* used by Import/HOL/real.imp *) | |
| 1517 | lemma two_realpow_ge_one: "(1::real) \<le> 2 ^ n" | |
| 1518 | by simp | |
| 1519 | ||
| 1520 | lemma two_realpow_gt [simp]: "real (n::nat) < 2 ^ n" | |
| 1521 | apply (induct "n") | |
| 1522 | apply (auto simp add: real_of_nat_Suc) | |
| 1523 | apply (subst mult_2) | |
| 1524 | apply (erule add_less_le_mono) | |
| 1525 | apply (rule two_realpow_ge_one) | |
| 1526 | done | |
| 1527 | ||
| 1528 | text {* TODO: no longer real-specific; rename and move elsewhere *}
 | |
| 1529 | lemma realpow_Suc_le_self: | |
| 1530 | fixes r :: "'a::linordered_semidom" | |
| 1531 | shows "[| 0 \<le> r; r \<le> 1 |] ==> r ^ Suc n \<le> r" | |
| 1532 | by (insert power_decreasing [of 1 "Suc n" r], simp) | |
| 1533 | ||
| 1534 | text {* TODO: no longer real-specific; rename and move elsewhere *}
 | |
| 1535 | lemma realpow_minus_mult: | |
| 1536 | fixes x :: "'a::monoid_mult" | |
| 1537 | shows "0 < n \<Longrightarrow> x ^ (n - 1) * x = x ^ n" | |
| 1538 | by (simp add: power_commutes split add: nat_diff_split) | |
| 1539 | ||
| 1540 | text {* FIXME: declare this [simp] for all types, or not at all *}
 | |
| 1541 | lemma real_two_squares_add_zero_iff [simp]: | |
| 1542 | "(x * x + y * y = 0) = ((x::real) = 0 \<and> y = 0)" | |
| 1543 | by (rule sum_squares_eq_zero_iff) | |
| 1544 | ||
| 1545 | text {* FIXME: declare this [simp] for all types, or not at all *}
 | |
| 1546 | lemma realpow_two_sum_zero_iff [simp]: | |
| 53076 | 1547 | "(x\<^sup>2 + y\<^sup>2 = (0::real)) = (x = 0 & y = 0)" | 
| 51523 | 1548 | by (rule sum_power2_eq_zero_iff) | 
| 1549 | ||
| 1550 | lemma real_minus_mult_self_le [simp]: "-(u * u) \<le> (x * (x::real))" | |
| 1551 | by (rule_tac y = 0 in order_trans, auto) | |
| 1552 | ||
| 53076 | 1553 | lemma realpow_square_minus_le [simp]: "- u\<^sup>2 \<le> (x::real)\<^sup>2" | 
| 51523 | 1554 | by (auto simp add: power2_eq_square) | 
| 1555 | ||
| 1556 | ||
| 58983 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1557 | lemma numeral_power_eq_real_of_int_cancel_iff[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1558 | "numeral x ^ n = real (y::int) \<longleftrightarrow> numeral x ^ n = y" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1559 | by (metis real_numeral(1) real_of_int_inject real_of_int_power) | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1560 | |
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1561 | lemma real_of_int_eq_numeral_power_cancel_iff[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1562 | "real (y::int) = numeral x ^ n \<longleftrightarrow> y = numeral x ^ n" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1563 | using numeral_power_eq_real_of_int_cancel_iff[of x n y] | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1564 | by metis | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1565 | |
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1566 | lemma numeral_power_eq_real_of_nat_cancel_iff[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1567 | "numeral x ^ n = real (y::nat) \<longleftrightarrow> numeral x ^ n = y" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1568 | by (metis of_nat_eq_iff of_nat_numeral real_of_int_eq_numeral_power_cancel_iff | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1569 | real_of_int_of_nat_eq zpower_int) | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1570 | |
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1571 | lemma real_of_nat_eq_numeral_power_cancel_iff[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1572 | "real (y::nat) = numeral x ^ n \<longleftrightarrow> y = numeral x ^ n" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1573 | using numeral_power_eq_real_of_nat_cancel_iff[of x n y] | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1574 | by metis | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1575 | |
| 51523 | 1576 | lemma numeral_power_le_real_of_nat_cancel_iff[simp]: | 
| 1577 | "(numeral x::real) ^ n \<le> real a \<longleftrightarrow> (numeral x::nat) ^ n \<le> a" | |
| 1578 | unfolding real_of_nat_le_iff[symmetric] by simp | |
| 1579 | ||
| 1580 | lemma real_of_nat_le_numeral_power_cancel_iff[simp]: | |
| 1581 | "real a \<le> (numeral x::real) ^ n \<longleftrightarrow> a \<le> (numeral x::nat) ^ n" | |
| 1582 | unfolding real_of_nat_le_iff[symmetric] by simp | |
| 1583 | ||
| 1584 | lemma numeral_power_le_real_of_int_cancel_iff[simp]: | |
| 1585 | "(numeral x::real) ^ n \<le> real a \<longleftrightarrow> (numeral x::int) ^ n \<le> a" | |
| 1586 | unfolding real_of_int_le_iff[symmetric] by simp | |
| 1587 | ||
| 1588 | lemma real_of_int_le_numeral_power_cancel_iff[simp]: | |
| 1589 | "real a \<le> (numeral x::real) ^ n \<longleftrightarrow> a \<le> (numeral x::int) ^ n" | |
| 1590 | unfolding real_of_int_le_iff[symmetric] by simp | |
| 1591 | ||
| 58983 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1592 | lemma numeral_power_less_real_of_nat_cancel_iff[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1593 | "(numeral x::real) ^ n < real a \<longleftrightarrow> (numeral x::nat) ^ n < a" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1594 | unfolding real_of_nat_less_iff[symmetric] by simp | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1595 | |
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1596 | lemma real_of_nat_less_numeral_power_cancel_iff[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1597 | "real a < (numeral x::real) ^ n \<longleftrightarrow> a < (numeral x::nat) ^ n" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1598 | unfolding real_of_nat_less_iff[symmetric] by simp | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1599 | |
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1600 | lemma numeral_power_less_real_of_int_cancel_iff[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1601 | "(numeral x::real) ^ n < real a \<longleftrightarrow> (numeral x::int) ^ n < a" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1602 | unfolding real_of_int_less_iff[symmetric] by simp | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1603 | |
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1604 | lemma real_of_int_less_numeral_power_cancel_iff[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1605 | "real a < (numeral x::real) ^ n \<longleftrightarrow> a < (numeral x::int) ^ n" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1606 | unfolding real_of_int_less_iff[symmetric] by simp | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1607 | |
| 51523 | 1608 | lemma neg_numeral_power_le_real_of_int_cancel_iff[simp]: | 
| 54489 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 haftmann parents: 
54281diff
changeset | 1609 | "(- numeral x::real) ^ n \<le> real a \<longleftrightarrow> (- numeral x::int) ^ n \<le> a" | 
| 51523 | 1610 | unfolding real_of_int_le_iff[symmetric] by simp | 
| 1611 | ||
| 1612 | lemma real_of_int_le_neg_numeral_power_cancel_iff[simp]: | |
| 54489 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 haftmann parents: 
54281diff
changeset | 1613 | "real a \<le> (- numeral x::real) ^ n \<longleftrightarrow> a \<le> (- numeral x::int) ^ n" | 
| 51523 | 1614 | unfolding real_of_int_le_iff[symmetric] by simp | 
| 1615 | ||
| 56889 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1616 | |
| 51523 | 1617 | subsection{*Density of the Reals*}
 | 
| 1618 | ||
| 1619 | lemma real_lbound_gt_zero: | |
| 1620 | "[| (0::real) < d1; 0 < d2 |] ==> \<exists>e. 0 < e & e < d1 & e < d2" | |
| 1621 | apply (rule_tac x = " (min d1 d2) /2" in exI) | |
| 1622 | apply (simp add: min_def) | |
| 1623 | done | |
| 1624 | ||
| 1625 | ||
| 1626 | text{*Similar results are proved in @{text Fields}*}
 | |
| 1627 | lemma real_less_half_sum: "x < y ==> x < (x+y) / (2::real)" | |
| 1628 | by auto | |
| 1629 | ||
| 1630 | lemma real_gt_half_sum: "x < y ==> (x+y)/(2::real) < y" | |
| 1631 | by auto | |
| 1632 | ||
| 1633 | lemma real_sum_of_halves: "x/2 + x/2 = (x::real)" | |
| 1634 | by simp | |
| 1635 | ||
| 1636 | subsection{*Absolute Value Function for the Reals*}
 | |
| 1637 | ||
| 1638 | lemma abs_minus_add_cancel: "abs(x + (-y)) = abs (y + (-(x::real)))" | |
| 1639 | by (simp add: abs_if) | |
| 1640 | ||
| 1641 | (* FIXME: redundant, but used by Integration/RealRandVar.thy in AFP *) | |
| 1642 | lemma abs_le_interval_iff: "(abs x \<le> r) = (-r\<le>x & x\<le>(r::real))" | |
| 1643 | by (force simp add: abs_le_iff) | |
| 1644 | ||
| 1645 | lemma abs_add_one_gt_zero: "(0::real) < 1 + abs(x)" | |
| 1646 | by (simp add: abs_if) | |
| 1647 | ||
| 1648 | lemma abs_real_of_nat_cancel [simp]: "abs (real x) = real (x::nat)" | |
| 1649 | by (rule abs_of_nonneg [OF real_of_nat_ge_zero]) | |
| 1650 | ||
| 1651 | lemma abs_add_one_not_less_self: "~ abs(x) + (1::real) < x" | |
| 1652 | by simp | |
| 1653 | ||
| 1654 | lemma abs_sum_triangle_ineq: "abs ((x::real) + y + (-l + -m)) \<le> abs(x + -l) + abs(y + -m)" | |
| 1655 | by simp | |
| 1656 | ||
| 1657 | ||
| 1658 | subsection{*Floor and Ceiling Functions from the Reals to the Integers*}
 | |
| 1659 | ||
| 1660 | (* FIXME: theorems for negative numerals *) | |
| 1661 | lemma numeral_less_real_of_int_iff [simp]: | |
| 1662 | "((numeral n) < real (m::int)) = (numeral n < m)" | |
| 1663 | apply auto | |
| 1664 | apply (rule real_of_int_less_iff [THEN iffD1]) | |
| 1665 | apply (drule_tac [2] real_of_int_less_iff [THEN iffD2], auto) | |
| 1666 | done | |
| 1667 | ||
| 1668 | lemma numeral_less_real_of_int_iff2 [simp]: | |
| 1669 | "(real (m::int) < (numeral n)) = (m < numeral n)" | |
| 1670 | apply auto | |
| 1671 | apply (rule real_of_int_less_iff [THEN iffD1]) | |
| 1672 | apply (drule_tac [2] real_of_int_less_iff [THEN iffD2], auto) | |
| 1673 | done | |
| 1674 | ||
| 56889 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1675 | lemma real_of_nat_less_numeral_iff [simp]: | 
| 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1676 | "real (n::nat) < numeral w \<longleftrightarrow> n < numeral w" | 
| 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1677 | using real_of_nat_less_iff[of n "numeral w"] by simp | 
| 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1678 | |
| 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1679 | lemma numeral_less_real_of_nat_iff [simp]: | 
| 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1680 | "numeral w < real (n::nat) \<longleftrightarrow> numeral w < n" | 
| 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1681 | using real_of_nat_less_iff[of "numeral w" n] by simp | 
| 
48a745e1bde7
avoid the Complex constructor, use the more natural Re/Im view; moved csqrt to Complex.
 hoelzl parents: 
56571diff
changeset | 1682 | |
| 51523 | 1683 | lemma numeral_le_real_of_int_iff [simp]: | 
| 1684 | "((numeral n) \<le> real (m::int)) = (numeral n \<le> m)" | |
| 1685 | by (simp add: linorder_not_less [symmetric]) | |
| 1686 | ||
| 1687 | lemma numeral_le_real_of_int_iff2 [simp]: | |
| 1688 | "(real (m::int) \<le> (numeral n)) = (m \<le> numeral n)" | |
| 1689 | by (simp add: linorder_not_less [symmetric]) | |
| 1690 | ||
| 1691 | lemma floor_real_of_nat [simp]: "floor (real (n::nat)) = int n" | |
| 1692 | unfolding real_of_nat_def by simp | |
| 1693 | ||
| 1694 | lemma floor_minus_real_of_nat [simp]: "floor (- real (n::nat)) = - int n" | |
| 1695 | unfolding real_of_nat_def by (simp add: floor_minus) | |
| 1696 | ||
| 1697 | lemma floor_real_of_int [simp]: "floor (real (n::int)) = n" | |
| 1698 | unfolding real_of_int_def by simp | |
| 1699 | ||
| 1700 | lemma floor_minus_real_of_int [simp]: "floor (- real (n::int)) = - n" | |
| 1701 | unfolding real_of_int_def by (simp add: floor_minus) | |
| 1702 | ||
| 1703 | lemma real_lb_ub_int: " \<exists>n::int. real n \<le> r & r < real (n+1)" | |
| 1704 | unfolding real_of_int_def by (rule floor_exists) | |
| 1705 | ||
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1706 | lemma lemma_floor: "real m \<le> r \<Longrightarrow> r < real n + 1 \<Longrightarrow> m \<le> (n::int)" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1707 | by simp | 
| 51523 | 1708 | |
| 1709 | lemma real_of_int_floor_le [simp]: "real (floor r) \<le> r" | |
| 1710 | unfolding real_of_int_def by (rule of_int_floor_le) | |
| 1711 | ||
| 1712 | lemma lemma_floor2: "real n < real (x::int) + 1 ==> n \<le> x" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1713 | by simp | 
| 51523 | 1714 | |
| 1715 | lemma real_of_int_floor_cancel [simp]: | |
| 1716 | "(real (floor x) = x) = (\<exists>n::int. x = real n)" | |
| 1717 | using floor_real_of_int by metis | |
| 1718 | ||
| 1719 | lemma floor_eq: "[| real n < x; x < real n + 1 |] ==> floor x = n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1720 | by linarith | 
| 51523 | 1721 | |
| 1722 | lemma floor_eq2: "[| real n \<le> x; x < real n + 1 |] ==> floor x = n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1723 | by linarith | 
| 51523 | 1724 | |
| 1725 | lemma floor_eq3: "[| real n < x; x < real (Suc n) |] ==> nat(floor x) = n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1726 | by linarith | 
| 51523 | 1727 | |
| 1728 | lemma floor_eq4: "[| real n \<le> x; x < real (Suc n) |] ==> nat(floor x) = n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1729 | by linarith | 
| 51523 | 1730 | |
| 1731 | lemma real_of_int_floor_ge_diff_one [simp]: "r - 1 \<le> real(floor r)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1732 | by linarith | 
| 51523 | 1733 | |
| 1734 | lemma real_of_int_floor_gt_diff_one [simp]: "r - 1 < real(floor r)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1735 | by linarith | 
| 51523 | 1736 | |
| 1737 | lemma real_of_int_floor_add_one_ge [simp]: "r \<le> real(floor r) + 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1738 | by linarith | 
| 51523 | 1739 | |
| 1740 | lemma real_of_int_floor_add_one_gt [simp]: "r < real(floor r) + 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1741 | by linarith | 
| 51523 | 1742 | |
| 1743 | lemma le_floor: "real a <= x ==> a <= floor x" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1744 | by linarith | 
| 51523 | 1745 | |
| 1746 | lemma real_le_floor: "a <= floor x ==> real a <= x" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1747 | by linarith | 
| 51523 | 1748 | |
| 1749 | lemma le_floor_eq: "(a <= floor x) = (real a <= x)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1750 | by linarith | 
| 51523 | 1751 | |
| 1752 | lemma floor_less_eq: "(floor x < a) = (x < real a)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1753 | by linarith | 
| 51523 | 1754 | |
| 1755 | lemma less_floor_eq: "(a < floor x) = (real a + 1 <= x)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1756 | by linarith | 
| 51523 | 1757 | |
| 1758 | lemma floor_le_eq: "(floor x <= a) = (x < real a + 1)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1759 | by linarith | 
| 51523 | 1760 | |
| 58983 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1761 | lemma floor_eq_iff: "floor x = b \<longleftrightarrow> real b \<le> x \<and> x < real (b + 1)" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1762 | by linarith | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1763 | |
| 51523 | 1764 | lemma floor_add [simp]: "floor (x + real a) = floor x + a" | 
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1765 | by linarith | 
| 51523 | 1766 | |
| 58983 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1767 | lemma floor_add2[simp]: "floor (real a + x) = a + floor x" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1768 | by linarith | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 1769 | |
| 51523 | 1770 | lemma floor_subtract [simp]: "floor (x - real a) = floor x - a" | 
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1771 | by linarith | 
| 51523 | 1772 | |
| 58788 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1773 | lemma floor_divide_real_eq_div: "0 \<le> b \<Longrightarrow> floor (a / real b) = floor a div b" | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1774 | proof cases | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1775 | assume "0 < b" | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1776 |   { fix i j :: int assume "real i \<le> a" "a < 1 + real i"
 | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1777 | "real j * real b \<le> a" "a < real b + real j * real b" | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1778 | then have "i < b + j * b" "j * b < 1 + i" | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1779 | unfolding real_of_int_less_iff[symmetric] by auto | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1780 | then have "(j - i div b) * b \<le> i mod b" "i mod b < ((j - i div b) + 1) * b" | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1781 | by (auto simp: field_simps) | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1782 | then have "(j - i div b) * b < 1 * b" "0 * b < ((j - i div b) + 1) * b" | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1783 | using pos_mod_bound[OF `0<b`, of i] pos_mod_sign[OF `0<b`, of i] by linarith+ | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1784 | then have "j = i div b" | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1785 | using `0 < b` unfolding mult_less_cancel_right by auto } | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1786 | with `0 < b` show ?thesis | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1787 | by (auto split: floor_split simp: field_simps) | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1788 | qed auto | 
| 
d17b3844b726
generalize natfloor_div_nat, add floor variant: floor_divide_real_eq_div
 hoelzl parents: 
58134diff
changeset | 1789 | |
| 51523 | 1790 | lemma floor_divide_eq_div: | 
| 1791 | "floor (real a / real b) = a div b" | |
| 1792 | proof cases | |
| 1793 | assume "b \<noteq> 0 \<or> b dvd a" | |
| 1794 | with real_of_int_div3[of a b] show ?thesis | |
| 1795 | by (auto simp: real_of_int_div[symmetric] intro!: floor_eq2 real_of_int_div4 neq_le_trans) | |
| 1796 | (metis add_left_cancel zero_neq_one real_of_int_div_aux real_of_int_inject | |
| 1797 | real_of_int_zero_cancel right_inverse_eq div_self mod_div_trivial) | |
| 1798 | qed (auto simp: real_of_int_div) | |
| 1799 | ||
| 58097 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1800 | lemma floor_divide_eq_div_numeral[simp]: "\<lfloor>numeral a / numeral b::real\<rfloor> = numeral a div numeral b" | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1801 | using floor_divide_eq_div[of "numeral a" "numeral b"] by simp | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1802 | |
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1803 | lemma floor_minus_divide_eq_div_numeral[simp]: "\<lfloor>- (numeral a / numeral b)::real\<rfloor> = - numeral a div numeral b" | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1804 | using floor_divide_eq_div[of "- numeral a" "numeral b"] by simp | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1805 | |
| 51523 | 1806 | lemma ceiling_real_of_nat [simp]: "ceiling (real (n::nat)) = int n" | 
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1807 | by linarith | 
| 51523 | 1808 | |
| 1809 | lemma real_of_int_ceiling_ge [simp]: "r \<le> real (ceiling r)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1810 | by linarith | 
| 51523 | 1811 | |
| 1812 | lemma ceiling_real_of_int [simp]: "ceiling (real (n::int)) = n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1813 | by linarith | 
| 51523 | 1814 | |
| 1815 | lemma real_of_int_ceiling_cancel [simp]: | |
| 1816 | "(real (ceiling x) = x) = (\<exists>n::int. x = real n)" | |
| 1817 | using ceiling_real_of_int by metis | |
| 1818 | ||
| 1819 | lemma ceiling_eq: "[| real n < x; x < real n + 1 |] ==> ceiling x = n + 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1820 | by linarith | 
| 51523 | 1821 | |
| 1822 | lemma ceiling_eq2: "[| real n < x; x \<le> real n + 1 |] ==> ceiling x = n + 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1823 | by linarith | 
| 51523 | 1824 | |
| 1825 | lemma ceiling_eq3: "[| real n - 1 < x; x \<le> real n |] ==> ceiling x = n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1826 | by linarith | 
| 51523 | 1827 | |
| 1828 | lemma real_of_int_ceiling_diff_one_le [simp]: "real (ceiling r) - 1 \<le> r" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1829 | by linarith | 
| 51523 | 1830 | |
| 1831 | lemma real_of_int_ceiling_le_add_one [simp]: "real (ceiling r) \<le> r + 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1832 | by linarith | 
| 51523 | 1833 | |
| 1834 | lemma ceiling_le: "x <= real a ==> ceiling x <= a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1835 | by linarith | 
| 51523 | 1836 | |
| 1837 | lemma ceiling_le_real: "ceiling x <= a ==> x <= real a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1838 | by linarith | 
| 51523 | 1839 | |
| 1840 | lemma ceiling_le_eq: "(ceiling x <= a) = (x <= real a)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1841 | by linarith | 
| 51523 | 1842 | |
| 1843 | lemma less_ceiling_eq: "(a < ceiling x) = (real a < x)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1844 | by linarith | 
| 51523 | 1845 | |
| 1846 | lemma ceiling_less_eq: "(ceiling x < a) = (x <= real a - 1)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1847 | by linarith | 
| 51523 | 1848 | |
| 1849 | lemma le_ceiling_eq: "(a <= ceiling x) = (real a - 1 < x)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1850 | by linarith | 
| 51523 | 1851 | |
| 1852 | lemma ceiling_add [simp]: "ceiling (x + real a) = ceiling x + a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1853 | by linarith | 
| 51523 | 1854 | |
| 1855 | lemma ceiling_subtract [simp]: "ceiling (x - real a) = ceiling x - a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1856 | by linarith | 
| 51523 | 1857 | |
| 58097 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1858 | lemma ceiling_divide_eq_div: "\<lceil>real a / real b\<rceil> = - (- a div b)" | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1859 | unfolding ceiling_def minus_divide_left real_of_int_minus[symmetric] floor_divide_eq_div by simp_all | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1860 | |
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1861 | lemma ceiling_divide_eq_div_numeral [simp]: | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1862 | "\<lceil>numeral a / numeral b :: real\<rceil> = - (- numeral a div numeral b)" | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1863 | using ceiling_divide_eq_div[of "numeral a" "numeral b"] by simp | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1864 | |
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1865 | lemma ceiling_minus_divide_eq_div_numeral [simp]: | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1866 | "\<lceil>- (numeral a / numeral b :: real)\<rceil> = - (numeral a div numeral b)" | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1867 | using ceiling_divide_eq_div[of "- numeral a" "numeral b"] by simp | 
| 51523 | 1868 | |
| 1869 | subsubsection {* Versions for the natural numbers *}
 | |
| 1870 | ||
| 1871 | definition | |
| 1872 | natfloor :: "real => nat" where | |
| 1873 | "natfloor x = nat(floor x)" | |
| 1874 | ||
| 1875 | definition | |
| 1876 | natceiling :: "real => nat" where | |
| 1877 | "natceiling x = nat(ceiling x)" | |
| 1878 | ||
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1879 | lemma natfloor_split[arith_split]: "P (natfloor t) \<longleftrightarrow> (t < 0 \<longrightarrow> P 0) \<and> (\<forall>n. of_nat n \<le> t \<and> t < of_nat n + 1 \<longrightarrow> P n)" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1880 | proof - | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1881 | have [dest]: "\<And>n m::nat. real n \<le> t \<Longrightarrow> t < real n + 1 \<Longrightarrow> real m \<le> t \<Longrightarrow> t < real m + 1 \<Longrightarrow> n = m" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1882 | by simp | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1883 | show ?thesis | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1884 | by (auto simp: natfloor_def real_of_nat_def[symmetric] split: split_nat floor_split) | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1885 | qed | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1886 | |
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1887 | lemma natceiling_split[arith_split]: | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1888 | "P (natceiling t) \<longleftrightarrow> (t \<le> - 1 \<longrightarrow> P 0) \<and> (\<forall>n. of_nat n - 1 < t \<and> t \<le> of_nat n \<longrightarrow> P n)" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1889 | proof - | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1890 | have [dest]: "\<And>n m::nat. real n - 1 < t \<Longrightarrow> t \<le> real n \<Longrightarrow> real m - 1 < t \<Longrightarrow> t \<le> real m \<Longrightarrow> n = m" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1891 | by simp | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1892 | show ?thesis | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1893 | by (auto simp: natceiling_def real_of_nat_def[symmetric] split: split_nat ceiling_split) | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1894 | qed | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1895 | |
| 51523 | 1896 | lemma natfloor_zero [simp]: "natfloor 0 = 0" | 
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1897 | by linarith | 
| 51523 | 1898 | |
| 1899 | lemma natfloor_one [simp]: "natfloor 1 = 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1900 | by linarith | 
| 51523 | 1901 | |
| 1902 | lemma natfloor_numeral_eq [simp]: "natfloor (numeral n) = numeral n" | |
| 1903 | by (unfold natfloor_def, simp) | |
| 1904 | ||
| 1905 | lemma natfloor_real_of_nat [simp]: "natfloor(real n) = n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1906 | by linarith | 
| 51523 | 1907 | |
| 1908 | lemma real_natfloor_le: "0 <= x ==> real(natfloor x) <= x" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1909 | by linarith | 
| 51523 | 1910 | |
| 1911 | lemma natfloor_neg: "x <= 0 ==> natfloor x = 0" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1912 | by linarith | 
| 51523 | 1913 | |
| 1914 | lemma natfloor_mono: "x <= y ==> natfloor x <= natfloor y" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1915 | by linarith | 
| 51523 | 1916 | |
| 1917 | lemma le_natfloor: "real x <= a ==> x <= natfloor a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1918 | by linarith | 
| 51523 | 1919 | |
| 1920 | lemma natfloor_less_iff: "0 \<le> x \<Longrightarrow> natfloor x < n \<longleftrightarrow> x < real n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1921 | by linarith | 
| 51523 | 1922 | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1923 | lemma less_natfloor: "0 \<le> x \<Longrightarrow> x < real (n :: nat) \<Longrightarrow> natfloor x < n" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1924 | by linarith | 
| 51523 | 1925 | |
| 1926 | lemma le_natfloor_eq: "0 <= x ==> (a <= natfloor x) = (real a <= x)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1927 | by linarith | 
| 51523 | 1928 | |
| 1929 | lemma le_natfloor_eq_numeral [simp]: | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1930 | "0 \<le> x \<Longrightarrow> (numeral n \<le> natfloor x) = (numeral n \<le> x)" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1931 | by (subst le_natfloor_eq, assumption) simp | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1932 | |
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1933 | lemma le_natfloor_eq_one [simp]: "(1 \<le> natfloor x) = (1 \<le> x)" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1934 | by linarith | 
| 51523 | 1935 | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1936 | lemma natfloor_eq: "real n \<le> x \<Longrightarrow> x < real n + 1 \<Longrightarrow> natfloor x = n" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1937 | by linarith | 
| 51523 | 1938 | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1939 | lemma real_natfloor_add_one_gt: "x < real (natfloor x) + 1" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1940 | by linarith | 
| 51523 | 1941 | |
| 1942 | lemma real_natfloor_gt_diff_one: "x - 1 < real(natfloor x)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1943 | by linarith | 
| 51523 | 1944 | |
| 1945 | lemma ge_natfloor_plus_one_imp_gt: "natfloor z + 1 <= n ==> z < real n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1946 | by linarith | 
| 51523 | 1947 | |
| 1948 | lemma natfloor_add [simp]: "0 <= x ==> natfloor (x + real a) = natfloor x + a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1949 | by linarith | 
| 51523 | 1950 | |
| 1951 | lemma natfloor_add_numeral [simp]: | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1952 | "0 <= x \<Longrightarrow> natfloor (x + numeral n) = natfloor x + numeral n" | 
| 51523 | 1953 | by (simp add: natfloor_add [symmetric]) | 
| 1954 | ||
| 1955 | lemma natfloor_add_one: "0 <= x ==> natfloor(x + 1) = natfloor x + 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1956 | by linarith | 
| 51523 | 1957 | |
| 1958 | lemma natfloor_subtract [simp]: | |
| 1959 | "natfloor(x - real a) = natfloor x - a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1960 | by linarith | 
| 51523 | 1961 | |
| 58789 | 1962 | lemma natfloor_div_nat: "natfloor (x / real y) = natfloor x div y" | 
| 1963 | proof cases | |
| 1964 | assume "0 \<le> x" then show ?thesis | |
| 1965 | unfolding natfloor_def real_of_int_of_nat_eq[symmetric] | |
| 1966 | by (subst floor_divide_real_eq_div) (simp_all add: nat_div_distrib) | |
| 1967 | qed (simp add: divide_nonpos_nonneg natfloor_neg) | |
| 51523 | 1968 | |
| 58097 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1969 | lemma natfloor_div_numeral[simp]: | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1970 | "natfloor (numeral x / numeral y) = numeral x div numeral y" | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1971 | using natfloor_div_nat[of "numeral x" "numeral y"] by simp | 
| 
cfd3cff9387b
add simp rules for divisions of numerals in floor and ceiling.
 hoelzl parents: 
58061diff
changeset | 1972 | |
| 51523 | 1973 | lemma le_mult_natfloor: | 
| 1974 | shows "natfloor a * natfloor b \<le> natfloor (a * b)" | |
| 1975 | by (cases "0 <= a & 0 <= b") | |
| 56536 | 1976 | (auto simp add: le_natfloor_eq mult_mono' real_natfloor_le natfloor_neg) | 
| 51523 | 1977 | |
| 1978 | lemma natceiling_zero [simp]: "natceiling 0 = 0" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1979 | by linarith | 
| 51523 | 1980 | |
| 1981 | lemma natceiling_one [simp]: "natceiling 1 = 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1982 | by linarith | 
| 51523 | 1983 | |
| 1984 | lemma zero_le_natceiling [simp]: "0 <= natceiling x" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1985 | by linarith | 
| 51523 | 1986 | |
| 1987 | lemma natceiling_numeral_eq [simp]: "natceiling (numeral n) = numeral n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1988 | by (simp add: natceiling_def) | 
| 51523 | 1989 | |
| 1990 | lemma natceiling_real_of_nat [simp]: "natceiling(real n) = n" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1991 | by linarith | 
| 51523 | 1992 | |
| 1993 | lemma real_natceiling_ge: "x <= real(natceiling x)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1994 | by linarith | 
| 51523 | 1995 | |
| 1996 | lemma natceiling_neg: "x <= 0 ==> natceiling x = 0" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 1997 | by linarith | 
| 51523 | 1998 | |
| 1999 | lemma natceiling_mono: "x <= y ==> natceiling x <= natceiling y" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2000 | by linarith | 
| 51523 | 2001 | |
| 2002 | lemma natceiling_le: "x <= real a ==> natceiling x <= a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2003 | by linarith | 
| 51523 | 2004 | |
| 2005 | lemma natceiling_le_eq: "(natceiling x <= a) = (x <= real a)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2006 | by linarith | 
| 51523 | 2007 | |
| 2008 | lemma natceiling_le_eq_numeral [simp]: | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2009 | "(natceiling x <= numeral n) = (x <= numeral n)" | 
| 51523 | 2010 | by (simp add: natceiling_le_eq) | 
| 2011 | ||
| 2012 | lemma natceiling_le_eq_one: "(natceiling x <= 1) = (x <= 1)" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2013 | by linarith | 
| 51523 | 2014 | |
| 2015 | lemma natceiling_eq: "real n < x ==> x <= real n + 1 ==> natceiling x = n + 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2016 | by linarith | 
| 51523 | 2017 | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2018 | lemma natceiling_add [simp]: "0 <= x ==> natceiling (x + real a) = natceiling x + a" | 
| 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2019 | by linarith | 
| 51523 | 2020 | |
| 2021 | lemma natceiling_add_numeral [simp]: | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2022 | "0 <= x ==> natceiling (x + numeral n) = natceiling x + numeral n" | 
| 51523 | 2023 | by (simp add: natceiling_add [symmetric]) | 
| 2024 | ||
| 2025 | lemma natceiling_add_one: "0 <= x ==> natceiling(x + 1) = natceiling x + 1" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2026 | by linarith | 
| 51523 | 2027 | |
| 2028 | lemma natceiling_subtract [simp]: "natceiling(x - real a) = natceiling x - a" | |
| 58040 
9a867afaab5a
better linarith support for floor, ceiling, natfloor, and natceiling
 hoelzl parents: 
57514diff
changeset | 2029 | by linarith | 
| 51523 | 2030 | |
| 57447 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 2031 | lemma Rats_no_top_le: "\<exists> q \<in> \<rat>. (x :: real) \<le> q" | 
| 57275 
0ddb5b755cdc
moved lemmas from the proof of the Central Limit Theorem by Jeremy Avigad and Luke Serafin
 hoelzl parents: 
56889diff
changeset | 2032 | by (auto intro!: bexI[of _ "of_nat (natceiling x)"]) (metis real_natceiling_ge real_of_nat_def) | 
| 
0ddb5b755cdc
moved lemmas from the proof of the Central Limit Theorem by Jeremy Avigad and Luke Serafin
 hoelzl parents: 
56889diff
changeset | 2033 | |
| 57447 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 2034 | lemma Rats_no_bot_less: "\<exists> q \<in> \<rat>. q < (x :: real)" | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 2035 | apply (auto intro!: bexI[of _ "of_int (floor x - 1)"]) | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 2036 | apply (rule less_le_trans[OF _ of_int_floor_le]) | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 2037 | apply simp | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 2038 | done | 
| 
87429bdecad5
import more stuff from the CLT proof; base the lborel measure on interval_measure; remove lebesgue measure
 hoelzl parents: 
57275diff
changeset | 2039 | |
| 51523 | 2040 | subsection {* Exponentiation with floor *}
 | 
| 2041 | ||
| 2042 | lemma floor_power: | |
| 2043 | assumes "x = real (floor x)" | |
| 2044 | shows "floor (x ^ n) = floor x ^ n" | |
| 2045 | proof - | |
| 2046 | have *: "x ^ n = real (floor x ^ n)" | |
| 2047 | using assms by (induct n arbitrary: x) simp_all | |
| 2048 | show ?thesis unfolding real_of_int_inject[symmetric] | |
| 2049 | unfolding * floor_real_of_int .. | |
| 2050 | qed | |
| 2051 | ||
| 2052 | lemma natfloor_power: | |
| 2053 | assumes "x = real (natfloor x)" | |
| 2054 | shows "natfloor (x ^ n) = natfloor x ^ n" | |
| 2055 | proof - | |
| 2056 | from assms have "0 \<le> floor x" by auto | |
| 2057 | note assms[unfolded natfloor_def real_nat_eq_real[OF `0 \<le> floor x`]] | |
| 2058 | from floor_power[OF this] | |
| 2059 | show ?thesis unfolding natfloor_def nat_power_eq[OF `0 \<le> floor x`, symmetric] | |
| 2060 | by simp | |
| 2061 | qed | |
| 2062 | ||
| 58983 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 2063 | lemma floor_numeral_power[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 2064 | "\<lfloor>numeral x ^ n\<rfloor> = numeral x ^ n" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 2065 | by (metis floor_of_int of_int_numeral of_int_power) | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 2066 | |
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 2067 | lemma ceiling_numeral_power[simp]: | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 2068 | "\<lceil>numeral x ^ n\<rceil> = numeral x ^ n" | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 2069 | by (metis ceiling_of_int of_int_numeral of_int_power) | 
| 
9c390032e4eb
cancel real of power of numeral also for equality and strict inequality;
 immler parents: 
58889diff
changeset | 2070 | |
| 51523 | 2071 | |
| 2072 | subsection {* Implementation of rational real numbers *}
 | |
| 2073 | ||
| 2074 | text {* Formal constructor *}
 | |
| 2075 | ||
| 2076 | definition Ratreal :: "rat \<Rightarrow> real" where | |
| 2077 | [code_abbrev, simp]: "Ratreal = of_rat" | |
| 2078 | ||
| 2079 | code_datatype Ratreal | |
| 2080 | ||
| 2081 | ||
| 2082 | text {* Numerals *}
 | |
| 2083 | ||
| 2084 | lemma [code_abbrev]: | |
| 2085 | "(of_rat (of_int a) :: real) = of_int a" | |
| 2086 | by simp | |
| 2087 | ||
| 2088 | lemma [code_abbrev]: | |
| 2089 | "(of_rat 0 :: real) = 0" | |
| 2090 | by simp | |
| 2091 | ||
| 2092 | lemma [code_abbrev]: | |
| 2093 | "(of_rat 1 :: real) = 1" | |
| 2094 | by simp | |
| 2095 | ||
| 2096 | lemma [code_abbrev]: | |
| 58134 
b563ec62d04e
more convenient printing of real numbers after evaluation
 haftmann parents: 
58097diff
changeset | 2097 | "(of_rat (- 1) :: real) = - 1" | 
| 
b563ec62d04e
more convenient printing of real numbers after evaluation
 haftmann parents: 
58097diff
changeset | 2098 | by simp | 
| 
b563ec62d04e
more convenient printing of real numbers after evaluation
 haftmann parents: 
58097diff
changeset | 2099 | |
| 
b563ec62d04e
more convenient printing of real numbers after evaluation
 haftmann parents: 
58097diff
changeset | 2100 | lemma [code_abbrev]: | 
| 51523 | 2101 | "(of_rat (numeral k) :: real) = numeral k" | 
| 2102 | by simp | |
| 2103 | ||
| 2104 | lemma [code_abbrev]: | |
| 54489 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 haftmann parents: 
54281diff
changeset | 2105 | "(of_rat (- numeral k) :: real) = - numeral k" | 
| 51523 | 2106 | by simp | 
| 2107 | ||
| 2108 | lemma [code_post]: | |
| 2109 | "(of_rat (1 / numeral k) :: real) = 1 / numeral k" | |
| 58134 
b563ec62d04e
more convenient printing of real numbers after evaluation
 haftmann parents: 
58097diff
changeset | 2110 | "(of_rat (numeral k / numeral l) :: real) = numeral k / numeral l" | 
| 
b563ec62d04e
more convenient printing of real numbers after evaluation
 haftmann parents: 
58097diff
changeset | 2111 | "(of_rat (- (1 / numeral k)) :: real) = - (1 / numeral k)" | 
| 
b563ec62d04e
more convenient printing of real numbers after evaluation
 haftmann parents: 
58097diff
changeset | 2112 | "(of_rat (- (numeral k / numeral l)) :: real) = - (numeral k / numeral l)" | 
| 54489 
03ff4d1e6784
eliminiated neg_numeral in favour of - (numeral _)
 haftmann parents: 
54281diff
changeset | 2113 | by (simp_all add: of_rat_divide of_rat_minus) | 
| 51523 | 2114 | |
| 2115 | ||
| 2116 | text {* Operations *}
 | |
| 2117 | ||
| 2118 | lemma zero_real_code [code]: | |
| 2119 | "0 = Ratreal 0" | |
| 2120 | by simp | |
| 2121 | ||
| 2122 | lemma one_real_code [code]: | |
| 2123 | "1 = Ratreal 1" | |
| 2124 | by simp | |
| 2125 | ||
| 2126 | instantiation real :: equal | |
| 2127 | begin | |
| 2128 | ||
| 2129 | definition "HOL.equal (x\<Colon>real) y \<longleftrightarrow> x - y = 0" | |
| 2130 | ||
| 2131 | instance proof | |
| 2132 | qed (simp add: equal_real_def) | |
| 2133 | ||
| 2134 | lemma real_equal_code [code]: | |
| 2135 | "HOL.equal (Ratreal x) (Ratreal y) \<longleftrightarrow> HOL.equal x y" | |
| 2136 | by (simp add: equal_real_def equal) | |
| 2137 | ||
| 2138 | lemma [code nbe]: | |
| 2139 | "HOL.equal (x::real) x \<longleftrightarrow> True" | |
| 2140 | by (rule equal_refl) | |
| 2141 | ||
| 2142 | end | |
| 2143 | ||
| 2144 | lemma real_less_eq_code [code]: "Ratreal x \<le> Ratreal y \<longleftrightarrow> x \<le> y" | |
| 2145 | by (simp add: of_rat_less_eq) | |
| 2146 | ||
| 2147 | lemma real_less_code [code]: "Ratreal x < Ratreal y \<longleftrightarrow> x < y" | |
| 2148 | by (simp add: of_rat_less) | |
| 2149 | ||
| 2150 | lemma real_plus_code [code]: "Ratreal x + Ratreal y = Ratreal (x + y)" | |
| 2151 | by (simp add: of_rat_add) | |
| 2152 | ||
| 2153 | lemma real_times_code [code]: "Ratreal x * Ratreal y = Ratreal (x * y)" | |
| 2154 | by (simp add: of_rat_mult) | |
| 2155 | ||
| 2156 | lemma real_uminus_code [code]: "- Ratreal x = Ratreal (- x)" | |
| 2157 | by (simp add: of_rat_minus) | |
| 2158 | ||
| 2159 | lemma real_minus_code [code]: "Ratreal x - Ratreal y = Ratreal (x - y)" | |
| 2160 | by (simp add: of_rat_diff) | |
| 2161 | ||
| 2162 | lemma real_inverse_code [code]: "inverse (Ratreal x) = Ratreal (inverse x)" | |
| 2163 | by (simp add: of_rat_inverse) | |
| 2164 | ||
| 2165 | lemma real_divide_code [code]: "Ratreal x / Ratreal y = Ratreal (x / y)" | |
| 2166 | by (simp add: of_rat_divide) | |
| 2167 | ||
| 2168 | lemma real_floor_code [code]: "floor (Ratreal x) = floor x" | |
| 2169 | by (metis Ratreal_def floor_le_iff floor_unique le_floor_iff of_int_floor_le of_rat_of_int_eq real_less_eq_code) | |
| 2170 | ||
| 2171 | ||
| 2172 | text {* Quickcheck *}
 | |
| 2173 | ||
| 2174 | definition (in term_syntax) | |
| 2175 | valterm_ratreal :: "rat \<times> (unit \<Rightarrow> Code_Evaluation.term) \<Rightarrow> real \<times> (unit \<Rightarrow> Code_Evaluation.term)" where | |
| 2176 |   [code_unfold]: "valterm_ratreal k = Code_Evaluation.valtermify Ratreal {\<cdot>} k"
 | |
| 2177 | ||
| 2178 | notation fcomp (infixl "\<circ>>" 60) | |
| 2179 | notation scomp (infixl "\<circ>\<rightarrow>" 60) | |
| 2180 | ||
| 2181 | instantiation real :: random | |
| 2182 | begin | |
| 2183 | ||
| 2184 | definition | |
| 2185 | "Quickcheck_Random.random i = Quickcheck_Random.random i \<circ>\<rightarrow> (\<lambda>r. Pair (valterm_ratreal r))" | |
| 2186 | ||
| 2187 | instance .. | |
| 2188 | ||
| 2189 | end | |
| 2190 | ||
| 2191 | no_notation fcomp (infixl "\<circ>>" 60) | |
| 2192 | no_notation scomp (infixl "\<circ>\<rightarrow>" 60) | |
| 2193 | ||
| 2194 | instantiation real :: exhaustive | |
| 2195 | begin | |
| 2196 | ||
| 2197 | definition | |
| 2198 | "exhaustive_real f d = Quickcheck_Exhaustive.exhaustive (%r. f (Ratreal r)) d" | |
| 2199 | ||
| 2200 | instance .. | |
| 2201 | ||
| 2202 | end | |
| 2203 | ||
| 2204 | instantiation real :: full_exhaustive | |
| 2205 | begin | |
| 2206 | ||
| 2207 | definition | |
| 2208 | "full_exhaustive_real f d = Quickcheck_Exhaustive.full_exhaustive (%r. f (valterm_ratreal r)) d" | |
| 2209 | ||
| 2210 | instance .. | |
| 2211 | ||
| 2212 | end | |
| 2213 | ||
| 2214 | instantiation real :: narrowing | |
| 2215 | begin | |
| 2216 | ||
| 2217 | definition | |
| 2218 | "narrowing = Quickcheck_Narrowing.apply (Quickcheck_Narrowing.cons Ratreal) narrowing" | |
| 2219 | ||
| 2220 | instance .. | |
| 2221 | ||
| 2222 | end | |
| 2223 | ||
| 2224 | ||
| 2225 | subsection {* Setup for Nitpick *}
 | |
| 2226 | ||
| 2227 | declaration {*
 | |
| 2228 |   Nitpick_HOL.register_frac_type @{type_name real}
 | |
| 2229 |    [(@{const_name zero_real_inst.zero_real}, @{const_name Nitpick.zero_frac}),
 | |
| 2230 |     (@{const_name one_real_inst.one_real}, @{const_name Nitpick.one_frac}),
 | |
| 2231 |     (@{const_name plus_real_inst.plus_real}, @{const_name Nitpick.plus_frac}),
 | |
| 2232 |     (@{const_name times_real_inst.times_real}, @{const_name Nitpick.times_frac}),
 | |
| 2233 |     (@{const_name uminus_real_inst.uminus_real}, @{const_name Nitpick.uminus_frac}),
 | |
| 2234 |     (@{const_name inverse_real_inst.inverse_real}, @{const_name Nitpick.inverse_frac}),
 | |
| 2235 |     (@{const_name ord_real_inst.less_real}, @{const_name Nitpick.less_frac}),
 | |
| 2236 |     (@{const_name ord_real_inst.less_eq_real}, @{const_name Nitpick.less_eq_frac})]
 | |
| 2237 | *} | |
| 2238 | ||
| 2239 | lemmas [nitpick_unfold] = inverse_real_inst.inverse_real one_real_inst.one_real | |
| 2240 | ord_real_inst.less_real ord_real_inst.less_eq_real plus_real_inst.plus_real | |
| 2241 | times_real_inst.times_real uminus_real_inst.uminus_real | |
| 2242 | zero_real_inst.zero_real | |
| 2243 | ||
| 56078 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2244 | |
| 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2245 | subsection {* Setup for SMT *}
 | 
| 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2246 | |
| 58061 | 2247 | ML_file "Tools/SMT/smt_real.ML" | 
| 2248 | ML_file "Tools/SMT/z3_real.ML" | |
| 56078 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2249 | |
| 58061 | 2250 | lemma [z3_rule]: | 
| 56078 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2251 | "0 + (x::real) = x" | 
| 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2252 | "x + 0 = x" | 
| 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2253 | "0 * x = 0" | 
| 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2254 | "1 * x = x" | 
| 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2255 | "x + y = y + x" | 
| 
624faeda77b5
moved 'SMT2' (SMT-LIB-2-based SMT module) into Isabelle
 blanchet parents: 
55945diff
changeset | 2256 | by auto | 
| 51523 | 2257 | |
| 2258 | end |