| author | nipkow | 
| Tue, 20 Oct 2009 14:44:02 +0200 | |
| changeset 33019 | bcf56a64ce1a | 
| parent 32069 | 6d28bbd33e2c | 
| child 33296 | a3924d1069e5 | 
| permissions | -rw-r--r-- | 
| 30925 | 1 | (* Title: HOL/Nat_Numeral.thy | 
| 23164 | 2 | Author: Lawrence C Paulson, Cambridge University Computer Laboratory | 
| 3 | Copyright 1999 University of Cambridge | |
| 4 | *) | |
| 5 | ||
| 30925 | 6 | header {* Binary numerals for the natural numbers *}
 | 
| 23164 | 7 | |
| 30925 | 8 | theory Nat_Numeral | 
| 23164 | 9 | imports IntDiv | 
| 31068 
f591144b0f17
modules numeral_simprocs, nat_numeral_simprocs; proper structures for numeral simprocs
 haftmann parents: 
31034diff
changeset | 10 | uses ("Tools/nat_numeral_simprocs.ML")
 | 
| 23164 | 11 | begin | 
| 12 | ||
| 31014 | 13 | subsection {* Numerals for natural numbers *}
 | 
| 14 | ||
| 23164 | 15 | text {*
 | 
| 16 | Arithmetic for naturals is reduced to that for the non-negative integers. | |
| 17 | *} | |
| 18 | ||
| 25571 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 19 | instantiation nat :: number | 
| 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 20 | begin | 
| 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 21 | |
| 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 22 | definition | 
| 32069 
6d28bbd33e2c
prefer code_inline over code_unfold; use code_unfold_post where appropriate
 haftmann parents: 
31998diff
changeset | 23 | nat_number_of_def [code_unfold, code del]: "number_of v = nat (number_of v)" | 
| 25571 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 24 | |
| 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 25 | instance .. | 
| 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 26 | |
| 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 27 | end | 
| 23164 | 28 | |
| 31998 
2c7a24f74db9
code attributes use common underscore convention
 haftmann parents: 
31790diff
changeset | 29 | lemma [code_post]: | 
| 25965 | 30 | "nat (number_of v) = number_of v" | 
| 31 | unfolding nat_number_of_def .. | |
| 32 | ||
| 31014 | 33 | |
| 34 | subsection {* Special case: squares and cubes *}
 | |
| 35 | ||
| 36 | lemma numeral_2_eq_2: "2 = Suc (Suc 0)" | |
| 37 | by (simp add: nat_number_of_def) | |
| 38 | ||
| 39 | lemma numeral_3_eq_3: "3 = Suc (Suc (Suc 0))" | |
| 40 | by (simp add: nat_number_of_def) | |
| 41 | ||
| 42 | context power | |
| 30960 | 43 | begin | 
| 44 | ||
| 23164 | 45 | abbreviation (xsymbols) | 
| 30960 | 46 |   power2 :: "'a \<Rightarrow> 'a"  ("(_\<twosuperior>)" [1000] 999) where
 | 
| 47 | "x\<twosuperior> \<equiv> x ^ 2" | |
| 23164 | 48 | |
| 49 | notation (latex output) | |
| 29401 
94fd5dd918f5
rename abbreviation square -> power2, to match theorem names
 huffman parents: 
29045diff
changeset | 50 |   power2  ("(_\<twosuperior>)" [1000] 999)
 | 
| 23164 | 51 | |
| 52 | notation (HTML output) | |
| 29401 
94fd5dd918f5
rename abbreviation square -> power2, to match theorem names
 huffman parents: 
29045diff
changeset | 53 |   power2  ("(_\<twosuperior>)" [1000] 999)
 | 
