| author | wenzelm | 
| Mon, 06 Sep 2021 12:23:06 +0200 | |
| changeset 74245 | 282cd3aa6cc6 | 
| parent 74101 | d804e93ae9ff | 
| child 74592 | 3c587b7c3d5c | 
| permissions | -rw-r--r-- | 
| 41959 | 1 | (* Title: HOL/Parity.thy | 
| 2 | Author: Jeremy Avigad | |
| 3 | Author: Jacques D. Fleuriot | |
| 21256 | 4 | *) | 
| 5 | ||
| 60758 | 6 | section \<open>Parity in rings and semirings\<close> | 
| 21256 | 7 | |
| 8 | theory Parity | |
| 66815 | 9 | imports Euclidean_Division | 
| 21256 | 10 | begin | 
| 11 | ||
| 61799 | 12 | subsection \<open>Ring structures with parity and \<open>even\<close>/\<open>odd\<close> predicates\<close> | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 13 | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 14 | class semiring_parity = comm_semiring_1 + semiring_modulo + | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 15 | assumes even_iff_mod_2_eq_zero: "2 dvd a \<longleftrightarrow> a mod 2 = 0" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 16 | and odd_iff_mod_2_eq_one: "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 17 | and odd_one [simp]: "\<not> 2 dvd 1" | 
| 66839 | 18 | begin | 
| 19 | ||
| 58740 | 20 | abbreviation even :: "'a \<Rightarrow> bool" | 
| 63654 | 21 | where "even a \<equiv> 2 dvd a" | 
| 54228 | 22 | |
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 23 | abbreviation odd :: "'a \<Rightarrow> bool" | 
| 63654 | 24 | where "odd a \<equiv> \<not> 2 dvd a" | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 25 | |
| 66815 | 26 | lemma parity_cases [case_names even odd]: | 
| 27 | assumes "even a \<Longrightarrow> a mod 2 = 0 \<Longrightarrow> P" | |
| 28 | assumes "odd a \<Longrightarrow> a mod 2 = 1 \<Longrightarrow> P" | |
| 29 | shows P | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 30 | using assms by (cases "even a") | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 31 | (simp_all add: even_iff_mod_2_eq_zero [symmetric] odd_iff_mod_2_eq_one [symmetric]) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 32 | |
| 71181 | 33 | lemma odd_of_bool_self [simp]: | 
| 34 | \<open>odd (of_bool p) \<longleftrightarrow> p\<close> | |
| 35 | by (cases p) simp_all | |
| 36 | ||
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 37 | lemma not_mod_2_eq_0_eq_1 [simp]: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 38 | "a mod 2 \<noteq> 0 \<longleftrightarrow> a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 39 | by (cases a rule: parity_cases) simp_all | 
| 66815 | 40 | |
| 41 | lemma not_mod_2_eq_1_eq_0 [simp]: | |
| 42 | "a mod 2 \<noteq> 1 \<longleftrightarrow> a mod 2 = 0" | |
| 43 | by (cases a rule: parity_cases) simp_all | |
| 44 | ||
| 58690 | 45 | lemma evenE [elim?]: | 
| 46 | assumes "even a" | |
| 47 | obtains b where "a = 2 * b" | |
| 58740 | 48 | using assms by (rule dvdE) | 
| 58690 | 49 | |
| 58681 | 50 | lemma oddE [elim?]: | 
| 58680 | 51 | assumes "odd a" | 
| 52 | obtains b where "a = 2 * b + 1" | |
| 58787 | 53 | proof - | 
| 66815 | 54 | have "a = 2 * (a div 2) + a mod 2" | 
| 55 | by (simp add: mult_div_mod_eq) | |
| 56 | with assms have "a = 2 * (a div 2) + 1" | |
| 57 | by (simp add: odd_iff_mod_2_eq_one) | |
| 58 | then show ?thesis .. | |
| 59 | qed | |
| 60 | ||
| 61 | lemma mod_2_eq_odd: | |
| 62 | "a mod 2 = of_bool (odd a)" | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 63 | by (auto elim: oddE simp add: even_iff_mod_2_eq_zero) | 
| 66815 | 64 | |
| 67816 | 65 | lemma of_bool_odd_eq_mod_2: | 
| 66 | "of_bool (odd a) = a mod 2" | |
| 67 | by (simp add: mod_2_eq_odd) | |
| 68 | ||
| 71426 | 69 | lemma even_mod_2_iff [simp]: | 
| 70 | \<open>even (a mod 2) \<longleftrightarrow> even a\<close> | |
| 71 | by (simp add: mod_2_eq_odd) | |
| 72 | ||
| 73 | lemma mod2_eq_if: | |
| 74 | "a mod 2 = (if even a then 0 else 1)" | |
| 75 | by (simp add: mod_2_eq_odd) | |
| 76 | ||
| 66815 | 77 | lemma even_zero [simp]: | 
| 78 | "even 0" | |
| 79 | by (fact dvd_0_right) | |
| 80 | ||
| 81 | lemma odd_even_add: | |
| 82 | "even (a + b)" if "odd a" and "odd b" | |
| 83 | proof - | |
| 84 | from that obtain c d where "a = 2 * c + 1" and "b = 2 * d + 1" | |
| 85 | by (blast elim: oddE) | |
| 86 | then have "a + b = 2 * c + 2 * d + (1 + 1)" | |
| 87 | by (simp only: ac_simps) | |
| 88 | also have "\<dots> = 2 * (c + d + 1)" | |
| 89 | by (simp add: algebra_simps) | |
| 90 | finally show ?thesis .. | |
| 91 | qed | |
| 92 | ||
| 93 | lemma even_add [simp]: | |
| 94 | "even (a + b) \<longleftrightarrow> (even a \<longleftrightarrow> even b)" | |
| 95 | by (auto simp add: dvd_add_right_iff dvd_add_left_iff odd_even_add) | |
| 96 | ||
| 97 | lemma odd_add [simp]: | |
| 98 | "odd (a + b) \<longleftrightarrow> \<not> (odd a \<longleftrightarrow> odd b)" | |
| 99 | by simp | |
| 100 | ||
| 101 | lemma even_plus_one_iff [simp]: | |
| 102 | "even (a + 1) \<longleftrightarrow> odd a" | |
| 103 | by (auto simp add: dvd_add_right_iff intro: odd_even_add) | |
| 104 | ||
| 105 | lemma even_mult_iff [simp]: | |
| 106 | "even (a * b) \<longleftrightarrow> even a \<or> even b" (is "?P \<longleftrightarrow> ?Q") | |
| 107 | proof | |
| 108 | assume ?Q | |
| 109 | then show ?P | |
| 110 | by auto | |
| 111 | next | |
| 112 | assume ?P | |
| 113 | show ?Q | |
| 114 | proof (rule ccontr) | |
| 115 | assume "\<not> (even a \<or> even b)" | |
| 116 | then have "odd a" and "odd b" | |
| 117 | by auto | |
| 118 | then obtain r s where "a = 2 * r + 1" and "b = 2 * s + 1" | |
| 119 | by (blast elim: oddE) | |
| 120 | then have "a * b = (2 * r + 1) * (2 * s + 1)" | |
| 121 | by simp | |
| 122 | also have "\<dots> = 2 * (2 * r * s + r + s) + 1" | |
| 123 | by (simp add: algebra_simps) | |
| 124 | finally have "odd (a * b)" | |
| 125 | by simp | |
| 126 | with \<open>?P\<close> show False | |
| 127 | by auto | |
| 128 | qed | |
| 129 | qed | |
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 130 | |
| 63654 | 131 | lemma even_numeral [simp]: "even (numeral (Num.Bit0 n))" | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 132 | proof - | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 133 | have "even (2 * numeral n)" | 
| 66815 | 134 | unfolding even_mult_iff by simp | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 135 | then have "even (numeral n + numeral n)" | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 136 | unfolding mult_2 . | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 137 | then show ?thesis | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 138 | unfolding numeral.simps . | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 139 | qed | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 140 | |
| 63654 | 141 | lemma odd_numeral [simp]: "odd (numeral (Num.Bit1 n))" | 
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 142 | proof | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 143 | assume "even (numeral (num.Bit1 n))" | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 144 | then have "even (numeral n + numeral n + 1)" | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 145 | unfolding numeral.simps . | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 146 | then have "even (2 * numeral n + 1)" | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 147 | unfolding mult_2 . | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 148 | then have "2 dvd numeral n * 2 + 1" | 
| 58740 | 149 | by (simp add: ac_simps) | 
| 63654 | 150 | then have "2 dvd 1" | 
| 151 | using dvd_add_times_triv_left_iff [of 2 "numeral n" 1] by simp | |
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 152 | then show False by simp | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 153 | qed | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 154 | |
| 71755 | 155 | lemma odd_numeral_BitM [simp]: | 
| 156 | \<open>odd (numeral (Num.BitM w))\<close> | |
| 157 | by (cases w) simp_all | |
| 158 | ||
| 63654 | 159 | lemma even_power [simp]: "even (a ^ n) \<longleftrightarrow> even a \<and> n > 0" | 
| 58680 | 160 | by (induct n) auto | 
| 161 | ||
| 71412 | 162 | lemma mask_eq_sum_exp: | 
| 163 |   \<open>2 ^ n - 1 = (\<Sum>m\<in>{q. q < n}. 2 ^ m)\<close>
 | |
