| author | Lukas Stevens <mail@lukas-stevens.de> | 
| Fri, 22 Jul 2022 14:21:53 +0000 | |
| changeset 75670 | acf86c9f7698 | 
| parent 75669 | 43f5dfb7fa35 | 
| child 75875 | 48d032035744 | 
| permissions | -rw-r--r-- | 
| 3366 | 1 | (* Title: HOL/Divides.thy | 
| 2 | Author: Lawrence C Paulson, Cambridge University Computer Laboratory | |
| 6865 
5577ffe4c2f1
now div and mod are overloaded; dvd is polymorphic
 paulson parents: 
3366diff
changeset | 3 | Copyright 1999 University of Cambridge | 
| 18154 | 4 | *) | 
| 3366 | 5 | |
| 64785 | 6 | section \<open>More on quotient and remainder\<close> | 
| 3366 | 7 | |
| 15131 | 8 | theory Divides | 
| 66817 | 9 | imports Parity | 
| 15131 | 10 | begin | 
| 3366 | 11 | |
| 66817 | 12 | subsection \<open>More on division\<close> | 
| 60758 | 13 | |
| 64635 | 14 | inductive eucl_rel_int :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" | 
| 15 | where eucl_rel_int_by0: "eucl_rel_int k 0 (0, k)" | |
| 16 | | eucl_rel_int_dividesI: "l \<noteq> 0 \<Longrightarrow> k = q * l \<Longrightarrow> eucl_rel_int k l (q, 0)" | |
| 17 | | eucl_rel_int_remainderI: "sgn r = sgn l \<Longrightarrow> \<bar>r\<bar> < \<bar>l\<bar> | |
| 18 | \<Longrightarrow> k = q * l + r \<Longrightarrow> eucl_rel_int k l (q, r)" | |
| 19 | ||
| 20 | lemma eucl_rel_int_iff: | |
| 21 | "eucl_rel_int k l (q, r) \<longleftrightarrow> | |
| 22 | k = l * q + r \<and> | |
| 23 | (if 0 < l then 0 \<le> r \<and> r < l else if l < 0 then l < r \<and> r \<le> 0 else q = 0)" | |
| 24 | by (cases "r = 0") | |
| 25 | (auto elim!: eucl_rel_int.cases intro: eucl_rel_int_by0 eucl_rel_int_dividesI eucl_rel_int_remainderI | |
| 26 | simp add: ac_simps sgn_1_pos sgn_1_neg) | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 27 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 28 | lemma unique_quotient_lemma: | 
| 68626 | 29 | assumes "b * q' + r' \<le> b * q + r" "0 \<le> r'" "r' < b" "r < b" shows "q' \<le> (q::int)" | 
| 30 | proof - | |
| 31 | have "r' + b * (q'-q) \<le> r" | |
| 32 | using assms by (simp add: right_diff_distrib) | |
| 33 | moreover have "0 < b * (1 + q - q') " | |
| 34 | using assms by (simp add: right_diff_distrib distrib_left) | |
| 35 | moreover have "b * q' < b * (1 + q)" | |
| 36 | using assms by (simp add: right_diff_distrib distrib_left) | |
| 37 | ultimately show ?thesis | |
| 38 | using assms by (simp add: mult_less_cancel_left) | |
| 39 | qed | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 40 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 41 | lemma unique_quotient_lemma_neg: | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 42 | "b * q' + r' \<le> b*q + r \<Longrightarrow> r \<le> 0 \<Longrightarrow> b < r \<Longrightarrow> b < r' \<Longrightarrow> q \<le> (q'::int)" | 
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 43 | using unique_quotient_lemma[where b = "-b" and r = "-r'" and r'="-r"] by auto | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 44 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 45 | lemma unique_quotient: | 
| 64635 | 46 | "eucl_rel_int a b (q, r) \<Longrightarrow> eucl_rel_int a b (q', r') \<Longrightarrow> q = q'" | 
| 68626 | 47 | apply (rule order_antisym) | 
| 48 | apply (simp_all add: eucl_rel_int_iff linorder_neq_iff split: if_split_asm) | |
| 49 | apply (blast intro: order_eq_refl [THEN unique_quotient_lemma] order_eq_refl [THEN unique_quotient_lemma_neg] sym)+ | |
| 64635 | 50 | done | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 51 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 52 | lemma unique_remainder: | 
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 53 | assumes "eucl_rel_int a b (q, r)" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 54 | and "eucl_rel_int a b (q', r')" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 55 | shows "r = r'" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 56 | proof - | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 57 | have "q = q'" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 58 | using assms by (blast intro: unique_quotient) | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 59 | then show "r = r'" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 60 | using assms by (simp add: eucl_rel_int_iff) | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 61 | qed | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 62 | |
| 64635 | 63 | lemma eucl_rel_int: | 
| 64 | "eucl_rel_int k l (k div l, k mod l)" | |
| 64592 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 65 | proof (cases k rule: int_cases3) | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 66 | case zero | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 67 | then show ?thesis | 
| 64635 | 68 | by (simp add: eucl_rel_int_iff divide_int_def modulo_int_def) | 
| 64592 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 69 | next | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 70 | case (pos n) | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 71 | then show ?thesis | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 72 | using div_mult_mod_eq [of n] | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 73 | by (cases l rule: int_cases3) | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 74 | (auto simp del: of_nat_mult of_nat_add | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 75 | simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps | 
| 67118 | 76 | eucl_rel_int_iff divide_int_def modulo_int_def) | 
| 64592 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 77 | next | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 78 | case (neg n) | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 79 | then show ?thesis | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 80 | using div_mult_mod_eq [of n] | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 81 | by (cases l rule: int_cases3) | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 82 | (auto simp del: of_nat_mult of_nat_add | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 83 | simp add: mod_greater_zero_iff_not_dvd of_nat_mult [symmetric] of_nat_add [symmetric] algebra_simps | 
| 67118 | 84 | eucl_rel_int_iff divide_int_def modulo_int_def) | 
| 64592 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 85 | qed | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 86 | |
| 47141 
02d6b816e4b3
move int::ring_div instance upward, simplify several proofs
 huffman parents: 
47140diff
changeset | 87 | lemma divmod_int_unique: | 
| 64635 | 88 | assumes "eucl_rel_int k l (q, r)" | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 89 | shows div_int_unique: "k div l = q" and mod_int_unique: "k mod l = r" | 
| 64635 | 90 | using assms eucl_rel_int [of k l] | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 91 | using unique_quotient [of k l] unique_remainder [of k l] | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 92 | by auto | 
| 64592 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 93 | |
| 64715 | 94 | lemma div_abs_eq_div_nat: | 
| 95 | "\<bar>k\<bar> div \<bar>l\<bar> = int (nat \<bar>k\<bar> div nat \<bar>l\<bar>)" | |
| 96 | by (simp add: divide_int_def) | |
| 97 | ||
| 98 | lemma mod_abs_eq_div_nat: | |
| 99 | "\<bar>k\<bar> mod \<bar>l\<bar> = int (nat \<bar>k\<bar> mod nat \<bar>l\<bar>)" | |
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 100 | by (simp add: modulo_int_def) | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 101 | |
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 102 | lemma zdiv_int: | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 103 | "int (a div b) = int a div int b" | 
| 69695 | 104 | by (simp add: divide_int_def) | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 105 | |
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 106 | lemma zmod_int: | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 107 | "int (a mod b) = int a mod int b" | 
| 69695 | 108 | by (simp add: modulo_int_def) | 
| 64715 | 109 | |
| 110 | lemma div_sgn_abs_cancel: | |
| 111 | fixes k l v :: int | |
| 112 | assumes "v \<noteq> 0" | |
| 113 | shows "(sgn v * \<bar>k\<bar>) div (sgn v * \<bar>l\<bar>) = \<bar>k\<bar> div \<bar>l\<bar>" | |
| 114 | proof - | |
| 115 | from assms have "sgn v = - 1 \<or> sgn v = 1" | |
| 116 | by (cases "v \<ge> 0") auto | |
| 117 | then show ?thesis | |
| 66630 | 118 | using assms unfolding divide_int_def [of "sgn v * \<bar>k\<bar>" "sgn v * \<bar>l\<bar>"] | 
| 119 | by (fastforce simp add: not_less div_abs_eq_div_nat) | |
| 64715 | 120 | qed | 
| 121 | ||
| 122 | lemma div_eq_sgn_abs: | |
| 123 | fixes k l v :: int | |
| 124 | assumes "sgn k = sgn l" | |
| 125 | shows "k div l = \<bar>k\<bar> div \<bar>l\<bar>" | |
| 126 | proof (cases "l = 0") | |
| 127 | case True | |
| 128 | then show ?thesis | |
| 129 | by simp | |
| 130 | next | |
| 131 | case False | |
| 132 | with assms have "(sgn k * \<bar>k\<bar>) div (sgn l * \<bar>l\<bar>) = \<bar>k\<bar> div \<bar>l\<bar>" | |
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 133 | using div_sgn_abs_cancel [of l k l] by simp | 
| 64715 | 134 | then show ?thesis | 
| 135 | by (simp add: sgn_mult_abs) | |
| 136 | qed | |
| 137 | ||
| 138 | lemma div_dvd_sgn_abs: | |
| 139 | fixes k l :: int | |
| 140 | assumes "l dvd k" | |
| 141 | shows "k div l = (sgn k * sgn l) * (\<bar>k\<bar> div \<bar>l\<bar>)" | |
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 142 | proof (cases "k = 0 \<or> l = 0") | 
| 64715 | 143 | case True | 
| 144 | then show ?thesis | |
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 145 | by auto | 
| 64715 | 146 | next | 
| 147 | case False | |
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 148 | then have "k \<noteq> 0" and "l \<noteq> 0" | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 149 | by auto | 
| 64715 | 150 | show ?thesis | 
| 151 | proof (cases "sgn l = sgn k") | |
| 152 | case True | |
| 153 | then show ?thesis | |
| 73535 | 154 | by (auto simp add: div_eq_sgn_abs) | 
| 64715 | 155 | next | 
| 156 | case False | |
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 157 | with \<open>k \<noteq> 0\<close> \<open>l \<noteq> 0\<close> | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 158 | have "sgn l * sgn k = - 1" | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 159 | by (simp add: sgn_if split: if_splits) | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 160 | with assms show ?thesis | 
| 64715 | 161 | unfolding divide_int_def [of k l] | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 162 | by (auto simp add: zdiv_int ac_simps) | 
| 64715 | 163 | qed | 
| 164 | qed | |
| 165 | ||
| 166 | lemma div_noneq_sgn_abs: | |
| 167 | fixes k l :: int | |
| 168 | assumes "l \<noteq> 0" | |
| 169 | assumes "sgn k \<noteq> sgn l" | |
| 170 | shows "k div l = - (\<bar>k\<bar> div \<bar>l\<bar>) - of_bool (\<not> l dvd k)" | |
| 171 | using assms | |
| 172 | by (simp only: divide_int_def [of k l], auto simp add: not_less zdiv_int) | |
| 173 | ||
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 174 | |
| 60758 | 175 | subsubsection \<open>Laws for div and mod with Unary Minus\<close> | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 176 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 177 | lemma zminus1_lemma: | 
| 64635 | 178 | "eucl_rel_int a b (q, r) ==> b \<noteq> 0 | 
| 179 | ==> eucl_rel_int (-a) b (if r=0 then -q else -q - 1, | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 180 | if r=0 then 0 else b-r)" | 
| 66630 | 181 | by (force simp add: eucl_rel_int_iff right_diff_distrib) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 182 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 183 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 184 | lemma zdiv_zminus1_eq_if: | 
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 185 | "b \<noteq> (0::int) | 
| 68631 | 186 | \<Longrightarrow> (-a) div b = (if a mod b = 0 then - (a div b) else - (a div b) - 1)" | 
| 64635 | 187 | by (blast intro: eucl_rel_int [THEN zminus1_lemma, THEN div_int_unique]) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 188 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 189 | lemma zmod_zminus1_eq_if: | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 190 | "(-a::int) mod b = (if a mod b = 0 then 0 else b - (a mod b))" | 
| 68631 | 191 | proof (cases "b = 0") | 
| 192 | case False | |
| 193 | then show ?thesis | |
| 194 | by (blast intro: eucl_rel_int [THEN zminus1_lemma, THEN mod_int_unique]) | |
| 195 | qed auto | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 196 | |
| 64593 
50c715579715
reoriented congruence rules in non-explosive direction
 haftmann parents: 
64592diff
changeset | 197 | lemma zmod_zminus1_not_zero: | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 198 | fixes k l :: int | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 199 | shows "- k mod l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0" | 
| 64592 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 200 | by (simp add: mod_eq_0_iff_dvd) | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 201 | |
| 64593 
50c715579715
reoriented congruence rules in non-explosive direction
 haftmann parents: 
64592diff
changeset | 202 | lemma zmod_zminus2_not_zero: | 
| 64592 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 203 | fixes k l :: int | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 204 | shows "k mod - l \<noteq> 0 \<Longrightarrow> k mod l \<noteq> 0" | 
| 
7759f1766189
more fine-grained type class hierarchy for div and mod
 haftmann parents: 
64250diff
changeset | 205 | by (simp add: mod_eq_0_iff_dvd) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 206 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 207 | lemma zdiv_zminus2_eq_if: | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 208 | "b \<noteq> (0::int) | 
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 209 | ==> a div (-b) = | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 210 | (if a mod b = 0 then - (a div b) else - (a div b) - 1)" | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 211 | by (auto simp add: zdiv_zminus1_eq_if div_minus_right) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 212 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 213 | lemma zmod_zminus2_eq_if: | 
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 214 | "a mod (-b::int) = (if a mod b = 0 then 0 else (a mod b) - b)" | 
| 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 215 | by (auto simp add: zmod_zminus1_eq_if mod_minus_right) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 216 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 217 | |
| 60758 | 218 | subsubsection \<open>Monotonicity in the First Argument (Dividend)\<close> | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 219 | |
| 68631 | 220 | lemma zdiv_mono1: | 
| 221 | fixes b::int | |
| 222 | assumes "a \<le> a'" "0 < b" shows "a div b \<le> a' div b" | |
| 223 | proof (rule unique_quotient_lemma) | |
| 224 | show "b * (a div b) + a mod b \<le> b * (a' div b) + a' mod b" | |
| 225 | using assms(1) by auto | |
| 226 | qed (use assms in auto) | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 227 | |
| 68631 | 228 | lemma zdiv_mono1_neg: | 
| 229 | fixes b::int | |
| 230 | assumes "a \<le> a'" "b < 0" shows "a' div b \<le> a div b" | |
| 231 | proof (rule unique_quotient_lemma_neg) | |
| 232 | show "b * (a div b) + a mod b \<le> b * (a' div b) + a' mod b" | |
| 233 | using assms(1) by auto | |
| 234 | qed (use assms in auto) | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 235 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 236 | |
| 60758 | 237 | subsubsection \<open>Monotonicity in the Second Argument (Divisor)\<close> | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 238 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 239 | lemma q_pos_lemma: | 
| 68631 | 240 | fixes q'::int | 
| 241 | assumes "0 \<le> b'*q' + r'" "r' < b'" "0 < b'" | |
| 242 | shows "0 \<le> q'" | |
| 243 | proof - | |
| 244 | have "0 < b'* (q' + 1)" | |
| 245 | using assms by (simp add: distrib_left) | |
| 246 | with assms show ?thesis | |
| 247 | by (simp add: zero_less_mult_iff) | |
| 248 | qed | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 249 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 250 | lemma zdiv_mono2_lemma: | 
| 68631 | 251 | fixes q'::int | 
| 252 | assumes eq: "b*q + r = b'*q' + r'" and le: "0 \<le> b'*q' + r'" and "r' < b'" "0 \<le> r" "0 < b'" "b' \<le> b" | |
| 253 | shows "q \<le> q'" | |
| 254 | proof - | |
| 255 | have "0 \<le> q'" | |
| 256 | using q_pos_lemma le \<open>r' < b'\<close> \<open>0 < b'\<close> by blast | |
| 257 | moreover have "b*q = r' - r + b'*q'" | |
| 258 | using eq by linarith | |
| 259 | ultimately have "b*q < b* (q' + 1)" | |
| 260 | using mult_right_mono assms unfolding distrib_left by fastforce | |
| 261 | with assms show ?thesis | |
| 262 | by (simp add: mult_less_cancel_left_pos) | |
| 263 | qed | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 264 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 265 | lemma zdiv_mono2: | 
| 68631 | 266 | fixes a::int | 
| 267 | assumes "0 \<le> a" "0 < b'" "b' \<le> b" shows "a div b \<le> a div b'" | |
| 268 | proof (rule zdiv_mono2_lemma) | |
| 269 | have "b \<noteq> 0" | |
| 270 | using assms by linarith | |
| 271 | show "b * (a div b) + a mod b = b' * (a div b') + a mod b'" | |
| 272 | by simp | |
| 273 | qed (use assms in auto) | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 274 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 275 | lemma zdiv_mono2_neg_lemma: | 
| 68631 | 276 | fixes q'::int | 
| 277 | assumes "b*q + r = b'*q' + r'" "b'*q' + r' < 0" "r < b" "0 \<le> r'" "0 < b'" "b' \<le> b" | |
| 278 | shows "q' \<le> q" | |
| 279 | proof - | |
| 280 | have "b'*q' < 0" | |
| 281 | using assms by linarith | |
| 282 | with assms have "q' \<le> 0" | |
| 283 | by (simp add: mult_less_0_iff) | |
| 284 | have "b*q' \<le> b'*q'" | |
| 285 | by (simp add: \<open>q' \<le> 0\<close> assms(6) mult_right_mono_neg) | |
| 286 | then have "b*q' < b* (q + 1)" | |
| 287 | using assms by (simp add: distrib_left) | |
| 288 | then show ?thesis | |
| 289 | using assms by (simp add: mult_less_cancel_left) | |
| 290 | qed | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 291 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 292 | lemma zdiv_mono2_neg: | 
| 68631 | 293 | fixes a::int | 
| 294 | assumes "a < 0" "0 < b'" "b' \<le> b" shows "a div b' \<le> a div b" | |
| 295 | proof (rule zdiv_mono2_neg_lemma) | |
| 296 | have "b \<noteq> 0" | |
| 297 | using assms by linarith | |
| 298 | show "b * (a div b) + a mod b = b' * (a div b') + a mod b'" | |
| 299 | by simp | |
| 300 | qed (use assms in auto) | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 301 | |
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 302 | lemma div_pos_geq: | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 303 | fixes k l :: int | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 304 | assumes "0 < l" and "l \<le> k" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 305 | shows "k div l = (k - l) div l + 1" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 306 | proof - | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 307 | have "k = (k - l) + l" by simp | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 308 | then obtain j where k: "k = j + l" .. | 
| 63499 
9c9a59949887
Tuned looping simp rules in semiring_div
 eberlm <eberlm@in.tum.de> parents: 
63417diff
changeset | 309 | with assms show ?thesis by (simp add: div_add_self2) | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 310 | qed | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 311 | |
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 312 | lemma mod_pos_geq: | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 313 | fixes k l :: int | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 314 | assumes "0 < l" and "l \<le> k" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 315 | shows "k mod l = (k - l) mod l" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 316 | proof - | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 317 | have "k = (k - l) + l" by simp | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 318 | then obtain j where k: "k = j + l" .. | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 319 | with assms show ?thesis by simp | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 320 | qed | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 321 | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 322 | |
| 60758 | 323 | subsubsection \<open>Splitting Rules for div and mod\<close> | 
| 324 | ||
| 325 | text\<open>The proofs of the two lemmas below are essentially identical\<close> | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 326 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 327 | lemma split_pos_lemma: | 
| 67091 | 328 | "0<k \<Longrightarrow> | 
| 329 | P(n div k :: int)(n mod k) = (\<forall>i j. 0\<le>j \<and> j<k \<and> n = k*i + j \<longrightarrow> P i j)" | |
| 66886 | 330 | by auto | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 331 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 332 | lemma split_neg_lemma: | 
| 67091 | 333 | "k<0 \<Longrightarrow> | 
| 334 | P(n div k :: int)(n mod k) = (\<forall>i j. k<j \<and> j\<le>0 \<and> n = k*i + j \<longrightarrow> P i j)" | |
| 66886 | 335 | by auto | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 336 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 337 | lemma split_zdiv: | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 338 | "P(n div k :: int) = | 
| 67091 | 339 | ((k = 0 \<longrightarrow> P 0) \<and> | 
| 340 | (0<k \<longrightarrow> (\<forall>i j. 0\<le>j \<and> j<k \<and> n = k*i + j \<longrightarrow> P i)) \<and> | |
| 341 | (k<0 \<longrightarrow> (\<forall>i j. k<j \<and> j\<le>0 \<and> n = k*i + j \<longrightarrow> P i)))" | |
| 68631 | 342 | proof (cases "k = 0") | 
| 343 | case False | |
| 344 | then show ?thesis | |
| 345 | unfolding linorder_neq_iff | |
| 346 | by (auto simp add: split_pos_lemma [of concl: "\<lambda>x y. P x"] split_neg_lemma [of concl: "\<lambda>x y. P x"]) | |
| 347 | qed auto | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 348 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 349 | lemma split_zmod: | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 350 | "P(n mod k :: int) = | 
| 67091 | 351 | ((k = 0 \<longrightarrow> P n) \<and> | 
| 352 | (0<k \<longrightarrow> (\<forall>i j. 0\<le>j \<and> j<k \<and> n = k*i + j \<longrightarrow> P j)) \<and> | |
| 353 | (k<0 \<longrightarrow> (\<forall>i j. k<j \<and> j\<le>0 \<and> n = k*i + j \<longrightarrow> P j)))" | |
| 68631 | 354 | proof (cases "k = 0") | 
| 355 | case False | |
| 356 | then show ?thesis | |
| 357 | unfolding linorder_neq_iff | |
| 358 | by (auto simp add: split_pos_lemma [of concl: "\<lambda>x y. P y"] split_neg_lemma [of concl: "\<lambda>x y. P y"]) | |
| 359 | qed auto | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 360 | |
| 69593 | 361 | text \<open>Enable (lin)arith to deal with \<^const>\<open>divide\<close> and \<^const>\<open>modulo\<close> | 
| 33730 
1755ca4ec022
Fixed splitting of div and mod on integers (split theorem differed from implementation).
 webertj parents: 
33728diff
changeset | 362 | when these are applied to some constant that is of the form | 
| 69593 | 363 | \<^term>\<open>numeral k\<close>:\<close> | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 364 | declare split_zdiv [of _ _ "numeral k", arith_split] for k | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 365 | declare split_zmod [of _ _ "numeral k", arith_split] for k | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 366 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 367 | |
| 61799 | 368 | subsubsection \<open>Computing \<open>div\<close> and \<open>mod\<close> with shifting\<close> | 
| 47166 | 369 | |
| 64635 | 370 | lemma pos_eucl_rel_int_mult_2: | 
| 47166 | 371 | assumes "0 \<le> b" | 
| 64635 | 372 | assumes "eucl_rel_int a b (q, r)" | 
| 373 | shows "eucl_rel_int (1 + 2*a) (2*b) (q, 1 + 2*r)" | |
| 374 | using assms unfolding eucl_rel_int_iff by auto | |
| 375 | ||
| 376 | lemma neg_eucl_rel_int_mult_2: | |
| 47166 | 377 | assumes "b \<le> 0" | 
| 64635 | 378 | assumes "eucl_rel_int (a + 1) b (q, r)" | 
| 379 | shows "eucl_rel_int (1 + 2*a) (2*b) (q, 2*r - 1)" | |
| 380 | using assms unfolding eucl_rel_int_iff by auto | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 381 | |
| 60758 | 382 | text\<open>computing div by shifting\<close> | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 383 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 384 | lemma pos_zdiv_mult_2: "(0::int) \<le> a ==> (1 + 2*b) div (2*a) = b div a" | 
| 64635 | 385 | using pos_eucl_rel_int_mult_2 [OF _ eucl_rel_int] | 
| 47166 | 386 | by (rule div_int_unique) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 387 | |
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 388 | lemma neg_zdiv_mult_2: | 
| 35815 
10e723e54076
tuned proofs (to avoid linarith error message caused by bootstrapping of HOL)
 boehmes parents: 
35673diff
changeset | 389 | assumes A: "a \<le> (0::int)" shows "(1 + 2*b) div (2*a) = (b+1) div a" | 
| 64635 | 390 | using neg_eucl_rel_int_mult_2 [OF A eucl_rel_int] | 
| 47166 | 391 | by (rule div_int_unique) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 392 | |
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 393 | lemma zdiv_numeral_Bit0 [simp]: | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 394 | "numeral (Num.Bit0 v) div numeral (Num.Bit0 w) = | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 395 | numeral v div (numeral w :: int)" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 396 | unfolding numeral.simps unfolding mult_2 [symmetric] | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 397 | by (rule div_mult_mult1, simp) | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 398 | |
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 399 | lemma zdiv_numeral_Bit1 [simp]: | 
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 400 | "numeral (Num.Bit1 v) div numeral (Num.Bit0 w) = | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 401 | (numeral v div (numeral w :: int))" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 402 | unfolding numeral.simps | 
| 57512 
cc97b347b301
reduced name variants for assoc and commute on plus and mult
 haftmann parents: 
57492diff
changeset | 403 | unfolding mult_2 [symmetric] add.commute [of _ 1] | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 404 | by (rule pos_zdiv_mult_2, simp) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 405 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 406 | lemma pos_zmod_mult_2: | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 407 | fixes a b :: int | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 408 | assumes "0 \<le> a" | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 409 | shows "(1 + 2 * b) mod (2 * a) = 1 + 2 * (b mod a)" | 
| 64635 | 410 | using pos_eucl_rel_int_mult_2 [OF assms eucl_rel_int] | 
| 47166 | 411 | by (rule mod_int_unique) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 412 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 413 | lemma neg_zmod_mult_2: | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 414 | fixes a b :: int | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 415 | assumes "a \<le> 0" | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 416 | shows "(1 + 2 * b) mod (2 * a) = 2 * ((b + 1) mod a) - 1" | 
| 64635 | 417 | using neg_eucl_rel_int_mult_2 [OF assms eucl_rel_int] | 
| 47166 | 418 | by (rule mod_int_unique) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 419 | |
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 420 | lemma zmod_numeral_Bit0 [simp]: | 
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 421 | "numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) = | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 422 | (2::int) * (numeral v mod numeral w)" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 423 | unfolding numeral_Bit0 [of v] numeral_Bit0 [of w] | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 424 | unfolding mult_2 [symmetric] by (rule mod_mult_mult1) | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 425 | |
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 426 | lemma zmod_numeral_Bit1 [simp]: | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 427 | "numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) = | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 428 | 2 * (numeral v mod numeral w) + (1::int)" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 429 | unfolding numeral_Bit1 [of v] numeral_Bit0 [of w] | 
| 57512 
cc97b347b301
reduced name variants for assoc and commute on plus and mult
 haftmann parents: 
57492diff
changeset | 430 | unfolding mult_2 [symmetric] add.commute [of _ 1] | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
46560diff
changeset | 431 | by (rule pos_zmod_mult_2, simp) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 432 | |
| 39489 | 433 | lemma zdiv_eq_0_iff: | 
| 66886 | 434 | "i div k = 0 \<longleftrightarrow> k = 0 \<or> 0 \<le> i \<and> i < k \<or> i \<le> 0 \<and> k < i" (is "?L = ?R") | 
| 435 | for i k :: int | |
| 39489 | 436 | proof | 
| 437 | assume ?L | |
| 66886 | 438 | moreover have "?L \<longrightarrow> ?R" | 
| 439 | by (rule split_zdiv [THEN iffD2]) simp | |
| 440 | ultimately show ?R | |
| 441 | by blast | |
| 39489 | 442 | next | 
| 66886 | 443 | assume ?R then show ?L | 
| 444 | by auto | |
| 39489 | 445 | qed | 
| 446 | ||
| 72610 | 447 | lemma zmod_trivial_iff: | 
| 63947 | 448 | fixes i k :: int | 
| 449 | shows "i mod k = i \<longleftrightarrow> k = 0 \<or> 0 \<le> i \<and> i < k \<or> i \<le> 0 \<and> k < i" | |
| 450 | proof - | |
| 451 | have "i mod k = i \<longleftrightarrow> i div k = 0" | |
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 452 | using div_mult_mod_eq [of i k] by safe auto | 
| 63947 | 453 | with zdiv_eq_0_iff | 
| 454 | show ?thesis | |
| 455 | by simp | |
| 456 | qed | |
| 39489 | 457 | |
| 64785 | 458 | |
| 60758 | 459 | subsubsection \<open>Quotients of Signs\<close> | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 460 | |
| 67083 | 461 | lemma div_eq_minus1: "0 < b \<Longrightarrow> - 1 div b = - 1" for b :: int | 
| 462 | by (simp add: divide_int_def) | |
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 463 | |
| 67083 | 464 | lemma zmod_minus1: "0 < b \<Longrightarrow> - 1 mod b = b - 1" for b :: int | 
| 465 | by (auto simp add: modulo_int_def) | |
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 466 | |
| 71991 | 467 | lemma minus_mod_int_eq: | 
| 468 | \<open>- k mod l = l - 1 - (k - 1) mod l\<close> if \<open>l \<ge> 0\<close> for k l :: int | |
| 469 | proof (cases \<open>l = 0\<close>) | |
| 470 | case True | |
| 471 | then show ?thesis | |
| 472 | by simp | |
| 473 | next | |
| 474 | case False | |
| 475 | with that have \<open>l > 0\<close> | |
| 476 | by simp | |
| 477 | then show ?thesis | |
| 478 | proof (cases \<open>l dvd k\<close>) | |
| 479 | case True | |
| 480 | then obtain j where \<open>k = l * j\<close> .. | |
| 481 | moreover have \<open>(l * j mod l - 1) mod l = l - 1\<close> | |
| 482 | using \<open>l > 0\<close> by (simp add: zmod_minus1) | |
| 483 | then have \<open>(l * j - 1) mod l = l - 1\<close> | |
| 484 | by (simp only: mod_simps) | |
| 485 | ultimately show ?thesis | |
| 486 | by simp | |
| 487 | next | |
| 488 | case False | |
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 489 | moreover have 1: \<open>0 < k mod l\<close> | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 490 | using \<open>0 < l\<close> False le_less by fastforce | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 491 | moreover have 2: \<open>k mod l < 1 + l\<close> | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 492 | using \<open>0 < l\<close> pos_mod_bound[of l k] by linarith | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 493 | from 1 2 \<open>l > 0\<close> have \<open>(k mod l - 1) mod l = k mod l - 1\<close> | 
| 72610 | 494 | by (simp add: zmod_trivial_iff) | 
| 71991 | 495 | ultimately show ?thesis | 
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 496 | by (simp only: zmod_zminus1_eq_if) | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 497 | (simp add: mod_eq_0_iff_dvd algebra_simps mod_simps) | 
| 71991 | 498 | qed | 
| 499 | qed | |
| 500 | ||
| 68631 | 501 | lemma div_neg_pos_less0: | 
| 502 | fixes a::int | |
| 503 | assumes "a < 0" "0 < b" | |
| 504 | shows "a div b < 0" | |
| 505 | proof - | |
| 506 | have "a div b \<le> - 1 div b" | |
| 68644 
242d298526a3
de-applying and simplifying proofs
 paulson <lp15@cam.ac.uk> parents: 
68631diff
changeset | 507 | using zdiv_mono1 assms by auto | 
| 68631 | 508 | also have "... \<le> -1" | 
| 509 | by (simp add: assms(2) div_eq_minus1) | |
| 510 | finally show ?thesis | |
| 511 | by force | |
| 512 | qed | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 513 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 514 | lemma div_nonneg_neg_le0: "[| (0::int) \<le> a; b < 0 |] ==> a div b \<le> 0" | 
| 68631 | 515 | by (drule zdiv_mono1_neg, auto) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 516 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 517 | lemma div_nonpos_pos_le0: "[| (a::int) \<le> 0; b > 0 |] ==> a div b \<le> 0" | 
| 68631 | 518 | by (drule zdiv_mono1, auto) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 519 | |
| 61799 | 520 | text\<open>Now for some equivalences of the form \<open>a div b >=< 0 \<longleftrightarrow> \<dots>\<close> | 
| 521 | conditional upon the sign of \<open>a\<close> or \<open>b\<close>. There are many more. | |
| 60758 | 522 | They should all be simp rules unless that causes too much search.\<close> | 
| 33804 | 523 | |
| 68631 | 524 | lemma pos_imp_zdiv_nonneg_iff: | 
| 525 | fixes a::int | |
| 526 | assumes "0 < b" | |
| 527 | shows "(0 \<le> a div b) = (0 \<le> a)" | |
| 528 | proof | |
| 529 | show "0 \<le> a div b \<Longrightarrow> 0 \<le> a" | |
| 530 | using assms | |
| 531 | by (simp add: linorder_not_less [symmetric]) (blast intro: div_neg_pos_less0) | |
| 532 | next | |
| 533 | assume "0 \<le> a" | |
| 534 | then have "0 div b \<le> a div b" | |
| 535 | using zdiv_mono1 assms by blast | |
| 536 | then show "0 \<le> a div b" | |
| 537 | by auto | |
| 538 | qed | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 539 | |
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 540 | lemma pos_imp_zdiv_pos_iff: | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 541 | "0<k \<Longrightarrow> 0 < (i::int) div k \<longleftrightarrow> k \<le> i" | 
| 68631 | 542 | using pos_imp_zdiv_nonneg_iff[of k i] zdiv_eq_0_iff[of i k] by arith | 
| 543 | ||
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 544 | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 545 | lemma neg_imp_zdiv_nonneg_iff: | 
| 68631 | 546 | fixes a::int | 
| 547 | assumes "b < 0" | |
| 548 | shows "(0 \<le> a div b) = (a \<le> 0)" | |
| 549 | using assms by (simp add: div_minus_minus [of a, symmetric] pos_imp_zdiv_nonneg_iff del: div_minus_minus) | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 550 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 551 | (*But not (a div b \<le> 0 iff a\<le>0); consider a=1, b=2 when a div b = 0.*) | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 552 | lemma pos_imp_zdiv_neg_iff: "(0::int) < b ==> (a div b < 0) = (a < 0)" | 
| 68631 | 553 | by (simp add: linorder_not_le [symmetric] pos_imp_zdiv_nonneg_iff) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 554 | |
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 555 | (*Again the law fails for \<le>: consider a = -1, b = -2 when a div b = 0*) | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 556 | lemma neg_imp_zdiv_neg_iff: "b < (0::int) ==> (a div b < 0) = (0 < a)" | 
| 68631 | 557 | by (simp add: linorder_not_le [symmetric] neg_imp_zdiv_nonneg_iff) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 558 | |
| 33804 | 559 | lemma nonneg1_imp_zdiv_pos_iff: | 
| 68631 | 560 | fixes a::int | 
| 561 | assumes "0 \<le> a" | |
| 562 | shows "a div b > 0 \<longleftrightarrow> a \<ge> b \<and> b>0" | |
| 563 | proof - | |
| 564 | have "0 < a div b \<Longrightarrow> b \<le> a" | |
| 565 | using div_pos_pos_trivial[of a b] assms by arith | |
| 566 | moreover have "0 < a div b \<Longrightarrow> b > 0" | |
| 567 | using assms div_nonneg_neg_le0[of a b] by(cases "b=0"; force) | |
| 568 | moreover have "b \<le> a \<and> 0 < b \<Longrightarrow> 0 < a div b" | |
| 569 | using int_one_le_iff_zero_less[of "a div b"] zdiv_mono1[of b a b] by simp | |
| 570 | ultimately show ?thesis | |
| 571 | by blast | |
| 572 | qed | |
| 33804 | 573 | |
| 68631 | 574 | lemma zmod_le_nonneg_dividend: "(m::int) \<ge> 0 \<Longrightarrow> m mod k \<le> m" | 
| 575 | by (rule split_zmod[THEN iffD2]) (fastforce dest: q_pos_lemma intro: split_mult_pos_le) | |
| 60930 | 576 | |
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 577 | |
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 578 | subsubsection \<open>Further properties\<close> | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 579 | |
| 66817 | 580 | lemma div_int_pos_iff: | 
| 581 | "k div l \<ge> 0 \<longleftrightarrow> k = 0 \<or> l = 0 \<or> k \<ge> 0 \<and> l \<ge> 0 | |
| 582 | \<or> k < 0 \<and> l < 0" | |
| 583 | for k l :: int | |
| 68631 | 584 | proof (cases "k = 0 \<or> l = 0") | 
| 585 | case False | |
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 586 | then have *: "k \<noteq> 0" "l \<noteq> 0" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 587 | by auto | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 588 | then have "0 \<le> k div l \<Longrightarrow> \<not> k < 0 \<Longrightarrow> 0 \<le> l" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 589 | by (meson neg_imp_zdiv_neg_iff not_le not_less_iff_gr_or_eq) | 
| 68631 | 590 | then show ?thesis | 
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 591 | using * by (auto simp add: pos_imp_zdiv_nonneg_iff neg_imp_zdiv_nonneg_iff) | 
| 68631 | 592 | qed auto | 
| 66817 | 593 | |
| 594 | lemma mod_int_pos_iff: | |
| 595 | "k mod l \<ge> 0 \<longleftrightarrow> l dvd k \<or> l = 0 \<and> k \<ge> 0 \<or> l > 0" | |
| 596 | for k l :: int | |
| 68631 | 597 | proof (cases "l > 0") | 
| 598 | case False | |
| 599 | then show ?thesis | |
| 69695 | 600 | by (simp add: dvd_eq_mod_eq_0) (use neg_mod_sign [of l k] in \<open>auto simp add: le_less not_less\<close>) | 
| 68631 | 601 | qed auto | 
| 66817 | 602 | |
| 68631 | 603 | text \<open>Simplify expressions in which div and mod combine numerical constants\<close> | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 604 | |
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 605 | lemma int_div_pos_eq: "\<lbrakk>(a::int) = b * q + r; 0 \<le> r; r < b\<rbrakk> \<Longrightarrow> a div b = q" | 
| 64635 | 606 | by (rule div_int_unique [of a b q r]) (simp add: eucl_rel_int_iff) | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 607 | |
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 608 | lemma int_div_neg_eq: "\<lbrakk>(a::int) = b * q + r; r \<le> 0; b < r\<rbrakk> \<Longrightarrow> a div b = q" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 609 | by (rule div_int_unique [of a b q r], | 
| 64635 | 610 | simp add: eucl_rel_int_iff) | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 611 | |
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 612 | lemma int_mod_pos_eq: "\<lbrakk>(a::int) = b * q + r; 0 \<le> r; r < b\<rbrakk> \<Longrightarrow> a mod b = r" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 613 | by (rule mod_int_unique [of a b q r], | 
| 64635 | 614 | simp add: eucl_rel_int_iff) | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 615 | |
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 616 | lemma int_mod_neg_eq: "\<lbrakk>(a::int) = b * q + r; r \<le> 0; b < r\<rbrakk> \<Longrightarrow> a mod b = r" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 617 | by (rule mod_int_unique [of a b q r], | 
| 64635 | 618 | simp add: eucl_rel_int_iff) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 619 | |
| 61944 | 620 | lemma abs_div: "(y::int) dvd x \<Longrightarrow> \<bar>x div y\<bar> = \<bar>x\<bar> div \<bar>y\<bar>" | 
| 68631 | 621 | unfolding dvd_def by (cases "y=0") (auto simp add: abs_mult) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 622 | |
| 60758 | 623 | text\<open>Suggested by Matthias Daum\<close> | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 624 | lemma int_power_div_base: | 
| 68631 | 625 | fixes k :: int | 
| 626 | assumes "0 < m" "0 < k" | |
| 627 | shows "k ^ m div k = (k::int) ^ (m - Suc 0)" | |
| 628 | proof - | |
| 629 | have eq: "k ^ m = k ^ ((m - Suc 0) + Suc 0)" | |
| 630 | by (simp add: assms) | |
| 631 | show ?thesis | |
| 632 | using assms by (simp only: power_add eq) auto | |
| 633 | qed | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 634 | |
| 60758 | 635 | text\<open>Suggested by Matthias Daum\<close> | 
| 68631 | 636 | lemma int_div_less_self: | 
| 637 | fixes x::int | |
| 638 | assumes "0 < x" "1 < k" | |
| 639 | shows "x div k < x" | |
| 640 | proof - | |
| 641 | have "nat x div nat k < nat x" | |
| 642 | by (simp add: assms) | |
| 643 | with assms show ?thesis | |
| 644 | by (simp add: nat_div_distrib [symmetric]) | |
| 645 | qed | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 646 | |
| 66837 | 647 | lemma mod_eq_dvd_iff_nat: | 
| 648 | "m mod q = n mod q \<longleftrightarrow> q dvd m - n" if "m \<ge> n" for m n q :: nat | |
| 649 | proof - | |
| 650 | have "int m mod int q = int n mod int q \<longleftrightarrow> int q dvd int m - int n" | |
| 651 | by (simp add: mod_eq_dvd_iff) | |
| 652 | with that have "int (m mod q) = int (n mod q) \<longleftrightarrow> int q dvd int (m - n)" | |
| 653 | by (simp only: of_nat_mod of_nat_diff) | |
| 654 | then show ?thesis | |
| 67118 | 655 | by simp | 
| 66837 | 656 | qed | 
| 657 | ||
| 658 | lemma mod_eq_nat1E: | |
| 659 | fixes m n q :: nat | |
| 660 | assumes "m mod q = n mod q" and "m \<ge> n" | |
| 661 | obtains s where "m = n + q * s" | |
| 662 | proof - | |
| 663 | from assms have "q dvd m - n" | |
| 664 | by (simp add: mod_eq_dvd_iff_nat) | |
| 665 | then obtain s where "m - n = q * s" .. | |
| 666 | with \<open>m \<ge> n\<close> have "m = n + q * s" | |
| 667 | by simp | |
| 668 | with that show thesis . | |
| 669 | qed | |
| 670 | ||
| 671 | lemma mod_eq_nat2E: | |
| 672 | fixes m n q :: nat | |
| 673 | assumes "m mod q = n mod q" and "n \<ge> m" | |
| 674 | obtains s where "n = m + q * s" | |
| 675 | using assms mod_eq_nat1E [of n q m] by (auto simp add: ac_simps) | |
| 676 | ||
| 677 | lemma nat_mod_eq_lemma: | |
| 678 | assumes "(x::nat) mod n = y mod n" and "y \<le> x" | |
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 679 | shows "\<exists>q. x = y + n * q" | 
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 680 | using assms by (rule mod_eq_nat1E) (rule exI) | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 681 | |
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 682 | lemma nat_mod_eq_iff: "(x::nat) mod n = y mod n \<longleftrightarrow> (\<exists>q1 q2. x + n * q1 = y + n * q2)" | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 683 | (is "?lhs = ?rhs") | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 684 | proof | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 685 | assume H: "x mod n = y mod n" | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 686 |   {assume xy: "x \<le> y"
 | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 687 | from H have th: "y mod n = x mod n" by simp | 
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 688 | from nat_mod_eq_lemma[OF th xy] have ?rhs | 
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 689 | proof | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 690 | fix q | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 691 | assume "y = x + n * q" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 692 | then have "x + n * q = y + n * 0" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 693 | by simp | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 694 | then show "\<exists>q1 q2. x + n * q1 = y + n * q2" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 695 | by blast | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 696 | qed} | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 697 | moreover | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 698 |   {assume xy: "y \<le> x"
 | 
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 699 | from nat_mod_eq_lemma[OF H xy] have ?rhs | 
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 700 | proof | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 701 | fix q | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 702 | assume "x = y + n * q" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 703 | then have "x + n * 0 = y + n * q" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 704 | by simp | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 705 | then show "\<exists>q1 q2. x + n * q1 = y + n * q2" | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 706 | by blast | 
| 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 707 | qed} | 
| 60562 
24af00b010cf
Amalgamation of the class comm_semiring_1_diff_distrib into comm_semiring_1_cancel. Moving axiom le_add_diff_inverse2 from semiring_numeral_div to linordered_semidom.
 paulson <lp15@cam.ac.uk> parents: 
60517diff
changeset | 708 | ultimately show ?rhs using linear[of x y] by blast | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 709 | next | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 710 | assume ?rhs then obtain q1 q2 where q12: "x + n * q1 = y + n * q2" by blast | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 711 | hence "(x + n * q1) mod n = (y + n * q2) mod n" by simp | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 712 | thus ?lhs by simp | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 713 | qed | 
| 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 714 | |
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66806diff
changeset | 715 | |
| 68253 | 716 | subsection \<open>Numeral division with a pragmatic type class\<close> | 
| 717 | ||
| 718 | text \<open> | |
| 719 | The following type class contains everything necessary to formulate | |
| 720 | a division algorithm in ring structures with numerals, restricted | |
| 721 | to its positive segments. This is its primary motivation, and it | |
| 722 | could surely be formulated using a more fine-grained, more algebraic | |
| 723 | and less technical class hierarchy. | |
| 724 | \<close> | |
| 725 | ||
| 70340 | 726 | class unique_euclidean_semiring_numeral = unique_euclidean_semiring_with_nat + linordered_semidom + | 
| 68253 | 727 | assumes div_less: "0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a div b = 0" | 
| 728 | and mod_less: " 0 \<le> a \<Longrightarrow> a < b \<Longrightarrow> a mod b = a" | |
| 729 | and div_positive: "0 < b \<Longrightarrow> b \<le> a \<Longrightarrow> a div b > 0" | |
| 730 | and mod_less_eq_dividend: "0 \<le> a \<Longrightarrow> a mod b \<le> a" | |
| 731 | and pos_mod_bound: "0 < b \<Longrightarrow> a mod b < b" | |
| 732 | and pos_mod_sign: "0 < b \<Longrightarrow> 0 \<le> a mod b" | |
| 733 | and mod_mult2_eq: "0 \<le> c \<Longrightarrow> a mod (b * c) = b * (a div b mod c) + a mod b" | |
| 734 | and div_mult2_eq: "0 \<le> c \<Longrightarrow> a div (b * c) = a div b div c" | |
| 735 | assumes discrete: "a < b \<longleftrightarrow> a + 1 \<le> b" | |
| 736 | fixes divmod :: "num \<Rightarrow> num \<Rightarrow> 'a \<times> 'a" | |
| 737 | and divmod_step :: "num \<Rightarrow> 'a \<times> 'a \<Rightarrow> 'a \<times> 'a" | |
| 738 | assumes divmod_def: "divmod m n = (numeral m div numeral n, numeral m mod numeral n)" | |
| 739 | and divmod_step_def: "divmod_step l qr = (let (q, r) = qr | |
| 740 | in if r \<ge> numeral l then (2 * q + 1, r - numeral l) | |
| 741 | else (2 * q, r))" | |
| 742 | \<comment> \<open>These are conceptually definitions but force generated code | |
| 743 | to be monomorphic wrt. particular instances of this class which | |
| 744 | yields a significant speedup.\<close> | |
| 745 | begin | |
| 746 | ||
| 747 | lemma divmod_digit_1: | |
| 748 | assumes "0 \<le> a" "0 < b" and "b \<le> a mod (2 * b)" | |
| 749 | shows "2 * (a div (2 * b)) + 1 = a div b" (is "?P") | |
| 750 | and "a mod (2 * b) - b = a mod b" (is "?Q") | |
| 751 | proof - | |
| 752 | from assms mod_less_eq_dividend [of a "2 * b"] have "b \<le> a" | |
| 753 | by (auto intro: trans) | |
| 754 | with \<open>0 < b\<close> have "0 < a div b" by (auto intro: div_positive) | |
| 755 | then have [simp]: "1 \<le> a div b" by (simp add: discrete) | |
| 756 | with \<open>0 < b\<close> have mod_less: "a mod b < b" by (simp add: pos_mod_bound) | |
| 757 | define w where "w = a div b mod 2" | |
| 758 | then have w_exhaust: "w = 0 \<or> w = 1" by auto | |
| 759 | have mod_w: "a mod (2 * b) = a mod b + b * w" | |
| 760 | by (simp add: w_def mod_mult2_eq ac_simps) | |
| 761 | from assms w_exhaust have "w = 1" | |
| 75669 
43f5dfb7fa35
tuned (some HOL lints, by Yecine Megdiche);
 Fabian Huch <huch@in.tum.de> parents: 
74101diff
changeset | 762 | using mod_less by (auto simp add: mod_w) | 
| 68253 | 763 | with mod_w have mod: "a mod (2 * b) = a mod b + b" by simp | 
| 764 | have "2 * (a div (2 * b)) = a div b - w" | |
| 765 | by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps) | |
| 766 | with \<open>w = 1\<close> have div: "2 * (a div (2 * b)) = a div b - 1" by simp | |
| 767 | then show ?P and ?Q | |
| 768 | by (simp_all add: div mod add_implies_diff [symmetric]) | |
| 769 | qed | |
| 770 | ||
| 771 | lemma divmod_digit_0: | |
| 772 | assumes "0 < b" and "a mod (2 * b) < b" | |
| 773 | shows "2 * (a div (2 * b)) = a div b" (is "?P") | |
| 774 | and "a mod (2 * b) = a mod b" (is "?Q") | |
| 775 | proof - | |
| 776 | define w where "w = a div b mod 2" | |
| 777 | then have w_exhaust: "w = 0 \<or> w = 1" by auto | |
| 778 | have mod_w: "a mod (2 * b) = a mod b + b * w" | |
| 779 | by (simp add: w_def mod_mult2_eq ac_simps) | |
| 780 | moreover have "b \<le> a mod b + b" | |
| 781 | proof - | |
| 782 | from \<open>0 < b\<close> pos_mod_sign have "0 \<le> a mod b" by blast | |
| 783 | then have "0 + b \<le> a mod b + b" by (rule add_right_mono) | |
| 784 | then show ?thesis by simp | |
| 785 | qed | |
| 786 | moreover note assms w_exhaust | |
| 787 | ultimately have "w = 0" by auto | |
| 788 | with mod_w have mod: "a mod (2 * b) = a mod b" by simp | |
| 789 | have "2 * (a div (2 * b)) = a div b - w" | |
| 790 | by (simp add: w_def div_mult2_eq minus_mod_eq_mult_div ac_simps) | |
| 791 | with \<open>w = 0\<close> have div: "2 * (a div (2 * b)) = a div b" by simp | |
| 792 | then show ?P and ?Q | |
| 793 | by (simp_all add: div mod) | |
| 794 | qed | |
| 795 | ||
| 69785 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 796 | lemma mod_double_modulus: | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 797 | assumes "m > 0" "x \<ge> 0" | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 798 | shows "x mod (2 * m) = x mod m \<or> x mod (2 * m) = x mod m + m" | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 799 | proof (cases "x mod (2 * m) < m") | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 800 | case True | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 801 | thus ?thesis using assms using divmod_digit_0(2)[of m x] by auto | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 802 | next | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 803 | case False | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 804 | hence *: "x mod (2 * m) - m = x mod m" | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 805 | using assms by (intro divmod_digit_1) auto | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 806 | hence "x mod (2 * m) = x mod m + m" | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 807 | by (subst * [symmetric], subst le_add_diff_inverse2) (use False in auto) | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 808 | thus ?thesis by simp | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 809 | qed | 
| 
9e326f6f8a24
More material for HOL-Number_Theory: ord, Carmichael's function, primitive roots
 Manuel Eberl <eberlm@in.tum.de> parents: 
