| author | wenzelm | 
| Mon, 04 Jul 2011 20:18:19 +0200 | |
| changeset 43660 | bfc0bb115fa1 | 
| parent 43531 | cc46a678faaf | 
| child 44345 | 881c324470a2 | 
| 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 | 
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 9 | imports Int | 
| 23164 | 10 | begin | 
| 11 | ||
| 31014 | 12 | subsection {* Numerals for natural numbers *}
 | 
| 13 | ||
| 23164 | 14 | text {*
 | 
| 15 | Arithmetic for naturals is reduced to that for the non-negative integers. | |
| 16 | *} | |
| 17 | ||
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 18 | instantiation nat :: number_semiring | 
| 25571 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 19 | begin | 
| 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 20 | |
| 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 21 | definition | 
| 32069 
6d28bbd33e2c
prefer code_inline over code_unfold; use code_unfold_post where appropriate
 haftmann parents: 
31998diff
changeset | 22 | 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 | 23 | |
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 24 | instance proof | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 25 | fix n show "number_of (int n) = (of_nat n :: nat)" | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 26 | unfolding nat_number_of_def number_of_eq by simp | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 27 | qed | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 28 | |
| 25571 
c9e39eafc7a0
instantiation target rather than legacy instance
 haftmann parents: 
25481diff
changeset | 29 | end | 
| 23164 | 30 | |
| 31998 
2c7a24f74db9
code attributes use common underscore convention
 haftmann parents: 
31790diff
changeset | 31 | lemma [code_post]: | 
| 25965 | 32 | "nat (number_of v) = number_of v" | 
| 33 | unfolding nat_number_of_def .. | |
| 34 | ||
| 31014 | 35 | |
| 36 | subsection {* Special case: squares and cubes *}
 | |
| 37 | ||
| 38 | lemma numeral_2_eq_2: "2 = Suc (Suc 0)" | |
| 39 | by (simp add: nat_number_of_def) | |
| 40 | ||
| 41 | lemma numeral_3_eq_3: "3 = Suc (Suc (Suc 0))" | |
| 42 | by (simp add: nat_number_of_def) | |
| 43 | ||
| 44 | context power | |
| 30960 | 45 | begin | 
| 46 | ||
| 23164 | 47 | abbreviation (xsymbols) | 
| 30960 | 48 |   power2 :: "'a \<Rightarrow> 'a"  ("(_\<twosuperior>)" [1000] 999) where
 | 
| 49 | "x\<twosuperior> \<equiv> x ^ 2" | |
| 23164 | 50 | |
| 51 | notation (latex output) | |
| 29401 
94fd5dd918f5
rename abbreviation square -> power2, to match theorem names
 huffman parents: 
29045diff
changeset | 52 |   power2  ("(_\<twosuperior>)" [1000] 999)
 | 
| 23164 | 53 | |
| 54 | notation (HTML output) | |
| 29401 
94fd5dd918f5
rename abbreviation square -> power2, to match theorem names
 huffman parents: 
29045diff
changeset | 55 |   power2  ("(_\<twosuperior>)" [1000] 999)
 | 
| 23164 | 56 | |
| 30960 | 57 | end | 
| 58 | ||
| 31014 | 59 | context monoid_mult | 
| 60 | begin | |
| 61 | ||
| 62 | lemma power2_eq_square: "a\<twosuperior> = a * a" | |
| 63 | by (simp add: numeral_2_eq_2) | |
| 64 | ||
| 65 | lemma power3_eq_cube: "a ^ 3 = a * a * a" | |
| 66 | by (simp add: numeral_3_eq_3 mult_assoc) | |
| 67 | ||
| 68 | lemma power_even_eq: | |
| 69 | "a ^ (2*n) = (a ^ n) ^ 2" | |
| 35047 
1b2bae06c796
hide fact Nat.add_0_right; make add_0_right from Groups priority
 haftmann parents: 
35043diff
changeset | 70 | by (subst mult_commute) (simp add: power_mult) | 
| 31014 | 71 | |
| 72 | lemma power_odd_eq: | |
| 73 | "a ^ Suc (2*n) = a * (a ^ n) ^ 2" | |
| 74 | by (simp add: power_even_eq) | |
| 75 | ||
| 76 | end | |
| 77 | ||
| 78 | context semiring_1 | |
| 79 | begin | |
| 80 | ||
| 81 | lemma zero_power2 [simp]: "0\<twosuperior> = 0" | |
| 82 | by (simp add: power2_eq_square) | |
| 83 | ||
| 84 | lemma one_power2 [simp]: "1\<twosuperior> = 1" | |
| 85 | by (simp add: power2_eq_square) | |
| 86 | ||
| 87 | end | |
| 88 | ||
| 36823 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 89 | context ring_1 | 
| 31014 | 90 | begin | 
| 91 | ||
| 92 | lemma power2_minus [simp]: | |
| 93 | "(- a)\<twosuperior> = a\<twosuperior>" | |
| 94 | by (simp add: power2_eq_square) | |
| 95 | ||
| 96 | text{*
 | |
| 97 |   We cannot prove general results about the numeral @{term "-1"},
 | |
| 98 |   so we have to use @{term "- 1"} instead.
 | |
| 99 | *} | |
| 100 | ||
| 101 | lemma power_minus1_even [simp]: | |
| 102 | "(- 1) ^ (2*n) = 1" | |
| 103 | proof (induct n) | |
| 104 | case 0 show ?case by simp | |
| 105 | next | |
| 106 | case (Suc n) then show ?case by (simp add: power_add) | |
| 107 | qed | |
| 108 | ||
| 109 | lemma power_minus1_odd: | |
| 110 | "(- 1) ^ Suc (2*n) = - 1" | |
| 111 | by simp | |
| 112 | ||
| 113 | lemma power_minus_even [simp]: | |
| 114 | "(-a) ^ (2*n) = a ^ (2*n)" | |
| 115 | by (simp add: power_minus [of a]) | |
| 116 | ||
| 117 | end | |
| 118 | ||
| 36823 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 119 | context ring_1_no_zero_divisors | 
| 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 120 | begin | 
| 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 121 | |
| 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 122 | lemma zero_eq_power2 [simp]: | 
| 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 123 | "a\<twosuperior> = 0 \<longleftrightarrow> a = 0" | 
| 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 124 | unfolding power2_eq_square by simp | 
| 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 125 | |
| 36964 | 126 | lemma power2_eq_1_iff: | 
| 36823 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 127 | "a\<twosuperior> = 1 \<longleftrightarrow> a = 1 \<or> a = - 1" | 
| 36964 | 128 | unfolding power2_eq_square by (rule square_eq_1_iff) | 
| 36823 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 129 | |
| 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 130 | end | 
| 
001d1aad99de
add lemma power2_eq_1_iff; generalize some other lemmas
 huffman parents: 