| 23164 | 54 | |
| 30960 | 55 | end | 
| 56 | ||
| 31014 | 57 | context monoid_mult | 
| 58 | begin | |
| 59 | ||
| 60 | lemma power2_eq_square: "a\<twosuperior> = a * a" | |
| 61 | by (simp add: numeral_2_eq_2) | |
| 62 | ||
| 63 | lemma power3_eq_cube: "a ^ 3 = a * a * a" | |
| 64 | by (simp add: numeral_3_eq_3 mult_assoc) | |
| 65 | ||
| 66 | lemma power_even_eq: | |
| 67 | "a ^ (2*n) = (a ^ n) ^ 2" | |
| 68 | by (subst OrderedGroup.mult_commute) (simp add: power_mult) | |
| 69 | ||
| 70 | lemma power_odd_eq: | |
| 71 | "a ^ Suc (2*n) = a * (a ^ n) ^ 2" | |
| 72 | by (simp add: power_even_eq) | |
| 73 | ||
| 74 | end | |
| 75 | ||
| 76 | context semiring_1 | |
| 77 | begin | |
| 78 | ||
| 79 | lemma zero_power2 [simp]: "0\<twosuperior> = 0" | |
| 80 | by (simp add: power2_eq_square) | |
| 81 | ||
| 82 | lemma one_power2 [simp]: "1\<twosuperior> = 1" | |
| 83 | by (simp add: power2_eq_square) | |
| 84 | ||
| 85 | end | |
| 86 | ||
| 87 | context comm_ring_1 | |
| 88 | begin | |
| 89 | ||
| 90 | lemma power2_minus [simp]: | |
| 91 | "(- a)\<twosuperior> = a\<twosuperior>" | |
| 92 | by (simp add: power2_eq_square) | |
| 93 | ||
| 94 | text{*
 | |
| 95 |   We cannot prove general results about the numeral @{term "-1"},
 | |
| 96 |   so we have to use @{term "- 1"} instead.
 | |
| 97 | *} | |
| 98 | ||
| 99 | lemma power_minus1_even [simp]: | |
| 100 | "(- 1) ^ (2*n) = 1" | |
| 101 | proof (induct n) | |
| 102 | case 0 show ?case by simp | |
| 103 | next | |
| 104 | case (Suc n) then show ?case by (simp add: power_add) | |
| 105 | qed | |
| 106 | ||
| 107 | lemma power_minus1_odd: | |
| 108 | "(- 1) ^ Suc (2*n) = - 1" | |
| 109 | by simp | |
| 110 | ||
| 111 | lemma power_minus_even [simp]: | |
| 112 | "(-a) ^ (2*n) = a ^ (2*n)" | |
| 113 | by (simp add: power_minus [of a]) | |
| 114 | ||
| 115 | end | |
| 116 | ||
| 117 | context ordered_ring_strict | |
| 118 | begin | |
| 119 | ||
| 120 | lemma sum_squares_ge_zero: | |
| 121 | "0 \<le> x * x + y * y" | |
| 122 | by (intro add_nonneg_nonneg zero_le_square) | |
| 123 | ||
| 124 | lemma not_sum_squares_lt_zero: | |
| 125 | "\<not> x * x + y * y < 0" | |
| 126 | by (simp add: not_less sum_squares_ge_zero) | |
| 127 | ||
| 128 | lemma sum_squares_eq_zero_iff: | |
| 129 | "x * x + y * y = 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 31034 | 130 | by (simp add: add_nonneg_eq_0_iff) | 
| 31014 | 131 | |
| 132 | lemma sum_squares_le_zero_iff: | |
| 133 | "x * x + y * y \<le> 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 134 | by (simp add: le_less not_sum_squares_lt_zero sum_squares_eq_zero_iff) | |
| 135 | ||
| 136 | lemma sum_squares_gt_zero_iff: | |
| 137 | "0 < x * x + y * y \<longleftrightarrow> x \<noteq> 0 \<or> y \<noteq> 0" | |
| 138 | proof - | |
| 139 | have "x * x + y * y \<noteq> 0 \<longleftrightarrow> x \<noteq> 0 \<or> y \<noteq> 0" | |
| 140 | by (simp add: sum_squares_eq_zero_iff) | |
| 141 | then have "0 \<noteq> x * x + y * y \<longleftrightarrow> x \<noteq> 0 \<or> y \<noteq> 0" | |
| 142 | by auto | |
| 143 | then show ?thesis | |
| 144 | by (simp add: less_le sum_squares_ge_zero) | |
| 145 | qed | |
| 146 | ||
| 147 | end | |
| 148 | ||
| 149 | context ordered_semidom | |
| 150 | begin | |
| 151 | ||
| 152 | lemma power2_le_imp_le: | |
| 153 | "x\<twosuperior> \<le> y\<twosuperior> \<Longrightarrow> 0 \<le> y \<Longrightarrow> x \<le> y" | |
| 154 | unfolding numeral_2_eq_2 by (rule power_le_imp_le_base) | |
| 155 | ||
| 156 | lemma power2_less_imp_less: | |
| 157 | "x\<twosuperior> < y\<twosuperior> \<Longrightarrow> 0 \<le> y \<Longrightarrow> x < y" | |
| 158 | by (rule power_less_imp_less_base) | |
| 159 | ||
| 160 | lemma power2_eq_imp_eq: | |
| 161 | "x\<twosuperior> = y\<twosuperior> \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> x = y" | |
| 162 | unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base) simp | |
| 163 | ||
| 164 | end | |
| 165 | ||
| 166 | context ordered_idom | |
| 167 | begin | |
| 168 | ||
| 169 | lemma zero_eq_power2 [simp]: | |
| 170 | "a\<twosuperior> = 0 \<longleftrightarrow> a = 0" | |
| 171 | by (force simp add: power2_eq_square) | |
| 172 | ||
| 173 | lemma zero_le_power2 [simp]: | |
| 174 | "0 \<le> a\<twosuperior>" | |
| 175 | by (simp add: power2_eq_square) | |
| 176 | ||
| 177 | lemma zero_less_power2 [simp]: | |
| 178 | "0 < a\<twosuperior> \<longleftrightarrow> a \<noteq> 0" | |
| 179 | by (force simp add: power2_eq_square zero_less_mult_iff linorder_neq_iff) | |
| 180 | ||
| 181 | lemma power2_less_0 [simp]: | |
| 182 | "\<not> a\<twosuperior> < 0" | |
| 183 | by (force simp add: power2_eq_square mult_less_0_iff) | |
| 184 | ||
| 185 | lemma abs_power2 [simp]: | |
| 186 | "abs (a\<twosuperior>) = a\<twosuperior>" | |
| 187 | by (simp add: power2_eq_square abs_mult abs_mult_self) | |
| 188 | ||
| 189 | lemma power2_abs [simp]: | |
| 190 | "(abs a)\<twosuperior> = a\<twosuperior>" | |
| 191 | by (simp add: power2_eq_square abs_mult_self) | |
| 192 | ||
| 193 | lemma odd_power_less_zero: | |
| 194 | "a < 0 \<Longrightarrow> a ^ Suc (2*n) < 0" | |
| 195 | proof (induct n) | |
| 196 | case 0 | |
| 197 | then show ?case by simp | |
| 198 | next | |
| 199 | case (Suc n) | |
| 200 | have "a ^ Suc (2 * Suc n) = (a*a) * a ^ Suc(2*n)" | |
| 201 | by (simp add: mult_ac power_add power2_eq_square) | |
| 202 | thus ?case | |
| 203 | by (simp del: power_Suc add: Suc mult_less_0_iff mult_neg_neg) | |
| 204 | qed | |
| 205 | ||
| 206 | lemma odd_0_le_power_imp_0_le: | |
| 207 | "0 \<le> a ^ Suc (2*n) \<Longrightarrow> 0 \<le> a" | |
| 208 | using odd_power_less_zero [of a n] | |
| 209 | by (force simp add: linorder_not_less [symmetric]) | |
| 210 | ||
| 211 | lemma zero_le_even_power'[simp]: | |
| 212 | "0 \<le> a ^ (2*n)" | |
| 213 | proof (induct n) | |
| 214 | case 0 | |
| 215 | show ?case by (simp add: zero_le_one) | |
| 216 | next | |
| 217 | case (Suc n) | |
| 218 | have "a ^ (2 * Suc n) = (a*a) * a ^ (2*n)" | |
| 219 | by (simp add: mult_ac power_add power2_eq_square) | |
| 220 | thus ?case | |
| 221 | by (simp add: Suc zero_le_mult_iff) | |
| 222 | qed | |
| 223 | ||
| 224 | lemma sum_power2_ge_zero: | |
| 225 | "0 \<le> x\<twosuperior> + y\<twosuperior>" | |
| 226 | unfolding power2_eq_square by (rule sum_squares_ge_zero) | |
| 227 | ||
| 228 | lemma not_sum_power2_lt_zero: | |
| 229 | "\<not> x\<twosuperior> + y\<twosuperior> < 0" | |
| 230 | unfolding power2_eq_square by (rule not_sum_squares_lt_zero) | |
| 231 | ||
| 232 | lemma sum_power2_eq_zero_iff: | |
| 233 | "x\<twosuperior> + y\<twosuperior> = 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 234 | unfolding power2_eq_square by (rule sum_squares_eq_zero_iff) | |
| 235 | ||
| 236 | lemma sum_power2_le_zero_iff: | |
| 237 | "x\<twosuperior> + y\<twosuperior> \<le> 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 238 | unfolding power2_eq_square by (rule sum_squares_le_zero_iff) | |
| 239 | ||
| 240 | lemma sum_power2_gt_zero_iff: | |
| 241 | "0 < x\<twosuperior> + y\<twosuperior> \<longleftrightarrow> x \<noteq> 0 \<or> y \<noteq> 0" | |
| 242 | unfolding power2_eq_square by (rule sum_squares_gt_zero_iff) | |
| 243 | ||
| 244 | end | |
| 245 | ||
| 246 | lemma power2_sum: | |
| 247 | fixes x y :: "'a::number_ring" | |
| 248 | shows "(x + y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> + 2 * x * y" | |
| 249 | by (simp add: ring_distribs power2_eq_square) | |
| 250 | ||
| 251 | lemma power2_diff: | |
| 252 | fixes x y :: "'a::number_ring" | |
| 253 | shows "(x - y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> - 2 * x * y" | |
| 254 | by (simp add: ring_distribs power2_eq_square) | |
| 255 | ||
| 23164 | 256 | |
| 29040 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 257 | subsection {* Predicate for negative binary numbers *}
 | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 258 | |
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 259 | definition neg :: "int \<Rightarrow> bool" where | 
| 29040 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 260 | "neg Z \<longleftrightarrow> Z < 0" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 261 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 262 | lemma not_neg_int [simp]: "~ neg (of_nat n)" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 263 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 264 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 265 | lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 266 | by (simp add: neg_def neg_less_0_iff_less del: of_nat_Suc) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 267 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 268 | lemmas neg_eq_less_0 = neg_def | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 269 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 270 | lemma not_neg_eq_ge_0: "(~neg x) = (0 \<le> x)" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 271 | by (simp add: neg_def linorder_not_less) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 272 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 273 | text{*To simplify inequalities when Numeral1 can get simplified to 1*}
 | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 274 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 275 | lemma not_neg_0: "~ neg 0" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 276 | by (simp add: One_int_def neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 277 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 278 | lemma not_neg_1: "~ neg 1" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 279 | by (simp add: neg_def linorder_not_less zero_le_one) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 280 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 281 | lemma neg_nat: "neg z ==> nat z = 0" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 282 | by (simp add: neg_def order_less_imp_le) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 283 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 284 | lemma not_neg_nat: "~ neg z ==> of_nat (nat z) = z" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 285 | by (simp add: linorder_not_less neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 286 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 287 | text {*
 | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 288 |   If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
 | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 289 |   @{term Numeral0} IS @{term "number_of Pls"}
 | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 290 | *} | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 291 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 292 | lemma not_neg_number_of_Pls: "~ neg (number_of Int.Pls)" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 293 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 294 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 295 | lemma neg_number_of_Min: "neg (number_of Int.Min)" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 296 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 297 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 298 | lemma neg_number_of_Bit0: | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 299 | "neg (number_of (Int.Bit0 w)) = neg (number_of w)" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 300 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 301 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 302 | lemma neg_number_of_Bit1: | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 303 | "neg (number_of (Int.Bit1 w)) = neg (number_of w)" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 304 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 305 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 306 | lemmas neg_simps [simp] = | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 307 | not_neg_0 not_neg_1 | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 308 | not_neg_number_of_Pls neg_number_of_Min | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 309 | neg_number_of_Bit0 neg_number_of_Bit1 | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 310 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 311 | |
| 23164 | 312 | subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
 | 
| 313 | ||
| 314 | declare nat_0 [simp] nat_1 [simp] | |
| 315 | ||
| 316 | lemma nat_number_of [simp]: "nat (number_of w) = number_of w" | |
| 317 | by (simp add: nat_number_of_def) | |
| 318 | ||
| 31998 
2c7a24f74db9
code attributes use common underscore convention
 haftmann parents: 
31790diff
changeset | 319 | lemma nat_numeral_0_eq_0 [simp, code_post]: "Numeral0 = (0::nat)" | 
| 23164 | 320 | by (simp add: nat_number_of_def) | 
| 321 | ||
| 322 | lemma nat_numeral_1_eq_1 [simp]: "Numeral1 = (1::nat)" | |
| 323 | by (simp add: nat_1 nat_number_of_def) | |
| 324 | ||
| 31998 
2c7a24f74db9
code attributes use common underscore convention
 haftmann parents: 
31790diff
changeset | 325 | lemma numeral_1_eq_Suc_0 [code_post]: "Numeral1 = Suc 0" | 
| 23164 | 326 | by (simp add: nat_numeral_1_eq_1) | 
| 327 | ||
| 328 | ||
| 329 | subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
 | |
| 330 | ||
| 331 | lemma int_nat_number_of [simp]: | |
| 23365 | 332 | "int (number_of v) = | 
| 23307 
2fe3345035c7
modify proofs to avoid referring to int::nat=>int
 huffman parents: 
23294diff
changeset | 333 | (if neg (number_of v :: int) then 0 | 
| 
2fe3345035c7
modify proofs to avoid referring to int::nat=>int
 huffman parents: 
23294diff
changeset | 334 | else (number_of v :: int))" | 
| 28984 | 335 | unfolding nat_number_of_def number_of_is_id neg_def | 
| 336 | by simp | |
| 23307 
2fe3345035c7
modify proofs to avoid referring to int::nat=>int
 huffman parents: 
23294diff
changeset | 337 | |
| 23164 | 338 | |
| 339 | subsubsection{*Successor *}
 | |
| 340 | ||
| 341 | lemma Suc_nat_eq_nat_zadd1: "(0::int) <= z ==> Suc (nat z) = nat (1 + z)" | |
| 342 | apply (rule sym) | |
| 343 | apply (simp add: nat_eq_iff int_Suc) | |
| 344 | done | |
| 345 | ||
| 346 | lemma Suc_nat_number_of_add: | |
| 347 | "Suc (number_of v + n) = | |
| 28984 | 348 | (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)" | 
| 349 | unfolding nat_number_of_def number_of_is_id neg_def numeral_simps | |
| 350 | by (simp add: Suc_nat_eq_nat_zadd1 add_ac) | |
| 23164 | 351 | |
| 352 | lemma Suc_nat_number_of [simp]: | |
| 353 | "Suc (number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 354 | (if neg (number_of v :: int) then 1 else number_of (Int.succ v))" | 
| 23164 | 355 | apply (cut_tac n = 0 in Suc_nat_number_of_add) | 
| 356 | apply (simp cong del: if_weak_cong) | |
| 357 | done | |
| 358 | ||
| 359 | ||
| 360 | subsubsection{*Addition *}
 | |
| 361 | ||
| 362 | lemma add_nat_number_of [simp]: | |
| 363 | "(number_of v :: nat) + number_of v' = | |
| 29012 | 364 | (if v < Int.Pls then number_of v' | 
| 365 | else if v' < Int.Pls then number_of v | |
| 23164 | 366 | else number_of (v + v'))" | 
| 29012 | 367 | unfolding nat_number_of_def number_of_is_id numeral_simps | 
| 28984 | 368 | by (simp add: nat_add_distrib) | 
| 23164 | 369 | |
| 30081 | 370 | lemma nat_number_of_add_1 [simp]: | 
| 371 | "number_of v + (1::nat) = | |
| 372 | (if v < Int.Pls then 1 else number_of (Int.succ v))" | |
| 373 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 374 | by (simp add: nat_add_distrib) | |
| 375 | ||
| 376 | lemma nat_1_add_number_of [simp]: | |
| 377 | "(1::nat) + number_of v = | |
| 378 | (if v < Int.Pls then 1 else number_of (Int.succ v))" | |
| 379 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 380 | by (simp add: nat_add_distrib) | |
| 381 | ||
| 382 | lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)" | |
| 383 | by (rule int_int_eq [THEN iffD1]) simp | |
| 384 | ||
| 23164 | 385 | |
| 386 | subsubsection{*Subtraction *}
 | |
| 387 | ||
| 388 | lemma diff_nat_eq_if: | |
| 389 | "nat z - nat z' = | |
| 390 | (if neg z' then nat z | |
| 391 | else let d = z-z' in | |
| 392 | if neg d then 0 else nat d)" | |
| 27651 
16a26996c30e
moved op dvd to theory Ring_and_Field; generalized a couple of lemmas
 haftmann parents: 
26342diff
changeset | 393 | by (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0) | 
| 
16a26996c30e
moved op dvd to theory Ring_and_Field; generalized a couple of lemmas
 haftmann parents: 
26342diff
changeset | 394 | |
| 23164 | 395 | |
| 396 | lemma diff_nat_number_of [simp]: | |
| 397 | "(number_of v :: nat) - number_of v' = | |
| 29012 | 398 | (if v' < Int.Pls then number_of v | 
| 23164 | 399 | else let d = number_of (v + uminus v') in | 
| 400 | if neg d then 0 else nat d)" | |
| 29012 | 401 | unfolding nat_number_of_def number_of_is_id numeral_simps neg_def | 
| 402 | by auto | |
| 23164 | 403 | |
| 30081 | 404 | lemma nat_number_of_diff_1 [simp]: | 
| 405 | "number_of v - (1::nat) = | |
| 406 | (if v \<le> Int.Pls then 0 else number_of (Int.pred v))" | |
| 407 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 408 | by auto | |
| 409 | ||
| 23164 | 410 | |
| 411 | subsubsection{*Multiplication *}
 | |
| 412 | ||
| 413 | lemma mult_nat_number_of [simp]: | |
| 414 | "(number_of v :: nat) * number_of v' = | |
| 29012 | 415 | (if v < Int.Pls then 0 else number_of (v * v'))" | 
| 416 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 28984 | 417 | by (simp add: nat_mult_distrib) | 
| 23164 | 418 | |
| 419 | ||
| 420 | subsubsection{*Quotient *}
 | |
| 421 | ||
| 422 | lemma div_nat_number_of [simp]: | |
| 423 | "(number_of v :: nat) div number_of v' = | |
| 424 | (if neg (number_of v :: int) then 0 | |
| 425 | else nat (number_of v div number_of v'))" | |
| 28984 | 426 | unfolding nat_number_of_def number_of_is_id neg_def | 
| 427 | by (simp add: nat_div_distrib) | |
| 23164 | 428 | |
| 429 | lemma one_div_nat_number_of [simp]: | |
| 27651 
16a26996c30e
moved op dvd to theory Ring_and_Field; generalized a couple of lemmas
 haftmann parents: 
26342diff
changeset | 430 | "Suc 0 div number_of v' = nat (1 div number_of v')" | 
| 23164 | 431 | by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) | 
| 432 | ||
| 433 | ||
| 434 | subsubsection{*Remainder *}
 | |
| 435 | ||
| 436 | lemma mod_nat_number_of [simp]: | |
| 437 | "(number_of v :: nat) mod number_of v' = | |
| 438 | (if neg (number_of v :: int) then 0 | |
| 439 | else if neg (number_of v' :: int) then number_of v | |
| 440 | else nat (number_of v mod number_of v'))" | |
| 28984 | 441 | unfolding nat_number_of_def number_of_is_id neg_def | 
| 442 | by (simp add: nat_mod_distrib) | |
| 23164 | 443 | |
| 444 | lemma one_mod_nat_number_of [simp]: | |
| 27651 
16a26996c30e
moved op dvd to theory Ring_and_Field; generalized a couple of lemmas
 haftmann parents: 
26342diff
changeset | 445 | "Suc 0 mod number_of v' = | 
| 23164 | 446 | (if neg (number_of v' :: int) then Suc 0 | 
| 447 | else nat (1 mod number_of v'))" | |
| 448 | by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) | |
| 449 | ||
| 450 | ||
| 451 | subsubsection{* Divisibility *}
 | |
| 452 | ||
| 453 | lemmas dvd_eq_mod_eq_0_number_of = | |
| 454 | dvd_eq_mod_eq_0 [of "number_of x" "number_of y", standard] | |
| 455 | ||
| 456 | declare dvd_eq_mod_eq_0_number_of [simp] | |
| 457 | ||
| 458 | ||
| 459 | subsection{*Comparisons*}
 | |
| 460 | ||
| 461 | subsubsection{*Equals (=) *}
 | |
| 462 | ||
| 463 | lemma eq_nat_nat_iff: | |
| 464 | "[| (0::int) <= z; 0 <= z' |] ==> (nat z = nat z') = (z=z')" | |
| 465 | by (auto elim!: nonneg_eq_int) | |
| 466 | ||
| 467 | lemma eq_nat_number_of [simp]: | |
| 468 | "((number_of v :: nat) = number_of v') = | |
| 28969 | 469 | (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0 | 
| 470 | else if neg (number_of v' :: int) then (number_of v :: int) = 0 | |
| 471 | else v = v')" | |
| 472 | unfolding nat_number_of_def number_of_is_id neg_def | |
| 473 | by auto | |
| 23164 | 474 | |
| 475 | ||
| 476 | subsubsection{*Less-than (<) *}
 | |
| 477 | ||
| 478 | lemma less_nat_number_of [simp]: | |
| 29011 | 479 | "(number_of v :: nat) < number_of v' \<longleftrightarrow> | 
| 480 | (if v < v' then Int.Pls < v' else False)" | |
| 481 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 28961 | 482 | by auto | 
| 23164 | 483 | |
| 484 | ||
| 29010 | 485 | subsubsection{*Less-than-or-equal *}
 | 
| 486 | ||
| 487 | lemma le_nat_number_of [simp]: | |
| 488 | "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow> | |
| 489 | (if v \<le> v' then True else v \<le> Int.Pls)" | |
| 490 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 491 | by auto | |
| 492 | ||
| 23164 | 493 | (*Maps #n to n for n = 0, 1, 2*) | 
| 494 | lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2 | |
| 495 | ||
| 496 | ||
| 497 | subsection{*Powers with Numeric Exponents*}
 | |
| 498 | ||
| 499 | text{*Squares of literal numerals will be evaluated.*}
 | |
| 31014 | 500 | lemmas power2_eq_square_number_of [simp] = | 
| 23164 | 501 | power2_eq_square [of "number_of w", standard] | 
| 502 | ||
| 503 | ||
| 504 | text{*Simprules for comparisons where common factors can be cancelled.*}
 | |
| 505 | lemmas zero_compare_simps = | |
| 506 | add_strict_increasing add_strict_increasing2 add_increasing | |
| 507 | zero_le_mult_iff zero_le_divide_iff | |
| 508 | zero_less_mult_iff zero_less_divide_iff | |
| 509 | mult_le_0_iff divide_le_0_iff | |
| 510 | mult_less_0_iff divide_less_0_iff | |
| 511 | zero_le_power2 power2_less_0 | |
| 512 | ||
| 513 | subsubsection{*Nat *}
 | |
| 514 | ||
| 515 | lemma Suc_pred': "0 < n ==> n = Suc(n - 1)" | |
| 516 | by (simp add: numerals) | |
| 517 | ||
| 518 | (*Expresses a natural number constant as the Suc of another one. | |
| 519 | NOT suitable for rewriting because n recurs in the condition.*) | |
| 520 | lemmas expand_Suc = Suc_pred' [of "number_of v", standard] | |
| 521 | ||
| 522 | subsubsection{*Arith *}
 | |
| 523 | ||
| 31790 | 524 | lemma Suc_eq_plus1: "Suc n = n + 1" | 
| 23164 | 525 | by (simp add: numerals) | 
| 526 | ||
| 31790 | 527 | lemma Suc_eq_plus1_left: "Suc n = 1 + n" | 
| 23164 | 528 | by (simp add: numerals) | 
| 529 | ||
| 530 | (* These two can be useful when m = number_of... *) | |
| 531 | ||
| 532 | lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))" | |
| 30079 
293b896b9c25
make proofs work whether or not One_nat_def is a simp rule; replace 1 with Suc 0 in the rhs of some simp rules
 huffman parents: 
29958diff
changeset | 533 | unfolding One_nat_def by (cases m) simp_all | 
| 23164 | 534 | |
| 535 | lemma mult_eq_if: "(m::nat) * n = (if m=0 then 0 else n + ((m - 1) * n))" | |
| 30079 
293b896b9c25
make proofs work whether or not One_nat_def is a simp rule; replace 1 with Suc 0 in the rhs of some simp rules
 huffman parents: 
29958diff
changeset | 536 | unfolding One_nat_def by (cases m) simp_all | 
| 23164 | 537 | |
| 538 | lemma power_eq_if: "(p ^ m :: nat) = (if m=0 then 1 else p * (p ^ (m - 1)))" | |
| 30079 
293b896b9c25
make proofs work whether or not One_nat_def is a simp rule; replace 1 with Suc 0 in the rhs of some simp rules
 huffman parents: 
29958diff
changeset | 539 | unfolding One_nat_def by (cases m) simp_all | 
| 23164 | 540 | |
| 541 | ||
| 542 | subsection{*Comparisons involving (0::nat) *}
 | |
| 543 | ||
| 544 | text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
 | |
| 545 | ||
| 546 | lemma eq_number_of_0 [simp]: | |
| 29012 | 547 | "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls" | 
| 548 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 549 | by auto | |
| 23164 | 550 | |
| 551 | lemma eq_0_number_of [simp]: | |
| 29012 | 552 | "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls" | 
| 23164 | 553 | by (rule trans [OF eq_sym_conv eq_number_of_0]) | 
| 554 | ||
| 555 | lemma less_0_number_of [simp]: | |
| 29012 | 556 | "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v" | 
| 557 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 558 | by simp | |
| 23164 | 559 | |
| 560 | lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)" | |
| 28969 | 561 | by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric]) | 
| 23164 | 562 | |
| 563 | ||
| 564 | ||
| 565 | subsection{*Comparisons involving  @{term Suc} *}
 | |
| 566 | ||
| 567 | lemma eq_number_of_Suc [simp]: | |
| 568 | "(number_of v = Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 569 | (let pv = number_of (Int.pred v) in | 
| 23164 | 570 | if neg pv then False else nat pv = n)" | 
| 571 | apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less | |
| 572 | number_of_pred nat_number_of_def | |
| 573 | split add: split_if) | |
| 574 | apply (rule_tac x = "number_of v" in spec) | |
| 575 | apply (auto simp add: nat_eq_iff) | |
| 576 | done | |
| 577 | ||
| 578 | lemma Suc_eq_number_of [simp]: | |
| 579 | "(Suc n = number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 580 | (let pv = number_of (Int.pred v) in | 
| 23164 | 581 | if neg pv then False else nat pv = n)" | 
| 582 | by (rule trans [OF eq_sym_conv eq_number_of_Suc]) | |
| 583 | ||
| 584 | lemma less_number_of_Suc [simp]: | |
| 585 | "(number_of v < Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 586 | (let pv = number_of (Int.pred v) in | 
| 23164 | 587 | if neg pv then True else nat pv < n)" | 
| 588 | apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less | |
| 589 | number_of_pred nat_number_of_def | |
| 590 | split add: split_if) | |
| 591 | apply (rule_tac x = "number_of v" in spec) | |
| 592 | apply (auto simp add: nat_less_iff) | |
| 593 | done | |
| 594 | ||
| 595 | lemma less_Suc_number_of [simp]: | |
| 596 | "(Suc n < number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 597 | (let pv = number_of (Int.pred v) in | 
| 23164 | 598 | if neg pv then False else n < nat pv)" | 
| 599 | apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less | |
| 600 | number_of_pred nat_number_of_def | |
| 601 | split add: split_if) | |
| 602 | apply (rule_tac x = "number_of v" in spec) | |
| 603 | apply (auto simp add: zless_nat_eq_int_zless) | |
| 604 | done | |
| 605 | ||
| 606 | lemma le_number_of_Suc [simp]: | |
| 607 | "(number_of v <= Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 608 | (let pv = number_of (Int.pred v) in | 
| 23164 | 609 | if neg pv then True else nat pv <= n)" | 
| 610 | by (simp add: Let_def less_Suc_number_of linorder_not_less [symmetric]) | |
| 611 | ||
| 612 | lemma le_Suc_number_of [simp]: | |
| 613 | "(Suc n <= number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 614 | (let pv = number_of (Int.pred v) in | 
| 23164 | 615 | if neg pv then False else n <= nat pv)" | 
| 616 | by (simp add: Let_def less_number_of_Suc linorder_not_less [symmetric]) | |
| 617 | ||
| 618 | ||
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 619 | lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min" | 
| 23164 | 620 | by auto | 
| 621 | ||
| 622 | ||
| 623 | ||
| 624 | subsection{*Max and Min Combined with @{term Suc} *}
 | |
| 625 | ||
| 626 | lemma max_number_of_Suc [simp]: | |
| 627 | "max (Suc n) (number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 628 | (let pv = number_of (Int.pred v) in | 
| 23164 | 629 | if neg pv then Suc n else Suc(max n (nat pv)))" | 
| 630 | apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def | |
| 631 | split add: split_if nat.split) | |
| 632 | apply (rule_tac x = "number_of v" in spec) | |
| 633 | apply auto | |
| 634 | done | |
| 635 | ||
| 636 | lemma max_Suc_number_of [simp]: | |
| 637 | "max (number_of v) (Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 638 | (let pv = number_of (Int.pred v) in | 
| 23164 | 639 | if neg pv then Suc n else Suc(max (nat pv) n))" | 
| 640 | apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def | |
| 641 | split add: split_if nat.split) | |
| 642 | apply (rule_tac x = "number_of v" in spec) | |
| 643 | apply auto | |
| 644 | done | |
| 645 | ||
| 646 | lemma min_number_of_Suc [simp]: | |
| 647 | "min (Suc n) (number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 648 | (let pv = number_of (Int.pred v) in | 
| 23164 | 649 | if neg pv then 0 else Suc(min n (nat pv)))" | 
| 650 | apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def | |
| 651 | split add: split_if nat.split) | |
| 652 | apply (rule_tac x = "number_of v" in spec) | |
| 653 | apply auto | |
| 654 | done | |
| 655 | ||
| 656 | lemma min_Suc_number_of [simp]: | |
| 657 | "min (number_of v) (Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 658 | (let pv = number_of (Int.pred v) in | 
| 23164 | 659 | if neg pv then 0 else Suc(min (nat pv) n))" | 
| 660 | apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def | |
| 661 | split add: split_if nat.split) | |
| 662 | apply (rule_tac x = "number_of v" in spec) | |
| 663 | apply auto | |
| 664 | done | |
| 665 | ||
| 666 | subsection{*Literal arithmetic involving powers*}
 | |
