src/HOL/Old_Number_Theory/Euler.thy
author haftmann
Fri Nov 27 08:41:10 2009 +0100 (2009-11-27)
changeset 33963 977b94b64905
parent 32479 521cc9bf2958
child 35544 342a448ae141
permissions -rw-r--r--
renamed former datatype.ML to datatype_data.ML; datatype.ML provides uniform view on datatype.ML and datatype_rep_proofs.ML
paulson@13871
     1
(*  Title:      HOL/Quadratic_Reciprocity/Euler.thy
kleing@14981
     2
    ID:         $Id$
paulson@13871
     3
    Authors:    Jeremy Avigad, David Gray, and Adam Kramer
paulson@13871
     4
*)
paulson@13871
     5
paulson@13871
     6
header {* Euler's criterion *}
paulson@13871
     7
wenzelm@16974
     8
theory Euler imports Residues EvenOdd begin
paulson@13871
     9
wenzelm@19670
    10
definition
wenzelm@21404
    11
  MultInvPair :: "int => int => int => int set" where
wenzelm@19670
    12
  "MultInvPair a p j = {StandardRes p j, StandardRes p (a * (MultInv p j))}"
wenzelm@19670
    13
wenzelm@21404
    14
definition
wenzelm@21404
    15
  SetS        :: "int => int => int set set" where
wenzelm@19670
    16
  "SetS        a p   =  (MultInvPair a p ` SRStar p)"
paulson@13871
    17
wenzelm@19670
    18
wenzelm@19670
    19
subsection {* Property for MultInvPair *}
paulson@13871
    20
wenzelm@19670
    21
lemma MultInvPair_prop1a:
wenzelm@19670
    22
  "[| zprime p; 2 < p; ~([a = 0](mod p));
wenzelm@19670
    23
      X \<in> (SetS a p); Y \<in> (SetS a p);
wenzelm@19670
    24
      ~((X \<inter> Y) = {}) |] ==> X = Y"
paulson@13871
    25
  apply (auto simp add: SetS_def)
wenzelm@16974
    26
  apply (drule StandardRes_SRStar_prop1a)+ defer 1
wenzelm@16974
    27
  apply (drule StandardRes_SRStar_prop1a)+
paulson@13871
    28
  apply (auto simp add: MultInvPair_def StandardRes_prop2 zcong_sym)
wenzelm@20369
    29
  apply (drule notE, rule MultInv_zcong_prop1, auto)[]
wenzelm@20369
    30
  apply (drule notE, rule MultInv_zcong_prop2, auto simp add: zcong_sym)[]
wenzelm@20369
    31
  apply (drule MultInv_zcong_prop2, auto simp add: zcong_sym)[]
wenzelm@20369
    32
  apply (drule MultInv_zcong_prop3, auto simp add: zcong_sym)[]
wenzelm@20369
    33
  apply (drule MultInv_zcong_prop1, auto)[]
wenzelm@20369
    34
  apply (drule MultInv_zcong_prop2, auto simp add: zcong_sym)[]
wenzelm@20369
    35
  apply (drule MultInv_zcong_prop2, auto simp add: zcong_sym)[]
wenzelm@20369
    36
  apply (drule MultInv_zcong_prop3, auto simp add: zcong_sym)[]
wenzelm@19670
    37
  done
paulson@13871
    38
wenzelm@19670
    39
lemma MultInvPair_prop1b:
wenzelm@19670
    40
  "[| zprime p; 2 < p; ~([a = 0](mod p));
wenzelm@19670
    41
      X \<in> (SetS a p); Y \<in> (SetS a p);
wenzelm@19670
    42
      X \<noteq> Y |] ==> X \<inter> Y = {}"
paulson@13871
    43
  apply (rule notnotD)
paulson@13871
    44
  apply (rule notI)
paulson@13871
    45
  apply (drule MultInvPair_prop1a, auto)
wenzelm@19670
    46
  done
paulson@13871
    47
nipkow@16663
    48
lemma MultInvPair_prop1c: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==>  
paulson@13871
    49
    \<forall>X \<in> SetS a p. \<forall>Y \<in> SetS a p. X \<noteq> Y --> X\<inter>Y = {}"