36719diff
changeset | 131 | |
| 35631 
0b8a5fd339ab
generalize some lemmas from class linordered_ring_strict to linordered_ring
 huffman parents: 
35216diff
changeset | 132 | context linordered_ring | 
| 31014 | 133 | begin | 
| 134 | ||
| 135 | lemma sum_squares_ge_zero: | |
| 136 | "0 \<le> x * x + y * y" | |
| 137 | by (intro add_nonneg_nonneg zero_le_square) | |
| 138 | ||
| 139 | lemma not_sum_squares_lt_zero: | |
| 140 | "\<not> x * x + y * y < 0" | |
| 141 | by (simp add: not_less sum_squares_ge_zero) | |
| 142 | ||
| 35631 
0b8a5fd339ab
generalize some lemmas from class linordered_ring_strict to linordered_ring
 huffman parents: 
35216diff
changeset | 143 | end | 
| 
0b8a5fd339ab
generalize some lemmas from class linordered_ring_strict to linordered_ring
 huffman parents: 
35216diff
changeset | 144 | |
| 
0b8a5fd339ab
generalize some lemmas from class linordered_ring_strict to linordered_ring
 huffman parents: 
35216diff
changeset | 145 | context linordered_ring_strict | 
| 
0b8a5fd339ab
generalize some lemmas from class linordered_ring_strict to linordered_ring
 huffman parents: 
35216diff
changeset | 146 | begin | 
| 
0b8a5fd339ab
generalize some lemmas from class linordered_ring_strict to linordered_ring
 huffman parents: 
35216diff
changeset | 147 | |
| 31014 | 148 | lemma sum_squares_eq_zero_iff: | 
| 149 | "x * x + y * y = 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 31034 | 150 | by (simp add: add_nonneg_eq_0_iff) | 
| 31014 | 151 | |
| 152 | lemma sum_squares_le_zero_iff: | |
| 153 | "x * x + y * y \<le> 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 154 | by (simp add: le_less not_sum_squares_lt_zero sum_squares_eq_zero_iff) | |
| 155 | ||
| 156 | lemma sum_squares_gt_zero_iff: | |
| 157 | "0 < x * x + y * y \<longleftrightarrow> x \<noteq> 0 \<or> y \<noteq> 0" | |
| 35631 
0b8a5fd339ab
generalize some lemmas from class linordered_ring_strict to linordered_ring
 huffman parents: 
35216diff
changeset | 158 | by (simp add: not_le [symmetric] sum_squares_le_zero_iff) | 
| 31014 | 159 | |
| 160 | end | |
| 161 | ||
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
33342diff
changeset | 162 | context linordered_semidom | 
| 31014 | 163 | begin | 
| 164 | ||
| 165 | lemma power2_le_imp_le: | |
| 166 | "x\<twosuperior> \<le> y\<twosuperior> \<Longrightarrow> 0 \<le> y \<Longrightarrow> x \<le> y" | |
| 167 | unfolding numeral_2_eq_2 by (rule power_le_imp_le_base) | |
| 168 | ||
| 169 | lemma power2_less_imp_less: | |
| 170 | "x\<twosuperior> < y\<twosuperior> \<Longrightarrow> 0 \<le> y \<Longrightarrow> x < y" | |
| 171 | by (rule power_less_imp_less_base) | |
| 172 | ||
| 173 | lemma power2_eq_imp_eq: | |
| 174 | "x\<twosuperior> = y\<twosuperior> \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> x = y" | |
| 175 | unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base) simp | |
| 176 | ||
| 177 | end | |
| 178 | ||
| 35028 
108662d50512
more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
 haftmann parents: 
