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