| 667 | ||
| 668 | lemma nat_power_eq: "(0::int) <= z ==> nat (z^n) = nat z ^ n" | |
| 669 | apply (induct "n") | |
| 670 | apply (simp_all (no_asm_simp) add: nat_mult_distrib) | |
| 671 | done | |
| 672 | ||
| 673 | lemma power_nat_number_of: | |
| 674 | "(number_of v :: nat) ^ n = | |
| 675 | (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))" | |
| 676 | by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq | |
| 677 | split add: split_if cong: imp_cong) | |
| 678 | ||
| 679 | ||
| 680 | lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w", standard] | |
| 681 | declare power_nat_number_of_number_of [simp] | |
| 682 | ||
| 683 | ||
| 684 | ||
| 23294 | 685 | text{*For arbitrary rings*}
 | 
| 23164 | 686 | |
| 23294 | 687 | lemma power_number_of_even: | 
| 31014 | 688 | fixes z :: "'a::number_ring" | 
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 689 | shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)" | 
| 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 690 | unfolding Let_def nat_number_of_def number_of_Bit0 | 
| 23164 | 691 | apply (rule_tac x = "number_of w" in spec, clarify) | 
| 692 | apply (case_tac " (0::int) <= x") | |
| 693 | apply (auto simp add: nat_mult_distrib power_even_eq power2_eq_square) | |
| 694 | done | |
| 695 | ||
| 23294 | 696 | lemma power_number_of_odd: | 
| 31014 | 697 | fixes z :: "'a::number_ring" | 
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 698 | shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w | 
| 23164 | 699 | then (let w = z ^ (number_of w) in z * w * w) else 1)" | 
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 700 | unfolding Let_def nat_number_of_def number_of_Bit1 | 
| 23164 | 701 | apply (rule_tac x = "number_of w" in spec, auto) | 
| 702 | apply (simp only: nat_add_distrib nat_mult_distrib) | |
| 703 | apply simp | |
| 23294 | 704 | apply (auto simp add: nat_add_distrib nat_mult_distrib power_even_eq power2_eq_square neg_nat power_Suc) | 
| 23164 | 705 | done | 
| 706 | ||
| 23294 | 707 | lemmas zpower_number_of_even = power_number_of_even [where 'a=int] | 
| 708 | lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int] | |
| 23164 | 709 | |
| 23294 | 710 | lemmas power_number_of_even_number_of [simp] = | 
| 711 | power_number_of_even [of "number_of v", standard] | |
| 23164 | 712 | |
| 23294 | 713 | lemmas power_number_of_odd_number_of [simp] = | 
| 714 | power_number_of_odd [of "number_of v", standard] | |
| 23164 | 715 | |
| 716 | ||
| 717 | (* Enable arith to deal with div/mod k where k is a numeral: *) | |
| 718 | declare split_div[of _ _ "number_of k", standard, arith_split] | |
| 719 | declare split_mod[of _ _ "number_of k", standard, arith_split] | |
| 720 | ||
| 721 | lemma nat_number_of_Pls: "Numeral0 = (0::nat)" | |
| 722 | by (simp add: number_of_Pls nat_number_of_def) | |
| 723 | ||
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 724 | lemma nat_number_of_Min: "number_of Int.Min = (0::nat)" | 
| 23164 | 725 | apply (simp only: number_of_Min nat_number_of_def nat_zminus_int) | 
| 726 | done | |
| 727 | ||
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 728 | lemma nat_number_of_Bit0: | 
| 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 729 | "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)" | 
| 28969 | 730 | unfolding nat_number_of_def number_of_is_id numeral_simps Let_def | 
| 731 | by auto | |
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 732 | |
| 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 733 | lemma nat_number_of_Bit1: | 
| 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 734 | "number_of (Int.Bit1 w) = | 
| 23164 | 735 | (if neg (number_of w :: int) then 0 | 
| 736 | else let n = number_of w in Suc (n + n))" | |
| 28969 | 737 | unfolding nat_number_of_def number_of_is_id numeral_simps neg_def Let_def | 
| 28968 | 738 | by auto | 
| 23164 | 739 | |
| 740 | lemmas nat_number = | |
| 741 | nat_number_of_Pls nat_number_of_Min | |
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 742 | nat_number_of_Bit0 nat_number_of_Bit1 | 
| 23164 | 743 | |
| 744 | lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)" | |
| 745 | by (simp add: Let_def) | |
| 746 | ||
| 31014 | 747 | lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring})"
 | 