33342diff
changeset | 179 | context linordered_idom | 
| 31014 | 180 | begin | 
| 181 | ||
| 182 | lemma zero_le_power2 [simp]: | |
| 183 | "0 \<le> a\<twosuperior>" | |
| 184 | by (simp add: power2_eq_square) | |
| 185 | ||
| 186 | lemma zero_less_power2 [simp]: | |
| 187 | "0 < a\<twosuperior> \<longleftrightarrow> a \<noteq> 0" | |
| 188 | by (force simp add: power2_eq_square zero_less_mult_iff linorder_neq_iff) | |
| 189 | ||
| 190 | lemma power2_less_0 [simp]: | |
| 191 | "\<not> a\<twosuperior> < 0" | |
| 192 | by (force simp add: power2_eq_square mult_less_0_iff) | |
| 193 | ||
| 194 | lemma abs_power2 [simp]: | |
| 195 | "abs (a\<twosuperior>) = a\<twosuperior>" | |
| 196 | by (simp add: power2_eq_square abs_mult abs_mult_self) | |
| 197 | ||
| 198 | lemma power2_abs [simp]: | |
| 199 | "(abs a)\<twosuperior> = a\<twosuperior>" | |
| 200 | by (simp add: power2_eq_square abs_mult_self) | |
| 201 | ||
| 202 | lemma odd_power_less_zero: | |
| 203 | "a < 0 \<Longrightarrow> a ^ Suc (2*n) < 0" | |
| 204 | proof (induct n) | |
| 205 | case 0 | |
| 206 | then show ?case by simp | |
| 207 | next | |
| 208 | case (Suc n) | |
| 209 | have "a ^ Suc (2 * Suc n) = (a*a) * a ^ Suc(2*n)" | |
| 210 | by (simp add: mult_ac power_add power2_eq_square) | |
| 211 | thus ?case | |
| 212 | by (simp del: power_Suc add: Suc mult_less_0_iff mult_neg_neg) | |
| 213 | qed | |
| 214 | ||
| 215 | lemma odd_0_le_power_imp_0_le: | |
| 216 | "0 \<le> a ^ Suc (2*n) \<Longrightarrow> 0 \<le> a" | |
| 217 | using odd_power_less_zero [of a n] | |
| 218 | by (force simp add: linorder_not_less [symmetric]) | |
| 219 | ||
| 220 | lemma zero_le_even_power'[simp]: | |
| 221 | "0 \<le> a ^ (2*n)" | |
| 222 | proof (induct n) | |
| 223 | case 0 | |
| 35216 | 224 | show ?case by simp | 
| 31014 | 225 | next | 
| 226 | case (Suc n) | |
| 227 | have "a ^ (2 * Suc n) = (a*a) * a ^ (2*n)" | |
| 228 | by (simp add: mult_ac power_add power2_eq_square) | |
| 229 | thus ?case | |
| 230 | by (simp add: Suc zero_le_mult_iff) | |
| 231 | qed | |
| 232 | ||
| 233 | lemma sum_power2_ge_zero: | |
| 234 | "0 \<le> x\<twosuperior> + y\<twosuperior>" | |
| 235 | unfolding power2_eq_square by (rule sum_squares_ge_zero) | |
| 236 | ||
| 237 | lemma not_sum_power2_lt_zero: | |
| 238 | "\<not> x\<twosuperior> + y\<twosuperior> < 0" | |
| 239 | unfolding power2_eq_square by (rule not_sum_squares_lt_zero) | |
| 240 | ||
| 241 | lemma sum_power2_eq_zero_iff: | |
| 242 | "x\<twosuperior> + y\<twosuperior> = 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 243 | unfolding power2_eq_square by (rule sum_squares_eq_zero_iff) | |
| 244 | ||
| 245 | lemma sum_power2_le_zero_iff: | |
| 246 | "x\<twosuperior> + y\<twosuperior> \<le> 0 \<longleftrightarrow> x = 0 \<and> y = 0" | |
| 247 | unfolding power2_eq_square by (rule sum_squares_le_zero_iff) | |
| 248 | ||
| 249 | lemma sum_power2_gt_zero_iff: | |
| 250 | "0 < x\<twosuperior> + y\<twosuperior> \<longleftrightarrow> x \<noteq> 0 \<or> y \<noteq> 0" | |
| 251 | unfolding power2_eq_square by (rule sum_squares_gt_zero_iff) | |
| 252 | ||
| 253 | end | |
| 254 | ||
| 255 | lemma power2_sum: | |
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 256 | fixes x y :: "'a::number_semiring" | 
| 31014 | 257 | shows "(x + y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> + 2 * x * y" | 
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 258 | by (simp add: algebra_simps power2_eq_square semiring_mult_2_right) | 
| 31014 | 259 | |
| 260 | lemma power2_diff: | |
| 261 | fixes x y :: "'a::number_ring" | |
| 262 | shows "(x - y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> - 2 * x * y" | |
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 263 | by (simp add: ring_distribs power2_eq_square mult_2) (rule mult_commute) | 
| 31014 | 264 | |
| 23164 | 265 | |
| 29040 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 266 | 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 | 267 | |
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 268 | 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 | 269 | "neg Z \<longleftrightarrow> Z < 0" | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 270 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 271 | 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 | 272 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 273 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 274 | lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))" | 
| 35216 | 275 | by (simp add: neg_def del: of_nat_Suc) | 
| 29040 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 276 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 277 | 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 | 278 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 279 | 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 | 280 | 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 | 281 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 282 | 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 | 283 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 284 | 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 | 285 | 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 | 286 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 287 | lemma not_neg_1: "~ neg 1" | 
| 35216 | 288 | by (simp add: neg_def linorder_not_less) | 
| 29040 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 289 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 290 | 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 | 291 | 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 | 292 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 293 | 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 | 294 | 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 | 295 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 296 | text {*
 | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 297 |   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 | 298 |   @{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 | 299 | *} | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 300 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 301 | 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 | 302 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 303 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 304 | 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 | 305 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 306 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 307 | lemma neg_number_of_Bit0: | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 308 | "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 | 309 | by (simp add: neg_def) | 
| 
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 | lemma neg_number_of_Bit1: | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 312 | "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 | 313 | by (simp add: neg_def) | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 314 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 315 | lemmas neg_simps [simp] = | 
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 316 | 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 | 317 | 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 | 318 | 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 | 319 | |
| 
286c669d3a7a
move all neg-related lemmas to NatBin; make type of neg specific to int
 huffman parents: 
29039diff
changeset | 320 | |
| 23164 | 321 | subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
 | 
| 322 | ||
| 35216 | 323 | declare nat_1 [simp] | 
| 23164 | 324 | |
| 325 | lemma nat_number_of [simp]: "nat (number_of w) = number_of w" | |
| 326 | by (simp add: nat_number_of_def) | |
| 327 | ||
| 31998 
2c7a24f74db9
code attributes use common underscore convention
 haftmann parents: 
31790diff
changeset | 328 | lemma nat_numeral_0_eq_0 [simp, code_post]: "Numeral0 = (0::nat)" | 
| 23164 | 329 | by (simp add: nat_number_of_def) | 
| 330 | ||
| 331 | lemma nat_numeral_1_eq_1 [simp]: "Numeral1 = (1::nat)" | |
| 35216 | 332 | by (simp add: nat_number_of_def) | 
| 23164 | 333 | |
| 36719 | 334 | lemma Numeral1_eq1_nat: | 
| 335 | "(1::nat) = Numeral1" | |
| 336 | by simp | |
| 337 | ||
| 31998 
2c7a24f74db9
code attributes use common underscore convention
 haftmann parents: 
31790diff
changeset | 338 | lemma numeral_1_eq_Suc_0 [code_post]: "Numeral1 = Suc 0" | 
| 35216 | 339 | by (simp only: nat_numeral_1_eq_1 One_nat_def) | 
| 23164 | 340 | |
| 341 | ||
| 342 | subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
 | |
| 343 | ||
| 344 | lemma int_nat_number_of [simp]: | |
| 23365 | 345 | "int (number_of v) = | 
| 23307 
2fe3345035c7
modify proofs to avoid referring to int::nat=>int
 huffman parents: 
23294diff
changeset | 346 | (if neg (number_of v :: int) then 0 | 
| 
2fe3345035c7
modify proofs to avoid referring to int::nat=>int
 huffman parents: 
23294diff
changeset | 347 | else (number_of v :: int))" | 
| 28984 | 348 | unfolding nat_number_of_def number_of_is_id neg_def | 
| 349 | by simp | |
| 23307 
2fe3345035c7
modify proofs to avoid referring to int::nat=>int
 huffman parents: 
23294diff
changeset | 350 | |
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 351 | lemma nonneg_int_cases: | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 352 | fixes k :: int assumes "0 \<le> k" obtains n where "k = of_nat n" | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 353 | using assms by (cases k, simp, simp) | 
| 23164 | 354 | |
| 355 | subsubsection{*Successor *}
 | |
| 356 | ||
| 357 | lemma Suc_nat_eq_nat_zadd1: "(0::int) <= z ==> Suc (nat z) = nat (1 + z)" | |
| 358 | apply (rule sym) | |
| 359 | apply (simp add: nat_eq_iff int_Suc) | |
| 360 | done | |
| 361 | ||
| 362 | lemma Suc_nat_number_of_add: | |
| 363 | "Suc (number_of v + n) = | |
| 28984 | 364 | (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)" | 
| 365 | unfolding nat_number_of_def number_of_is_id neg_def numeral_simps | |
| 366 | by (simp add: Suc_nat_eq_nat_zadd1 add_ac) | |
| 23164 | 367 | |
| 368 | lemma Suc_nat_number_of [simp]: | |
| 369 | "Suc (number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 370 | (if neg (number_of v :: int) then 1 else number_of (Int.succ v))" | 
| 23164 | 371 | apply (cut_tac n = 0 in Suc_nat_number_of_add) | 
| 372 | apply (simp cong del: if_weak_cong) | |
| 373 | done | |
| 374 | ||
| 375 | ||
| 376 | subsubsection{*Addition *}
 | |
| 377 | ||
| 378 | lemma add_nat_number_of [simp]: | |
| 379 | "(number_of v :: nat) + number_of v' = | |
| 29012 | 380 | (if v < Int.Pls then number_of v' | 
| 381 | else if v' < Int.Pls then number_of v | |
| 23164 | 382 | else number_of (v + v'))" | 
| 29012 | 383 | unfolding nat_number_of_def number_of_is_id numeral_simps | 
| 28984 | 384 | by (simp add: nat_add_distrib) | 
| 23164 | 385 | |
| 30081 | 386 | lemma nat_number_of_add_1 [simp]: | 
| 387 | "number_of v + (1::nat) = | |
| 388 | (if v < Int.Pls then 1 else number_of (Int.succ v))" | |
| 389 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 390 | by (simp add: nat_add_distrib) | |
| 391 | ||
| 392 | lemma nat_1_add_number_of [simp]: | |
| 393 | "(1::nat) + number_of v = | |
| 394 | (if v < Int.Pls then 1 else number_of (Int.succ v))" | |
| 395 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 396 | by (simp add: nat_add_distrib) | |
| 397 | ||
| 398 | lemma nat_1_add_1 [simp]: "1 + 1 = (2::nat)" | |
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 399 | by (rule semiring_one_add_one_is_two) | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 400 | |
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 401 | text {* TODO: replace simp rules above with these generic ones: *}
 | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 402 | |
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 403 | lemma semiring_add_number_of: | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 404 | "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow> | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 405 | (number_of v :: 'a::number_semiring) + number_of v' = number_of (v + v')" | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 406 | unfolding Int.Pls_def | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 407 | by (elim nonneg_int_cases, | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 408 | simp only: number_of_int of_nat_add [symmetric]) | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 409 | |
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 410 | lemma semiring_number_of_add_1: | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 411 | "Int.Pls \<le> v \<Longrightarrow> | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 412 | number_of v + (1::'a::number_semiring) = number_of (Int.succ v)" | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 413 | unfolding Int.Pls_def Int.succ_def | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 414 | by (elim nonneg_int_cases, | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 415 | simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric]) | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 416 | |
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 417 | lemma semiring_1_add_number_of: | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 418 | "Int.Pls \<le> v \<Longrightarrow> | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 419 | (1::'a::number_semiring) + number_of v = number_of (Int.succ v)" | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 420 | unfolding Int.Pls_def Int.succ_def | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 421 | by (elim nonneg_int_cases, | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 422 | simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric]) | 
| 30081 | 423 | |
| 23164 | 424 | |
| 425 | subsubsection{*Subtraction *}
 | |
| 426 | ||
| 427 | lemma diff_nat_eq_if: | |
| 428 | "nat z - nat z' = | |
| 429 | (if neg z' then nat z | |
| 430 | else let d = z-z' in | |
| 431 | 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 | 432 | 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 | 433 | |
| 23164 | 434 | |
| 435 | lemma diff_nat_number_of [simp]: | |
| 436 | "(number_of v :: nat) - number_of v' = | |
| 29012 | 437 | (if v' < Int.Pls then number_of v | 
| 23164 | 438 | else let d = number_of (v + uminus v') in | 
| 439 | if neg d then 0 else nat d)" | |
| 29012 | 440 | unfolding nat_number_of_def number_of_is_id numeral_simps neg_def | 
| 441 | by auto | |
| 23164 | 442 | |
| 30081 | 443 | lemma nat_number_of_diff_1 [simp]: | 
| 444 | "number_of v - (1::nat) = | |
| 445 | (if v \<le> Int.Pls then 0 else number_of (Int.pred v))" | |
| 446 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 447 | by auto | |
| 448 | ||
| 23164 | 449 | |
| 450 | subsubsection{*Multiplication *}
 | |
| 451 | ||
| 452 | lemma mult_nat_number_of [simp]: | |
| 453 | "(number_of v :: nat) * number_of v' = | |
| 29012 | 454 | (if v < Int.Pls then 0 else number_of (v * v'))" | 
| 455 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 28984 | 456 | by (simp add: nat_mult_distrib) | 
| 23164 | 457 | |
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 458 | (* TODO: replace mult_nat_number_of with this next rule *) | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 459 | lemma semiring_mult_number_of: | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 460 | "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow> | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 461 | (number_of v :: 'a::number_semiring) * number_of v' = number_of (v * v')" | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 462 | unfolding Int.Pls_def | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 463 | by (elim nonneg_int_cases, | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 464 | simp only: number_of_int of_nat_mult [symmetric]) | 
| 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 465 | |
| 23164 | 466 | |
| 467 | subsection{*Comparisons*}
 | |
| 468 | ||
| 469 | subsubsection{*Equals (=) *}
 | |
| 470 | ||
| 471 | lemma eq_nat_number_of [simp]: | |
| 472 | "((number_of v :: nat) = number_of v') = | |
| 28969 | 473 | (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0 | 
| 474 | else if neg (number_of v' :: int) then (number_of v :: int) = 0 | |
| 475 | else v = v')" | |
| 476 | unfolding nat_number_of_def number_of_is_id neg_def | |
| 477 | by auto | |
| 23164 | 478 | |
| 479 | ||
| 480 | subsubsection{*Less-than (<) *}
 | |
| 481 | ||
| 482 | lemma less_nat_number_of [simp]: | |
| 29011 | 483 | "(number_of v :: nat) < number_of v' \<longleftrightarrow> | 
| 484 | (if v < v' then Int.Pls < v' else False)" | |
| 485 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 28961 | 486 | by auto | 
| 23164 | 487 | |
| 488 | ||
| 29010 | 489 | subsubsection{*Less-than-or-equal *}
 | 
| 490 | ||
| 491 | lemma le_nat_number_of [simp]: | |
| 492 | "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow> | |
| 493 | (if v \<le> v' then True else v \<le> Int.Pls)" | |
| 494 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 495 | by auto | |
| 496 | ||
| 23164 | 497 | (*Maps #n to n for n = 0, 1, 2*) | 
| 498 | lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2 | |
| 499 | ||
| 500 | ||
| 501 | subsection{*Powers with Numeric Exponents*}
 | |
| 502 | ||
| 503 | text{*Squares of literal numerals will be evaluated.*}
 | |
| 31014 | 504 | lemmas power2_eq_square_number_of [simp] = | 
| 23164 | 505 | power2_eq_square [of "number_of w", standard] | 
| 506 | ||
| 507 | ||
| 508 | text{*Simprules for comparisons where common factors can be cancelled.*}
 | |
| 509 | lemmas zero_compare_simps = | |
| 510 | add_strict_increasing add_strict_increasing2 add_increasing | |
| 511 | zero_le_mult_iff zero_le_divide_iff | |
| 512 | zero_less_mult_iff zero_less_divide_iff | |
| 513 | mult_le_0_iff divide_le_0_iff | |
| 514 | mult_less_0_iff divide_less_0_iff | |
| 515 | zero_le_power2 power2_less_0 | |
| 516 | ||
| 517 | subsubsection{*Nat *}
 | |
| 518 | ||
| 519 | lemma Suc_pred': "0 < n ==> n = Suc(n - 1)" | |
| 35216 | 520 | by simp | 
| 23164 | 521 | |
| 522 | (*Expresses a natural number constant as the Suc of another one. | |
| 523 | NOT suitable for rewriting because n recurs in the condition.*) | |
| 524 | lemmas expand_Suc = Suc_pred' [of "number_of v", standard] | |
| 525 | ||
| 526 | subsubsection{*Arith *}
 | |
| 527 | ||
| 31790 | 528 | lemma Suc_eq_plus1: "Suc n = n + 1" | 
| 35216 | 529 | unfolding One_nat_def by simp | 
| 23164 | 530 | |
| 31790 | 531 | lemma Suc_eq_plus1_left: "Suc n = 1 + n" | 
| 35216 | 532 | unfolding One_nat_def by simp | 
| 23164 | 533 | |
| 534 | (* These two can be useful when m = number_of... *) | |
| 535 | ||
| 536 | 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 | 537 | unfolding One_nat_def by (cases m) simp_all | 
| 23164 | 538 | |
| 539 | 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 | 540 | unfolding One_nat_def by (cases m) simp_all | 
| 23164 | 541 | |
| 542 | 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 | 543 | unfolding One_nat_def by (cases m) simp_all | 
| 23164 | 544 | |
| 545 | ||
| 546 | subsection{*Comparisons involving (0::nat) *}
 | |
| 547 | ||
| 548 | text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
 | |
| 549 | ||
| 550 | lemma eq_number_of_0 [simp]: | |
| 29012 | 551 | "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls" | 
| 552 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 553 | by auto | |
| 23164 | 554 | |
| 555 | lemma eq_0_number_of [simp]: | |
| 29012 | 556 | "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls" | 
| 23164 | 557 | by (rule trans [OF eq_sym_conv eq_number_of_0]) | 
| 558 | ||
| 559 | lemma less_0_number_of [simp]: | |
| 29012 | 560 | "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v" | 
| 561 | unfolding nat_number_of_def number_of_is_id numeral_simps | |
| 562 | by simp | |
| 23164 | 563 | |
| 564 | lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)" | |
| 28969 | 565 | by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric]) | 
| 23164 | 566 | |
| 567 | ||
| 568 | ||
| 569 | subsection{*Comparisons involving  @{term Suc} *}
 | |
| 570 | ||
| 571 | lemma eq_number_of_Suc [simp]: | |
| 572 | "(number_of v = Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 573 | (let pv = number_of (Int.pred v) in | 
| 23164 | 574 | if neg pv then False else nat pv = n)" | 
| 575 | apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less | |
| 576 | number_of_pred nat_number_of_def | |
| 577 | split add: split_if) | |
| 578 | apply (rule_tac x = "number_of v" in spec) | |
| 579 | apply (auto simp add: nat_eq_iff) | |
| 580 | done | |
| 581 | ||
| 582 | lemma Suc_eq_number_of [simp]: | |
| 583 | "(Suc n = number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 584 | (let pv = number_of (Int.pred v) in | 
| 23164 | 585 | if neg pv then False else nat pv = n)" | 
| 586 | by (rule trans [OF eq_sym_conv eq_number_of_Suc]) | |
| 587 | ||
| 588 | lemma less_number_of_Suc [simp]: | |
| 589 | "(number_of v < Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 590 | (let pv = number_of (Int.pred v) in | 
| 23164 | 591 | if neg pv then True else nat pv < n)" | 
| 592 | apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less | |
| 593 | number_of_pred nat_number_of_def | |
| 594 | split add: split_if) | |
| 595 | apply (rule_tac x = "number_of v" in spec) | |
| 596 | apply (auto simp add: nat_less_iff) | |
| 597 | done | |
| 598 | ||
| 599 | lemma less_Suc_number_of [simp]: | |
| 600 | "(Suc n < number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 601 | (let pv = number_of (Int.pred v) in | 
| 23164 | 602 | if neg pv then False else n < nat pv)" | 
| 603 | apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less | |
| 604 | number_of_pred nat_number_of_def | |
| 605 | split add: split_if) | |
| 606 | apply (rule_tac x = "number_of v" in spec) | |
| 607 | apply (auto simp add: zless_nat_eq_int_zless) | |
| 608 | done | |
| 609 | ||
| 610 | lemma le_number_of_Suc [simp]: | |
| 611 | "(number_of v <= Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 612 | (let pv = number_of (Int.pred v) in | 
| 23164 | 613 | if neg pv then True else nat pv <= n)" | 
| 35216 | 614 | by (simp add: Let_def linorder_not_less [symmetric]) | 
| 23164 | 615 | |
| 616 | lemma le_Suc_number_of [simp]: | |
| 617 | "(Suc n <= number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 618 | (let pv = number_of (Int.pred v) in | 
| 23164 | 619 | if neg pv then False else n <= nat pv)" | 
| 35216 | 620 | by (simp add: Let_def linorder_not_less [symmetric]) | 
| 23164 | 621 | |
| 622 | ||
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 623 | lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min" | 
| 23164 | 624 | by auto | 
| 625 | ||
| 626 | ||
| 627 | ||
| 628 | subsection{*Max and Min Combined with @{term Suc} *}
 | |