paulson@13871
    50
  by (auto simp add: MultInvPair_prop1b)
paulson@13871
    51
nipkow@16663
    52
lemma MultInvPair_prop2: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==> 
wenzelm@16974
    53
                          Union ( SetS a p) = SRStar p"
paulson@13871
    54
  apply (auto simp add: SetS_def MultInvPair_def StandardRes_SRStar_prop4 
paulson@13871
    55
    SRStar_mult_prop2)
paulson@13871
    56
  apply (frule StandardRes_SRStar_prop3)
paulson@13871
    57
  apply (rule bexI, auto)
wenzelm@19670
    58
  done
paulson@13871
    59
nipkow@16663
    60
lemma MultInvPair_distinct: "[| zprime p; 2 < p; ~([a = 0] (mod p)); 
paulson@13871
    61
                                ~([j = 0] (mod p)); 
paulson@13871
    62
                                ~(QuadRes p a) |]  ==> 
wenzelm@16974
    63
                             ~([j = a * MultInv p j] (mod p))"
wenzelm@20369
    64
proof
nipkow@16663
    65
  assume "zprime p" and "2 < p" and "~([a = 0] (mod p))" and 
wenzelm@16974
    66
    "~([j = 0] (mod p))" and "~(QuadRes p a)"
wenzelm@16974
    67
  assume "[j = a * MultInv p j] (mod p)"
wenzelm@16974
    68
  then have "[j * j = (a * MultInv p j) * j] (mod p)"
paulson@13871
    69
    by (auto simp add: zcong_scalar)
wenzelm@16974
    70
  then have a:"[j * j = a * (MultInv p j * j)] (mod p)"
paulson@13871
    71
    by (auto simp add: zmult_ac)
wenzelm@16974
    72
  have "[j * j = a] (mod p)"
wenzelm@16974
    73
    proof -
wenzelm@16974
    74
      from prems have b: "[MultInv p j * j = 1] (mod p)"
paulson@13871
    75
        by (simp add: MultInv_prop2a)
wenzelm@16974
    76
      from b a show ?thesis
paulson@13871
    77
        by (auto simp add: zcong_zmult_prop2)
wenzelm@16974
    78
    qed
wenzelm@16974
    79
  then have "[j^2 = a] (mod p)"
huffman@26086
    80
    by (metis  number_of_is_id power2_eq_square succ_bin_simps)
wenzelm@16974
    81
  with prems show False
paulson@13871
    82
    by (simp add: QuadRes_def)
wenzelm@16974
    83
qed
paulson@13871
    84
nipkow@16663
    85
lemma MultInvPair_card_two: "[| zprime p; 2 < p; ~([a = 0] (mod p)); 
paulson@13871
    86
                                ~(QuadRes p a); ~([j = 0] (mod p)) |]  ==> 
wenzelm@16974
    87
                             card (MultInvPair a p j) = 2"
paulson@13871
    88
  apply (auto simp add: MultInvPair_def)
wenzelm@16974
    89
  apply (subgoal_tac "~ (StandardRes p j = StandardRes p (a * MultInv p j))")
paulson@13871
    90
  apply auto
haftmann@26510
    91
  apply (metis MultInvPair_distinct Pls_def StandardRes_def aux number_of_is_id one_is_num_one)
wenzelm@20369
    92
  done
paulson@13871
    93
wenzelm@19670
    94
wenzelm@19670
    95
subsection {* Properties of SetS *}
paulson@13871
    96
wenzelm@16974
    97
lemma SetS_finite: "2 < p ==> finite (SetS a p)"
paulson@13871
    98
  by (auto simp add: SetS_def SRStar_finite [of p] finite_imageI)
paulson@13871
    99
wenzelm@16974
   100
lemma SetS_elems_finite: "\<forall>X \<in> SetS a p. finite X"
paulson@13871
   101
  by (auto simp add: SetS_def MultInvPair_def)
paulson@13871
   102
nipkow@16663
   103