69695diff
changeset | 810 | |
| 68253 | 811 | lemma fst_divmod: | 
| 812 | "fst (divmod m n) = numeral m div numeral n" | |
| 813 | by (simp add: divmod_def) | |
| 814 | ||
| 815 | lemma snd_divmod: | |
| 816 | "snd (divmod m n) = numeral m mod numeral n" | |
| 817 | by (simp add: divmod_def) | |
| 818 | ||
| 819 | text \<open> | |
| 820 | This is a formulation of one step (referring to one digit position) | |
| 821 | in school-method division: compare the dividend at the current | |
| 822 | digit position with the remainder from previous division steps | |
| 823 | and evaluate accordingly. | |
| 824 | \<close> | |
| 825 | ||
| 826 | lemma divmod_step_eq [simp]: | |
| 827 | "divmod_step l (q, r) = (if numeral l \<le> r | |
| 828 | then (2 * q + 1, r - numeral l) else (2 * q, r))" | |
| 829 | by (simp add: divmod_step_def) | |
| 830 | ||
| 831 | text \<open> | |
| 832 | This is a formulation of school-method division. | |
| 833 | If the divisor is smaller than the dividend, terminate. | |
| 834 | If not, shift the dividend to the right until termination | |
| 835 | occurs and then reiterate single division steps in the | |
| 836 | opposite direction. | |
| 837 | \<close> | |
| 838 | ||
| 839 | lemma divmod_divmod_step: | |
| 840 | "divmod m n = (if m < n then (0, numeral m) | |
| 841 | else divmod_step n (divmod m (Num.Bit0 n)))" | |
| 842 | proof (cases "m < n") | |
| 843 | case True then have "numeral m < numeral n" by simp | |
| 844 | then show ?thesis | |
| 845 | by (simp add: prod_eq_iff div_less mod_less fst_divmod snd_divmod) | |
| 846 | next | |
| 847 | case False | |
| 848 | have "divmod m n = | |
| 849 | divmod_step n (numeral m div (2 * numeral n), | |
| 850 | numeral m mod (2 * numeral n))" | |
| 851 | proof (cases "numeral n \<le> numeral m mod (2 * numeral n)") | |
| 852 | case True | |
| 853 | with divmod_step_eq | |
| 854 | have "divmod_step n (numeral m div (2 * numeral n), numeral m mod (2 * numeral n)) = | |
| 855 | (2 * (numeral m div (2 * numeral n)) + 1, numeral m mod (2 * numeral n) - numeral n)" | |
| 856 | by simp | |
| 857 | moreover from True divmod_digit_1 [of "numeral m" "numeral n"] | |
| 858 | have "2 * (numeral m div (2 * numeral n)) + 1 = numeral m div numeral n" | |
| 859 | and "numeral m mod (2 * numeral n) - numeral n = numeral m mod numeral n" | |
| 860 | by simp_all | |
| 861 | ultimately show ?thesis by (simp only: divmod_def) | |
| 862 | next | |
| 863 | case False then have *: "numeral m mod (2 * numeral n) < numeral n" | |
| 864 | by (simp add: not_le) | |
| 865 | with divmod_step_eq | |
| 866 | have "divmod_step n (numeral m div (2 * numeral n), numeral m mod (2 * numeral n)) = | |
| 867 | (2 * (numeral m div (2 * numeral n)), numeral m mod (2 * numeral n))" | |
| 868 | by auto | |
| 869 | moreover from * divmod_digit_0 [of "numeral n" "numeral m"] | |
| 870 | have "2 * (numeral m div (2 * numeral n)) = numeral m div numeral n" | |
| 871 | and "numeral m mod (2 * numeral n) = numeral m mod numeral n" | |
| 872 | by (simp_all only: zero_less_numeral) | |
| 873 | ultimately show ?thesis by (simp only: divmod_def) | |
| 874 | qed | |
| 875 | then have "divmod m n = | |
| 876 | divmod_step n (numeral m div numeral (Num.Bit0 n), | |
| 877 | numeral m mod numeral (Num.Bit0 n))" | |
| 878 | by (simp only: numeral.simps distrib mult_1) | |
| 879 | then have "divmod m n = divmod_step n (divmod m (Num.Bit0 n))" | |
| 880 | by (simp add: divmod_def) | |
| 881 | with False show ?thesis by simp | |
| 882 | qed | |
| 883 | ||
| 884 | text \<open>The division rewrite proper -- first, trivial results involving \<open>1\<close>\<close> | |
| 885 | ||
| 886 | lemma divmod_trivial [simp]: | |
| 71756 | 887 | "divmod m Num.One = (numeral m, 0)" | 
| 68253 | 888 | "divmod num.One (num.Bit0 n) = (0, Numeral1)" | 
| 889 | "divmod num.One (num.Bit1 n) = (0, Numeral1)" | |
| 890 | using divmod_divmod_step [of "Num.One"] by (simp_all add: divmod_def) | |
| 891 | ||
| 892 | text \<open>Division by an even number is a right-shift\<close> | |
| 893 | ||
| 894 | lemma divmod_cancel [simp]: | |
| 895 | "divmod (Num.Bit0 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r))" (is ?P) | |
| 896 | "divmod (Num.Bit1 m) (Num.Bit0 n) = (case divmod m n of (q, r) \<Rightarrow> (q, 2 * r + 1))" (is ?Q) | |
| 897 | proof - | |
| 898 | have *: "\<And>q. numeral (Num.Bit0 q) = 2 * numeral q" | |
| 899 | "\<And>q. numeral (Num.Bit1 q) = 2 * numeral q + 1" | |
| 900 | by (simp_all only: numeral_mult numeral.simps distrib) simp_all | |
| 901 | have "1 div 2 = 0" "1 mod 2 = 1" by (auto intro: div_less mod_less) | |
| 902 | then show ?P and ?Q | |
| 903 | by (simp_all add: fst_divmod snd_divmod prod_eq_iff split_def * [of m] * [of n] mod_mult_mult1 | |
| 904 | div_mult2_eq [of _ _ 2] mod_mult2_eq [of _ _ 2] | |
| 905 | add.commute del: numeral_times_numeral) | |
| 906 | qed | |
| 907 | ||
| 908 | text \<open>The really hard work\<close> | |
| 909 | ||
| 910 | lemma divmod_steps [simp]: | |
| 911 | "divmod (num.Bit0 m) (num.Bit1 n) = | |
| 912 | (if m \<le> n then (0, numeral (num.Bit0 m)) | |
| 913 | else divmod_step (num.Bit1 n) | |
| 914 | (divmod (num.Bit0 m) | |
| 915 | (num.Bit0 (num.Bit1 n))))" | |
| 916 | "divmod (num.Bit1 m) (num.Bit1 n) = | |
| 917 | (if m < n then (0, numeral (num.Bit1 m)) | |
| 918 | else divmod_step (num.Bit1 n) | |
| 919 | (divmod (num.Bit1 m) | |
| 920 | (num.Bit0 (num.Bit1 n))))" | |
| 921 | by (simp_all add: divmod_divmod_step) | |
| 922 | ||
| 923 | lemmas divmod_algorithm_code = divmod_step_eq divmod_trivial divmod_cancel divmod_steps | |
| 924 | ||
| 925 | text \<open>Special case: divisibility\<close> | |
| 926 | ||
| 927 | definition divides_aux :: "'a \<times> 'a \<Rightarrow> bool" | |
| 928 | where | |
| 929 | "divides_aux qr \<longleftrightarrow> snd qr = 0" | |
| 930 | ||
| 931 | lemma divides_aux_eq [simp]: | |
| 932 | "divides_aux (q, r) \<longleftrightarrow> r = 0" | |
| 933 | by (simp add: divides_aux_def) | |
| 934 | ||
| 935 | lemma dvd_numeral_simp [simp]: | |
| 936 | "numeral m dvd numeral n \<longleftrightarrow> divides_aux (divmod n m)" | |
| 937 | by (simp add: divmod_def mod_eq_0_iff_dvd) | |
| 938 | ||
| 939 | text \<open>Generic computation of quotient and remainder\<close> | |
| 940 | ||
| 941 | lemma numeral_div_numeral [simp]: | |
| 942 | "numeral k div numeral l = fst (divmod k l)" | |
| 943 | by (simp add: fst_divmod) | |
| 944 | ||
| 945 | lemma numeral_mod_numeral [simp]: | |
| 946 | "numeral k mod numeral l = snd (divmod k l)" | |
| 947 | by (simp add: snd_divmod) | |
| 948 | ||
| 949 | lemma one_div_numeral [simp]: | |
| 950 | "1 div numeral n = fst (divmod num.One n)" | |
| 951 | by (simp add: fst_divmod) | |
| 952 | ||
| 953 | lemma one_mod_numeral [simp]: | |
| 954 | "1 mod numeral n = snd (divmod num.One n)" | |
| 955 | by (simp add: snd_divmod) | |
| 956 | ||
| 957 | text \<open>Computing congruences modulo \<open>2 ^ q\<close>\<close> | |
| 958 | ||
| 959 | lemma cong_exp_iff_simps: | |
| 960 | "numeral n mod numeral Num.One = 0 | |
| 961 | \<longleftrightarrow> True" | |
| 962 | "numeral (Num.Bit0 n) mod numeral (Num.Bit0 q) = 0 | |
| 963 | \<longleftrightarrow> numeral n mod numeral q = 0" | |
| 964 | "numeral (Num.Bit1 n) mod numeral (Num.Bit0 q) = 0 | |
| 965 | \<longleftrightarrow> False" | |
| 966 | "numeral m mod numeral Num.One = (numeral n mod numeral Num.One) | |
| 967 | \<longleftrightarrow> True" | |
| 968 | "numeral Num.One mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) | |
| 969 | \<longleftrightarrow> True" | |
| 970 | "numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) | |
| 971 | \<longleftrightarrow> False" | |
| 972 | "numeral Num.One mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) | |
| 973 | \<longleftrightarrow> (numeral n mod numeral q) = 0" | |
| 974 | "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) | |
| 975 | \<longleftrightarrow> False" | |
| 976 | "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) | |
| 977 | \<longleftrightarrow> numeral m mod numeral q = (numeral n mod numeral q)" | |
| 978 | "numeral (Num.Bit0 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) | |
| 979 | \<longleftrightarrow> False" | |
| 980 | "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral Num.One mod numeral (Num.Bit0 q)) | |
| 981 | \<longleftrightarrow> (numeral m mod numeral q) = 0" | |
| 982 | "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit0 n) mod numeral (Num.Bit0 q)) | |
| 983 | \<longleftrightarrow> False" | |
| 984 | "numeral (Num.Bit1 m) mod numeral (Num.Bit0 q) = (numeral (Num.Bit1 n) mod numeral (Num.Bit0 q)) | |
| 985 | \<longleftrightarrow> numeral m mod numeral q = (numeral n mod numeral q)" | |
| 986 | by (auto simp add: case_prod_beta dest: arg_cong [of _ _ even]) | |
| 987 | ||
| 988 | end | |
| 989 | ||
| 990 | hide_fact (open) div_less mod_less mod_less_eq_dividend mod_mult2_eq div_mult2_eq | |
| 991 | ||
| 992 | instantiation nat :: unique_euclidean_semiring_numeral | |
| 993 | begin | |
| 994 | ||
| 995 | definition divmod_nat :: "num \<Rightarrow> num \<Rightarrow> nat \<times> nat" | |
| 996 | where | |
| 997 | divmod'_nat_def: "divmod_nat m n = (numeral m div numeral n, numeral m mod numeral n)" | |
| 998 | ||
| 999 | definition divmod_step_nat :: "num \<Rightarrow> nat \<times> nat \<Rightarrow> nat \<times> nat" | |
| 1000 | where | |
| 1001 | "divmod_step_nat l qr = (let (q, r) = qr | |
| 1002 | in if r \<ge> numeral l then (2 * q + 1, r - numeral l) | |
| 1003 | else (2 * q, r))" | |
| 1004 | ||
| 1005 | instance by standard | |
| 1006 | (auto simp add: divmod'_nat_def divmod_step_nat_def div_greater_zero_iff div_mult2_eq mod_mult2_eq) | |
| 1007 | ||
| 1008 | end | |
| 1009 | ||
| 1010 | declare divmod_algorithm_code [where ?'a = nat, code] | |
| 1011 | ||
| 1012 | lemma Suc_0_div_numeral [simp]: | |
| 1013 | fixes k l :: num | |
| 1014 | shows "Suc 0 div numeral k = fst (divmod Num.One k)" | |
| 1015 | by (simp_all add: fst_divmod) | |
| 1016 | ||
| 1017 | lemma Suc_0_mod_numeral [simp]: | |
| 1018 | fixes k l :: num | |
| 1019 | shows "Suc 0 mod numeral k = snd (divmod Num.One k)" | |
| 1020 | by (simp_all add: snd_divmod) | |
| 1021 | ||
| 1022 | instantiation int :: unique_euclidean_semiring_numeral | |
| 1023 | begin | |
| 1024 | ||
| 1025 | definition divmod_int :: "num \<Rightarrow> num \<Rightarrow> int \<times> int" | |
| 1026 | where | |
| 1027 | "divmod_int m n = (numeral m div numeral n, numeral m mod numeral n)" | |
| 1028 | ||
| 1029 | definition divmod_step_int :: "num \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int" | |
| 1030 | where | |
| 1031 | "divmod_step_int l qr = (let (q, r) = qr | |
| 1032 | in if r \<ge> numeral l then (2 * q + 1, r - numeral l) | |
| 1033 | else (2 * q, r))" | |
| 1034 | ||
| 1035 | instance | |
| 1036 | by standard (auto intro: zmod_le_nonneg_dividend simp add: divmod_int_def divmod_step_int_def | |
| 1037 | pos_imp_zdiv_pos_iff zmod_zmult2_eq zdiv_zmult2_eq) | |
| 1038 | ||
| 1039 | end | |
| 1040 | ||
| 1041 | declare divmod_algorithm_code [where ?'a = int, code] | |
| 1042 | ||
| 1043 | context | |
| 1044 | begin | |
| 1045 | ||
| 1046 | qualified definition adjust_div :: "int \<times> int \<Rightarrow> int" | |
| 1047 | where | |
| 1048 | "adjust_div qr = (let (q, r) = qr in q + of_bool (r \<noteq> 0))" | |
| 1049 | ||
| 1050 | qualified lemma adjust_div_eq [simp, code]: | |
| 1051 | "adjust_div (q, r) = q + of_bool (r \<noteq> 0)" | |
| 1052 | by (simp add: adjust_div_def) | |
| 1053 | ||
| 1054 | qualified definition adjust_mod :: "int \<Rightarrow> int \<Rightarrow> int" | |
| 1055 | where | |
| 1056 | [simp]: "adjust_mod l r = (if r = 0 then 0 else l - r)" | |
| 1057 | ||
| 1058 | lemma minus_numeral_div_numeral [simp]: | |
| 1059 | "- numeral m div numeral n = - (adjust_div (divmod m n) :: int)" | |
| 1060 | proof - | |
| 1061 | have "int (fst (divmod m n)) = fst (divmod m n)" | |
| 1062 | by (simp only: fst_divmod divide_int_def) auto | |
| 1063 | then show ?thesis | |
| 1064 | by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def) | |
| 1065 | qed | |
| 1066 | ||
| 1067 | lemma minus_numeral_mod_numeral [simp]: | |
| 1068 | "- numeral m mod numeral n = adjust_mod (numeral n) (snd (divmod m n) :: int)" | |
| 1069 | proof (cases "snd (divmod m n) = (0::int)") | |
| 1070 | case True | |
| 1071 | then show ?thesis | |
| 1072 | by (simp add: mod_eq_0_iff_dvd divides_aux_def) | |
| 1073 | next | |
| 1074 | case False | |
| 1075 | then have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \<noteq> (0::int)" | |
| 1076 | by (simp only: snd_divmod modulo_int_def) auto | |
| 1077 | then show ?thesis | |
| 1078 | by (simp add: divides_aux_def adjust_div_def) | |
| 1079 | (simp add: divides_aux_def modulo_int_def) | |
| 1080 | qed | |
| 1081 | ||
| 1082 | lemma numeral_div_minus_numeral [simp]: | |
| 1083 | "numeral m div - numeral n = - (adjust_div (divmod m n) :: int)" | |
| 1084 | proof - | |
| 1085 | have "int (fst (divmod m n)) = fst (divmod m n)" | |
| 1086 | by (simp only: fst_divmod divide_int_def) auto | |
| 1087 | then show ?thesis | |
| 1088 | by (auto simp add: split_def Let_def adjust_div_def divides_aux_def divide_int_def) | |
| 1089 | qed | |
| 1090 | ||
| 1091 | lemma numeral_mod_minus_numeral [simp]: | |
| 1092 | "numeral m mod - numeral n = - adjust_mod (numeral n) (snd (divmod m n) :: int)" | |
| 1093 | proof (cases "snd (divmod m n) = (0::int)") | |
| 1094 | case True | |
| 1095 | then show ?thesis | |
| 1096 | by (simp add: mod_eq_0_iff_dvd divides_aux_def) | |
| 1097 | next | |
| 1098 | case False | |
| 1099 | then have "int (snd (divmod m n)) = snd (divmod m n)" if "snd (divmod m n) \<noteq> (0::int)" | |
| 1100 | by (simp only: snd_divmod modulo_int_def) auto | |
| 1101 | then show ?thesis | |
| 1102 | by (simp add: divides_aux_def adjust_div_def) | |
| 1103 | (simp add: divides_aux_def modulo_int_def) | |
| 1104 | qed | |
| 1105 | ||
| 1106 | lemma minus_one_div_numeral [simp]: | |
| 1107 | "- 1 div numeral n = - (adjust_div (divmod Num.One n) :: int)" | |
| 1108 | using minus_numeral_div_numeral [of Num.One n] by simp | |
| 1109 | ||
| 1110 | lemma minus_one_mod_numeral [simp]: | |
| 1111 | "- 1 mod numeral n = adjust_mod (numeral n) (snd (divmod Num.One n) :: int)" | |
| 1112 | using minus_numeral_mod_numeral [of Num.One n] by simp | |
| 1113 | ||
| 1114 | lemma one_div_minus_numeral [simp]: | |
| 1115 | "1 div - numeral n = - (adjust_div (divmod Num.One n) :: int)" | |
| 1116 | using numeral_div_minus_numeral [of Num.One n] by simp | |
| 1117 | ||
| 1118 | lemma one_mod_minus_numeral [simp]: | |
| 1119 | "1 mod - numeral n = - adjust_mod (numeral n) (snd (divmod Num.One n) :: int)" | |
| 1120 | using numeral_mod_minus_numeral [of Num.One n] by simp | |
| 1121 | ||
| 1122 | end | |
| 1123 | ||
| 71756 | 1124 | lemma divmod_BitM_2_eq [simp]: | 
| 1125 | \<open>divmod (Num.BitM m) (Num.Bit0 Num.One) = (numeral m - 1, (1 :: int))\<close> | |
| 1126 | by (cases m) simp_all | |
| 1127 | ||
| 68253 | 1128 | lemma div_positive_int: | 
| 1129 | "k div l > 0" if "k \<ge> l" and "l > 0" for k l :: int | |
| 1130 | using that div_positive [of l k] by blast | |
| 1131 | ||
| 1132 | ||
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1133 | subsubsection \<open>Dedicated simproc for calculation\<close> | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1134 | |
| 60758 | 1135 | text \<open> | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1136 | There is space for improvement here: the calculation itself | 
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66806diff
changeset | 1137 | could be carried out outside the logic, and a generic simproc | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1138 | (simplifier setup) for generic calculation would be helpful. | 
| 60758 | 1139 | \<close> | 
| 53067 
ee0b7c2315d2
type class for generic division algorithm on numerals
 haftmann parents: 
53066diff
changeset | 1140 | |
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1141 | simproc_setup numeral_divmod | 
| 66806 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1142 |   ("0 div 0 :: 'a :: unique_euclidean_semiring_numeral" | "0 mod 0 :: 'a :: unique_euclidean_semiring_numeral" |
 | 
| 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1143 | "0 div 1 :: 'a :: unique_euclidean_semiring_numeral" | "0 mod 1 :: 'a :: unique_euclidean_semiring_numeral" | | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1144 | "0 div - 1 :: int" | "0 mod - 1 :: int" | | 
| 66806 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1145 | "0 div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "0 mod numeral b :: 'a :: unique_euclidean_semiring_numeral" | | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1146 | "0 div - numeral b :: int" | "0 mod - numeral b :: int" | | 
| 66806 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1147 | "1 div 0 :: 'a :: unique_euclidean_semiring_numeral" | "1 mod 0 :: 'a :: unique_euclidean_semiring_numeral" | | 
| 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1148 | "1 div 1 :: 'a :: unique_euclidean_semiring_numeral" | "1 mod 1 :: 'a :: unique_euclidean_semiring_numeral" | | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1149 | "1 div - 1 :: int" | "1 mod - 1 :: int" | | 
| 66806 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1150 | "1 div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "1 mod numeral b :: 'a :: unique_euclidean_semiring_numeral" | | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1151 | "1 div - numeral b :: int" |"1 mod - numeral b :: int" | | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1152 | "- 1 div 0 :: int" | "- 1 mod 0 :: int" | "- 1 div 1 :: int" | "- 1 mod 1 :: int" | | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1153 | "- 1 div - 1 :: int" | "- 1 mod - 1 :: int" | "- 1 div numeral b :: int" | "- 1 mod numeral b :: int" | | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1154 | "- 1 div - numeral b :: int" | "- 1 mod - numeral b :: int" | | 
| 66806 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1155 | "numeral a div 0 :: 'a :: unique_euclidean_semiring_numeral" | "numeral a mod 0 :: 'a :: unique_euclidean_semiring_numeral" | | 
| 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1156 | "numeral a div 1 :: 'a :: unique_euclidean_semiring_numeral" | "numeral a mod 1 :: 'a :: unique_euclidean_semiring_numeral" | | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1157 | "numeral a div - 1 :: int" | "numeral a mod - 1 :: int" | | 
| 66806 
a4e82b58d833
abolished (semi)ring_div in favour of euclidean_(semi)ring_cancel
 haftmann parents: 
66801diff
changeset | 1158 | "numeral a div numeral b :: 'a :: unique_euclidean_semiring_numeral" | "numeral a mod numeral b :: 'a :: unique_euclidean_semiring_numeral" | | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1159 | "numeral a div - numeral b :: int" | "numeral a mod - numeral b :: int" | | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1160 | "- numeral a div 0 :: int" | "- numeral a mod 0 :: int" | | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1161 | "- numeral a div 1 :: int" | "- numeral a mod 1 :: int" | | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1162 | "- numeral a div - 1 :: int" | "- numeral a mod - 1 :: int" | | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1163 | "- numeral a div numeral b :: int" | "- numeral a mod numeral b :: int" | | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1164 | "- numeral a div - numeral b :: int" | "- numeral a mod - numeral b :: int") = | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1165 | \<open> let | 
| 69593 | 1166 | val if_cong = the (Code.get_case_cong \<^theory> \<^const_name>\<open>If\<close>); | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1167 | fun successful_rewrite ctxt ct = | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1168 | let | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1169 | val thm = Simplifier.rewrite ctxt ct | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1170 | in if Thm.is_reflexive thm then NONE else SOME thm end; | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1171 | in fn phi => | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1172 | let | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1173 |       val simps = Morphism.fact phi (@{thms div_0 mod_0 div_by_0 mod_by_0 div_by_1 mod_by_1
 | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1174 | one_div_numeral one_mod_numeral minus_one_div_numeral minus_one_mod_numeral | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1175 | one_div_minus_numeral one_mod_minus_numeral | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1176 | numeral_div_numeral numeral_mod_numeral minus_numeral_div_numeral minus_numeral_mod_numeral | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1177 | numeral_div_minus_numeral numeral_mod_minus_numeral | 
| 60930 | 1178 | div_minus_minus mod_minus_minus Divides.adjust_div_eq of_bool_eq one_neq_zero | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1179 | numeral_neq_zero neg_equal_0_iff_equal arith_simps arith_special divmod_trivial | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1180 | divmod_cancel divmod_steps divmod_step_eq fst_conv snd_conv numeral_One | 
| 60930 | 1181 | case_prod_beta rel_simps Divides.adjust_mod_def div_minus1_right mod_minus1_right | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1182 | minus_minus numeral_times_numeral mult_zero_right mult_1_right} | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1183 |         @ [@{lemma "0 = 0 \<longleftrightarrow> True" by simp}]);
 | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1184 | fun prepare_simpset ctxt = HOL_ss |> Simplifier.simpset_map ctxt | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1185 | (Simplifier.add_cong if_cong #> fold Simplifier.add_simp simps) | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1186 | in fn ctxt => successful_rewrite (Simplifier.put_simpset (prepare_simpset ctxt) ctxt) end | 
| 69216 
1a52baa70aed
clarified ML_Context.expression: it is a closed expression, not a let-declaration -- thus source positions are more accurate (amending d8849cfad60f, 162a4c2e97bc);
 wenzelm parents: 
68644diff
changeset | 1187 | end | 
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1188 | \<close> | 
| 34126 | 1189 | |
| 35673 | 1190 | |
| 60758 | 1191 | subsubsection \<open>Code generation\<close> | 
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 1192 | |
| 68253 | 1193 | definition divmod_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat" | 
| 1194 | where "divmod_nat m n = (m div n, m mod n)" | |
| 1195 | ||
| 1196 | lemma fst_divmod_nat [simp]: | |
| 1197 | "fst (divmod_nat m n) = m div n" | |
| 1198 | by (simp add: divmod_nat_def) | |
| 1199 | ||
| 1200 | lemma snd_divmod_nat [simp]: | |
| 1201 | "snd (divmod_nat m n) = m mod n" | |
| 1202 | by (simp add: divmod_nat_def) | |
| 1203 | ||
| 1204 | lemma divmod_nat_if [code]: | |
| 1205 | "Divides.divmod_nat m n = (if n = 0 \<or> m < n then (0, m) else | |
| 1206 | let (q, r) = Divides.divmod_nat (m - n) n in (Suc q, r))" | |
| 1207 | by (simp add: prod_eq_iff case_prod_beta not_less le_div_geq le_mod_geq) | |
| 1208 | ||
| 1209 | lemma [code]: | |
| 1210 | "m div n = fst (divmod_nat m n)" | |
| 1211 | "m mod n = snd (divmod_nat m n)" | |
| 1212 | by simp_all | |
| 1213 | ||
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1214 | lemma [code]: | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1215 | fixes k :: int | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1216 | shows | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1217 | "k div 0 = 0" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1218 | "k mod 0 = k" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1219 | "0 div k = 0" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1220 | "0 mod k = 0" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1221 | "k div Int.Pos Num.One = k" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1222 | "k mod Int.Pos Num.One = 0" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1223 | "k div Int.Neg Num.One = - k" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1224 | "k mod Int.Neg Num.One = 0" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1225 | "Int.Pos m div Int.Pos n = (fst (divmod m n) :: int)" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1226 | "Int.Pos m mod Int.Pos n = (snd (divmod m n) :: int)" | 
| 60930 | 1227 | "Int.Neg m div Int.Pos n = - (Divides.adjust_div (divmod m n) :: int)" | 
| 1228 | "Int.Neg m mod Int.Pos n = Divides.adjust_mod (Int.Pos n) (snd (divmod m n) :: int)" | |
| 1229 | "Int.Pos m div Int.Neg n = - (Divides.adjust_div (divmod m n) :: int)" | |
| 1230 | "Int.Pos m mod Int.Neg n = - Divides.adjust_mod (Int.Pos n) (snd (divmod m n) :: int)" | |
| 60868 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1231 | "Int.Neg m div Int.Neg n = (fst (divmod m n) :: int)" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1232 | "Int.Neg m mod Int.Neg n = - (snd (divmod m n) :: int)" | 
| 
dd18c33c001e
direct bootstrap of integer division from natural division
 haftmann parents: 
60867diff
changeset | 1233 | by simp_all | 
| 53069 
d165213e3924
execution of int division by class semiring_numeral_div, replacing pdivmod by divmod_abs
 haftmann parents: 
53068diff
changeset | 1234 | |
| 52435 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
52398diff
changeset | 1235 | code_identifier | 
| 
6646bb548c6b
migration from code_(const|type|class|instance) to code_printing and from code_module to code_identifier
 haftmann parents: 
52398diff
changeset | 1236 | code_module Divides \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith | 
| 33364 | 1237 | |
| 64246 | 1238 | |
| 68253 | 1239 | subsection \<open>Lemmas of doubtful value\<close> | 
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66806diff
changeset | 1240 | |
| 68631 | 1241 | lemma div_geq: "m div n = Suc ((m - n) div n)" if "0 < n" and " \<not> m < n" for m n :: nat | 
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66806diff
changeset | 1242 | by (rule le_div_geq) (use that in \<open>simp_all add: not_less\<close>) | 
| 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66806diff
changeset | 1243 | |
| 68631 | 1244 | lemma mod_geq: "m mod n = (m - n) mod n" if "\<not> m < n" for m n :: nat | 
| 66808 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66806diff
changeset | 1245 | by (rule le_mod_geq) (use that in \<open>simp add: not_less\<close>) | 
| 
1907167b6038
elementary definition of division on natural numbers
 haftmann parents: 
66806diff
changeset | 1246 | |
| 68631 | 1247 | lemma mod_eq_0D: "\<exists>q. m = d * q" if "m mod d = 0" for m d :: nat | 
| 1248 | using that by (auto simp add: mod_eq_0_iff_dvd) | |
| 66816 
212a3334e7da
more fundamental definition of div and mod on int
 haftmann parents: 
66815diff
changeset | 1249 | |
| 69695 | 1250 | lemma pos_mod_conj: "0 < b \<Longrightarrow> 0 \<le> a mod b \<and> a mod b < b" for a b :: int | 
| 1251 | by simp | |
| 1252 | ||
| 1253 | lemma neg_mod_conj: "b < 0 \<Longrightarrow> a mod b \<le> 0 \<and> b < a mod b" for a b :: int | |
| 1254 | by simp | |
| 1255 | ||
| 1256 | lemma zmod_eq_0_iff: "m mod d = 0 \<longleftrightarrow> (\<exists>q. m = d * q)" for m d :: int | |
| 1257 | by (auto simp add: mod_eq_0_iff_dvd) | |
| 1258 | ||
| 1259 | (* REVISIT: should this be generalized to all semiring_div types? *) | |
| 1260 | lemma zmod_eq_0D [dest!]: "\<exists>q. m = d * q" if "m mod d = 0" for m d :: int | |
| 1261 | using that by auto | |
| 1262 | ||
| 33361 
1f18de40b43f
combined former theories Divides and IntDiv to one theory Divides
 haftmann parents: 
33340diff
changeset | 1263 | end |