| 629 | ||
| 630 | lemma max_number_of_Suc [simp]: | |
| 631 | "max (Suc n) (number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 632 | (let pv = number_of (Int.pred v) in | 
| 23164 | 633 | if neg pv then Suc n else Suc(max n (nat pv)))" | 
| 634 | apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def | |
| 635 | split add: split_if nat.split) | |
| 636 | apply (rule_tac x = "number_of v" in spec) | |
| 637 | apply auto | |
| 638 | done | |
| 639 | ||
| 640 | lemma max_Suc_number_of [simp]: | |
| 641 | "max (number_of v) (Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 642 | (let pv = number_of (Int.pred v) in | 
| 23164 | 643 | if neg pv then Suc n else Suc(max (nat pv) n))" | 
| 644 | apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def | |
| 645 | split add: split_if nat.split) | |
| 646 | apply (rule_tac x = "number_of v" in spec) | |
| 647 | apply auto | |
| 648 | done | |
| 649 | ||
| 650 | lemma min_number_of_Suc [simp]: | |
| 651 | "min (Suc n) (number_of v) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 652 | (let pv = number_of (Int.pred v) in | 
| 23164 | 653 | if neg pv then 0 else Suc(min n (nat pv)))" | 
| 654 | apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def | |
| 655 | split add: split_if nat.split) | |
| 656 | apply (rule_tac x = "number_of v" in spec) | |
| 657 | apply auto | |
| 658 | done | |
| 659 | ||
| 660 | lemma min_Suc_number_of [simp]: | |
| 661 | "min (number_of v) (Suc n) = | |
| 25919 
8b1c0d434824
joined theories IntDef, Numeral, IntArith to theory Int
 haftmann parents: 