lemma SetS_elems_card: "[| zprime p; 2 < p; ~([a = 0] (mod p)); 
paulson@13871
   104
                        ~(QuadRes p a) |]  ==>
wenzelm@16974
   105
                        \<forall>X \<in> SetS a p. card X = 2"
paulson@13871
   106
  apply (auto simp add: SetS_def)
paulson@13871
   107
  apply (frule StandardRes_SRStar_prop1a)
paulson@13871
   108
  apply (rule MultInvPair_card_two, auto)
wenzelm@19670
   109
  done
paulson@13871
   110
wenzelm@16974
   111
lemma Union_SetS_finite: "2 < p ==> finite (Union (SetS a p))"
nipkow@15402
   112
  by (auto simp add: SetS_finite SetS_elems_finite finite_Union)
paulson@13871
   113
paulson@13871
   114
lemma card_setsum_aux: "[| finite S; \<forall>X \<in> S. finite (X::int set); 
wenzelm@16974
   115
    \<forall>X \<in> S. card X = n |] ==> setsum card S = setsum (%x. n) S"
berghofe@22274
   116
  by (induct set: finite) auto
paulson@13871
   117
nipkow@16663
   118
lemma SetS_card: "[| zprime p; 2 < p; ~([a = 0] (mod p)); ~(QuadRes p a) |] ==> 
wenzelm@16974
   119
                  int(card(SetS a p)) = (p - 1) div 2"
wenzelm@16974
   120
proof -
wenzelm@16974
   121
  assume "zprime p" and "2 < p" and  "~([a = 0] (mod p))" and "~(QuadRes p a)"
wenzelm@16974
   122
  then have "(p - 1) = 2 * int(card(SetS a p))"
wenzelm@16974
   123
  proof -
wenzelm@16974
   124
    have "p - 1 = int(card(Union (SetS a p)))"
paulson@13871
   125
      by (auto simp add: prems MultInvPair_prop2 SRStar_card)
wenzelm@16974
   126
    also have "... = int (setsum card (SetS a p))"
paulson@13871
   127
      by (auto simp add: prems SetS_finite SetS_elems_finite
nipkow@15402
   128
                         MultInvPair_prop1c [of p a] card_Union_disjoint)
wenzelm@16974
   129
    also have "... = int(setsum (%x.2) (SetS a p))"
wenzelm@19670
   130
      using prems
wenzelm@19670
   131
      by (auto simp add: SetS_elems_card SetS_finite SetS_elems_finite 
paulson@15047
   132
        card_setsum_aux simp del: setsum_constant)
wenzelm@16974
   133
    also have "... = 2 * int(card( SetS a p))"
paulson@13871
   134
      by (auto simp add: prems SetS_finite setsum_const2)
wenzelm@16974
   135
    finally show ?thesis .
wenzelm@16974
   136
  qed
wenzelm@16974
   137
  from this show ?thesis
paulson@13871
   138
    by auto
wenzelm@16974
   139
qed
paulson@13871
   140
nipkow@16663
   141
lemma SetS_setprod_prop: "[| zprime p; 2 < p; ~([a = 0] (mod p));
paulson@13871
   142
                              ~(QuadRes p a); x \<in> (SetS a p) |] ==> 
wenzelm@16974
   143
                          [\<Prod>x = a] (mod p)"
paulson@13871
   144
  apply (auto simp add: SetS_def MultInvPair_def)
paulson@13871
   145
  apply (frule StandardRes_SRStar_prop1a)
wenzelm@16974
   146
  apply (subgoal_tac "StandardRes p x \<noteq> StandardRes p (a * MultInv p x)")
paulson@13871
   147
  apply (auto simp add: StandardRes_prop2 MultInvPair_distinct)
paulson@13871
   148
  apply (frule_tac m = p and x = x and y = "(a * MultInv p x)" in 
wenzelm@16974
   149
    StandardRes_prop4)
wenzelm@16974
   150
  apply (subgoal_tac "[x * (a * MultInv p x) = a * (x * MultInv p x)] (mod p)")
