src/HOL/Number_Theory/Residues.thy
 author haftmann Sat Dec 17 15:22:14 2016 +0100 (2016-12-17) changeset 64593 50c715579715 parent 64282 261d42f0bfac child 65066 c64d778a593a permissions -rw-r--r--
reoriented congruence rules in non-explosive direction
1 (*  Title:      HOL/Number_Theory/Residues.thy
2     Author:     Jeremy Avigad
4 An algebraic treatment of residue rings, and resulting proofs of
5 Euler's theorem and Wilson's theorem.
6 *)
8 section \<open>Residue rings\<close>
10 theory Residues
11 imports Cong MiscAlgebra
12 begin
14 definition QuadRes :: "int \<Rightarrow> int \<Rightarrow> bool" where
15   "QuadRes p a = (\<exists>y. ([y^2 = a] (mod p)))"
17 definition Legendre :: "int \<Rightarrow> int \<Rightarrow> int" where
18   "Legendre a p = (if ([a = 0] (mod p)) then 0
19     else if QuadRes p a then 1
20     else -1)"
22 subsection \<open>A locale for residue rings\<close>
24 definition residue_ring :: "int \<Rightarrow> int ring"
25 where
26   "residue_ring m =
27     \<lparr>carrier = {0..m - 1},
28      mult = \<lambda>x y. (x * y) mod m,
29      one = 1,
30      zero = 0,
31      add = \<lambda>x y. (x + y) mod m\<rparr>"
33 locale residues =
34   fixes m :: int and R (structure)
35   assumes m_gt_one: "m > 1"
36   defines "R \<equiv> residue_ring m"
37 begin
39 lemma abelian_group: "abelian_group R"
40   apply (insert m_gt_one)
41   apply (rule abelian_groupI)
42   apply (unfold R_def residue_ring_def)
43   apply (auto simp add: mod_add_right_eq ac_simps)
44   apply (case_tac "x = 0")
45   apply force
46   apply (subgoal_tac "(x + (m - x)) mod m = 0")
47   apply (erule bexI)
48   apply auto
49   done
51 lemma comm_monoid: "comm_monoid R"
52   apply (insert m_gt_one)
53   apply (unfold R_def residue_ring_def)
54   apply (rule comm_monoidI)
55   apply auto
56   apply (subgoal_tac "x * y mod m * z mod m = z * (x * y mod m) mod m")
57   apply (erule ssubst)
58   apply (subst mod_mult_right_eq)+
59   apply (simp_all only: ac_simps)
60   done
62 lemma cring: "cring R"
63   apply (rule cringI)
64   apply (rule abelian_group)
65   apply (rule comm_monoid)
66   apply (unfold R_def residue_ring_def, auto)
67   apply (subst mod_add_eq)
68   apply (subst mult.commute)
69   apply (subst mod_mult_right_eq)
70   apply (simp add: field_simps)
71   done
73 end
75 sublocale residues < cring
76   by (rule cring)
79 context residues
80 begin
82 text \<open>
83   These lemmas translate back and forth between internal and
84   external concepts.
85 \<close>
87 lemma res_carrier_eq: "carrier R = {0..m - 1}"
88   unfolding R_def residue_ring_def by auto
90 lemma res_add_eq: "x \<oplus> y = (x + y) mod m"
91   unfolding R_def residue_ring_def by auto
93 lemma res_mult_eq: "x \<otimes> y = (x * y) mod m"
94   unfolding R_def residue_ring_def by auto
96 lemma res_zero_eq: "\<zero> = 0"
97   unfolding R_def residue_ring_def by auto
99 lemma res_one_eq: "\<one> = 1"
100   unfolding R_def residue_ring_def units_of_def by auto
102 lemma res_units_eq: "Units R = {x. 0 < x \<and> x < m \<and> coprime x m}"
103   apply (insert m_gt_one)
104   apply (unfold Units_def R_def residue_ring_def)
105   apply auto
106   apply (subgoal_tac "x \<noteq> 0")
107   apply auto
108   apply (metis invertible_coprime_int)
109   apply (subst (asm) coprime_iff_invertible'_int)
110   apply (auto simp add: cong_int_def mult.commute)
111   done
113 lemma res_neg_eq: "\<ominus> x = (- x) mod m"
114   apply (insert m_gt_one)
115   apply (unfold R_def a_inv_def m_inv_def residue_ring_def)
116   apply auto
117   apply (rule the_equality)
118   apply auto
119   apply (subst mod_add_right_eq)
120   apply auto
121   apply (subst mod_add_left_eq)
122   apply auto
123   apply (subgoal_tac "y mod m = - x mod m")
124   apply simp
125   apply (metis minus_add_cancel mod_mult_self1 mult.commute)
126   done
128 lemma finite [iff]: "finite (carrier R)"
129   by (subst res_carrier_eq) auto
131 lemma finite_Units [iff]: "finite (Units R)"
132   by (subst res_units_eq) auto
134 text \<open>
135   The function \<open>a \<mapsto> a mod m\<close> maps the integers to the
136   residue classes. The following lemmas show that this mapping
137   respects addition and multiplication on the integers.
138 \<close>
140 lemma mod_in_carrier [iff]: "a mod m \<in> carrier R"
141   unfolding res_carrier_eq
142   using insert m_gt_one by auto
144 lemma add_cong: "(x mod m) \<oplus> (y mod m) = (x + y) mod m"
145   unfolding R_def residue_ring_def
146   by (auto simp add: mod_simps)
148 lemma mult_cong: "(x mod m) \<otimes> (y mod m) = (x * y) mod m"
149   unfolding R_def residue_ring_def
150   by (auto simp add: mod_simps)
152 lemma zero_cong: "\<zero> = 0"
153   unfolding R_def residue_ring_def by auto
155 lemma one_cong: "\<one> = 1 mod m"
156   using m_gt_one unfolding R_def residue_ring_def by auto
158 (* FIXME revise algebra library to use 1? *)
159 lemma pow_cong: "(x mod m) (^) n = x^n mod m"
160   apply (insert m_gt_one)
161   apply (induct n)
162   apply (auto simp add: nat_pow_def one_cong)
163   apply (metis mult.commute mult_cong)
164   done
166 lemma neg_cong: "\<ominus> (x mod m) = (- x) mod m"
167   by (metis mod_minus_eq res_neg_eq)
169 lemma (in residues) prod_cong: "finite A \<Longrightarrow> (\<Otimes>i\<in>A. (f i) mod m) = (\<Prod>i\<in>A. f i) mod m"
170   by (induct set: finite) (auto simp: one_cong mult_cong)
172 lemma (in residues) sum_cong: "finite A \<Longrightarrow> (\<Oplus>i\<in>A. (f i) mod m) = (\<Sum>i\<in>A. f i) mod m"
173   by (induct set: finite) (auto simp: zero_cong add_cong)
175 lemma mod_in_res_units [simp]:
176   assumes "1 < m" and "coprime a m"
177   shows "a mod m \<in> Units R"
178 proof (cases "a mod m = 0")
179   case True with assms show ?thesis
180     by (auto simp add: res_units_eq gcd_red_int [symmetric])
181 next
182   case False
183   from assms have "0 < m" by simp
184   with pos_mod_sign [of m a] have "0 \<le> a mod m" .
185   with False have "0 < a mod m" by simp
186   with assms show ?thesis
187     by (auto simp add: res_units_eq gcd_red_int [symmetric] ac_simps)
188 qed
190 lemma res_eq_to_cong: "(a mod m) = (b mod m) \<longleftrightarrow> [a = b] (mod m)"
191   unfolding cong_int_def by auto
194 text \<open>Simplifying with these will translate a ring equation in R to a congruence.\<close>
195 lemmas res_to_cong_simps = add_cong mult_cong pow_cong one_cong
196     prod_cong sum_cong neg_cong res_eq_to_cong
198 text \<open>Other useful facts about the residue ring.\<close>
199 lemma one_eq_neg_one: "\<one> = \<ominus> \<one> \<Longrightarrow> m = 2"
200   apply (simp add: res_one_eq res_neg_eq)
202     zero_neq_one zmod_zminus1_eq_if)
203   done
205 end
208 subsection \<open>Prime residues\<close>
210 locale residues_prime =
211   fixes p :: nat and R (structure)
212   assumes p_prime [intro]: "prime p"
213   defines "R \<equiv> residue_ring (int p)"
215 sublocale residues_prime < residues p
216   apply (unfold R_def residues_def)
217   using p_prime apply auto
218   apply (metis (full_types) of_nat_1 of_nat_less_iff prime_gt_1_nat)
219   done
221 context residues_prime
222 begin
224 lemma is_field: "field R"
225   apply (rule cring.field_intro2)
226   apply (rule cring)
227   apply (auto simp add: res_carrier_eq res_one_eq res_zero_eq res_units_eq)
228   apply (rule classical)
229   apply (erule notE)
230   apply (subst gcd.commute)
231   apply (rule prime_imp_coprime_int)
232   apply (simp add: p_prime)
233   apply (rule notI)
234   apply (frule zdvd_imp_le)
235   apply auto
236   done
238 lemma res_prime_units_eq: "Units R = {1..p - 1}"
239   apply (subst res_units_eq)
240   apply auto
241   apply (subst gcd.commute)
242   apply (auto simp add: p_prime prime_imp_coprime_int zdvd_not_zless)
243   done
245 end
247 sublocale residues_prime < field
248   by (rule is_field)
251 section \<open>Test cases: Euler's theorem and Wilson's theorem\<close>
253 subsection \<open>Euler's theorem\<close>
255 text \<open>The definition of the phi function.\<close>
257 definition phi :: "int \<Rightarrow> nat"
258   where "phi m = card {x. 0 < x \<and> x < m \<and> gcd x m = 1}"
260 lemma phi_def_nat: "phi m = card {x. 0 < x \<and> x < nat m \<and> gcd x (nat m) = 1}"
261   apply (simp add: phi_def)
262   apply (rule bij_betw_same_card [of nat])
263   apply (auto simp add: inj_on_def bij_betw_def image_def)
264   apply (metis dual_order.irrefl dual_order.strict_trans leI nat_1 transfer_nat_int_gcd(1))
265   apply (metis One_nat_def of_nat_0 of_nat_1 of_nat_less_0_iff int_nat_eq nat_int
266     transfer_int_nat_gcd(1) of_nat_less_iff)
267   done
269 lemma prime_phi:
270   assumes "2 \<le> p" "phi p = p - 1"
271   shows "prime p"
272 proof -
273   have *: "{x. 0 < x \<and> x < p \<and> coprime x p} = {1..p - 1}"
274     using assms unfolding phi_def_nat
275     by (intro card_seteq) fastforce+
276   have False if **: "1 < x" "x < p" and "x dvd p" for x :: nat
277   proof -
278     from * have cop: "x \<in> {1..p - 1} \<Longrightarrow> coprime x p"
279       by blast
280     have "coprime x p"
281       apply (rule cop)
282       using ** apply auto
283       done
284     with \<open>x dvd p\<close> \<open>1 < x\<close> show ?thesis
285       by auto
286   qed
287   then show ?thesis
288     using \<open>2 \<le> p\<close>
289     by (simp add: prime_nat_iff)
290        (metis One_nat_def dvd_pos_nat nat_dvd_not_less nat_neq_iff not_gr0
291               not_numeral_le_zero one_dvd)
292 qed
294 lemma phi_zero [simp]: "phi 0 = 0"
295   unfolding phi_def
296 (* Auto hangs here. Once again, where is the simplification rule
297    1 \<equiv> Suc 0 coming from? *)
298   apply (auto simp add: card_eq_0_iff)
299 (* Add card_eq_0_iff as a simp rule? delete card_empty_imp? *)
300   done
302 lemma phi_one [simp]: "phi 1 = 0"
303   by (auto simp add: phi_def card_eq_0_iff)
305 lemma (in residues) phi_eq: "phi m = card (Units R)"
306   by (simp add: phi_def res_units_eq)
308 lemma (in residues) euler_theorem1:
309   assumes a: "gcd a m = 1"
310   shows "[a^phi m = 1] (mod m)"
311 proof -
312   from a m_gt_one have [simp]: "a mod m \<in> Units R"
313     by (intro mod_in_res_units)
314   from phi_eq have "(a mod m) (^) (phi m) = (a mod m) (^) (card (Units R))"
315     by simp
316   also have "\<dots> = \<one>"
317     by (intro units_power_order_eq_one) auto
318   finally show ?thesis
319     by (simp add: res_to_cong_simps)
320 qed
322 (* In fact, there is a two line proof!
324 lemma (in residues) euler_theorem1:
325   assumes a: "gcd a m = 1"
326   shows "[a^phi m = 1] (mod m)"
327 proof -
328   have "(a mod m) (^) (phi m) = \<one>"
329     by (simp add: phi_eq units_power_order_eq_one a m_gt_one)
330   then show ?thesis
331     by (simp add: res_to_cong_simps)
332 qed
334 *)
336 text \<open>Outside the locale, we can relax the restriction \<open>m > 1\<close>.\<close>
337 lemma euler_theorem:
338   assumes "m \<ge> 0"
339     and "gcd a m = 1"
340   shows "[a^phi m = 1] (mod m)"
341 proof (cases "m = 0 | m = 1")
342   case True
343   then show ?thesis by auto
344 next
345   case False
346   with assms show ?thesis
347     by (intro residues.euler_theorem1, unfold residues_def, auto)
348 qed
350 lemma (in residues_prime) phi_prime: "phi p = nat p - 1"
351   apply (subst phi_eq)
352   apply (subst res_prime_units_eq)
353   apply auto
354   done
356 lemma phi_prime: "prime (int p) \<Longrightarrow> phi p = nat p - 1"
357   apply (rule residues_prime.phi_prime)
358   apply simp
359   apply (erule residues_prime.intro)
360   done
362 lemma fermat_theorem:
363   fixes a :: int
364   assumes "prime (int p)"
365     and "\<not> p dvd a"
366   shows "[a^(p - 1) = 1] (mod p)"
367 proof -
368   from assms have "[a ^ phi p = 1] (mod p)"
369     by (auto intro!: euler_theorem intro!: prime_imp_coprime_int[of p]
370              simp: gcd.commute[of _ "int p"])
371   also have "phi p = nat p - 1"
372     by (rule phi_prime) (rule assms)
373   finally show ?thesis
374     by (metis nat_int)
375 qed
377 lemma fermat_theorem_nat:
378   assumes "prime (int p)" and "\<not> p dvd a"
379   shows "[a ^ (p - 1) = 1] (mod p)"
380   using fermat_theorem [of p a] assms
381   by (metis of_nat_1 of_nat_power transfer_int_nat_cong zdvd_int)
384 subsection \<open>Wilson's theorem\<close>
386 lemma (in field) inv_pair_lemma: "x \<in> Units R \<Longrightarrow> y \<in> Units R \<Longrightarrow>
387     {x, inv x} \<noteq> {y, inv y} \<Longrightarrow> {x, inv x} \<inter> {y, inv y} = {}"
388   apply auto
389   apply (metis Units_inv_inv)+
390   done
392 lemma (in residues_prime) wilson_theorem1:
393   assumes a: "p > 2"
394   shows "[fact (p - 1) = (-1::int)] (mod p)"
395 proof -
396   let ?Inverse_Pairs = "{{x, inv x}| x. x \<in> Units R - {\<one>, \<ominus> \<one>}}"
397   have UR: "Units R = {\<one>, \<ominus> \<one>} \<union> \<Union>?Inverse_Pairs"
398     by auto
399   have "(\<Otimes>i\<in>Units R. i) = (\<Otimes>i\<in>{\<one>, \<ominus> \<one>}. i) \<otimes> (\<Otimes>i\<in>\<Union>?Inverse_Pairs. i)"
400     apply (subst UR)
401     apply (subst finprod_Un_disjoint)
402     apply (auto intro: funcsetI)
403     using inv_one apply auto[1]
404     using inv_eq_neg_one_eq apply auto
405     done
406   also have "(\<Otimes>i\<in>{\<one>, \<ominus> \<one>}. i) = \<ominus> \<one>"
407     apply (subst finprod_insert)
408     apply auto
409     apply (frule one_eq_neg_one)
410     using a apply force
411     done
412   also have "(\<Otimes>i\<in>(\<Union>?Inverse_Pairs). i) = (\<Otimes>A\<in>?Inverse_Pairs. (\<Otimes>y\<in>A. y))"
413     apply (subst finprod_Union_disjoint)
414     apply auto
415     apply (metis Units_inv_inv)+
416     done
417   also have "\<dots> = \<one>"
418     apply (rule finprod_one)
419     apply auto
420     apply (subst finprod_insert)
421     apply auto
422     apply (metis inv_eq_self)
423     done
424   finally have "(\<Otimes>i\<in>Units R. i) = \<ominus> \<one>"
425     by simp
426   also have "(\<Otimes>i\<in>Units R. i) = (\<Otimes>i\<in>Units R. i mod p)"
427     apply (rule finprod_cong')
428     apply auto
429     apply (subst (asm) res_prime_units_eq)
430     apply auto
431     done
432   also have "\<dots> = (\<Prod>i\<in>Units R. i) mod p"
433     apply (rule prod_cong)
434     apply auto
435     done
436   also have "\<dots> = fact (p - 1) mod p"
437     apply (simp add: fact_prod)
438     apply (insert assms)
439     apply (subst res_prime_units_eq)
440     apply (simp add: int_prod zmod_int prod_int_eq)
441     done
442   finally have "fact (p - 1) mod p = \<ominus> \<one>" .
443   then show ?thesis
444     by (metis of_nat_fact Divides.transfer_int_nat_functions(2)
445       cong_int_def res_neg_eq res_one_eq)
446 qed
448 lemma wilson_theorem:
449   assumes "prime p"
450   shows "[fact (p - 1) = - 1] (mod p)"
451 proof (cases "p = 2")
452   case True
453   then show ?thesis
454     by (simp add: cong_int_def fact_prod)
455 next
456   case False
457   then show ?thesis
458     using assms prime_ge_2_nat
459     by (metis residues_prime.wilson_theorem1 residues_prime.intro le_eq_less_or_eq)
460 qed
462 end