25571diff
changeset | 662 | (let pv = number_of (Int.pred v) in | 
| 23164 | 663 | if neg pv then 0 else Suc(min (nat pv) n))" | 
| 664 | apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def | |
| 665 | split add: split_if nat.split) | |
| 666 | apply (rule_tac x = "number_of v" in spec) | |
| 667 | apply auto | |
| 668 | done | |
| 669 | ||
| 670 | subsection{*Literal arithmetic involving powers*}
 | |
| 671 | ||
| 672 | lemma power_nat_number_of: | |
| 673 | "(number_of v :: nat) ^ n = | |
| 674 | (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))" | |
| 675 | by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq | |
| 676 | split add: split_if cong: imp_cong) | |
| 677 | ||
| 678 | ||
| 679 | lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w", standard] | |
| 680 | declare power_nat_number_of_number_of [simp] | |
| 681 | ||
| 682 | ||
| 683 | ||
| 23294 | 684 | text{*For arbitrary rings*}
 | 
| 23164 | 685 | |
| 23294 | 686 | lemma power_number_of_even: | 
| 43526 
2b92a6943915
generalize lemmas power_number_of_even and power_number_of_odd
 huffman parents: 
40690diff
changeset | 687 | fixes z :: "'a::monoid_mult" | 
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 688 | shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)" | 
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 689 | by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 690 | nat_add_distrib power_add simp del: nat_number_of) | 
| 23164 | 691 | |
| 23294 | 692 | lemma power_number_of_odd: | 
| 43526 
2b92a6943915
generalize lemmas power_number_of_even and power_number_of_odd
 huffman parents: 