paulson@13871
   151
  apply (drule_tac a = "StandardRes p x * StandardRes p (a * MultInv p x)" and
paulson@13871
   152
                   b = "x * (a * MultInv p x)" and
wenzelm@16974
   153
                   c = "a * (x * MultInv p x)" in  zcong_trans, force)
paulson@13871
   154
  apply (frule_tac p = p and x = x in MultInv_prop2, auto)
paulson@25760
   155
apply (metis StandardRes_SRStar_prop3 mult_1_right mult_commute zcong_sym zcong_zmult_prop1)
paulson@13871
   156
  apply (auto simp add: zmult_ac)
wenzelm@19670
   157
  done
paulson@13871
   158
wenzelm@16974
   159
lemma aux1: "[| 0 < x; (x::int) < a; x \<noteq> (a - 1) |] ==> x < a - 1"
paulson@13871
   160
  by arith
paulson@13871
   161
wenzelm@16974
   162
lemma aux2: "[| (a::int) < c; b < c |] ==> (a \<le> b | b \<le> a)"
paulson@13871
   163
  by auto
paulson@13871
   164
wenzelm@18369
   165
lemma SRStar_d22set_prop: "2 < p \<Longrightarrow> (SRStar p) = {1} \<union> (d22set (p - 1))"
wenzelm@18369
   166
  apply (induct p rule: d22set.induct)
wenzelm@18369
   167
  apply auto
nipkow@16733
   168
  apply (simp add: SRStar_def d22set.simps)
paulson@13871
   169
  apply (simp add: SRStar_def d22set.simps, clarify)
paulson@13871
   170
  apply (frule aux1)
paulson@13871
   171
  apply (frule aux2, auto)
paulson@13871
   172
  apply (simp_all add: SRStar_def)
paulson@13871
   173
  apply (simp add: d22set.simps)
paulson@13871
   174
  apply (frule d22set_le)
paulson@13871
   175
  apply (frule d22set_g_1, auto)
wenzelm@18369
   176
  done
paulson@13871
   177
nipkow@16663
   178
lemma Union_SetS_setprod_prop1: "[| zprime p; 2 < p; ~([a = 0] (mod p)); ~(QuadRes p a) |] ==>
nipkow@15392
   179
                                 [\<Prod>(Union (SetS a p)) = a ^ nat ((p - 1) div 2)] (mod p)"
nipkow@15392
   180
proof -
nipkow@16663
   181
  assume "zprime p" and "2 < p" and  "~([a = 0] (mod p))" and "~(QuadRes p a)"
nipkow@15392
   182
  then have "[\<Prod>(Union (SetS a p)) = 
nipkow@15392
   183
      setprod (setprod (%x. x)) (SetS a p)] (mod p)"
paulson@13871
   184
    by (auto simp add: SetS_finite SetS_elems_finite
nipkow@15392
   185
                       MultInvPair_prop1c setprod_Union_disjoint)
nipkow@15392
   186
  also have "[setprod (setprod (%x. x)) (SetS a p) = 
nipkow@15392
   187
      setprod (%x. a) (SetS a p)] (mod p)"
wenzelm@18369
   188
    by (rule setprod_same_function_zcong)
wenzelm@18369
   189
      (auto simp add: prems SetS_setprod_prop SetS_finite)
nipkow@15392
   190
  also (zcong_trans) have "[setprod (%x. a) (SetS a p) = 
nipkow@15392
   191
      a^(card (SetS a p))] (mod p)"
nipkow@15392
   192
    by (auto simp add: prems SetS_finite setprod_constant)
nipkow@15392
   193
  finally (zcong_trans) show ?thesis
paulson@13871
   194
    apply (rule zcong_trans)
nipkow@15392
   195
    apply (subgoal_tac "card(SetS a p) = nat((p - 1) div 2)", auto)
nipkow@15392
   196
    apply (subgoal_tac "nat(int(card(SetS a p))) = nat((p - 1) div 2)", force)
paulson@13871
   197
    apply (auto simp add: prems SetS_card)
wenzelm@18369
   198
    done
nipkow@15392
   199
qed
paulson@13871
   200
nipkow@16663
   201