| 748 | by (simp only: number_of_Min power_minus1_even) | |
| 23164 | 749 | |
| 31014 | 750 | lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring})"
 | 
| 751 | by (simp only: number_of_Min power_minus1_odd) | |
| 23164 | 752 | |
| 753 | ||
| 754 | subsection{*Literal arithmetic and @{term of_nat}*}
 | |
| 755 | ||
| 756 | lemma of_nat_double: | |
| 757 | "0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)" | |
| 758 | by (simp only: mult_2 nat_add_distrib of_nat_add) | |
| 759 | ||
| 760 | lemma nat_numeral_m1_eq_0: "-1 = (0::nat)" | |
| 761 | by (simp only: nat_number_of_def) | |
| 762 | ||
| 763 | lemma of_nat_number_of_lemma: | |
| 764 | "of_nat (number_of v :: nat) = | |
| 765 | (if 0 \<le> (number_of v :: int) | |
| 766 | then (number_of v :: 'a :: number_ring) | |
| 767 | else 0)" | |
| 768 | by (simp add: int_number_of_def nat_number_of_def number_of_eq of_nat_nat); | |
| 769 | ||
| 770 | lemma of_nat_number_of_eq [simp]: | |
| 771 | "of_nat (number_of v :: nat) = | |
| 772 | (if neg (number_of v :: int) then 0 | |
| 773 | else (number_of v :: 'a :: number_ring))" | |
| 774 | by (simp only: of_nat_number_of_lemma neg_def, simp) | |
| 775 | ||
| 776 | ||
| 777 | subsection {*Lemmas for the Combination and Cancellation Simprocs*}
 | |
| 778 | ||
| 779 | lemma nat_number_of_add_left: | |
| 780 | "number_of v + (number_of v' + (k::nat)) = | |
| 781 | (if neg (number_of v :: int) then number_of v' + k | |
| 782 | else if neg (number_of v' :: int) then number_of v + k | |
| 783 | else number_of (v + v') + k)" | |
| 28968 | 784 | unfolding nat_number_of_def number_of_is_id neg_def | 
| 785 | by auto | |
| 23164 | 786 | |
| 787 | lemma nat_number_of_mult_left: | |
| 788 | "number_of v * (number_of v' * (k::nat)) = | |
| 29012 | 789 | (if v < Int.Pls then 0 | 
| 23164 | 790 | else number_of (v * v') * k)" | 
| 791 | by simp | |
| 792 | ||
| 793 | ||
| 794 | subsubsection{*For @{text combine_numerals}*}
 | |
| 795 | ||
| 796 | lemma left_add_mult_distrib: "i*u + (j*u + k) = (i+j)*u + (k::nat)" | |
| 797 | by (simp add: add_mult_distrib) | |
| 798 | ||
| 799 | ||
| 800 | subsubsection{*For @{text cancel_numerals}*}
 | |
| 801 | ||
| 802 | lemma nat_diff_add_eq1: | |
| 803 | "j <= (i::nat) ==> ((i*u + m) - (j*u + n)) = (((i-j)*u + m) - n)" | |
| 804 | by (simp split add: nat_diff_split add: add_mult_distrib) | |
| 805 | ||
| 806 | lemma nat_diff_add_eq2: | |
| 807 | "i <= (j::nat) ==> ((i*u + m) - (j*u + n)) = (m - ((j-i)*u + n))" | |
| 808 | by (simp split add: nat_diff_split add: add_mult_distrib) | |
| 809 | ||
| 810 | lemma nat_eq_add_iff1: | |
| 811 | "j <= (i::nat) ==> (i*u + m = j*u + n) = ((i-j)*u + m = n)" | |
| 812 | by (auto split add: nat_diff_split simp add: add_mult_distrib) | |
| 813 | ||
| 814 | lemma nat_eq_add_iff2: | |
| 815 | "i <= (j::nat) ==> (i*u + m = j*u + n) = (m = (j-i)*u + n)" | |
| 816 | by (auto split add: nat_diff_split simp add: add_mult_distrib) | |
| 817 | ||
| 818 | lemma nat_less_add_iff1: | |
| 819 | "j <= (i::nat) ==> (i*u + m < j*u + n) = ((i-j)*u + m < n)" | |
| 820 | by (auto split add: nat_diff_split simp add: add_mult_distrib) | |
| 821 | ||
| 822 | lemma nat_less_add_iff2: | |
| 823 | "i <= (j::nat) ==> (i*u + m < j*u + n) = (m < (j-i)*u + n)" | |
| 824 | by (auto split add: nat_diff_split simp add: add_mult_distrib) | |
| 825 | ||
| 826 | lemma nat_le_add_iff1: | |
| 827 | "j <= (i::nat) ==> (i*u + m <= j*u + n) = ((i-j)*u + m <= n)" | |
| 828 | by (auto split add: nat_diff_split simp add: add_mult_distrib) | |
| 829 | ||
| 830 | lemma nat_le_add_iff2: | |
| 831 | "i <= (j::nat) ==> (i*u + m <= j*u + n) = (m <= (j-i)*u + n)" | |
| 832 | by (auto split add: nat_diff_split simp add: add_mult_distrib) | |
| 833 | ||
| 834 | ||
| 835 | subsubsection{*For @{text cancel_numeral_factors} *}
 | |
| 836 | ||
| 837 | lemma nat_mult_le_cancel1: "(0::nat) < k ==> (k*m <= k*n) = (m<=n)" | |
| 838 | by auto | |
| 839 | ||
| 840 | lemma nat_mult_less_cancel1: "(0::nat) < k ==> (k*m < k*n) = (m<n)" | |
| 841 | by auto | |
| 842 | ||
| 843 | lemma nat_mult_eq_cancel1: "(0::nat) < k ==> (k*m = k*n) = (m=n)" | |
| 844 | by auto | |
| 845 | ||
| 846 | lemma nat_mult_div_cancel1: "(0::nat) < k ==> (k*m) div (k*n) = (m div n)" | |
| 847 | by auto | |
| 848 | ||
| 23969 | 849 | lemma nat_mult_dvd_cancel_disj[simp]: | 
| 850 | "(k*m) dvd (k*n) = (k=0 | m dvd (n::nat))" | |
| 851 | by(auto simp: dvd_eq_mod_eq_0 mod_mult_distrib2[symmetric]) | |
| 852 | ||
| 853 | lemma nat_mult_dvd_cancel1: "0 < k \<Longrightarrow> (k*m) dvd (k*n::nat) = (m dvd n)" | |
| 854 | by(auto) | |
| 855 | ||
| 23164 | 856 | |
| 857 | subsubsection{*For @{text cancel_factor} *}
 | |
| 858 | ||
| 859 | lemma nat_mult_le_cancel_disj: "(k*m <= k*n) = ((0::nat) < k --> m<=n)" | |
| 860 | by auto | |
| 861 | ||
| 862 | lemma nat_mult_less_cancel_disj: "(k*m < k*n) = ((0::nat) < k & m<n)" | |
| 863 | by auto | |
| 864 | ||
| 865 | lemma nat_mult_eq_cancel_disj: "(k*m = k*n) = (k = (0::nat) | m=n)" | |
| 866 | by auto | |
| 867 | ||
| 23969 | 868 | lemma nat_mult_div_cancel_disj[simp]: | 
| 23164 | 869 | "(k*m) div (k*n) = (if k = (0::nat) then 0 else m div n)" | 
| 870 | by (simp add: nat_mult_div_cancel1) | |
| 871 | ||
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 872 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 873 | subsection {* Simprocs for the Naturals *}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 874 | |
| 31068 
f591144b0f17
modules numeral_simprocs, nat_numeral_simprocs; proper structures for numeral simprocs
 haftmann parents: 
31034diff
changeset | 875 | use "Tools/nat_numeral_simprocs.ML" | 
| 
f591144b0f17
modules numeral_simprocs, nat_numeral_simprocs; proper structures for numeral simprocs
 haftmann parents: 
31034diff
changeset | 876 | |
| 31100 | 877 | declaration {* 
 | 
| 878 |   K (Lin_Arith.add_simps (@{thms neg_simps} @ [@{thm Suc_nat_number_of}, @{thm int_nat_number_of}])
 | |
| 879 |   #> Lin_Arith.add_simps (@{thms ring_distribs} @ [@{thm Let_number_of}, @{thm Let_0}, @{thm Let_1},
 | |
| 880 |      @{thm nat_0}, @{thm nat_1},
 | |
| 881 |      @{thm add_nat_number_of}, @{thm diff_nat_number_of}, @{thm mult_nat_number_of},
 | |
| 882 |      @{thm eq_nat_number_of}, @{thm less_nat_number_of}, @{thm le_number_of_eq_not_less},
 | |
| 883 |      @{thm le_Suc_number_of}, @{thm le_number_of_Suc},
 | |
| 884 |      @{thm less_Suc_number_of}, @{thm less_number_of_Suc},
 | |
| 885 |      @{thm Suc_eq_number_of}, @{thm eq_number_of_Suc},
 | |
| 886 |      @{thm mult_Suc}, @{thm mult_Suc_right},
 | |
| 887 |      @{thm add_Suc}, @{thm add_Suc_right},
 | |
| 888 |      @{thm eq_number_of_0}, @{thm eq_0_number_of}, @{thm less_0_number_of},
 | |
| 889 |      @{thm of_int_number_of_eq}, @{thm of_nat_number_of_eq}, @{thm nat_number_of},
 | |
| 890 |      @{thm if_True}, @{thm if_False}])
 | |
| 891 | #> Lin_Arith.add_simprocs (Nat_Numeral_Simprocs.combine_numerals :: Nat_Numeral_Simprocs.cancel_numerals)) | |
| 31068 
f591144b0f17
modules numeral_simprocs, nat_numeral_simprocs; proper structures for numeral simprocs
 haftmann parents: 
31034diff
changeset | 892 | *} | 
| 
f591144b0f17
modules numeral_simprocs, nat_numeral_simprocs; proper structures for numeral simprocs
 haftmann parents: 
31034diff
changeset | 893 | |
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 894 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 895 | subsubsection{*For simplifying @{term "Suc m - K"} and  @{term "K - Suc m"}*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 896 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 897 | text{*Where K above is a literal*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 898 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 899 | lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 900 | by (simp add: numeral_0_eq_0 numeral_1_eq_1 split add: nat_diff_split) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 901 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 902 | text {*Now just instantiating @{text n} to @{text "number_of v"} does
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 903 | the right simplification, but with some redundant inequality | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 904 | tests.*} | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 905 | lemma neg_number_of_pred_iff_0: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 906 | "neg (number_of (Int.pred v)::int) = (number_of v = (0::nat))" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 907 | apply (subgoal_tac "neg (number_of (Int.pred v)) = (number_of v < Suc 0) ") | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 908 | apply (simp only: less_Suc_eq_le le_0_eq) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 909 | apply (subst less_number_of_Suc, simp) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 910 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 911 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 912 | text{*No longer required as a simprule because of the @{text inverse_fold}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 913 | simproc*} | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 914 | lemma Suc_diff_number_of: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 915 | "Int.Pls < v ==> | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 916 | Suc m - (number_of v) = m - (number_of (Int.pred v))" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 917 | apply (subst Suc_diff_eq_diff_pred) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 918 | apply simp | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 919 | apply (simp del: nat_numeral_1_eq_1) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 920 | apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 921 | neg_number_of_pred_iff_0) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 922 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 923 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 924 | lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 925 | by (simp add: numerals split add: nat_diff_split) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 926 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 927 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 928 | subsubsection{*For @{term nat_case} and @{term nat_rec}*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 929 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 930 | lemma nat_case_number_of [simp]: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 931 | "nat_case a f (number_of v) = | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 932 | (let pv = number_of (Int.pred v) in | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 933 | if neg pv then a else f (nat pv))" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 934 | by (simp split add: nat.split add: Let_def neg_number_of_pred_iff_0) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 935 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 936 | lemma nat_case_add_eq_if [simp]: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 937 | "nat_case a f ((number_of v) + n) = | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 938 | (let pv = number_of (Int.pred v) in | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 939 | if neg pv then nat_case a f n else f (nat pv + n))" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 940 | apply (subst add_eq_if) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 941 | apply (simp split add: nat.split | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 942 | del: nat_numeral_1_eq_1 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 943 | add: nat_numeral_1_eq_1 [symmetric] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 944 | numeral_1_eq_Suc_0 [symmetric] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 945 | neg_number_of_pred_iff_0) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 946 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 947 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 948 | lemma nat_rec_number_of [simp]: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 949 | "nat_rec a f (number_of v) = | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 950 | (let pv = number_of (Int.pred v) in | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 951 | if neg pv then a else f (nat pv) (nat_rec a f (nat pv)))" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 952 | apply (case_tac " (number_of v) ::nat") | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 953 | apply (simp_all (no_asm_simp) add: Let_def neg_number_of_pred_iff_0) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 954 | apply (simp split add: split_if_asm) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 955 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 956 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 957 | lemma nat_rec_add_eq_if [simp]: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 958 | "nat_rec a f (number_of v + n) = | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 959 | (let pv = number_of (Int.pred v) in | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 960 | if neg pv then nat_rec a f n | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 961 | else f (nat pv + n) (nat_rec a f (nat pv + n)))" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 962 | apply (subst add_eq_if) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 963 | apply (simp split add: nat.split | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 964 | del: nat_numeral_1_eq_1 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 965 | add: nat_numeral_1_eq_1 [symmetric] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 966 | numeral_1_eq_Suc_0 [symmetric] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 967 | neg_number_of_pred_iff_0) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 968 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 969 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 970 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 971 | subsubsection{*Various Other Lemmas*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 972 | |
| 31080 | 973 | lemma card_UNIV_bool[simp]: "card (UNIV :: bool set) = 2" | 
| 974 | by(simp add: UNIV_bool) | |
| 975 | ||
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 976 | text {*Evens and Odds, for Mutilated Chess Board*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 977 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 978 | text{*Lemmas for specialist use, NOT as default simprules*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 979 | lemma nat_mult_2: "2 * z = (z+z::nat)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 980 | proof - | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 981 | have "2*z = (1 + 1)*z" by simp | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 982 | also have "... = z+z" by (simp add: left_distrib) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 983 | finally show ?thesis . | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 984 | qed | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 985 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 986 | lemma nat_mult_2_right: "z * 2 = (z+z::nat)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 987 | by (subst mult_commute, rule nat_mult_2) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 988 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 989 | text{*Case analysis on @{term "n<2"}*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 990 | lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 991 | by arith | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 992 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 993 | lemma div2_Suc_Suc [simp]: "Suc(Suc m) div 2 = Suc (m div 2)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 994 | by arith | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 995 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 996 | lemma add_self_div_2 [simp]: "(m + m) div 2 = (m::nat)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 997 | by (simp add: nat_mult_2 [symmetric]) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 998 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 999 | lemma mod2_Suc_Suc [simp]: "Suc(Suc(m)) mod 2 = m mod 2" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1000 | apply (subgoal_tac "m mod 2 < 2") | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1001 | apply (erule less_2_cases [THEN disjE]) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1002 | apply (simp_all (no_asm_simp) add: Let_def mod_Suc nat_1) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1003 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1004 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1005 | lemma mod2_gr_0 [simp]: "!!m::nat. (0 < m mod 2) = (m mod 2 = 1)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1006 | apply (subgoal_tac "m mod 2 < 2") | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1007 | apply (force simp del: mod_less_divisor, simp) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1008 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1009 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1010 | text{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1011 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1012 | lemma add_2_eq_Suc [simp]: "2 + n = Suc (Suc n)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1013 | by simp | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1014 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1015 | lemma add_2_eq_Suc' [simp]: "n + 2 = Suc (Suc n)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1016 | by simp | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1017 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1018 | text{*Can be used to eliminate long strings of Sucs, but not by default*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1019 | lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1020 | by simp | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1021 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1022 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1023 | text{*These lemmas collapse some needless occurrences of Suc:
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1024 | at least three Sucs, since two and fewer are rewritten back to Suc again! | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1025 | We already have some rules to simplify operands smaller than 3.*} | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1026 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1027 | lemma div_Suc_eq_div_add3 [simp]: "m div (Suc (Suc (Suc n))) = m div (3+n)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1028 | by (simp add: Suc3_eq_add_3) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1029 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1030 | lemma mod_Suc_eq_mod_add3 [simp]: "m mod (Suc (Suc (Suc n))) = m mod (3+n)" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1031 | by (simp add: Suc3_eq_add_3) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1032 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1033 | lemma Suc_div_eq_add3_div: "(Suc (Suc (Suc m))) div n = (3+m) div n" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1034 | by (simp add: Suc3_eq_add_3) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1035 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1036 | lemma Suc_mod_eq_add3_mod: "(Suc (Suc (Suc m))) mod n = (3+m) mod n" | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1037 | by (simp add: Suc3_eq_add_3) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1038 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1039 | lemmas Suc_div_eq_add3_div_number_of = | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1040 | Suc_div_eq_add3_div [of _ "number_of v", standard] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1041 | declare Suc_div_eq_add3_div_number_of [simp] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1042 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1043 | lemmas Suc_mod_eq_add3_mod_number_of = | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1044 | Suc_mod_eq_add3_mod [of _ "number_of v", standard] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1045 | declare Suc_mod_eq_add3_mod_number_of [simp] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 1046 | |
| 31096 | 1047 | end |