40690diff
changeset | 693 | fixes z :: "'a::monoid_mult" | 
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 694 | shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w | 
| 23164 | 695 | then (let w = z ^ (number_of w) in z * w * w) else 1)" | 
| 35815 
10e723e54076
tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
 boehmes parents: 
35631diff
changeset | 696 | unfolding Let_def Bit1_def nat_number_of_def number_of_is_id | 
| 
10e723e54076
tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
 boehmes parents: 
35631diff
changeset | 697 | apply (cases "0 <= w") | 
| 
10e723e54076
tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
 boehmes parents: 
35631diff
changeset | 698 | apply (simp only: mult_assoc nat_add_distrib power_add, simp) | 
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 699 | apply (simp add: not_le mult_2 [symmetric] add_assoc) | 
| 23164 | 700 | done | 
| 701 | ||
| 23294 | 702 | lemmas zpower_number_of_even = power_number_of_even [where 'a=int] | 
| 703 | lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int] | |
| 23164 | 704 | |
| 23294 | 705 | lemmas power_number_of_even_number_of [simp] = | 
| 706 | power_number_of_even [of "number_of v", standard] | |
| 23164 | 707 | |
| 23294 | 708 | lemmas power_number_of_odd_number_of [simp] = | 
| 709 | power_number_of_odd [of "number_of v", standard] | |
| 23164 | 710 | |
| 711 | lemma nat_number_of_Pls: "Numeral0 = (0::nat)" | |
| 35216 | 712 | by (simp add: nat_number_of_def) | 
| 23164 | 713 | |
| 40690 
3f472e57446a
added "no_atp" for fact that confuses the SMT normalizer and that doesn't help ATPs anyway
 blanchet parents: 