lemma Union_SetS_setprod_prop2: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==> 
wenzelm@16974
   202
                                    \<Prod>(Union (SetS a p)) = zfact (p - 1)"
wenzelm@16974
   203
proof -
wenzelm@16974
   204
  assume "zprime p" and "2 < p" and "~([a = 0](mod p))"
nipkow@15392
   205
  then have "\<Prod>(Union (SetS a p)) = \<Prod>(SRStar p)"
paulson@13871
   206
    by (auto simp add: MultInvPair_prop2)
nipkow@15392
   207
  also have "... = \<Prod>({1} \<union> (d22set (p - 1)))"
paulson@13871
   208
    by (auto simp add: prems SRStar_d22set_prop)
nipkow@15392
   209
  also have "... = zfact(p - 1)"
nipkow@15392
   210
  proof -
wenzelm@18369
   211
    have "~(1 \<in> d22set (p - 1)) & finite( d22set (p - 1))"
paulson@25760
   212
      by (metis d22set_fin d22set_g_1 linorder_neq_iff)
wenzelm@18369
   213
    then have "\<Prod>({1} \<union> (d22set (p - 1))) = \<Prod>(d22set (p - 1))"
wenzelm@18369
   214
      by auto
wenzelm@18369
   215
    then show ?thesis
wenzelm@18369
   216
      by (auto simp add: d22set_prod_zfact)
wenzelm@16974
   217
  qed
nipkow@15392
   218
  finally show ?thesis .
wenzelm@16974
   219
qed
paulson@13871
   220
nipkow@16663
   221
lemma zfact_prop: "[| zprime p; 2 < p; ~([a = 0] (mod p)); ~(QuadRes p a) |] ==>
wenzelm@16974
   222
                   [zfact (p - 1) = a ^ nat ((p - 1) div 2)] (mod p)"
paulson@13871
   223
  apply (frule Union_SetS_setprod_prop1) 
paulson@13871
   224
  apply (auto simp add: Union_SetS_setprod_prop2)
wenzelm@18369
   225
  done
paulson@13871
   226
wenzelm@19670
   227
text {* \medskip Prove the first part of Euler's Criterion: *}
paulson@13871
   228
nipkow@16663
   229
lemma Euler_part1: "[| 2 < p; zprime p; ~([x = 0](mod p)); 
paulson@13871
   230
    ~(QuadRes p x) |] ==> 
wenzelm@16974
   231
      [x^(nat (((p) - 1) div 2)) = -1](mod p)"
paulson@25760
   232
  by (metis Wilson_Russ number_of_is_id zcong_sym zcong_trans zfact_prop)
paulson@13871
   233
wenzelm@19670
   234
text {* \medskip Prove another part of Euler Criterion: *}
paulson@13871
   235
wenzelm@16974
   236
lemma aux_1: "0 < p ==> (a::int) ^ nat (p) = a * a ^ (nat (p) - 1)"
wenzelm@16974
   237
proof -
wenzelm@16974
   238
  assume "0 < p"
wenzelm@16974
   239
  then have "a ^ (nat p) =  a ^ (1 + (nat p - 1))"
paulson@13871
   240
    by (auto simp add: diff_add_assoc)
wenzelm@16974
   241
  also have "... = (a ^ 1) * a ^ (nat(p) - 1)"
paulson@13871
   242
    by (simp only: zpower_zadd_distrib)
wenzelm@16974
   243
  also have "... = a * a ^ (nat(p) - 1)"
paulson@13871
   244
    by auto
wenzelm@16974
   245
  finally show ?thesis .
wenzelm@16974
   246
qed
paulson@13871
   247
wenzelm@16974
   248
lemma aux_2: "[| (2::int) < p; p \<in> zOdd |] ==> 0 < ((p - 1) div 2)"
wenzelm@16974
   249
proof -
wenzelm@16974
   250
  assume "2 < p" and "p \<in> zOdd"
wenzelm@16974
   251
  then have "(p - 1):zEven"
paulson@13871
   252
    by (auto simp add: zEven_def zOdd_def)
