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