40077diff
changeset | 714 | lemma nat_number_of_Min [no_atp]: "number_of Int.Min = (0::nat)" | 
| 23164 | 715 | apply (simp only: number_of_Min nat_number_of_def nat_zminus_int) | 
| 716 | done | |
| 717 | ||
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 718 | 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 | 719 | "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)" | 
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 720 | by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 721 | nat_add_distrib simp del: nat_number_of) | 
| 26086 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 722 | |
| 
3c243098b64a
New simpler representation of numerals, using Bit0 and Bit1 instead of BIT, B0, and B1
 huffman parents: 
25965diff
changeset | 723 | 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 | 724 | "number_of (Int.Bit1 w) = | 
| 23164 | 725 | (if neg (number_of w :: int) then 0 | 
| 726 | else let n = number_of w in Suc (n + n))" | |
| 35815 
10e723e54076
tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
 boehmes parents: 
35631diff
changeset | 727 | unfolding Let_def Bit1_def nat_number_of_def number_of_is_id neg_def | 
| 
10e723e54076
tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
 boehmes parents: 
35631diff
changeset | 728 | apply (cases "w < 0") | 
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 729 | apply (simp add: mult_2 [symmetric] add_assoc) | 
| 35815 
10e723e54076
tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
 boehmes parents: 
35631diff
changeset | 730 | apply (simp only: nat_add_distrib, simp) | 
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 731 | done | 
| 23164 | 732 | |
| 40077 | 733 | lemmas eval_nat_numeral = | 
| 35216 | 734 | nat_number_of_Bit0 nat_number_of_Bit1 | 
| 735 | ||
| 36699 
816da1023508
moved nat_arith ot Nat_Numeral: clarified normalizer setup
 haftmann parents: 
35815diff
changeset | 736 | lemmas nat_arith = | 
| 
816da1023508
moved nat_arith ot Nat_Numeral: clarified normalizer setup
 haftmann parents: 
35815diff
changeset | 737 | add_nat_number_of | 
| 
816da1023508
moved nat_arith ot Nat_Numeral: clarified normalizer setup
 haftmann parents: 
35815diff
changeset | 738 | diff_nat_number_of | 
| 
816da1023508
moved nat_arith ot Nat_Numeral: clarified normalizer setup
 haftmann parents: 
35815diff
changeset | 739 | mult_nat_number_of | 
| 
816da1023508
moved nat_arith ot Nat_Numeral: clarified normalizer setup
 haftmann parents: 
35815diff
changeset | 740 | eq_nat_number_of | 
| 
816da1023508
moved nat_arith ot Nat_Numeral: clarified normalizer setup
 haftmann parents: 
35815diff
changeset | 741 | less_nat_number_of | 
| 
816da1023508
moved nat_arith ot Nat_Numeral: clarified normalizer setup
 haftmann parents: 
35815diff
changeset | 742 | |
| 36716 | 743 | lemmas semiring_norm = | 
| 744 | Let_def arith_simps nat_arith rel_simps neg_simps if_False | |
| 745 | if_True add_0 add_Suc add_number_of_left mult_number_of_left | |
| 746 | numeral_1_eq_1 [symmetric] Suc_eq_plus1 | |
| 747 | numeral_0_eq_0 [symmetric] numerals [symmetric] | |
| 36841 
02df88789641
include iszero_simps in semiring_norm just once (they are already included in rel_simps)
 huffman parents: 
