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