| 164 | proof - | |
| 165 |   have *: \<open>{q. q < Suc m} = insert m {q. q < m}\<close> for m
 | |
| 166 | by auto | |
| 167 |   have \<open>2 ^ n = (\<Sum>m\<in>{q. q < n}. 2 ^ m) + 1\<close>
 | |
| 168 | by (induction n) (simp_all add: ac_simps mult_2 *) | |
| 169 |   then have \<open>2 ^ n - 1 = (\<Sum>m\<in>{q. q < n}. 2 ^ m) + 1 - 1\<close>
 | |
| 170 | by simp | |
| 171 | then show ?thesis | |
| 172 | by simp | |
| 173 | qed | |
| 174 | ||
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 175 | end | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 176 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 177 | class ring_parity = ring + semiring_parity | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 178 | begin | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 179 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 180 | subclass comm_ring_1 .. | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 181 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 182 | lemma even_minus: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 183 | "even (- a) \<longleftrightarrow> even a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 184 | by (fact dvd_minus_iff) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 185 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 186 | lemma even_diff [simp]: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 187 | "even (a - b) \<longleftrightarrow> even (a + b)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 188 | using even_add [of a "- b"] by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 189 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 190 | end | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 191 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 192 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 193 | subsection \<open>Special case: euclidean rings containing the natural numbers\<close> | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 194 | |
| 71157 | 195 | context unique_euclidean_semiring_with_nat | 
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 196 | begin | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 197 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 198 | subclass semiring_parity | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 199 | proof | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 200 | show "2 dvd a \<longleftrightarrow> a mod 2 = 0" for a | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 201 | by (fact dvd_eq_mod_eq_0) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 202 | show "\<not> 2 dvd a \<longleftrightarrow> a mod 2 = 1" for a | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 203 | proof | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 204 | assume "a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 205 | then show "\<not> 2 dvd a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 206 | by auto | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 207 | next | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 208 | assume "\<not> 2 dvd a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 209 | have eucl: "euclidean_size (a mod 2) = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 210 | proof (rule order_antisym) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 211 | show "euclidean_size (a mod 2) \<le> 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 212 | using mod_size_less [of 2 a] by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 213 | show "1 \<le> euclidean_size (a mod 2)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 214 | using \<open>\<not> 2 dvd a\<close> by (simp add: Suc_le_eq dvd_eq_mod_eq_0) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 215 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 216 | from \<open>\<not> 2 dvd a\<close> have "\<not> of_nat 2 dvd division_segment a * of_nat (euclidean_size a)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 217 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 218 | then have "\<not> of_nat 2 dvd of_nat (euclidean_size a)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 219 | by (auto simp only: dvd_mult_unit_iff' is_unit_division_segment) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 220 | then have "\<not> 2 dvd euclidean_size a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 221 | using of_nat_dvd_iff [of 2] by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 222 | then have "euclidean_size a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 223 | by (simp add: semidom_modulo_class.dvd_eq_mod_eq_0) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 224 | then have "of_nat (euclidean_size a mod 2) = of_nat 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 225 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 226 | then have "of_nat (euclidean_size a) mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 227 | by (simp add: of_nat_mod) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 228 | from \<open>\<not> 2 dvd a\<close> eucl | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 229 | show "a mod 2 = 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 230 | by (auto intro: division_segment_eq_iff simp add: division_segment_mod) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 231 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 232 | show "\<not> is_unit 2" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 233 | proof (rule notI) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 234 | assume "is_unit 2" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 235 | then have "of_nat 2 dvd of_nat 1" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 236 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 237 | then have "is_unit (2::nat)" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 238 | by (simp only: of_nat_dvd_iff) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 239 | then show False | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 240 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 241 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 242 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 243 | |
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 244 | lemma even_of_nat [simp]: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 245 | "even (of_nat a) \<longleftrightarrow> even a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 246 | proof - | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 247 | have "even (of_nat a) \<longleftrightarrow> of_nat 2 dvd of_nat a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 248 | by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 249 | also have "\<dots> \<longleftrightarrow> even a" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 250 | by (simp only: of_nat_dvd_iff) | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 251 | finally show ?thesis . | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 252 | qed | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 253 | |
| 66815 | 254 | lemma even_succ_div_two [simp]: | 
| 255 | "even a \<Longrightarrow> (a + 1) div 2 = a div 2" | |
| 256 | by (cases "a = 0") (auto elim!: evenE dest: mult_not_zero) | |
| 257 | ||
| 258 | lemma odd_succ_div_two [simp]: | |
| 259 | "odd a \<Longrightarrow> (a + 1) div 2 = a div 2 + 1" | |
| 260 | by (auto elim!: oddE simp add: add.assoc) | |
| 261 | ||
| 262 | lemma even_two_times_div_two: | |
| 263 | "even a \<Longrightarrow> 2 * (a div 2) = a" | |
| 264 | by (fact dvd_mult_div_cancel) | |
| 265 | ||
| 266 | lemma odd_two_times_div_two_succ [simp]: | |
| 267 | "odd a \<Longrightarrow> 2 * (a div 2) + 1 = a" | |
| 268 | using mult_div_mod_eq [of 2 a] | |
| 269 | by (simp add: even_iff_mod_2_eq_zero) | |
| 270 | ||
| 67051 | 271 | lemma coprime_left_2_iff_odd [simp]: | 
| 272 | "coprime 2 a \<longleftrightarrow> odd a" | |
| 273 | proof | |
| 274 | assume "odd a" | |
| 275 | show "coprime 2 a" | |
| 276 | proof (rule coprimeI) | |
| 277 | fix b | |
| 278 | assume "b dvd 2" "b dvd a" | |
| 279 | then have "b dvd a mod 2" | |
| 280 | by (auto intro: dvd_mod) | |
| 281 | with \<open>odd a\<close> show "is_unit b" | |
| 282 | by (simp add: mod_2_eq_odd) | |
| 283 | qed | |
| 284 | next | |
| 285 | assume "coprime 2 a" | |
| 286 | show "odd a" | |
| 287 | proof (rule notI) | |
| 288 | assume "even a" | |
| 289 | then obtain b where "a = 2 * b" .. | |
| 290 | with \<open>coprime 2 a\<close> have "coprime 2 (2 * b)" | |
| 291 | by simp | |
| 292 | moreover have "\<not> coprime 2 (2 * b)" | |
| 293 | by (rule not_coprimeI [of 2]) simp_all | |
| 294 | ultimately show False | |
| 295 | by blast | |
| 296 | qed | |
| 297 | qed | |
| 298 | ||
| 299 | lemma coprime_right_2_iff_odd [simp]: | |
| 300 | "coprime a 2 \<longleftrightarrow> odd a" | |
| 301 | using coprime_left_2_iff_odd [of a] by (simp add: ac_simps) | |
| 302 | ||
| 58678 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 303 | end | 
| 
398e05aa84d4
purely algebraic characterization of even and odd
 haftmann parents: 
58645diff
changeset | 304 | |
| 71157 | 305 | context unique_euclidean_ring_with_nat | 
| 58679 | 306 | begin | 
| 307 | ||
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 308 | subclass ring_parity .. | 
| 58680 | 309 | |
| 67906 | 310 | lemma minus_1_mod_2_eq [simp]: | 
| 311 | "- 1 mod 2 = 1" | |
| 312 | by (simp add: mod_2_eq_odd) | |
| 313 | ||
| 314 | lemma minus_1_div_2_eq [simp]: | |
| 315 | "- 1 div 2 = - 1" | |
| 316 | proof - | |
| 317 | from div_mult_mod_eq [of "- 1" 2] | |
| 318 | have "- 1 div 2 * 2 = - 1 * 2" | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 319 | using add_implies_diff by fastforce | 
| 67906 | 320 | then show ?thesis | 
| 321 | using mult_right_cancel [of 2 "- 1 div 2" "- 1"] by simp | |
| 322 | qed | |
| 323 | ||
| 58679 | 324 | end | 
| 325 | ||
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66582diff
changeset | 326 | |
| 69593 | 327 | subsection \<open>Instance for \<^typ>\<open>nat\<close>\<close> | 
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66582diff
changeset | 328 | |
| 70340 | 329 | instance nat :: unique_euclidean_semiring_with_nat | 
| 66815 | 330 | by standard (simp_all add: dvd_eq_mod_eq_0) | 
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66582diff
changeset | 331 | |
| 66815 | 332 | lemma even_Suc_Suc_iff [simp]: | 
| 333 | "even (Suc (Suc n)) \<longleftrightarrow> even n" | |
| 58787 | 334 | using dvd_add_triv_right_iff [of 2 n] by simp | 
| 58687 | 335 | |
| 66815 | 336 | lemma even_Suc [simp]: "even (Suc n) \<longleftrightarrow> odd n" | 
| 337 | using even_plus_one_iff [of n] by simp | |
| 58787 | 338 | |
| 66815 | 339 | lemma even_diff_nat [simp]: | 
| 340 | "even (m - n) \<longleftrightarrow> m < n \<or> even (m + n)" for m n :: nat | |
| 58787 | 341 | proof (cases "n \<le> m") | 
| 342 | case True | |
| 343 | then have "m - n + n * 2 = m + n" by (simp add: mult_2_right) | |
| 66815 | 344 | moreover have "even (m - n) \<longleftrightarrow> even (m - n + n * 2)" by simp | 
| 345 | ultimately have "even (m - n) \<longleftrightarrow> even (m + n)" by (simp only:) | |
| 58787 | 346 | then show ?thesis by auto | 
| 347 | next | |
| 348 | case False | |
| 349 | then show ?thesis by simp | |
| 63654 | 350 | qed | 
| 351 | ||
| 66815 | 352 | lemma odd_pos: | 
| 353 | "odd n \<Longrightarrow> 0 < n" for n :: nat | |
| 58690 | 354 | by (auto elim: oddE) | 
| 60343 
063698416239
correct sort constraints for abbreviations in type classes
 haftmann parents: 
59816diff
changeset | 355 | |
| 66815 | 356 | lemma Suc_double_not_eq_double: | 
| 357 | "Suc (2 * m) \<noteq> 2 * n" | |
| 62597 | 358 | proof | 
| 359 | assume "Suc (2 * m) = 2 * n" | |
| 360 | moreover have "odd (Suc (2 * m))" and "even (2 * n)" | |
| 361 | by simp_all | |
| 362 | ultimately show False by simp | |
| 363 | qed | |
| 364 | ||
| 66815 | 365 | lemma double_not_eq_Suc_double: | 
| 366 | "2 * m \<noteq> Suc (2 * n)" | |
| 62597 | 367 | using Suc_double_not_eq_double [of n m] by simp | 
| 368 | ||
| 66815 | 369 | lemma odd_Suc_minus_one [simp]: "odd n \<Longrightarrow> Suc (n - Suc 0) = n" | 
| 370 | by (auto elim: oddE) | |
| 60343 
063698416239
correct sort constraints for abbreviations in type classes
 haftmann parents: 
59816diff
changeset | 371 | |
| 66815 | 372 | lemma even_Suc_div_two [simp]: | 
| 373 | "even n \<Longrightarrow> Suc n div 2 = n div 2" | |
| 374 | using even_succ_div_two [of n] by simp | |
| 60343 
063698416239
correct sort constraints for abbreviations in type classes
 haftmann parents: 
59816diff
changeset | 375 | |
| 66815 | 376 | lemma odd_Suc_div_two [simp]: | 
| 377 | "odd n \<Longrightarrow> Suc n div 2 = Suc (n div 2)" | |
| 378 | using odd_succ_div_two [of n] by simp | |
| 60343 
063698416239
correct sort constraints for abbreviations in type classes
 haftmann parents: 
59816diff
changeset | 379 | |
| 66815 | 380 | lemma odd_two_times_div_two_nat [simp]: | 
| 381 | assumes "odd n" | |
| 382 | shows "2 * (n div 2) = n - (1 :: nat)" | |
| 383 | proof - | |
| 384 | from assms have "2 * (n div 2) + 1 = n" | |
| 385 | by (rule odd_two_times_div_two_succ) | |
| 386 | then have "Suc (2 * (n div 2)) - 1 = n - 1" | |
| 58787 | 387 | by simp | 
| 66815 | 388 | then show ?thesis | 
| 389 | by simp | |
| 58787 | 390 | qed | 
| 58680 | 391 | |
| 70341 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 392 | lemma not_mod2_eq_Suc_0_eq_0 [simp]: | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 393 | "n mod 2 \<noteq> Suc 0 \<longleftrightarrow> n mod 2 = 0" | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 394 | using not_mod_2_eq_1_eq_0 [of n] by simp | 
| 
972c0c744e7c
generalized type classes for parity to cover word types also, which contain zero divisors
 haftmann parents: 
70340diff
changeset | 395 | |
| 69502 | 396 | lemma odd_card_imp_not_empty: | 
| 397 |   \<open>A \<noteq> {}\<close> if \<open>odd (card A)\<close>
 | |
| 398 | using that by auto | |
| 399 | ||
| 70365 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 400 | lemma nat_induct2 [case_names 0 1 step]: | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 401 | assumes "P 0" "P 1" and step: "\<And>n::nat. P n \<Longrightarrow> P (n + 2)" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 402 | shows "P n" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 403 | proof (induct n rule: less_induct) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 404 | case (less n) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 405 | show ?case | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 406 | proof (cases "n < Suc (Suc 0)") | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 407 | case True | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 408 | then show ?thesis | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 409 | using assms by (auto simp: less_Suc_eq) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 410 | next | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 411 | case False | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 412 | then obtain k where k: "n = Suc (Suc k)" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 413 | by (force simp: not_less nat_le_iff_add) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 414 | then have "k<n" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 415 | by simp | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 416 | with less assms have "P (k+2)" | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 417 | by blast | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 418 | then show ?thesis | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 419 | by (simp add: k) | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 420 | qed | 
| 
4df0628e8545
a few new lemmas and a bit of tidying
 paulson <lp15@cam.ac.uk> parents: 
70353diff
changeset | 421 | qed | 
| 58687 | 422 | |
| 71413 | 423 | lemma mask_eq_sum_exp_nat: | 
| 424 |   \<open>2 ^ n - Suc 0 = (\<Sum>m\<in>{q. q < n}. 2 ^ m)\<close>
 | |
| 425 | using mask_eq_sum_exp [where ?'a = nat] by simp | |
| 426 | ||
| 71412 | 427 | context semiring_parity | 
| 428 | begin | |
| 429 | ||
| 430 | lemma even_sum_iff: | |
| 431 |   \<open>even (sum f A) \<longleftrightarrow> even (card {a\<in>A. odd (f a)})\<close> if \<open>finite A\<close>
 | |
| 432 | using that proof (induction A) | |
| 433 | case empty | |
| 434 | then show ?case | |
| 435 | by simp | |
| 436 | next | |
| 437 | case (insert a A) | |
| 438 |   moreover have \<open>{b \<in> insert a A. odd (f b)} = (if odd (f a) then {a} else {}) \<union> {b \<in> A. odd (f b)}\<close>
 | |
| 439 | by auto | |
| 440 | ultimately show ?case | |
| 441 | by simp | |
| 442 | qed | |
| 443 | ||
| 444 | lemma even_prod_iff: | |
| 445 | \<open>even (prod f A) \<longleftrightarrow> (\<exists>a\<in>A. even (f a))\<close> if \<open>finite A\<close> | |
| 446 | using that by (induction A) simp_all | |
| 447 | ||
| 448 | lemma even_mask_iff [simp]: | |
| 449 | \<open>even (2 ^ n - 1) \<longleftrightarrow> n = 0\<close> | |
| 450 | proof (cases \<open>n = 0\<close>) | |
| 451 | case True | |
| 452 | then show ?thesis | |
| 453 | by simp | |
| 454 | next | |
| 455 | case False | |
| 456 |   then have \<open>{a. a = 0 \<and> a < n} = {0}\<close>
 | |
| 457 | by auto | |
| 458 | then show ?thesis | |
| 459 | by (auto simp add: mask_eq_sum_exp even_sum_iff) | |
| 460 | qed | |
| 461 | ||
| 462 | end | |
| 463 | ||
| 71138 | 464 | |
| 60758 | 465 | subsection \<open>Parity and powers\<close> | 
| 58689 | 466 | |
| 61531 
ab2e862263e7
Rounding function, uniform limits, cotangent, binomial identities
 eberlm parents: 
60867diff
changeset | 467 | context ring_1 | 
| 58689 | 468 | begin | 
| 469 | ||
| 63654 | 470 | lemma power_minus_even [simp]: "even n \<Longrightarrow> (- a) ^ n = a ^ n" | 
| 58690 | 471 | by (auto elim: evenE) | 
| 58689 | 472 | |
| 63654 | 473 | lemma power_minus_odd [simp]: "odd n \<Longrightarrow> (- a) ^ n = - (a ^ n)" | 
| 58690 | 474 | by (auto elim: oddE) | 
| 475 | ||
| 66815 | 476 | lemma uminus_power_if: | 
| 477 | "(- a) ^ n = (if even n then a ^ n else - (a ^ n))" | |
| 478 | by auto | |
| 479 | ||
| 63654 | 480 | lemma neg_one_even_power [simp]: "even n \<Longrightarrow> (- 1) ^ n = 1" | 
| 58690 | 481 | by simp | 
| 58689 | 482 | |
| 63654 | 483 | lemma neg_one_odd_power [simp]: "odd n \<Longrightarrow> (- 1) ^ n = - 1" | 
| 58690 | 484 | by simp | 
| 58689 | 485 | |
| 66582 | 486 | lemma neg_one_power_add_eq_neg_one_power_diff: "k \<le> n \<Longrightarrow> (- 1) ^ (n + k) = (- 1) ^ (n - k)" | 
| 487 | by (cases "even (n + k)") auto | |
| 488 | ||
| 67371 
2d9cf74943e1
moved in some material from Euler-MacLaurin
 paulson <lp15@cam.ac.uk> parents: 
67083diff
changeset | 489 | lemma minus_one_power_iff: "(- 1) ^ n = (if even n then 1 else - 1)" | 
| 
2d9cf74943e1
moved in some material from Euler-MacLaurin
 paulson <lp15@cam.ac.uk> parents: 
67083diff
changeset | 490 | by (induct n) auto | 
| 
2d9cf74943e1
moved in some material from Euler-MacLaurin
 paulson <lp15@cam.ac.uk> parents: 
67083diff
changeset | 491 | |
| 63654 | 492 | end | 
| 58689 | 493 | |
| 494 | context linordered_idom | |
| 495 | begin | |
| 496 | ||
| 63654 | 497 | lemma zero_le_even_power: "even n \<Longrightarrow> 0 \<le> a ^ n" | 
| 58690 | 498 | by (auto elim: evenE) | 
| 58689 | 499 | |
| 63654 | 500 | lemma zero_le_odd_power: "odd n \<Longrightarrow> 0 \<le> a ^ n \<longleftrightarrow> 0 \<le> a" | 
| 58689 | 501 | by (auto simp add: power_even_eq zero_le_mult_iff elim: oddE) | 
| 502 | ||
| 63654 | 503 | lemma zero_le_power_eq: "0 \<le> a ^ n \<longleftrightarrow> even n \<or> odd n \<and> 0 \<le> a" | 
| 58787 | 504 | by (auto simp add: zero_le_even_power zero_le_odd_power) | 
| 63654 | 505 | |
| 506 | lemma zero_less_power_eq: "0 < a ^ n \<longleftrightarrow> n = 0 \<or> even n \<and> a \<noteq> 0 \<or> odd n \<and> 0 < a" | |
| 58689 | 507 | proof - | 
| 508 | have [simp]: "0 = a ^ n \<longleftrightarrow> a = 0 \<and> n > 0" | |
| 58787 | 509 | unfolding power_eq_0_iff [of a n, symmetric] by blast | 
| 58689 | 510 | show ?thesis | 
| 63654 | 511 | unfolding less_le zero_le_power_eq by auto | 
| 58689 | 512 | qed | 
| 513 | ||
| 63654 | 514 | lemma power_less_zero_eq [simp]: "a ^ n < 0 \<longleftrightarrow> odd n \<and> a < 0" | 
| 58689 | 515 | unfolding not_le [symmetric] zero_le_power_eq by auto | 
| 516 | ||
| 63654 | 517 | lemma power_le_zero_eq: "a ^ n \<le> 0 \<longleftrightarrow> n > 0 \<and> (odd n \<and> a \<le> 0 \<or> even n \<and> a = 0)" | 
| 518 | unfolding not_less [symmetric] zero_less_power_eq by auto | |
| 519 | ||
| 520 | lemma power_even_abs: "even n \<Longrightarrow> \<bar>a\<bar> ^ n = a ^ n" | |
| 58689 | 521 | using power_abs [of a n] by (simp add: zero_le_even_power) | 
| 522 | ||
| 523 | lemma power_mono_even: | |
| 524 | assumes "even n" and "\<bar>a\<bar> \<le> \<bar>b\<bar>" | |
| 525 | shows "a ^ n \<le> b ^ n" | |
| 526 | proof - | |
| 527 | have "0 \<le> \<bar>a\<bar>" by auto | |
| 63654 | 528 | with \<open>\<bar>a\<bar> \<le> \<bar>b\<bar>\<close> have "\<bar>a\<bar> ^ n \<le> \<bar>b\<bar> ^ n" | 
| 529 | by (rule power_mono) | |
| 530 | with \<open>even n\<close> show ?thesis | |
| 531 | by (simp add: power_even_abs) | |
| 58689 | 532 | qed | 
| 533 | ||
| 534 | lemma power_mono_odd: | |
| 535 | assumes "odd n" and "a \<le> b" | |
| 536 | shows "a ^ n \<le> b ^ n" | |
| 537 | proof (cases "b < 0") | |
| 63654 | 538 | case True | 
| 539 | with \<open>a \<le> b\<close> have "- b \<le> - a" and "0 \<le> - b" by auto | |
| 540 | then have "(- b) ^ n \<le> (- a) ^ n" by (rule power_mono) | |
| 60758 | 541 | with \<open>odd n\<close> show ?thesis by simp | 
| 58689 | 542 | next | 
| 63654 | 543 | case False | 
| 544 | then have "0 \<le> b" by auto | |
| 58689 | 545 | show ?thesis | 
| 546 | proof (cases "a < 0") | |
| 63654 | 547 | case True | 
| 548 | then have "n \<noteq> 0" and "a \<le> 0" using \<open>odd n\<close> [THEN odd_pos] by auto | |
| 60758 | 549 | then have "a ^ n \<le> 0" unfolding power_le_zero_eq using \<open>odd n\<close> by auto | 
| 63654 | 550 | moreover from \<open>0 \<le> b\<close> have "0 \<le> b ^ n" by auto | 
| 58689 | 551 | ultimately show ?thesis by auto | 
| 552 | next | |
| 63654 | 553 | case False | 
| 554 | then have "0 \<le> a" by auto | |
| 555 | with \<open>a \<le> b\<close> show ?thesis | |
| 556 | using power_mono by auto | |
| 58689 | 557 | qed | 
| 558 | qed | |
| 62083 | 559 | |
| 60758 | 560 | text \<open>Simplify, when the exponent is a numeral\<close> | 
| 58689 | 561 | |
| 562 | lemma zero_le_power_eq_numeral [simp]: | |
| 563 | "0 \<le> a ^ numeral w \<longleftrightarrow> even (numeral w :: nat) \<or> odd (numeral w :: nat) \<and> 0 \<le> a" | |
| 564 | by (fact zero_le_power_eq) | |
| 565 | ||
| 566 | lemma zero_less_power_eq_numeral [simp]: | |
| 63654 | 567 | "0 < a ^ numeral w \<longleftrightarrow> | 
| 568 | numeral w = (0 :: nat) \<or> | |
| 569 | even (numeral w :: nat) \<and> a \<noteq> 0 \<or> | |
| 570 | odd (numeral w :: nat) \<and> 0 < a" | |
| 58689 | 571 | by (fact zero_less_power_eq) | 
| 572 | ||
| 573 | lemma power_le_zero_eq_numeral [simp]: | |
| 63654 | 574 | "a ^ numeral w \<le> 0 \<longleftrightarrow> | 
| 575 | (0 :: nat) < numeral w \<and> | |
| 576 | (odd (numeral w :: nat) \<and> a \<le> 0 \<or> even (numeral w :: nat) \<and> a = 0)" | |
| 58689 | 577 | by (fact power_le_zero_eq) | 
| 578 | ||
| 579 | lemma power_less_zero_eq_numeral [simp]: | |
| 580 | "a ^ numeral w < 0 \<longleftrightarrow> odd (numeral w :: nat) \<and> a < 0" | |
| 581 | by (fact power_less_zero_eq) | |
| 582 | ||
| 583 | lemma power_even_abs_numeral [simp]: | |
| 584 | "even (numeral w :: nat) \<Longrightarrow> \<bar>a\<bar> ^ numeral w = a ^ numeral w" | |
| 585 | by (fact power_even_abs) | |
| 586 | ||
| 587 | end | |
| 588 | ||
| 71413 | 589 | context unique_euclidean_semiring_with_nat | 
| 590 | begin | |
| 591 | ||
| 592 | lemma even_mask_div_iff': | |
| 593 | \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> m \<le> n\<close> | |
| 594 | proof - | |
| 595 | have \<open>even ((2 ^ m - 1) div 2 ^ n) \<longleftrightarrow> even (of_nat ((2 ^ m - Suc 0) div 2 ^ n))\<close> | |
| 596 | by (simp only: of_nat_div) (simp add: of_nat_diff) | |
| 597 | also have \<open>\<dots> \<longleftrightarrow> even ((2 ^ m - Suc 0) div 2 ^ n)\<close> | |
| 598 | by simp | |
| 599 | also have \<open>\<dots> \<longleftrightarrow> m \<le> n\<close> | |
| 600 | proof (cases \<open>m \<le> n\<close>) | |
| 601 | case True | |
| 602 | then show ?thesis | |
| 603 | by (simp add: Suc_le_lessD) | |
| 604 | next | |
| 605 | case False | |
| 606 | then obtain r where r: \<open>m = n + Suc r\<close> | |
| 607 | using less_imp_Suc_add by fastforce | |
| 608 |     from r have \<open>{q. q < m} \<inter> {q. 2 ^ n dvd (2::nat) ^ q} = {q. n \<le> q \<and> q < m}\<close>
 | |
| 609 | by (auto simp add: dvd_power_iff_le) | |
| 610 |     moreover from r have \<open>{q. q < m} \<inter> {q. \<not> 2 ^ n dvd (2::nat) ^ q} = {q. q < n}\<close>
 | |
| 611 | by (auto simp add: dvd_power_iff_le) | |
| 612 |     moreover from False have \<open>{q. n \<le> q \<and> q < m \<and> q \<le> n} = {n}\<close>
 | |
| 613 | by auto | |
| 614 |     then have \<open>odd ((\<Sum>a\<in>{q. n \<le> q \<and> q < m}. 2 ^ a div (2::nat) ^ n) + sum ((^) 2) {q. q < n} div 2 ^ n)\<close>
 | |
| 615 | by (simp_all add: euclidean_semiring_cancel_class.power_diff_power_eq semiring_parity_class.even_sum_iff not_less mask_eq_sum_exp_nat [symmetric]) | |
| 616 |     ultimately have \<open>odd (sum ((^) (2::nat)) {q. q < m} div 2 ^ n)\<close>
 | |
| 617 | by (subst euclidean_semiring_cancel_class.sum_div_partition) simp_all | |
| 618 | with False show ?thesis | |
| 619 | by (simp add: mask_eq_sum_exp_nat) | |
| 620 | qed | |
| 621 | finally show ?thesis . | |
| 622 | qed | |
| 623 | ||
| 624 | end | |
| 625 | ||
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 626 | |
| 69593 | 627 | subsection \<open>Instance for \<^typ>\<open>int\<close>\<close> | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 628 | |
| 67816 | 629 | lemma even_diff_iff: | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 630 | "even (k - l) \<longleftrightarrow> even (k + l)" for k l :: int | 
| 67816 | 631 | by (fact even_diff) | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 632 | |
| 67816 | 633 | lemma even_abs_add_iff: | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 634 | "even (\<bar>k\<bar> + l) \<longleftrightarrow> even (k + l)" for k l :: int | 
| 67816 | 635 | by simp | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 636 | |
| 67816 | 637 | lemma even_add_abs_iff: | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 638 | "even (k + \<bar>l\<bar>) \<longleftrightarrow> even (k + l)" for k l :: int | 
| 67816 | 639 | by simp | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 640 | |
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 641 | lemma even_nat_iff: "0 \<le> k \<Longrightarrow> even (nat k) \<longleftrightarrow> even k" | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 642 | by (simp add: even_of_nat [of "nat k", where ?'a = int, symmetric]) | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 643 | |
| 71138 | 644 | lemma zdiv_zmult2_eq: | 
| 645 | \<open>a div (b * c) = (a div b) div c\<close> if \<open>c \<ge> 0\<close> for a b c :: int | |
| 646 | proof (cases \<open>b \<ge> 0\<close>) | |
| 647 | case True | |
| 648 | with that show ?thesis | |
| 649 | using div_mult2_eq' [of a \<open>nat b\<close> \<open>nat c\<close>] by simp | |
| 650 | next | |
| 651 | case False | |
| 652 | with that show ?thesis | |
| 653 | using div_mult2_eq' [of \<open>- a\<close> \<open>nat (- b)\<close> \<open>nat c\<close>] by simp | |
| 654 | qed | |
| 655 | ||
| 656 | lemma zmod_zmult2_eq: | |
| 657 | \<open>a mod (b * c) = b * (a div b mod c) + a mod b\<close> if \<open>c \<ge> 0\<close> for a b c :: int | |
| 658 | proof (cases \<open>b \<ge> 0\<close>) | |
| 659 | case True | |
| 660 | with that show ?thesis | |
| 661 | using mod_mult2_eq' [of a \<open>nat b\<close> \<open>nat c\<close>] by simp | |
| 662 | next | |
| 663 | case False | |
| 664 | with that show ?thesis | |
| 665 | using mod_mult2_eq' [of \<open>- a\<close> \<open>nat (- b)\<close> \<open>nat c\<close>] by simp | |
| 666 | qed | |
| 667 | ||
| 71837 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 668 | context | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 669 |   assumes "SORT_CONSTRAINT('a::division_ring)"
 | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 670 | begin | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 671 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 672 | lemma power_int_minus_left: | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 673 | "power_int (-a :: 'a) n = (if even n then power_int a n else -power_int a n)" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 674 | by (auto simp: power_int_def minus_one_power_iff even_nat_iff) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 675 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 676 | lemma power_int_minus_left_even [simp]: "even n \<Longrightarrow> power_int (-a :: 'a) n = power_int a n" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 677 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 678 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 679 | lemma power_int_minus_left_odd [simp]: "odd n \<Longrightarrow> power_int (-a :: 'a) n = -power_int a n" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 680 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 681 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 682 | lemma power_int_minus_left_distrib: | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 683 | "NO_MATCH (-1) x \<Longrightarrow> power_int (-a :: 'a) n = power_int (-1) n * power_int a n" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 684 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 685 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 686 | lemma power_int_minus_one_minus: "power_int (-1 :: 'a) (-n) = power_int (-1) n" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 687 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 688 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 689 | lemma power_int_minus_one_diff_commute: "power_int (-1 :: 'a) (a - b) = power_int (-1) (b - a)" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 690 | by (subst power_int_minus_one_minus [symmetric]) auto | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 691 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 692 | lemma power_int_minus_one_mult_self [simp]: | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 693 | "power_int (-1 :: 'a) m * power_int (-1) m = 1" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 694 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 695 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 696 | lemma power_int_minus_one_mult_self' [simp]: | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 697 | "power_int (-1 :: 'a) m * (power_int (-1) m * b) = b" | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 698 | by (simp add: power_int_minus_left) | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 699 | |
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 700 | end | 
| 
dca11678c495
new constant power_int in HOL
 Manuel Eberl <eberlm@in.tum.de> parents: 
71822diff
changeset | 701 | |
| 71853 | 702 | code_identifier | 
| 703 | code_module Parity \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith | |
| 704 | ||
| 67816 | 705 | end |