36823diff
changeset | 748 | not_iszero_Numeral1 | 
| 36716 | 749 | |
| 23164 | 750 | lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)" | 
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 751 | by (fact Let_def) | 
| 23164 | 752 | |
| 31014 | 753 | lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring})"
 | 
| 754 | by (simp only: number_of_Min power_minus1_even) | |
| 23164 | 755 | |
| 31014 | 756 | lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring})"
 | 
| 757 | by (simp only: number_of_Min power_minus1_odd) | |
| 23164 | 758 | |
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 759 | lemma nat_number_of_add_left: | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 760 | "number_of v + (number_of v' + (k::nat)) = | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 761 | (if neg (number_of v :: int) then number_of v' + k | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 762 | else if neg (number_of v' :: int) then number_of v + k | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 763 | else number_of (v + v') + k)" | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 764 | by (auto simp add: neg_def) | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 765 | |
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 766 | lemma nat_number_of_mult_left: | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 767 | "number_of v * (number_of v' * (k::nat)) = | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 768 | (if v < Int.Pls then 0 | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 769 | else number_of (v * v') * k)" | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 770 | by (auto simp add: not_less Pls_def nat_number_of_def number_of_is_id | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 771 | nat_mult_distrib simp del: nat_number_of) | 
| 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 772 | |
| 23164 | 773 | |
| 774 | subsection{*Literal arithmetic and @{term of_nat}*}
 | |
| 775 | ||
| 776 | lemma of_nat_double: | |
| 777 | "0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)" | |
| 778 | by (simp only: mult_2 nat_add_distrib of_nat_add) | |
| 779 | ||
| 780 | lemma nat_numeral_m1_eq_0: "-1 = (0::nat)" | |
| 781 | by (simp only: nat_number_of_def) | |
| 782 | ||
| 783 | lemma of_nat_number_of_lemma: | |
| 784 | "of_nat (number_of v :: nat) = | |
| 785 | (if 0 \<le> (number_of v :: int) | |
| 786 | then (number_of v :: 'a :: number_ring) | |
| 787 | else 0)" | |
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 788 | by (simp add: int_number_of_def nat_number_of_def number_of_eq of_nat_nat) | 
| 23164 | 789 | |
| 790 | lemma of_nat_number_of_eq [simp]: | |
| 791 | "of_nat (number_of v :: nat) = | |
| 792 | (if neg (number_of v :: int) then 0 | |
| 793 | else (number_of v :: 'a :: number_ring))" | |
| 794 | by (simp only: of_nat_number_of_lemma neg_def, simp) | |
| 795 | ||
| 796 | ||
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 797 | 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 | 798 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 799 | 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 | 800 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 801 | lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)" | 
| 35216 | 802 | by (simp split: nat_diff_split) | 
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 803 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 804 | 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 | 805 | 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 | 806 | tests.*} | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 807 | 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 | 808 | "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 | 809 | 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 | 810 | 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 | 811 | 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 | 812 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 813 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 814 | 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 | 815 | simproc*} | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 816 | lemma Suc_diff_number_of: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 817 | "Int.Pls < v ==> | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 818 | 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 | 819 | 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 | 820 | apply simp | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 821 | 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 | 822 | 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 | 823 | neg_number_of_pred_iff_0) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 824 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 825 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 826 | lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n" | 
| 35216 | 827 | by (simp split: nat_diff_split) | 
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 828 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 829 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 830 | 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 | 831 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 832 | lemma nat_case_number_of [simp]: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 833 | "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 | 834 | (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 | 835 | 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 | 836 | 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 | 837 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 838 | 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 | 839 | "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 | 840 | (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 | 841 | 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 | 842 | apply (subst add_eq_if) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 843 | apply (simp split add: nat.split | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 844 | del: nat_numeral_1_eq_1 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 845 | 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 | 846 | numeral_1_eq_Suc_0 [symmetric] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 847 | neg_number_of_pred_iff_0) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 848 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 849 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 850 | lemma nat_rec_number_of [simp]: | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 851 | "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 | 852 | (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 | 853 | 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 | 854 | 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 | 855 | 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 | 856 | 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 | 857 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 858 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 859 | 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 | 860 | "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 | 861 | (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 | 862 | 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 | 863 | 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 | 864 | apply (subst add_eq_if) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 865 | apply (simp split add: nat.split | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 866 | del: nat_numeral_1_eq_1 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 867 | 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 | 868 | numeral_1_eq_Suc_0 [symmetric] | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 869 | neg_number_of_pred_iff_0) | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 870 | done | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 871 | |
| 
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 | subsubsection{*Various Other Lemmas*}
 | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 874 | |
| 31080 | 875 | lemma card_UNIV_bool[simp]: "card (UNIV :: bool set) = 2" | 
| 876 | by(simp add: UNIV_bool) | |
| 877 | ||
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 878 | 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 | 879 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 880 | 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 | 881 | lemma nat_mult_2: "2 * z = (z+z::nat)" | 
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 882 | by (rule semiring_mult_2) | 
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 883 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 884 | lemma nat_mult_2_right: "z * 2 = (z+z::nat)" | 
| 43531 
cc46a678faaf
added number_semiring class, plus a few new lemmas;
 huffman parents: 
43526diff
changeset | 885 | by (rule semiring_mult_2_right) | 
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 886 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 887 | 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 | 888 | lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0" | 
| 33296 
a3924d1069e5
moved theory Divides after theory Nat_Numeral; tuned some proof texts
 haftmann parents: 
32069diff
changeset | 889 | by (auto simp add: nat_1_add_1 [symmetric]) | 
| 30652 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 890 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 891 | 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 | 892 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 893 | 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 | 894 | by simp | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 895 | |
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 896 | 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 | 897 | by simp | 
| 
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 | 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 | 900 | 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 | 901 | by simp | 
| 
752329615264
distributed contents of theory Arith_Tools to theories Int, IntDiv and NatBin accordingly
 haftmann parents: 
30497diff
changeset | 902 | |
| 31096 | 903 | end |