wenzelm@16974
   253
  then have aux_1: "2 * ((p - 1) div 2) = (p - 1)"
paulson@13871
   254
    by (auto simp add: even_div_2_prop2)
wenzelm@23373
   255
  with `2 < p` have "1 < (p - 1)"
paulson@13871
   256
    by auto
wenzelm@16974
   257
  then have " 1 < (2 * ((p - 1) div 2))"
paulson@13871
   258
    by (auto simp add: aux_1)
wenzelm@16974
   259
  then have "0 < (2 * ((p - 1) div 2)) div 2"
paulson@13871
   260
    by auto
paulson@13871
   261
  then show ?thesis by auto
wenzelm@16974
   262
qed
paulson@13871
   263
wenzelm@19670
   264
lemma Euler_part2:
wenzelm@19670
   265
    "[| 2 < p; zprime p; [a = 0] (mod p) |] ==> [0 = a ^ nat ((p - 1) div 2)] (mod p)"
paulson@13871
   266
  apply (frule zprime_zOdd_eq_grt_2)
paulson@13871
   267
  apply (frule aux_2, auto)
paulson@13871
   268
  apply (frule_tac a = a in aux_1, auto)
paulson@13871
   269
  apply (frule zcong_zmult_prop1, auto)
wenzelm@18369
   270
  done
paulson@13871
   271
wenzelm@19670
   272
text {* \medskip Prove the final part of Euler's Criterion: *}
paulson@13871
   273
wenzelm@16974
   274
lemma aux__1: "[| ~([x = 0] (mod p)); [y ^ 2 = x] (mod p)|] ==> ~(p dvd y)"
nipkow@30042
   275
  by (metis dvdI power2_eq_square zcong_sym zcong_trans zcong_zero_equiv_div dvd_trans)
paulson@13871
   276
wenzelm@16974
   277
lemma aux__2: "2 * nat((p - 1) div 2) =  nat (2 * ((p - 1) div 2))"
paulson@13871
   278
  by (auto simp add: nat_mult_distrib)
paulson@13871
   279
nipkow@16663
   280
lemma Euler_part3: "[| 2 < p; zprime p; ~([x = 0](mod p)); QuadRes p x |] ==> 
wenzelm@16974
   281
                      [x^(nat (((p) - 1) div 2)) = 1](mod p)"
paulson@13871
   282
  apply (subgoal_tac "p \<in> zOdd")
paulson@13871
   283
  apply (auto simp add: QuadRes_def)
paulson@25675
   284
   prefer 2 
paulson@25675
   285
   apply (metis number_of_is_id numeral_1_eq_1 zprime_zOdd_eq_grt_2)
paulson@13871
   286
  apply (frule aux__1, auto)
wenzelm@16974
   287
  apply (drule_tac z = "nat ((p - 1) div 2)" in zcong_zpower)
paulson@25675
   288
  apply (auto simp add: zpower_zpower) 
paulson@13871
   289
  apply (rule zcong_trans)
wenzelm@16974
   290
  apply (auto simp add: zcong_sym [of "x ^ nat ((p - 1) div 2)"])
huffman@26086
   291
  apply (metis Little_Fermat even_div_2_prop2 mult_Bit0 number_of_is_id odd_minus_one_even one_is_num_one zmult_1 aux__2)
wenzelm@18369
   292
  done
paulson@13871
   293
wenzelm@19670
   294
wenzelm@19670
   295
text {* \medskip Finally show Euler's Criterion: *}
paulson@13871
   296
nipkow@16663
   297
theorem Euler_Criterion: "[| 2 < p; zprime p |] ==> [(Legendre a p) =
wenzelm@16974
   298
    a^(nat (((p) - 1) div 2))] (mod p)"
paulson@13871
   299
  apply (auto simp add: Legendre_def Euler_part2)
wenzelm@20369
   300
  apply (frule Euler_part3, auto simp add: zcong_sym)[]
wenzelm@20369
   301
  apply (frule Euler_part1, auto simp add: zcong_sym)[]
wenzelm@18369
   302
  done
paulson@13871
   303
wenzelm@18369
   304
end