Removed Old_Number_Theory; all theories ported (thanks to Jaime Mendizabal Roche)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Number_Theory/Euler_Criterion.thy Mon Oct 17 15:20:06 2016 +0200
@@ -0,0 +1,171 @@
+(* Author: Jaime Mendizabal Roche *)
+
+theory Euler_Criterion
+imports Residues
+begin
+
+context
+ fixes p :: "nat"
+ fixes a :: "int"
+
+ assumes p_prime: "prime p"
+ assumes p_ge_2: "2 < p"
+ assumes p_a_relprime: "[a \<noteq> 0](mod p)"
+begin
+
+private lemma odd_p: "odd p" using p_ge_2 p_prime prime_odd_nat by blast
+
+private lemma p_minus_1_int: "int (p - 1) = int p - 1" using p_prime prime_ge_1_nat by force
+
+private lemma E_1: assumes "QuadRes p a"
+ shows "[a ^ ((p - 1) div 2) = 1] (mod (int p))"
+proof -
+ from assms obtain b where b: "[b ^ 2 = a] (mod p)" unfolding QuadRes_def by blast
+ hence "[a ^ ((p - 1) div 2) = b ^ (2 * ((p - 1) div 2))] (mod p)"
+ by (simp add: cong_exp_int cong_sym_int power_mult)
+ hence "[a ^ ((p - 1) div 2) = b ^ (p - 1)] (mod p)" using odd_p by force
+ moreover have "~ p dvd b"
+ using b cong_altdef_int[of a 0 p] cong_dvd_eq_int[of "b ^ 2" a "int p"] p_a_relprime p_prime
+ by (auto simp: prime_dvd_power_int_iff)
+ ultimately show ?thesis using fermat_theorem[of p b] p_prime
+ by (auto intro: cong_trans_int)
+qed
+
+private definition S1 :: "int set" where "S1 = {0 <.. int p - 1}"
+
+private definition P :: "int \<Rightarrow> int \<Rightarrow> bool" where
+ "P x y \<longleftrightarrow> [x * y = a] (mod p) \<and> y \<in> S1"
+
+private definition f_1 :: "int \<Rightarrow> int" where
+ "f_1 x = (THE y. P x y)"
+
+private definition f :: "int \<Rightarrow> int set" where
+ "f x = {x, f_1 x}"
+
+private definition S2 :: "int set set" where "S2 = f ` S1"
+
+private lemma P_lemma: assumes "x \<in> S1"
+ shows "\<exists>! y. P x y"
+proof -
+ have "~ p dvd x" using assms zdvd_not_zless S1_def by auto
+ hence co_xp: "coprime x p" using p_prime prime_imp_coprime_int[of p x]
+ by (simp add: gcd.commute)
+ then obtain y' where y': "[x * y' = 1] (mod p)" using cong_solve_coprime_int by blast
+ moreover define y where "y = y' * a mod p"
+ ultimately have "[x * y = a] (mod p)" using mod_mult_right_eq[of x "y' * a" p]
+ cong_scalar_int[of "x * y'"] unfolding cong_int_def mult.assoc by auto
+ moreover have "y \<in> {0 .. int p - 1}" unfolding y_def using p_ge_2 by auto
+ hence "y \<in> S1" using calculation cong_altdef_int p_a_relprime S1_def by auto
+ ultimately have "P x y" unfolding P_def by blast
+ moreover {
+ fix y1 y2
+ assume "P x y1" "P x y2"
+ moreover hence "[y1 = y2] (mod p)" unfolding P_def
+ using co_xp cong_mult_lcancel_int[of x p y1 y2] cong_sym_int cong_trans_int by blast
+ ultimately have "y1 = y2" unfolding P_def S1_def using cong_less_imp_eq_int by auto
+ }
+ ultimately show ?thesis by blast
+qed
+
+private lemma f_1_lemma_1: assumes "x \<in> S1"
+ shows "P x (f_1 x)" using assms P_lemma theI'[of "P x"] f_1_def by presburger
+
+private lemma f_1_lemma_2: assumes "x \<in> S1"
+ shows "f_1 (f_1 x) = x"
+ using assms f_1_lemma_1[of x] f_1_def P_lemma[of "f_1 x"] P_def by (auto simp: mult.commute)
+
+private lemma f_lemma_1: assumes "x \<in> S1"
+ shows "f x = f (f_1 x)" using f_def f_1_lemma_2[of x] assms by auto
+
+private lemma l1: assumes "~ QuadRes p a" "x \<in> S1"
+ shows "x \<noteq> f_1 x"
+ using f_1_lemma_1[of x] assms unfolding P_def QuadRes_def power2_eq_square by fastforce
+
+private lemma l2: assumes "~ QuadRes p a" "x \<in> S1"
+ shows "[\<Prod> (f x) = a] (mod p)"
+ using assms l1 f_1_lemma_1 P_def f_def by auto
+
+private lemma l3: assumes "x \<in> S2"
+ shows "finite x" using assms f_def S2_def by auto
+
+private lemma l4: "S1 = \<Union> S2" using f_1_lemma_1 P_def f_def S2_def by auto
+
+private lemma l5: assumes "x \<in> S2" "y \<in> S2" "x \<noteq> y"
+ shows "x \<inter> y = {}"
+proof -
+ obtain a b where ab: "x = f a" "a \<in> S1" "y = f b" "b \<in> S1" using assms S2_def by auto
+ hence "a \<noteq> b" "a \<noteq> f_1 b" "f_1 a \<noteq> b" using assms(3) f_lemma_1 by blast+
+ moreover hence "f_1 a \<noteq> f_1 b" using f_1_lemma_2[of a] f_1_lemma_2[of b] ab by force
+ ultimately show ?thesis using f_def ab by fastforce
+qed
+
+private lemma l6: "prod Prod S2 = \<Prod> S1"
+ using prod.Union_disjoint[of S2 "\<lambda>x. x"] l3 l4 l5 unfolding comp_def by auto
+
+private lemma l7: "fact n = \<Prod> {0 <.. int n}"
+proof (induction n)
+case (Suc n)
+ have "int (Suc n) = int n + 1" by simp
+ hence "insert (int (Suc n)) {0<..int n} = {0<..int (Suc n)}" by auto
+ thus ?case using prod.insert[of "{0<..int n}" "int (Suc n)" "\<lambda>x. x"] Suc fact_Suc by auto
+qed simp
+
+private lemma l8: "fact (p - 1) = \<Prod> S1" using l7[of "p - 1"] S1_def p_minus_1_int by presburger
+
+private lemma l9: "[prod Prod S2 = -1] (mod p)"
+ using l6 l8 wilson_theorem[of p] p_prime by presburger
+
+private lemma l10: assumes "card S = n" "\<And>x. x \<in> S \<Longrightarrow> [g x = a] (mod p)"
+ shows "[prod g S = a ^ n] (mod p)" using assms
+proof (induction n arbitrary: S)
+case 0
+ thus ?case using card_0_eq[of S] prod.empty prod.infinite by fastforce
+next
+case (Suc n)
+ then obtain x where x: "x \<in> S" by force
+ define S' where "S' = S - {x}"
+ hence "[prod g S' = a ^ n] (mod int p)"
+ using x Suc(1)[of S'] Suc(2) Suc(3) by (simp add: card_ge_0_finite)
+ moreover have "prod g S = g x * prod g S'"
+ using x S'_def Suc(2) prod.remove[of S x g] by fastforce
+ ultimately show ?case using x Suc(3) cong_mult_int by simp
+qed
+
+private lemma l11: assumes "~ QuadRes p a"
+ shows "card S2 = (p - 1) div 2"
+proof -
+ have "sum card S2 = 2 * card S2"
+ using sum.cong[of S2 S2 card "\<lambda>x. 2"] l1 f_def S2_def assms by fastforce
+ moreover have "p - 1 = sum card S2"
+ using l4 card_UN_disjoint[of S2 "\<lambda>x. x"] l3 l5 S1_def S2_def by auto
+ ultimately show ?thesis by linarith
+qed
+
+private lemma l12: assumes "~ QuadRes p a"
+ shows "[prod Prod S2 = a ^ ((p - 1) div 2)] (mod p)"
+ using assms l2 l10 l11 unfolding S2_def by blast
+
+private lemma E_2: assumes "~ QuadRes p a"
+ shows "[a ^ ((p - 1) div 2) = -1] (mod p)" using l9 l12 cong_trans_int cong_sym_int assms by blast
+
+lemma euler_criterion_aux: "[(Legendre a p) = a ^ ((p - 1) div 2)] (mod p)"
+ using E_1 E_2 Legendre_def cong_sym_int p_a_relprime by presburger
+
+end
+
+theorem euler_criterion: assumes "prime p" "2 < p"
+ shows "[(Legendre a p) = a ^ ((p - 1) div 2)] (mod p)"
+proof (cases "[a = 0] (mod p)")
+case True
+ hence "[a ^ ((p - 1) div 2) = 0 ^ ((p - 1) div 2)] (mod p)" using cong_exp_int by blast
+ moreover have "(0::int) ^ ((p - 1) div 2) = 0" using zero_power[of "(p - 1) div 2"] assms(2) by simp
+ ultimately have "[a ^ ((p - 1) div 2) = 0] (mod p)" using cong_trans_int cong_refl_int by presburger
+ thus ?thesis unfolding Legendre_def using True cong_sym_int by presburger
+next
+case False
+ thus ?thesis using euler_criterion_aux assms by presburger
+qed
+
+hide_fact euler_criterion_aux
+
+end
--- a/src/HOL/Number_Theory/Gauss.thy Tue Oct 18 07:04:08 2016 +0200
+++ b/src/HOL/Number_Theory/Gauss.thy Mon Oct 17 15:20:06 2016 +0200
@@ -6,7 +6,7 @@
section \<open>Gauss' Lemma\<close>
theory Gauss
-imports Residues
+imports Euler_Criterion
begin
lemma cong_prime_prod_zero_nat:
@@ -373,25 +373,24 @@
by (simp add: A_card_eq cong_sym_int)
qed
-(*NOT WORKING. Old_Number_Theory/Euler.thy needs to be translated, but it's
-quite a mess and should better be completely redone.
-
theorem gauss_lemma: "(Legendre a p) = (-1) ^ (card E)"
proof -
- from Euler_Criterion p_prime p_ge_2 have
+ from euler_criterion p_prime p_ge_2 have
"[(Legendre a p) = a^(nat (((p) - 1) div 2))] (mod p)"
by auto
+ moreover have "int ((p - 1) div 2) =(int p - 1) div 2" using p_eq2 by linarith
+ hence "[a ^ nat (int ((p - 1) div 2)) = a ^ nat ((int p - 1) div 2)] (mod int p)" by force
moreover note pre_gauss_lemma
- ultimately have "[(Legendre a p) = (-1) ^ (card E)] (mod p)"
- by (rule cong_trans_int)
+ ultimately have "[(Legendre a p) = (-1) ^ (card E)] (mod p)" using cong_trans_int by blast
moreover from p_a_relprime have "(Legendre a p) = 1 | (Legendre a p) = (-1)"
by (auto simp add: Legendre_def)
moreover have "(-1::int) ^ (card E) = 1 | (-1::int) ^ (card E) = -1"
- by (rule neg_one_power)
+ using neg_one_even_power neg_one_odd_power by blast
+ moreover have "[1 \<noteq> - 1] (mod int p)"
+ using cong_altdef_int nonzero_mod_p[of 2] p_odd_int by fastforce
ultimately show ?thesis
- by (auto simp add: p_ge_2 one_not_neg_one_mod_m zcong_sym)
+ by (auto simp add: cong_sym_int)
qed
-*)
end
--- a/src/HOL/Number_Theory/Number_Theory.thy Tue Oct 18 07:04:08 2016 +0200
+++ b/src/HOL/Number_Theory/Number_Theory.thy Mon Oct 17 15:20:06 2016 +0200
@@ -2,7 +2,7 @@
section \<open>Comprehensive number theory\<close>
theory Number_Theory
-imports Fib Residues Eratosthenes
+imports Fib Residues Eratosthenes QuadraticReciprocity Pocklington
begin
end
--- a/src/HOL/Number_Theory/Pocklington.thy Tue Oct 18 07:04:08 2016 +0200
+++ b/src/HOL/Number_Theory/Pocklington.thy Mon Oct 17 15:20:06 2016 +0200
@@ -10,7 +10,7 @@
subsection\<open>Lemmas about previously defined terms\<close>
-lemma prime:
+lemma prime_nat_iff'':
"prime (p::nat) \<longleftrightarrow> p \<noteq> 0 \<and> p \<noteq> 1 \<and> (\<forall>m. 0 < m \<and> m < p \<longrightarrow> coprime p m)"
unfolding prime_nat_iff
proof safe
@@ -78,7 +78,7 @@
from pa have ap: "coprime a p"
by (metis gcd.commute)
have px:"coprime x p"
- by (metis gcd.commute p prime x0 xp)
+ by (metis gcd.commute p prime_nat_iff'' x0 xp)
obtain y where y: "y < p" "[x * y = a] (mod p)" "\<forall>z. z < p \<and> [x * z = a] (mod p) \<longrightarrow> z = y"
by (metis cong_solve_unique neq0_conv p prime_gt_0_nat px)
{assume y0: "y = 0"
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Number_Theory/QuadraticReciprocity.thy Mon Oct 17 15:20:06 2016 +0200
@@ -0,0 +1,387 @@
+(* Author: Jaime Mendizabal Roche *)
+
+theory QuadraticReciprocity
+imports Gauss
+begin
+
+text {* The proof is based on Gauss's fifth proof, which can be found at http://www.lehigh.edu/~shw2/q-recip/gauss5.pdf *}
+
+locale QR =
+ fixes p :: "nat"
+ fixes q :: "nat"
+
+ assumes p_prime: "prime p"
+ assumes p_ge_2: "2 < p"
+ assumes q_prime: "prime q"
+ assumes q_ge_2: "2 < q"
+ assumes pq_neq: "p \<noteq> q"
+begin
+
+lemma odd_p: "odd p" using p_ge_2 p_prime prime_odd_nat by blast
+
+lemma p_ge_0: "0 < int p"
+ using p_prime not_prime_0[where 'a = nat] by fastforce+
+
+lemma p_eq2: "int p = (2 * ((int p - 1) div 2)) + 1" using odd_p by simp
+
+lemma odd_q: "odd q" using q_ge_2 q_prime prime_odd_nat by blast
+
+lemma q_ge_0: "0 < int q" using q_prime not_prime_0[where 'a = nat] by fastforce+
+
+lemma q_eq2: "int q = (2 * ((int q - 1) div 2)) + 1" using odd_q by simp
+
+lemma pq_eq2: "int p * int q = (2 * ((int p * int q - 1) div 2)) + 1" using odd_p odd_q by simp
+
+lemma pq_coprime: "coprime p q"
+ using pq_neq p_prime primes_coprime_nat q_prime by blast
+
+lemma pq_coprime_int: "coprime (int p) (int q)"
+ using pq_coprime transfer_int_nat_gcd(1) by presburger
+
+lemma qp_ineq: "(int p * k \<le> (int p * int q - 1) div 2) = (k \<le> (int q - 1) div 2)"
+proof -
+ have "(2 * int p * k \<le> int p * int q - 1) = (2 * k \<le> int q - 1)" using p_ge_0 by auto
+ thus ?thesis by auto
+qed
+
+lemma QRqp: "QR q p" using QR_def QR_axioms by simp
+
+lemma pq_commute: "int p * int q = int q * int p" by simp
+
+lemma pq_ge_0: "int p * int q > 0" using p_ge_0 q_ge_0 mult_pos_pos by blast
+
+definition "r = ((p - 1) div 2)*((q - 1) div 2)"
+definition "m = card (GAUSS.E p q)"
+definition "n = card (GAUSS.E q p)"
+
+abbreviation "Res (k::int) \<equiv> {0 .. k - 1}"
+abbreviation "Res_ge_0 (k::int) \<equiv> {0 <.. k - 1}"
+abbreviation "Res_0 (k::int) \<equiv> {0::int}"
+abbreviation "Res_l (k::int) \<equiv> {0 <.. (k - 1) div 2}"
+abbreviation "Res_h (k::int) \<equiv> {(k - 1) div 2 <.. k - 1}"
+
+abbreviation "Sets_pq r0 r1 r2 \<equiv>
+ {(x::int). x \<in> r0 (int p * int q) \<and> x mod p \<in> r1 (int p) \<and> x mod q \<in> r2 (int q)}"
+
+definition "A = Sets_pq Res_l Res_l Res_h"
+definition "B = Sets_pq Res_l Res_h Res_l"
+definition "C = Sets_pq Res_h Res_h Res_l"
+definition "D = Sets_pq Res_l Res_h Res_h"
+definition "E = Sets_pq Res_l Res_0 Res_h"
+definition "F = Sets_pq Res_l Res_h Res_0"
+
+definition "a = card A"
+definition "b = card B"
+definition "c = card C"
+definition "d = card D"
+definition "e = card E"
+definition "f = card F"
+
+lemma Gpq: "GAUSS p q" unfolding GAUSS_def
+ using p_prime pq_neq p_ge_2 q_prime
+ by (auto simp: cong_altdef_int zdvd_int [symmetric] dest: primes_dvd_imp_eq)
+
+lemma Gqp: "GAUSS q p" using QRqp QR.Gpq by simp
+
+lemma QR_lemma_01: "(\<lambda>x. x mod q) ` E = GAUSS.E q p"
+proof
+ {
+ fix x
+ assume a1: "x \<in> E"
+ then obtain k where k: "x = int p * k" unfolding E_def by blast
+ have "x \<in> Res_l (int p * int q)" using a1 E_def by blast
+ hence "k \<in> GAUSS.A q" using Gqp GAUSS.A_def k qp_ineq by (simp add: zero_less_mult_iff)
+ hence "x mod q \<in> GAUSS.E q p"
+ using GAUSS.C_def[of q p] Gqp k GAUSS.B_def[of q p] a1 GAUSS.E_def[of q p]
+ unfolding E_def by force
+ hence "x \<in> E \<longrightarrow> x mod int q \<in> GAUSS.E q p" by auto
+ }
+ thus "(\<lambda>x. x mod int q) ` E \<subseteq> GAUSS.E q p" by auto
+next
+ show "GAUSS.E q p \<subseteq> (\<lambda>x. x mod q) ` E"
+ proof
+ fix x
+ assume a1: "x \<in> GAUSS.E q p"
+ then obtain ka where ka: "ka \<in> GAUSS.A q" "x = (ka * p) mod q"
+ using Gqp GAUSS.B_def GAUSS.C_def GAUSS.E_def by auto
+ hence "ka * p \<in> Res_l (int p * int q)"
+ using GAUSS.A_def Gqp p_ge_0 qp_ineq by (simp add: Groups.mult_ac(2))
+ thus "x \<in> (\<lambda>x. x mod q) ` E" unfolding E_def using ka a1 Gqp GAUSS.E_def q_ge_0 by force
+ qed
+qed
+
+lemma QR_lemma_02: "e= n"
+proof -
+ {
+ fix x y
+ assume a: "x \<in> E" "y \<in> E" "x mod q = y mod q"
+ obtain p_inv where p_inv: "[int p * p_inv = 1] (mod int q)"
+ using pq_coprime_int cong_solve_coprime_int by blast
+ obtain kx ky where k: "x = int p * kx" "y = int p * ky" using a E_def dvd_def[of p x] by blast
+ hence "0 < x" "int p * kx \<le> (int p * int q - 1) div 2"
+ "0 < y" "int p * ky \<le> (int p * int q - 1) div 2"
+ using E_def a greaterThanAtMost_iff mem_Collect_eq by blast+
+ hence "0 \<le> kx" "kx < q" "0 \<le> ky" "ky < q" using qp_ineq k by (simp add: zero_less_mult_iff)+
+ moreover have "(p_inv * (p * kx)) mod q = (p_inv * (p * ky)) mod q"
+ using a(3) mod_mult_cong k by blast
+ hence "(p * p_inv * kx) mod q = (p * p_inv * ky) mod q" by (simp add:algebra_simps)
+ hence "kx mod q = ky mod q"
+ using p_inv mod_mult_cong[of "p * p_inv" "q" "1"] cong_int_def by auto
+ hence "[kx = ky] (mod q)" using cong_int_def by blast
+ ultimately have "x = y" using cong_less_imp_eq_int k by blast
+ }
+ hence "inj_on (\<lambda>x. x mod q) E" unfolding inj_on_def by auto
+ thus ?thesis using QR_lemma_01 card_image e_def n_def by fastforce
+qed
+
+lemma QR_lemma_03: "f = m"
+proof -
+ have "F = QR.E q p" unfolding F_def pq_commute using QRqp QR.E_def[of q p] by fastforce
+ hence "f = QR.e q p" unfolding f_def using QRqp QR.e_def[of q p] by presburger
+ thus ?thesis using QRqp QR.QR_lemma_02 m_def QRqp QR.n_def by presburger
+qed
+
+definition f_1 :: "int \<Rightarrow> int \<times> int" where
+ "f_1 x = ((x mod p), (x mod q))"
+
+definition P_1 :: "int \<times> int \<Rightarrow> int \<Rightarrow> bool" where
+ "P_1 res x \<longleftrightarrow> x mod p = fst res & x mod q = snd res & x \<in> Res (int p * int q)"
+
+definition g_1 :: "int \<times> int \<Rightarrow> int" where
+ "g_1 res = (THE x. P_1 res x)"
+
+lemma P_1_lemma: assumes "0 \<le> fst res" "fst res < p" "0 \<le> snd res" "snd res < q"
+ shows "\<exists>! x. P_1 res x"
+proof -
+ obtain y k1 k2 where yk: "y = nat (fst res) + k1 * p" "y = nat (snd res) + k2 * q"
+ using chinese_remainder[of p q] pq_coprime p_ge_0 q_ge_0 by fastforce
+ have h1: "[y = fst res] (mod p)" "[y = snd res] (mod q)"
+ using yk(1) assms(1) cong_iff_lin_int[of "fst res"] cong_sym_int apply simp
+ using yk(2) assms(3) cong_iff_lin_int[of "snd res"] cong_sym_int by simp
+ have "(y mod (int p * int q)) mod int p = fst res" "(y mod (int p * int q)) mod int q = snd res"
+ using h1(1) mod_mod_cancel[of "int p"] assms(1) assms(2) cong_int_def apply simp
+ using h1(2) mod_mod_cancel[of "int q"] assms(3) assms(4) cong_int_def by simp
+ then obtain x where "P_1 res x" unfolding P_1_def
+ using Divides.pos_mod_bound Divides.pos_mod_sign pq_ge_0 by fastforce
+ moreover {
+ fix a b
+ assume a: "P_1 res a" "P_1 res b"
+ hence "int p * int q dvd a - b"
+ using divides_mult[of "int p" "a - b" "int q"] pq_coprime_int zmod_eq_dvd_iff[of a _ b]
+ unfolding P_1_def by force
+ hence "a = b" using dvd_imp_le_int[of "a - b"] a unfolding P_1_def by fastforce
+ }
+ ultimately show ?thesis by auto
+qed
+
+lemma g_1_lemma: assumes "0 \<le> fst res" "fst res < p" "0 \<le> snd res" "snd res < q"
+ shows "P_1 res (g_1 res)" using assms P_1_lemma theI'[of "P_1 res"] g_1_def by presburger
+
+definition "BuC = Sets_pq Res_ge_0 Res_h Res_l"
+
+lemma QR_lemma_04: "card BuC = card ((Res_h p) \<times> (Res_l q))"
+ using card_bij_eq[of f_1 "BuC" "(Res_h p) \<times> (Res_l q)" g_1]
+proof
+ {
+ fix x y
+ assume a: "x \<in> BuC" "y \<in> BuC" "f_1 x = f_1 y"
+ hence "int p * int q dvd x - y"
+ using f_1_def pq_coprime_int divides_mult[of "int p" "x - y" "int q"]
+ zmod_eq_dvd_iff[of x _ y] by auto
+ hence "x = y"
+ using dvd_imp_le_int[of "x - y" "int p * int q"] a unfolding BuC_def by force
+ }
+ thus "inj_on f_1 BuC" unfolding inj_on_def by auto
+next
+ {
+ fix x y
+ assume a: "x \<in> (Res_h p) \<times> (Res_l q)" "y \<in> (Res_h p) \<times> (Res_l q)" "g_1 x = g_1 y"
+ hence "0 \<le> fst x" "fst x < p" "0 \<le> snd x" "snd x < q"
+ "0 \<le> fst y" "fst y < p" "0 \<le> snd y" "snd y < q"
+ using mem_Sigma_iff prod.collapse by fastforce+
+ hence "x = y" using g_1_lemma[of x] g_1_lemma[of y] a P_1_def by fastforce
+ }
+ thus "inj_on g_1 ((Res_h p) \<times> (Res_l q))" unfolding inj_on_def by auto
+next
+ show "g_1 ` ((Res_h p) \<times> (Res_l q)) \<subseteq> BuC"
+ proof
+ fix y
+ assume "y \<in> g_1 ` ((Res_h p) \<times> (Res_l q))"
+ then obtain x where x: "y = g_1 x" "x \<in> ((Res_h p) \<times> (Res_l q))" by blast
+ hence "P_1 x y" using g_1_lemma by fastforce
+ thus "y \<in> BuC" unfolding P_1_def BuC_def mem_Collect_eq using x SigmaE prod.sel by fastforce
+ qed
+qed (auto simp: BuC_def finite_subset f_1_def)
+
+lemma QR_lemma_05: "card ((Res_h p) \<times> (Res_l q)) = r"
+proof -
+ have "card (Res_l q) = (q - 1) div 2" "card (Res_h p) = (p - 1) div 2" using p_eq2 by force+
+ thus ?thesis unfolding r_def using card_cartesian_product[of "Res_h p" "Res_l q"] by presburger
+qed
+
+lemma QR_lemma_06: "b + c = r"
+proof -
+ have "B \<inter> C = {}" "finite B" "finite C" "B \<union> C = BuC" unfolding B_def C_def BuC_def by fastforce+
+ thus ?thesis
+ unfolding b_def c_def using card_empty card_Un_Int QR_lemma_04 QR_lemma_05 by fastforce
+qed
+
+definition f_2:: "int \<Rightarrow> int" where
+ "f_2 x = (int p * int q) - x"
+
+lemma f_2_lemma_1: "\<And>x. f_2 (f_2 x) = x" unfolding f_2_def by simp
+
+lemma f_2_lemma_2: "[f_2 x = int p - x] (mod p)" unfolding f_2_def using cong_altdef_int by simp
+
+lemma f_2_lemma_3: "f_2 x \<in> S \<Longrightarrow> x \<in> f_2 ` S"
+ using f_2_lemma_1[of x] image_eqI[of x f_2 "f_2 x" S] by presburger
+
+lemma QR_lemma_07: "f_2 ` Res_l (int p * int q) = Res_h (int p * int q)"
+ "f_2 ` Res_h (int p * int q) = Res_l (int p * int q)"
+proof -
+ have h1: "f_2 ` Res_l (int p * int q) \<subseteq> Res_h (int p * int q)" using f_2_def by force
+ have h2: "f_2 ` Res_h (int p * int q) \<subseteq> Res_l (int p * int q)" using f_2_def pq_eq2 by fastforce
+ have h3: "Res_h (int p * int q) \<subseteq> f_2 ` Res_l (int p * int q)" using h2 f_2_lemma_3 by blast
+ have h4: "Res_l (int p * int q) \<subseteq> f_2 ` Res_h (int p * int q)" using h1 f_2_lemma_3 by blast
+ show "f_2 ` Res_l (int p * int q) = Res_h (int p * int q)" using h1 h3 by blast
+ show "f_2 ` Res_h (int p * int q) = Res_l (int p * int q)" using h2 h4 by blast
+qed
+
+lemma QR_lemma_08: "(f_2 x mod p \<in> Res_l p) = (x mod p \<in> Res_h p)"
+ "(f_2 x mod p \<in> Res_h p) = (x mod p \<in> Res_l p)"
+ using f_2_lemma_2[of x] cong_int_def[of "f_2 x" "p - x" p] minus_mod_self2[of x p]
+ zmod_zminus1_eq_if[of x p] p_eq2 by auto
+
+lemma QR_lemma_09: "(f_2 x mod q \<in> Res_l q) = (x mod q \<in> Res_h q)"
+ "(f_2 x mod q \<in> Res_h q) = (x mod q \<in> Res_l q)"
+ using QRqp QR.QR_lemma_08 f_2_def QR.f_2_def pq_commute by auto+
+
+lemma QR_lemma_10: "a = c" unfolding a_def c_def apply (rule card_bij_eq[of f_2 A C f_2])
+ unfolding A_def C_def
+ using QR_lemma_07 QR_lemma_08 QR_lemma_09 apply ((simp add: inj_on_def f_2_def),blast)+
+ by fastforce+
+
+definition "BuD = Sets_pq Res_l Res_h Res_ge_0"
+definition "BuDuF = Sets_pq Res_l Res_h Res"
+
+definition f_3 :: "int \<Rightarrow> int \<times> int" where
+ "f_3 x = (x mod p, x div p + 1)"
+
+definition g_3 :: "int \<times> int \<Rightarrow> int" where
+ "g_3 x = fst x + (snd x - 1) * p"
+
+lemma QR_lemma_11: "card BuDuF = card ((Res_h p) \<times> (Res_l q))"
+ using card_bij_eq[of f_3 BuDuF "(Res_h p) \<times> (Res_l q)" g_3]
+proof
+ show "f_3 ` BuDuF \<subseteq> (Res_h p) \<times> (Res_l q)"
+ proof
+ fix y
+ assume "y \<in> f_3 ` BuDuF"
+ then obtain x where x: "y = f_3 x" "x \<in> BuDuF" by blast
+ hence "x \<le> int p * (int q - 1) div 2 + (int p - 1) div 2"
+ unfolding BuDuF_def using p_eq2 int_distrib(4) by auto
+ moreover have "(int p - 1) div 2 \<le> - 1 + x mod p" using x BuDuF_def by auto
+ moreover have "int p * (int q - 1) div 2 = int p * ((int q - 1) div 2)"
+ using zdiv_zmult1_eq odd_q by auto
+ hence "p * (int q - 1) div 2 = p * ((int q + 1) div 2 - 1)" by fastforce
+ ultimately have "x \<le> p * ((int q + 1) div 2 - 1) - 1 + x mod p" by linarith
+ hence "x div p < (int q + 1) div 2 - 1"
+ using mult.commute[of "int p" "x div p"] p_ge_0 div_mult_mod_eq[of x p]
+ mult_less_cancel_left_pos[of p "x div p" "(int q + 1) div 2 - 1"] by linarith
+ moreover have "0 < x div p + 1"
+ using pos_imp_zdiv_neg_iff[of p x] p_ge_0 x mem_Collect_eq BuDuF_def by auto
+ ultimately show "y \<in> (Res_h p) \<times> (Res_l q)" using x BuDuF_def f_3_def by auto
+ qed
+next
+ have h1: "\<And>x. x \<in> ((Res_h p) \<times> (Res_l q)) \<Longrightarrow> f_3 (g_3 x) = x"
+ proof -
+ fix x
+ assume a: "x \<in> ((Res_h p) \<times> (Res_l q))"
+ moreover have h: "(fst x + (snd x - 1) * int p) mod int p = fst x" using a by force
+ ultimately have "(fst x + (snd x - 1) * int p) div int p + 1 = snd x"
+ by (auto simp: semiring_numeral_div_class.div_less)
+ with h show "f_3 (g_3 x) = x" unfolding f_3_def g_3_def by simp
+ qed
+ show "inj_on g_3 ((Res_h p) \<times> (Res_l q))" apply (rule inj_onI[of "(Res_h p) \<times> (Res_l q)" g_3])
+ proof -
+ fix x y
+ assume "x \<in> ((Res_h p) \<times> (Res_l q))" "y \<in> ((Res_h p) \<times> (Res_l q))" "g_3 x = g_3 y"
+ thus "x = y" using h1[of x] h1[of y] by presburger
+ qed
+next
+ show "g_3 ` ((Res_h p) \<times> (Res_l q)) \<subseteq> BuDuF"
+ proof
+ fix y
+ assume "y \<in> g_3 ` ((Res_h p) \<times> (Res_l q))"
+ then obtain x where x: "y = g_3 x" "x \<in> (Res_h p) \<times> (Res_l q)" by blast
+ hence "snd x \<le> (int q - 1) div 2" by force
+ moreover have "int p * ((int q - 1) div 2) = (int p * int q - int p) div 2"
+ using int_distrib(4) zdiv_zmult1_eq[of "int p" "int q - 1" 2] odd_q by fastforce
+ ultimately have "(snd x) * int p \<le> (int q * int p - int p) div 2"
+ using mult_right_mono[of "snd x" "(int q - 1) div 2" p] mult.commute[of "(int q - 1) div 2" p]
+ pq_commute by presburger
+ hence "(snd x - 1) * int p \<le> (int q * int p - 1) div 2 - int p"
+ using p_ge_0 int_distrib(3) by auto
+ moreover have "fst x \<le> int p - 1" using x by force
+ ultimately have "fst x + (snd x - 1) * int p \<le> (int p * int q - 1) div 2"
+ using pq_commute by linarith
+ moreover have "0 < fst x" "0 \<le> (snd x - 1) * p" using x(2) by fastforce+
+ ultimately show "y \<in> BuDuF" unfolding BuDuF_def using q_ge_0 x g_3_def x(1) by auto
+ qed
+next
+ show "finite BuDuF" unfolding BuDuF_def by fastforce
+qed (simp add: inj_on_inverseI[of BuDuF g_3] f_3_def g_3_def QR_lemma_05)+
+
+lemma QR_lemma_12: "b + d + m = r"
+proof -
+ have "B \<inter> D = {}" "finite B" "finite D" "B \<union> D = BuD" unfolding B_def D_def BuD_def by fastforce+
+ hence "b + d = card BuD" unfolding b_def d_def using card_Un_Int by fastforce
+ moreover have "BuD \<inter> F = {}" "finite BuD" "finite F" unfolding BuD_def F_def by fastforce+
+ moreover have "BuD \<union> F = BuDuF" unfolding BuD_def F_def BuDuF_def
+ using q_ge_0 ivl_disj_un_singleton(5)[of 0 "int q - 1"] by auto
+ ultimately show ?thesis using QR_lemma_03 QR_lemma_05 QR_lemma_11 card_Un_disjoint[of BuD F]
+ unfolding b_def d_def f_def by presburger
+qed
+
+lemma QR_lemma_13: "a + d + n = r"
+proof -
+ have "A = QR.B q p" unfolding A_def pq_commute using QRqp QR.B_def[of q p] by blast
+ hence "a = QR.b q p" using a_def QRqp QR.b_def[of q p] by presburger
+ moreover have "D = QR.D q p" unfolding D_def pq_commute using QRqp QR.D_def[of q p] by blast
+ hence "d = QR.d q p" using d_def QRqp QR.d_def[of q p] by presburger
+ moreover have "n = QR.m q p" using n_def QRqp QR.m_def[of q p] by presburger
+ moreover have "r = QR.r q p" unfolding r_def using QRqp QR.r_def[of q p] by auto
+ ultimately show ?thesis using QRqp QR.QR_lemma_12 by presburger
+qed
+
+lemma QR_lemma_14: "(-1::int) ^ (m + n) = (-1) ^ r"
+proof -
+ have "m + n + 2 * d = r" using QR_lemma_06 QR_lemma_10 QR_lemma_12 QR_lemma_13 by auto
+ thus ?thesis using power_add[of "-1::int" "m + n" "2 * d"] by fastforce
+qed
+
+lemma Quadratic_Reciprocity:
+ "(Legendre p q) * (Legendre q p) = (-1::int) ^ ((p - 1) div 2 * ((q - 1) div 2))"
+ using Gpq Gqp GAUSS.gauss_lemma power_add[of "-1::int" m n] QR_lemma_14
+ unfolding r_def m_def n_def by auto
+
+end
+
+theorem Quadratic_Reciprocity: assumes "prime p" "2 < p" "prime q" "2 < q" "p \<noteq> q"
+ shows "(Legendre p q) * (Legendre q p) = (-1::int) ^ ((p - 1) div 2 * ((q - 1) div 2))"
+ using QR.Quadratic_Reciprocity QR_def assms by blast
+
+theorem Quadratic_Reciprocity_int: assumes "prime (nat p)" "2 < p" "prime (nat q)" "2 < q" "p \<noteq> q"
+ shows "(Legendre p q) * (Legendre q p) = (-1::int) ^ (nat ((p - 1) div 2 * ((q - 1) div 2)))"
+proof -
+ have "0 \<le> (p - 1) div 2" using assms by simp
+ moreover have "(nat p - 1) div 2 = nat ((p - 1) div 2)" "(nat q - 1) div 2 = nat ((q - 1) div 2)"
+ by fastforce+
+ ultimately have "(nat p - 1) div 2 * ((nat q - 1) div 2) = nat ((p - 1) div 2 * ((q - 1) div 2))"
+ using nat_mult_distrib by presburger
+ moreover have "2 < nat p" "2 < nat q" "nat p \<noteq> nat q" "int (nat p) = p" "int (nat q) = q"
+ using assms by linarith+
+ ultimately show ?thesis using Quadratic_Reciprocity[of "nat p" "nat q"] assms by presburger
+qed
+
+end
\ No newline at end of file
--- a/src/HOL/Number_Theory/Residues.thy Tue Oct 18 07:04:08 2016 +0200
+++ b/src/HOL/Number_Theory/Residues.thy Mon Oct 17 15:20:06 2016 +0200
@@ -11,6 +11,14 @@
imports Cong MiscAlgebra
begin
+definition QuadRes :: "int \<Rightarrow> int \<Rightarrow> bool" where
+ "QuadRes p a = (\<exists>y. ([y^2 = a] (mod p)))"
+
+definition Legendre :: "int \<Rightarrow> int \<Rightarrow> int" where
+ "Legendre a p = (if ([a = 0] (mod p)) then 0
+ else if QuadRes p a then 1
+ else -1)"
+
subsection \<open>A locale for residue rings\<close>
definition residue_ring :: "int \<Rightarrow> int ring"
--- a/src/HOL/Old_Number_Theory/BijectionRel.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,232 +0,0 @@
-(* Title: HOL/Old_Number_Theory/BijectionRel.thy
- Author: Thomas M. Rasmussen
- Copyright 2000 University of Cambridge
-*)
-
-section \<open>Bijections between sets\<close>
-
-theory BijectionRel
-imports Main
-begin
-
-text \<open>
- Inductive definitions of bijections between two different sets and
- between the same set. Theorem for relating the two definitions.
-
- \bigskip
-\<close>
-
-inductive_set
- bijR :: "('a => 'b => bool) => ('a set * 'b set) set"
- for P :: "'a => 'b => bool"
-where
- empty [simp]: "({}, {}) \<in> bijR P"
-| insert: "P a b ==> a \<notin> A ==> b \<notin> B ==> (A, B) \<in> bijR P
- ==> (insert a A, insert b B) \<in> bijR P"
-
-text \<open>
- Add extra condition to @{term insert}: @{term "\<forall>b \<in> B. \<not> P a b"}
- (and similar for @{term A}).
-\<close>
-
-definition
- bijP :: "('a => 'a => bool) => 'a set => bool" where
- "bijP P F = (\<forall>a b. a \<in> F \<and> P a b --> b \<in> F)"
-
-definition
- uniqP :: "('a => 'a => bool) => bool" where
- "uniqP P = (\<forall>a b c d. P a b \<and> P c d --> (a = c) = (b = d))"
-
-definition
- symP :: "('a => 'a => bool) => bool" where
- "symP P = (\<forall>a b. P a b = P b a)"
-
-inductive_set
- bijER :: "('a => 'a => bool) => 'a set set"
- for P :: "'a => 'a => bool"
-where
- empty [simp]: "{} \<in> bijER P"
-| insert1: "P a a ==> a \<notin> A ==> A \<in> bijER P ==> insert a A \<in> bijER P"
-| insert2: "P a b ==> a \<noteq> b ==> a \<notin> A ==> b \<notin> A ==> A \<in> bijER P
- ==> insert a (insert b A) \<in> bijER P"
-
-
-text \<open>\medskip @{term bijR}\<close>
-
-lemma fin_bijRl: "(A, B) \<in> bijR P ==> finite A"
- apply (erule bijR.induct)
- apply auto
- done
-
-lemma fin_bijRr: "(A, B) \<in> bijR P ==> finite B"
- apply (erule bijR.induct)
- apply auto
- done
-
-lemma aux_induct:
- assumes major: "finite F"
- and subs: "F \<subseteq> A"
- and cases: "P {}"
- "!!F a. F \<subseteq> A ==> a \<in> A ==> a \<notin> F ==> P F ==> P (insert a F)"
- shows "P F"
- using major subs
- apply (induct set: finite)
- apply (blast intro: cases)+
- done
-
-
-lemma inj_func_bijR_aux1:
- "A \<subseteq> B ==> a \<notin> A ==> a \<in> B ==> inj_on f B ==> f a \<notin> f ` A"
- apply (unfold inj_on_def)
- apply auto
- done
-
-lemma inj_func_bijR_aux2:
- "\<forall>a. a \<in> A --> P a (f a) ==> inj_on f A ==> finite A ==> F <= A
- ==> (F, f ` F) \<in> bijR P"
- apply (rule_tac F = F and A = A in aux_induct)
- apply (rule finite_subset)
- apply auto
- apply (rule bijR.insert)
- apply (rule_tac [3] inj_func_bijR_aux1)
- apply auto
- done
-
-lemma inj_func_bijR:
- "\<forall>a. a \<in> A --> P a (f a) ==> inj_on f A ==> finite A
- ==> (A, f ` A) \<in> bijR P"
- apply (rule inj_func_bijR_aux2)
- apply auto
- done
-
-
-text \<open>\medskip @{term bijER}\<close>
-
-lemma fin_bijER: "A \<in> bijER P ==> finite A"
- apply (erule bijER.induct)
- apply auto
- done
-
-lemma aux1:
- "a \<notin> A ==> a \<notin> B ==> F \<subseteq> insert a A ==> F \<subseteq> insert a B ==> a \<in> F
- ==> \<exists>C. F = insert a C \<and> a \<notin> C \<and> C <= A \<and> C <= B"
- apply (rule_tac x = "F - {a}" in exI)
- apply auto
- done
-
-lemma aux2: "a \<noteq> b ==> a \<notin> A ==> b \<notin> B ==> a \<in> F ==> b \<in> F
- ==> F \<subseteq> insert a A ==> F \<subseteq> insert b B
- ==> \<exists>C. F = insert a (insert b C) \<and> a \<notin> C \<and> b \<notin> C \<and> C \<subseteq> A \<and> C \<subseteq> B"
- apply (rule_tac x = "F - {a, b}" in exI)
- apply auto
- done
-
-lemma aux_uniq: "uniqP P ==> P a b ==> P c d ==> (a = c) = (b = d)"
- apply (unfold uniqP_def)
- apply auto
- done
-
-lemma aux_sym: "symP P ==> P a b = P b a"
- apply (unfold symP_def)
- apply auto
- done
-
-lemma aux_in1:
- "uniqP P ==> b \<notin> C ==> P b b ==> bijP P (insert b C) ==> bijP P C"
- apply (unfold bijP_def)
- apply auto
- apply (subgoal_tac "b \<noteq> a")
- prefer 2
- apply clarify
- apply (simp add: aux_uniq)
- apply auto
- done
-
-lemma aux_in2:
- "symP P ==> uniqP P ==> a \<notin> C ==> b \<notin> C ==> a \<noteq> b ==> P a b
- ==> bijP P (insert a (insert b C)) ==> bijP P C"
- apply (unfold bijP_def)
- apply auto
- apply (subgoal_tac "aa \<noteq> a")
- prefer 2
- apply clarify
- apply (subgoal_tac "aa \<noteq> b")
- prefer 2
- apply clarify
- apply (simp add: aux_uniq)
- apply (subgoal_tac "ba \<noteq> a")
- apply auto
- apply (subgoal_tac "P a aa")
- prefer 2
- apply (simp add: aux_sym)
- apply (subgoal_tac "b = aa")
- apply (rule_tac [2] iffD1)
- apply (rule_tac [2] a = a and c = a and P = P in aux_uniq)
- apply auto
- done
-
-lemma aux_foo: "\<forall>a b. Q a \<and> P a b --> R b ==> P a b ==> Q a ==> R b"
- apply auto
- done
-
-lemma aux_bij: "bijP P F ==> symP P ==> P a b ==> (a \<in> F) = (b \<in> F)"
- apply (unfold bijP_def)
- apply (rule iffI)
- apply (erule_tac [!] aux_foo)
- apply simp_all
- apply (rule iffD2)
- apply (rule_tac P = P in aux_sym)
- apply simp_all
- done
-
-
-lemma aux_bijRER:
- "(A, B) \<in> bijR P ==> uniqP P ==> symP P
- ==> \<forall>F. bijP P F \<and> F \<subseteq> A \<and> F \<subseteq> B --> F \<in> bijER P"
- apply (erule bijR.induct)
- apply simp
- apply (case_tac "a = b")
- apply clarify
- apply (case_tac "b \<in> F")
- prefer 2
- apply (simp add: subset_insert)
- apply (cut_tac F = F and a = b and A = A and B = B in aux1)
- prefer 6
- apply clarify
- apply (rule bijER.insert1)
- apply simp_all
- apply (subgoal_tac "bijP P C")
- apply simp
- apply (rule aux_in1)
- apply simp_all
- apply clarify
- apply (case_tac "a \<in> F")
- apply (case_tac [!] "b \<in> F")
- apply (cut_tac F = F and a = a and b = b and A = A and B = B
- in aux2)
- apply (simp_all add: subset_insert)
- apply clarify
- apply (rule bijER.insert2)
- apply simp_all
- apply (subgoal_tac "bijP P C")
- apply simp
- apply (rule aux_in2)
- apply simp_all
- apply (subgoal_tac "b \<in> F")
- apply (rule_tac [2] iffD1)
- apply (rule_tac [2] a = a and F = F and P = P in aux_bij)
- apply (simp_all (no_asm_simp))
- apply (subgoal_tac [2] "a \<in> F")
- apply (rule_tac [3] iffD2)
- apply (rule_tac [3] b = b and F = F and P = P in aux_bij)
- apply auto
- done
-
-lemma bijR_bijER:
- "(A, A) \<in> bijR P ==>
- bijP P A ==> uniqP P ==> symP P ==> A \<in> bijER P"
- apply (cut_tac A = A and B = A and P = P in aux_bijRER)
- apply auto
- done
-
-end
--- a/src/HOL/Old_Number_Theory/Chinese.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,252 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Chinese.thy
- Author: Thomas M. Rasmussen
- Copyright 2000 University of Cambridge
-*)
-
-section \<open>The Chinese Remainder Theorem\<close>
-
-theory Chinese
-imports IntPrimes
-begin
-
-text \<open>
- The Chinese Remainder Theorem for an arbitrary finite number of
- equations. (The one-equation case is included in theory \<open>IntPrimes\<close>. Uses functions for indexing.\footnote{Maybe @{term
- funprod} and @{term funsum} should be based on general @{term fold}
- on indices?}
-\<close>
-
-
-subsection \<open>Definitions\<close>
-
-primrec funprod :: "(nat => int) => nat => nat => int"
-where
- "funprod f i 0 = f i"
-| "funprod f i (Suc n) = f (Suc (i + n)) * funprod f i n"
-
-primrec funsum :: "(nat => int) => nat => nat => int"
-where
- "funsum f i 0 = f i"
-| "funsum f i (Suc n) = f (Suc (i + n)) + funsum f i n"
-
-definition
- m_cond :: "nat => (nat => int) => bool" where
- "m_cond n mf =
- ((\<forall>i. i \<le> n --> 0 < mf i) \<and>
- (\<forall>i j. i \<le> n \<and> j \<le> n \<and> i \<noteq> j --> zgcd (mf i) (mf j) = 1))"
-
-definition
- km_cond :: "nat => (nat => int) => (nat => int) => bool" where
- "km_cond n kf mf = (\<forall>i. i \<le> n --> zgcd (kf i) (mf i) = 1)"
-
-definition
- lincong_sol ::
- "nat => (nat => int) => (nat => int) => (nat => int) => int => bool" where
- "lincong_sol n kf bf mf x = (\<forall>i. i \<le> n --> zcong (kf i * x) (bf i) (mf i))"
-
-definition
- mhf :: "(nat => int) => nat => nat => int" where
- "mhf mf n i =
- (if i = 0 then funprod mf (Suc 0) (n - Suc 0)
- else if i = n then funprod mf 0 (n - Suc 0)
- else funprod mf 0 (i - Suc 0) * funprod mf (Suc i) (n - Suc 0 - i))"
-
-definition
- xilin_sol ::
- "nat => nat => (nat => int) => (nat => int) => (nat => int) => int" where
- "xilin_sol i n kf bf mf =
- (if 0 < n \<and> i \<le> n \<and> m_cond n mf \<and> km_cond n kf mf then
- (SOME x. 0 \<le> x \<and> x < mf i \<and> zcong (kf i * mhf mf n i * x) (bf i) (mf i))
- else 0)"
-
-definition
- x_sol :: "nat => (nat => int) => (nat => int) => (nat => int) => int" where
- "x_sol n kf bf mf = funsum (\<lambda>i. xilin_sol i n kf bf mf * mhf mf n i) 0 n"
-
-
-text \<open>\medskip @{term funprod} and @{term funsum}\<close>
-
-lemma funprod_pos: "(\<forall>i. i \<le> n --> 0 < mf i) ==> 0 < funprod mf 0 n"
-by (induct n) auto
-
-lemma funprod_zgcd [rule_format (no_asm)]:
- "(\<forall>i. k \<le> i \<and> i \<le> k + l --> zgcd (mf i) (mf m) = 1) -->
- zgcd (funprod mf k l) (mf m) = 1"
- apply (induct l)
- apply simp_all
- apply (rule impI)+
- apply (subst zgcd_zmult_cancel)
- apply auto
- done
-
-lemma funprod_zdvd [rule_format]:
- "k \<le> i --> i \<le> k + l --> mf i dvd funprod mf k l"
- apply (induct l)
- apply auto
- apply (subgoal_tac "i = Suc (k + l)")
- apply (simp_all (no_asm_simp))
- done
-
-lemma funsum_mod:
- "funsum f k l mod m = funsum (\<lambda>i. (f i) mod m) k l mod m"
- apply (induct l)
- apply auto
- apply (rule trans)
- apply (rule mod_add_eq)
- apply simp
- apply (rule mod_add_right_eq [symmetric])
- done
-
-lemma funsum_zero [rule_format (no_asm)]:
- "(\<forall>i. k \<le> i \<and> i \<le> k + l --> f i = 0) --> (funsum f k l) = 0"
- apply (induct l)
- apply auto
- done
-
-lemma funsum_oneelem [rule_format (no_asm)]:
- "k \<le> j --> j \<le> k + l -->
- (\<forall>i. k \<le> i \<and> i \<le> k + l \<and> i \<noteq> j --> f i = 0) -->
- funsum f k l = f j"
- apply (induct l)
- prefer 2
- apply clarify
- defer
- apply clarify
- apply (subgoal_tac "k = j")
- apply (simp_all (no_asm_simp))
- apply (case_tac "Suc (k + l) = j")
- apply (subgoal_tac "funsum f k l = 0")
- apply (rule_tac [2] funsum_zero)
- apply (subgoal_tac [3] "f (Suc (k + l)) = 0")
- apply (subgoal_tac [3] "j \<le> k + l")
- prefer 4
- apply arith
- apply auto
- done
-
-
-subsection \<open>Chinese: uniqueness\<close>
-
-lemma zcong_funprod_aux:
- "m_cond n mf ==> km_cond n kf mf
- ==> lincong_sol n kf bf mf x ==> lincong_sol n kf bf mf y
- ==> [x = y] (mod mf n)"
- apply (unfold m_cond_def km_cond_def lincong_sol_def)
- apply (rule iffD1)
- apply (rule_tac k = "kf n" in zcong_cancel2)
- apply (rule_tac [3] b = "bf n" in zcong_trans)
- prefer 4
- apply (subst zcong_sym)
- defer
- apply (rule order_less_imp_le)
- apply simp_all
- done
-
-lemma zcong_funprod [rule_format]:
- "m_cond n mf --> km_cond n kf mf -->
- lincong_sol n kf bf mf x --> lincong_sol n kf bf mf y -->
- [x = y] (mod funprod mf 0 n)"
- apply (induct n)
- apply (simp_all (no_asm))
- apply (blast intro: zcong_funprod_aux)
- apply (rule impI)+
- apply (rule zcong_zgcd_zmult_zmod)
- apply (blast intro: zcong_funprod_aux)
- prefer 2
- apply (subst zgcd_commute)
- apply (rule funprod_zgcd)
- apply (auto simp add: m_cond_def km_cond_def lincong_sol_def)
- done
-
-
-subsection \<open>Chinese: existence\<close>
-
-lemma unique_xi_sol:
- "0 < n ==> i \<le> n ==> m_cond n mf ==> km_cond n kf mf
- ==> \<exists>!x. 0 \<le> x \<and> x < mf i \<and> [kf i * mhf mf n i * x = bf i] (mod mf i)"
- apply (rule zcong_lineq_unique)
- apply (tactic \<open>stac @{context} @{thm zgcd_zmult_cancel} 2\<close>)
- apply (unfold m_cond_def km_cond_def mhf_def)
- apply (simp_all (no_asm_simp))
- apply safe
- apply (tactic \<open>stac @{context} @{thm zgcd_zmult_cancel} 3\<close>)
- apply (rule_tac [!] funprod_zgcd)
- apply safe
- apply simp_all
- apply (subgoal_tac "ia<n")
- prefer 2
- apply arith
- apply (case_tac [2] i)
- apply simp_all
- done
-
-lemma x_sol_lin_aux:
- "0 < n ==> i \<le> n ==> j \<le> n ==> j \<noteq> i ==> mf j dvd mhf mf n i"
- apply (unfold mhf_def)
- apply (case_tac "i = 0")
- apply (case_tac [2] "i = n")
- apply (simp_all (no_asm_simp))
- apply (case_tac [3] "j < i")
- apply (rule_tac [3] dvd_mult2)
- apply (rule_tac [4] dvd_mult)
- apply (rule_tac [!] funprod_zdvd)
- apply arith
- apply arith
- apply arith
- apply arith
- apply arith
- apply arith
- apply arith
- apply arith
- done
-
-lemma x_sol_lin:
- "0 < n ==> i \<le> n
- ==> x_sol n kf bf mf mod mf i =
- xilin_sol i n kf bf mf * mhf mf n i mod mf i"
- apply (unfold x_sol_def)
- apply (subst funsum_mod)
- apply (subst funsum_oneelem)
- apply auto
- apply (subst dvd_eq_mod_eq_0 [symmetric])
- apply (rule dvd_mult)
- apply (rule x_sol_lin_aux)
- apply auto
- done
-
-
-subsection \<open>Chinese\<close>
-
-lemma chinese_remainder:
- "0 < n ==> m_cond n mf ==> km_cond n kf mf
- ==> \<exists>!x. 0 \<le> x \<and> x < funprod mf 0 n \<and> lincong_sol n kf bf mf x"
- apply safe
- apply (rule_tac [2] m = "funprod mf 0 n" in zcong_zless_imp_eq)
- apply (rule_tac [6] zcong_funprod)
- apply auto
- apply (rule_tac x = "x_sol n kf bf mf mod funprod mf 0 n" in exI)
- apply (unfold lincong_sol_def)
- apply safe
- apply (tactic \<open>stac @{context} @{thm zcong_zmod} 3\<close>)
- apply (tactic \<open>stac @{context} @{thm mod_mult_eq} 3\<close>)
- apply (tactic \<open>stac @{context} @{thm mod_mod_cancel} 3\<close>)
- apply (tactic \<open>stac @{context} @{thm x_sol_lin} 4\<close>)
- apply (tactic \<open>stac @{context} (@{thm mod_mult_eq} RS sym) 6\<close>)
- apply (tactic \<open>stac @{context} (@{thm zcong_zmod} RS sym) 6\<close>)
- apply (subgoal_tac [6]
- "0 \<le> xilin_sol i n kf bf mf \<and> xilin_sol i n kf bf mf < mf i
- \<and> [kf i * mhf mf n i * xilin_sol i n kf bf mf = bf i] (mod mf i)")
- prefer 6
- apply (simp add: ac_simps)
- apply (unfold xilin_sol_def)
- apply (tactic \<open>asm_simp_tac @{context} 6\<close>)
- apply (rule_tac [6] ex1_implies_ex [THEN someI_ex])
- apply (rule_tac [6] unique_xi_sol)
- apply (rule_tac [3] funprod_zdvd)
- apply (unfold m_cond_def)
- apply (rule funprod_pos [THEN pos_mod_sign])
- apply (rule_tac [2] funprod_pos [THEN pos_mod_bound])
- apply auto
- done
-
-end
--- a/src/HOL/Old_Number_Theory/Euler.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,303 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Euler.thy
- Authors: Jeremy Avigad, David Gray, and Adam Kramer
-*)
-
-section \<open>Euler's criterion\<close>
-
-theory Euler
-imports Residues EvenOdd
-begin
-
-definition MultInvPair :: "int => int => int => int set"
- where "MultInvPair a p j = {StandardRes p j, StandardRes p (a * (MultInv p j))}"
-
-definition SetS :: "int => int => int set set"
- where "SetS a p = MultInvPair a p ` SRStar p"
-
-
-subsection \<open>Property for MultInvPair\<close>
-
-lemma MultInvPair_prop1a:
- "[| zprime p; 2 < p; ~([a = 0](mod p));
- X \<in> (SetS a p); Y \<in> (SetS a p);
- ~((X \<inter> Y) = {}) |] ==> X = Y"
- apply (auto simp add: SetS_def)
- apply (drule StandardRes_SRStar_prop1a)+ defer 1
- apply (drule StandardRes_SRStar_prop1a)+
- apply (auto simp add: MultInvPair_def StandardRes_prop2 zcong_sym)
- apply (drule notE, rule MultInv_zcong_prop1, auto)[]
- apply (drule notE, rule MultInv_zcong_prop2, auto simp add: zcong_sym)[]
- apply (drule MultInv_zcong_prop2, auto simp add: zcong_sym)[]
- apply (drule MultInv_zcong_prop3, auto simp add: zcong_sym)[]
- apply (drule MultInv_zcong_prop1, auto)[]
- apply (drule MultInv_zcong_prop2, auto simp add: zcong_sym)[]
- apply (drule MultInv_zcong_prop2, auto simp add: zcong_sym)[]
- apply (drule MultInv_zcong_prop3, auto simp add: zcong_sym)[]
- done
-
-lemma MultInvPair_prop1b:
- "[| zprime p; 2 < p; ~([a = 0](mod p));
- X \<in> (SetS a p); Y \<in> (SetS a p);
- X \<noteq> Y |] ==> X \<inter> Y = {}"
- apply (rule notnotD)
- apply (rule notI)
- apply (drule MultInvPair_prop1a, auto)
- done
-
-lemma MultInvPair_prop1c: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==>
- \<forall>X \<in> SetS a p. \<forall>Y \<in> SetS a p. X \<noteq> Y --> X\<inter>Y = {}"
- by (auto simp add: MultInvPair_prop1b)
-
-lemma MultInvPair_prop2: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==>
- \<Union>(SetS a p) = SRStar p"
- apply (auto simp add: SetS_def MultInvPair_def StandardRes_SRStar_prop4
- SRStar_mult_prop2)
- apply (frule StandardRes_SRStar_prop3)
- apply (rule bexI, auto)
- done
-
-lemma MultInvPair_distinct:
- assumes "zprime p" and "2 < p" and
- "~([a = 0] (mod p))" and
- "~([j = 0] (mod p))" and
- "~(QuadRes p a)"
- shows "~([j = a * MultInv p j] (mod p))"
-proof
- assume "[j = a * MultInv p j] (mod p)"
- then have "[j * j = (a * MultInv p j) * j] (mod p)"
- by (auto simp add: zcong_scalar)
- then have a:"[j * j = a * (MultInv p j * j)] (mod p)"
- by (auto simp add: ac_simps)
- have "[j * j = a] (mod p)"
- proof -
- from assms(1,2,4) have "[MultInv p j * j = 1] (mod p)"
- by (simp add: MultInv_prop2a)
- from this and a show ?thesis
- by (auto simp add: zcong_zmult_prop2)
- qed
- then have "[j\<^sup>2 = a] (mod p)" by (simp add: power2_eq_square)
- with assms show False by (simp add: QuadRes_def)
-qed
-
-lemma MultInvPair_card_two: "[| zprime p; 2 < p; ~([a = 0] (mod p));
- ~(QuadRes p a); ~([j = 0] (mod p)) |] ==>
- card (MultInvPair a p j) = 2"
- apply (auto simp add: MultInvPair_def)
- apply (subgoal_tac "~ (StandardRes p j = StandardRes p (a * MultInv p j))")
- apply auto
- apply (metis MultInvPair_distinct StandardRes_def aux)
- done
-
-
-subsection \<open>Properties of SetS\<close>
-
-lemma SetS_finite: "2 < p ==> finite (SetS a p)"
- by (auto simp add: SetS_def SRStar_finite [of p])
-
-lemma SetS_elems_finite: "\<forall>X \<in> SetS a p. finite X"
- by (auto simp add: SetS_def MultInvPair_def)
-
-lemma SetS_elems_card: "[| zprime p; 2 < p; ~([a = 0] (mod p));
- ~(QuadRes p a) |] ==>
- \<forall>X \<in> SetS a p. card X = 2"
- apply (auto simp add: SetS_def)
- apply (frule StandardRes_SRStar_prop1a)
- apply (rule MultInvPair_card_two, auto)
- done
-
-lemma Union_SetS_finite: "2 < p ==> finite (\<Union>(SetS a p))"
- by (auto simp add: SetS_finite SetS_elems_finite)
-
-lemma card_sum_aux: "[| finite S; \<forall>X \<in> S. finite (X::int set);
- \<forall>X \<in> S. card X = n |] ==> sum card S = sum (%x. n) S"
- by (induct set: finite) auto
-
-lemma SetS_card:
- assumes "zprime p" and "2 < p" and "~([a = 0] (mod p))" and "~(QuadRes p a)"
- shows "int(card(SetS a p)) = (p - 1) div 2"
-proof -
- have "(p - 1) = 2 * int(card(SetS a p))"
- proof -
- have "p - 1 = int(card(\<Union>(SetS a p)))"
- by (auto simp add: assms MultInvPair_prop2 SRStar_card)
- also have "... = int (sum card (SetS a p))"
- by (auto simp add: assms SetS_finite SetS_elems_finite
- MultInvPair_prop1c [of p a] card_Union_disjoint)
- also have "... = int(sum (%x.2) (SetS a p))"
- using assms by (auto simp add: SetS_elems_card SetS_finite SetS_elems_finite
- card_sum_aux simp del: sum_constant)
- also have "... = 2 * int(card( SetS a p))"
- by (auto simp add: assms SetS_finite sum_const2)
- finally show ?thesis .
- qed
- then show ?thesis by auto
-qed
-
-lemma SetS_prod_prop: "[| zprime p; 2 < p; ~([a = 0] (mod p));
- ~(QuadRes p a); x \<in> (SetS a p) |] ==>
- [\<Prod>x = a] (mod p)"
- apply (auto simp add: SetS_def MultInvPair_def)
- apply (frule StandardRes_SRStar_prop1a)
- apply hypsubst_thin
- apply (subgoal_tac "StandardRes p x \<noteq> StandardRes p (a * MultInv p x)")
- apply (auto simp add: StandardRes_prop2 MultInvPair_distinct)
- apply (frule_tac m = p and x = x and y = "(a * MultInv p x)" in
- StandardRes_prop4)
- apply (subgoal_tac "[x * (a * MultInv p x) = a * (x * MultInv p x)] (mod p)")
- apply (drule_tac a = "StandardRes p x * StandardRes p (a * MultInv p x)" and
- b = "x * (a * MultInv p x)" and
- c = "a * (x * MultInv p x)" in zcong_trans, force)
- apply (frule_tac p = p and x = x in MultInv_prop2, auto)
-apply (metis StandardRes_SRStar_prop3 mult_1_right mult.commute zcong_sym zcong_zmult_prop1)
- apply (auto simp add: ac_simps)
- done
-
-lemma aux1: "[| 0 < x; (x::int) < a; x \<noteq> (a - 1) |] ==> x < a - 1"
- by arith
-
-lemma aux2: "[| (a::int) < c; b < c |] ==> (a \<le> b | b \<le> a)"
- by auto
-
-lemma d22set_induct_old: "(\<And>a::int. 1 < a \<longrightarrow> P (a - 1) \<Longrightarrow> P a) \<Longrightarrow> P x"
-using d22set.induct by blast
-
-lemma SRStar_d22set_prop: "2 < p \<Longrightarrow> (SRStar p) = {1} \<union> (d22set (p - 1))"
- apply (induct p rule: d22set_induct_old)
- apply auto
- apply (simp add: SRStar_def d22set.simps)
- apply (simp add: SRStar_def d22set.simps, clarify)
- apply (frule aux1)
- apply (frule aux2, auto)
- apply (simp_all add: SRStar_def)
- apply (simp add: d22set.simps)
- apply (frule d22set_le)
- apply (frule d22set_g_1, auto)
- done
-
-lemma Union_SetS_prod_prop1:
- assumes "zprime p" and "2 < p" and "~([a = 0] (mod p))" and
- "~(QuadRes p a)"
- shows "[\<Prod>(\<Union>(SetS a p)) = a ^ nat ((p - 1) div 2)] (mod p)"
-proof -
- from assms have "[\<Prod>(\<Union>(SetS a p)) = prod (prod (%x. x)) (SetS a p)] (mod p)"
- by (auto simp add: SetS_finite SetS_elems_finite
- MultInvPair_prop1c prod.Union_disjoint)
- also have "[prod (prod (%x. x)) (SetS a p) =
- prod (%x. a) (SetS a p)] (mod p)"
- by (rule prod_same_function_zcong)
- (auto simp add: assms SetS_prod_prop SetS_finite)
- also (zcong_trans) have "[prod (%x. a) (SetS a p) =
- a^(card (SetS a p))] (mod p)"
- by (auto simp add: assms SetS_finite prod_constant)
- finally (zcong_trans) show ?thesis
- apply (rule zcong_trans)
- apply (subgoal_tac "card(SetS a p) = nat((p - 1) div 2)", auto)
- apply (subgoal_tac "nat(int(card(SetS a p))) = nat((p - 1) div 2)", force)
- apply (auto simp add: assms SetS_card)
- done
-qed
-
-lemma Union_SetS_prod_prop2:
- assumes "zprime p" and "2 < p" and "~([a = 0](mod p))"
- shows "\<Prod>(\<Union>(SetS a p)) = zfact (p - 1)"
-proof -
- from assms have "\<Prod>(\<Union>(SetS a p)) = \<Prod>(SRStar p)"
- by (auto simp add: MultInvPair_prop2)
- also have "... = \<Prod>({1} \<union> (d22set (p - 1)))"
- by (auto simp add: assms SRStar_d22set_prop)
- also have "... = zfact(p - 1)"
- proof -
- have "~(1 \<in> d22set (p - 1)) & finite( d22set (p - 1))"
- by (metis d22set_fin d22set_g_1 linorder_neq_iff)
- then have "\<Prod>({1} \<union> (d22set (p - 1))) = \<Prod>(d22set (p - 1))"
- by auto
- then show ?thesis
- by (auto simp add: d22set_prod_zfact)
- qed
- finally show ?thesis .
-qed
-
-lemma zfact_prop: "[| zprime p; 2 < p; ~([a = 0] (mod p)); ~(QuadRes p a) |] ==>
- [zfact (p - 1) = a ^ nat ((p - 1) div 2)] (mod p)"
- apply (frule Union_SetS_prod_prop1)
- apply (auto simp add: Union_SetS_prod_prop2)
- done
-
-text \<open>\medskip Prove the first part of Euler's Criterion:\<close>
-
-lemma Euler_part1: "[| 2 < p; zprime p; ~([x = 0](mod p));
- ~(QuadRes p x) |] ==>
- [x^(nat (((p) - 1) div 2)) = -1](mod p)"
- by (metis Wilson_Russ zcong_sym zcong_trans zfact_prop)
-
-text \<open>\medskip Prove another part of Euler Criterion:\<close>
-
-lemma aux_1: "0 < p ==> (a::int) ^ nat (p) = a * a ^ (nat (p) - 1)"
-proof -
- assume "0 < p"
- then have "a ^ (nat p) = a ^ (1 + (nat p - 1))"
- by (auto simp add: diff_add_assoc)
- also have "... = (a ^ 1) * a ^ (nat(p) - 1)"
- by (simp only: power_add)
- also have "... = a * a ^ (nat(p) - 1)"
- by auto
- finally show ?thesis .
-qed
-
-lemma aux_2: "[| (2::int) < p; p \<in> zOdd |] ==> 0 < ((p - 1) div 2)"
-proof -
- assume "2 < p" and "p \<in> zOdd"
- then have "(p - 1):zEven"
- by (auto simp add: zEven_def zOdd_def)
- then have aux_1: "2 * ((p - 1) div 2) = (p - 1)"
- by (auto simp add: even_div_2_prop2)
- with \<open>2 < p\<close> have "1 < (p - 1)"
- by auto
- then have " 1 < (2 * ((p - 1) div 2))"
- by (auto simp add: aux_1)
- then have "0 < (2 * ((p - 1) div 2)) div 2"
- by auto
- then show ?thesis by auto
-qed
-
-lemma Euler_part2:
- "[| 2 < p; zprime p; [a = 0] (mod p) |] ==> [0 = a ^ nat ((p - 1) div 2)] (mod p)"
- apply (frule zprime_zOdd_eq_grt_2)
- apply (frule aux_2, auto)
- apply (frule_tac a = a in aux_1, auto)
- apply (frule zcong_zmult_prop1, auto)
- done
-
-text \<open>\medskip Prove the final part of Euler's Criterion:\<close>
-
-lemma aux__1: "[| ~([x = 0] (mod p)); [y\<^sup>2 = x] (mod p)|] ==> ~(p dvd y)"
- by (metis dvdI power2_eq_square zcong_sym zcong_trans zcong_zero_equiv_div dvd_trans)
-
-lemma aux__2: "2 * nat((p - 1) div 2) = nat (2 * ((p - 1) div 2))"
- by (auto simp add: nat_mult_distrib)
-
-lemma Euler_part3: "[| 2 < p; zprime p; ~([x = 0](mod p)); QuadRes p x |] ==>
- [x^(nat (((p) - 1) div 2)) = 1](mod p)"
- apply (subgoal_tac "p \<in> zOdd")
- apply (auto simp add: QuadRes_def)
- prefer 2
- apply (metis zprime_zOdd_eq_grt_2)
- apply (frule aux__1, auto)
- apply (drule_tac z = "nat ((p - 1) div 2)" in zcong_zpower)
- apply (auto simp add: power_mult [symmetric])
- apply (rule zcong_trans)
- apply (auto simp add: zcong_sym [of "x ^ nat ((p - 1) div 2)"])
- apply (metis Little_Fermat even_div_2_prop2 odd_minus_one_even mult_1 aux__2)
- done
-
-
-text \<open>\medskip Finally show Euler's Criterion:\<close>
-
-theorem Euler_Criterion: "[| 2 < p; zprime p |] ==> [(Legendre a p) =
- a^(nat (((p) - 1) div 2))] (mod p)"
- apply (auto simp add: Legendre_def Euler_part2)
- apply (frule Euler_part3, auto simp add: zcong_sym)[]
- apply (frule Euler_part1, auto simp add: zcong_sym)[]
- done
-
-end
--- a/src/HOL/Old_Number_Theory/EulerFermat.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,332 +0,0 @@
-(* Title: HOL/Old_Number_Theory/EulerFermat.thy
- Author: Thomas M. Rasmussen
- Copyright 2000 University of Cambridge
-*)
-
-section \<open>Fermat's Little Theorem extended to Euler's Totient function\<close>
-
-theory EulerFermat
-imports BijectionRel IntFact
-begin
-
-text \<open>
- Fermat's Little Theorem extended to Euler's Totient function. More
- abstract approach than Boyer-Moore (which seems necessary to achieve
- the extended version).
-\<close>
-
-
-subsection \<open>Definitions and lemmas\<close>
-
-inductive_set RsetR :: "int => int set set" for m :: int
-where
- empty [simp]: "{} \<in> RsetR m"
-| insert: "A \<in> RsetR m ==> zgcd a m = 1 ==>
- \<forall>a'. a' \<in> A --> \<not> zcong a a' m ==> insert a A \<in> RsetR m"
-
-fun BnorRset :: "int \<Rightarrow> int => int set" where
- "BnorRset a m =
- (if 0 < a then
- let na = BnorRset (a - 1) m
- in (if zgcd a m = 1 then insert a na else na)
- else {})"
-
-definition norRRset :: "int => int set"
- where "norRRset m = BnorRset (m - 1) m"
-
-definition noXRRset :: "int => int => int set"
- where "noXRRset m x = (\<lambda>a. a * x) ` norRRset m"
-
-definition phi :: "int => nat"
- where "phi m = card (norRRset m)"
-
-definition is_RRset :: "int set => int => bool"
- where "is_RRset A m = (A \<in> RsetR m \<and> card A = phi m)"
-
-definition RRset2norRR :: "int set => int => int => int"
- where
- "RRset2norRR A m a =
- (if 1 < m \<and> is_RRset A m \<and> a \<in> A then
- SOME b. zcong a b m \<and> b \<in> norRRset m
- else 0)"
-
-definition zcongm :: "int => int => int => bool"
- where "zcongm m = (\<lambda>a b. zcong a b m)"
-
-lemma abs_eq_1_iff [iff]: "(\<bar>z\<bar> = (1::int)) = (z = 1 \<or> z = -1)"
- \<comment> \<open>LCP: not sure why this lemma is needed now\<close>
- by (auto simp add: abs_if)
-
-
-text \<open>\medskip \<open>norRRset\<close>\<close>
-
-declare BnorRset.simps [simp del]
-
-lemma BnorRset_induct:
- assumes "!!a m. P {} a m"
- and "!!a m :: int. 0 < a ==> P (BnorRset (a - 1) m) (a - 1) m
- ==> P (BnorRset a m) a m"
- shows "P (BnorRset u v) u v"
- apply (rule BnorRset.induct)
- apply (case_tac "0 < a")
- apply (rule_tac assms)
- apply simp_all
- apply (simp_all add: BnorRset.simps assms)
- done
-
-lemma Bnor_mem_zle [rule_format]: "b \<in> BnorRset a m \<longrightarrow> b \<le> a"
- apply (induct a m rule: BnorRset_induct)
- apply simp
- apply (subst BnorRset.simps)
- apply (unfold Let_def, auto)
- done
-
-lemma Bnor_mem_zle_swap: "a < b ==> b \<notin> BnorRset a m"
- by (auto dest: Bnor_mem_zle)
-
-lemma Bnor_mem_zg [rule_format]: "b \<in> BnorRset a m --> 0 < b"
- apply (induct a m rule: BnorRset_induct)
- prefer 2
- apply (subst BnorRset.simps)
- apply (unfold Let_def, auto)
- done
-
-lemma Bnor_mem_if [rule_format]:
- "zgcd b m = 1 --> 0 < b --> b \<le> a --> b \<in> BnorRset a m"
- apply (induct a m rule: BnorRset.induct, auto)
- apply (subst BnorRset.simps)
- defer
- apply (subst BnorRset.simps)
- apply (unfold Let_def, auto)
- done
-
-lemma Bnor_in_RsetR [rule_format]: "a < m --> BnorRset a m \<in> RsetR m"
- apply (induct a m rule: BnorRset_induct, simp)
- apply (subst BnorRset.simps)
- apply (unfold Let_def, auto)
- apply (rule RsetR.insert)
- apply (rule_tac [3] allI)
- apply (rule_tac [3] impI)
- apply (rule_tac [3] zcong_not)
- apply (subgoal_tac [6] "a' \<le> a - 1")
- apply (rule_tac [7] Bnor_mem_zle)
- apply (rule_tac [5] Bnor_mem_zg, auto)
- done
-
-lemma Bnor_fin: "finite (BnorRset a m)"
- apply (induct a m rule: BnorRset_induct)
- prefer 2
- apply (subst BnorRset.simps)
- apply (unfold Let_def, auto)
- done
-
-lemma norR_mem_unique_aux: "a \<le> b - 1 ==> a < (b::int)"
- apply auto
- done
-
-lemma norR_mem_unique:
- "1 < m ==>
- zgcd a m = 1 ==> \<exists>!b. [a = b] (mod m) \<and> b \<in> norRRset m"
- apply (unfold norRRset_def)
- apply (cut_tac a = a and m = m in zcong_zless_unique, auto)
- apply (rule_tac [2] m = m in zcong_zless_imp_eq)
- apply (auto intro: Bnor_mem_zle Bnor_mem_zg zcong_trans
- order_less_imp_le norR_mem_unique_aux simp add: zcong_sym)
- apply (rule_tac x = b in exI, safe)
- apply (rule Bnor_mem_if)
- apply (case_tac [2] "b = 0")
- apply (auto intro: order_less_le [THEN iffD2])
- prefer 2
- apply (simp only: zcong_def)
- apply (subgoal_tac "zgcd a m = m")
- prefer 2
- apply (subst zdvd_iff_zgcd [symmetric])
- apply (rule_tac [4] zgcd_zcong_zgcd)
- apply (simp_all (no_asm_use) add: zcong_sym)
- done
-
-
-text \<open>\medskip @{term noXRRset}\<close>
-
-lemma RRset_gcd [rule_format]:
- "is_RRset A m ==> a \<in> A --> zgcd a m = 1"
- apply (unfold is_RRset_def)
- apply (rule RsetR.induct, auto)
- done
-
-lemma RsetR_zmult_mono:
- "A \<in> RsetR m ==>
- 0 < m ==> zgcd x m = 1 ==> (\<lambda>a. a * x) ` A \<in> RsetR m"
- apply (erule RsetR.induct, simp_all)
- apply (rule RsetR.insert, auto)
- apply (blast intro: zgcd_zgcd_zmult)
- apply (simp add: zcong_cancel)
- done
-
-lemma card_nor_eq_noX:
- "0 < m ==>
- zgcd x m = 1 ==> card (noXRRset m x) = card (norRRset m)"
- apply (unfold norRRset_def noXRRset_def)
- apply (rule card_image)
- apply (auto simp add: inj_on_def Bnor_fin)
- apply (simp add: BnorRset.simps)
- done
-
-lemma noX_is_RRset:
- "0 < m ==> zgcd x m = 1 ==> is_RRset (noXRRset m x) m"
- apply (unfold is_RRset_def phi_def)
- apply (auto simp add: card_nor_eq_noX)
- apply (unfold noXRRset_def norRRset_def)
- apply (rule RsetR_zmult_mono)
- apply (rule Bnor_in_RsetR, simp_all)
- done
-
-lemma aux_some:
- "1 < m ==> is_RRset A m ==> a \<in> A
- ==> zcong a (SOME b. [a = b] (mod m) \<and> b \<in> norRRset m) m \<and>
- (SOME b. [a = b] (mod m) \<and> b \<in> norRRset m) \<in> norRRset m"
- apply (rule norR_mem_unique [THEN ex1_implies_ex, THEN someI_ex])
- apply (rule_tac [2] RRset_gcd, simp_all)
- done
-
-lemma RRset2norRR_correct:
- "1 < m ==> is_RRset A m ==> a \<in> A ==>
- [a = RRset2norRR A m a] (mod m) \<and> RRset2norRR A m a \<in> norRRset m"
- apply (unfold RRset2norRR_def, simp)
- apply (rule aux_some, simp_all)
- done
-
-lemmas RRset2norRR_correct1 = RRset2norRR_correct [THEN conjunct1]
-lemmas RRset2norRR_correct2 = RRset2norRR_correct [THEN conjunct2]
-
-lemma RsetR_fin: "A \<in> RsetR m ==> finite A"
- by (induct set: RsetR) auto
-
-lemma RRset_zcong_eq [rule_format]:
- "1 < m ==>
- is_RRset A m ==> [a = b] (mod m) ==> a \<in> A --> b \<in> A --> a = b"
- apply (unfold is_RRset_def)
- apply (rule RsetR.induct)
- apply (auto simp add: zcong_sym)
- done
-
-lemma aux:
- "P (SOME a. P a) ==> Q (SOME a. Q a) ==>
- (SOME a. P a) = (SOME a. Q a) ==> \<exists>a. P a \<and> Q a"
- apply auto
- done
-
-lemma RRset2norRR_inj:
- "1 < m ==> is_RRset A m ==> inj_on (RRset2norRR A m) A"
- apply (unfold RRset2norRR_def inj_on_def, auto)
- apply (subgoal_tac "\<exists>b. ([x = b] (mod m) \<and> b \<in> norRRset m) \<and>
- ([y = b] (mod m) \<and> b \<in> norRRset m)")
- apply (rule_tac [2] aux)
- apply (rule_tac [3] aux_some)
- apply (rule_tac [2] aux_some)
- apply (rule RRset_zcong_eq, auto)
- apply (rule_tac b = b in zcong_trans)
- apply (simp_all add: zcong_sym)
- done
-
-lemma RRset2norRR_eq_norR:
- "1 < m ==> is_RRset A m ==> RRset2norRR A m ` A = norRRset m"
- apply (rule card_seteq)
- prefer 3
- apply (subst card_image)
- apply (rule_tac RRset2norRR_inj, auto)
- apply (rule_tac [3] RRset2norRR_correct2, auto)
- apply (unfold is_RRset_def phi_def norRRset_def)
- apply (auto simp add: Bnor_fin)
- done
-
-
-lemma Bnor_prod_power_aux: "a \<notin> A ==> inj f ==> f a \<notin> f ` A"
-by (unfold inj_on_def, auto)
-
-lemma Bnor_prod_power [rule_format]:
- "x \<noteq> 0 ==> a < m --> \<Prod>((\<lambda>a. a * x) ` BnorRset a m) =
- \<Prod>(BnorRset a m) * x^card (BnorRset a m)"
- apply (induct a m rule: BnorRset_induct)
- prefer 2
- apply (simplesubst BnorRset.simps) \<comment>\<open>multiple redexes\<close>
- apply (unfold Let_def, auto)
- apply (simp add: Bnor_fin Bnor_mem_zle_swap)
- apply (subst prod.insert)
- apply (rule_tac [2] Bnor_prod_power_aux)
- apply (unfold inj_on_def)
- apply (simp_all add: ac_simps Bnor_fin Bnor_mem_zle_swap)
- done
-
-
-subsection \<open>Fermat\<close>
-
-lemma bijzcong_zcong_prod:
- "(A, B) \<in> bijR (zcongm m) ==> [\<Prod>A = \<Prod>B] (mod m)"
- apply (unfold zcongm_def)
- apply (erule bijR.induct)
- apply (subgoal_tac [2] "a \<notin> A \<and> b \<notin> B \<and> finite A \<and> finite B")
- apply (auto intro: fin_bijRl fin_bijRr zcong_zmult)
- done
-
-lemma Bnor_prod_zgcd [rule_format]:
- "a < m --> zgcd (\<Prod>(BnorRset a m)) m = 1"
- apply (induct a m rule: BnorRset_induct)
- prefer 2
- apply (subst BnorRset.simps)
- apply (unfold Let_def, auto)
- apply (simp add: Bnor_fin Bnor_mem_zle_swap)
- apply (blast intro: zgcd_zgcd_zmult)
- done
-
-theorem Euler_Fermat:
- "0 < m ==> zgcd x m = 1 ==> [x^(phi m) = 1] (mod m)"
- apply (unfold norRRset_def phi_def)
- apply (case_tac "x = 0")
- apply (case_tac [2] "m = 1")
- apply (rule_tac [3] iffD1)
- apply (rule_tac [3] k = "\<Prod>(BnorRset (m - 1) m)"
- in zcong_cancel2)
- prefer 5
- apply (subst Bnor_prod_power [symmetric])
- apply (rule_tac [7] Bnor_prod_zgcd, simp_all)
- apply (rule bijzcong_zcong_prod)
- apply (fold norRRset_def, fold noXRRset_def)
- apply (subst RRset2norRR_eq_norR [symmetric])
- apply (rule_tac [3] inj_func_bijR, auto)
- apply (unfold zcongm_def)
- apply (rule_tac [2] RRset2norRR_correct1)
- apply (rule_tac [5] RRset2norRR_inj)
- apply (auto intro: order_less_le [THEN iffD2]
- simp add: noX_is_RRset)
- apply (unfold noXRRset_def norRRset_def)
- apply (rule finite_imageI)
- apply (rule Bnor_fin)
- done
-
-lemma Bnor_prime:
- "\<lbrakk> zprime p; a < p \<rbrakk> \<Longrightarrow> card (BnorRset a p) = nat a"
- apply (induct a p rule: BnorRset.induct)
- apply (subst BnorRset.simps)
- apply (unfold Let_def, auto simp add:zless_zprime_imp_zrelprime)
- apply (subgoal_tac "finite (BnorRset (a - 1) m)")
- apply (subgoal_tac "a ~: BnorRset (a - 1) m")
- apply (auto simp add: card_insert_disjoint Suc_nat_eq_nat_zadd1)
- apply (frule Bnor_mem_zle, arith)
- apply (frule Bnor_fin)
- done
-
-lemma phi_prime: "zprime p ==> phi p = nat (p - 1)"
- apply (unfold phi_def norRRset_def)
- apply (rule Bnor_prime, auto)
- done
-
-theorem Little_Fermat:
- "zprime p ==> \<not> p dvd x ==> [x^(nat (p - 1)) = 1] (mod p)"
- apply (subst phi_prime [symmetric])
- apply (rule_tac [2] Euler_Fermat)
- apply (erule_tac [3] zprime_imp_zrelprime)
- apply (unfold zprime_def, auto)
- done
-
-end
--- a/src/HOL/Old_Number_Theory/EvenOdd.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,261 +0,0 @@
-(* Title: HOL/Old_Number_Theory/EvenOdd.thy
- Authors: Jeremy Avigad, David Gray, and Adam Kramer
-*)
-
-section \<open>Parity: Even and Odd Integers\<close>
-
-theory EvenOdd
-imports Int2
-begin
-
-definition zOdd :: "int set"
- where "zOdd = {x. \<exists>k. x = 2 * k + 1}"
-
-definition zEven :: "int set"
- where "zEven = {x. \<exists>k. x = 2 * k}"
-
-lemma in_zEven_zOdd_iff:
- fixes k :: int
- shows "k \<in> zEven \<longleftrightarrow> even k"
- and "k \<in> zOdd \<longleftrightarrow> odd k"
- by (auto simp add: zEven_def zOdd_def elim: evenE oddE)
-
-
-subsection \<open>Some useful properties about even and odd\<close>
-
-lemma zOddI [intro?]: "x = 2 * k + 1 \<Longrightarrow> x \<in> zOdd"
- and zOddE [elim?]: "x \<in> zOdd \<Longrightarrow> (!!k. x = 2 * k + 1 \<Longrightarrow> C) \<Longrightarrow> C"
- by (auto simp add: zOdd_def)
-
-lemma zEvenI [intro?]: "x = 2 * k \<Longrightarrow> x \<in> zEven"
- and zEvenE [elim?]: "x \<in> zEven \<Longrightarrow> (!!k. x = 2 * k \<Longrightarrow> C) \<Longrightarrow> C"
- by (auto simp add: zEven_def)
-
-lemma one_not_even: "~(1 \<in> zEven)"
-proof
- assume "1 \<in> zEven"
- then obtain k :: int where "1 = 2 * k" ..
- then show False by arith
-qed
-
-lemma even_odd_conj: "~(x \<in> zOdd & x \<in> zEven)"
-proof -
- {
- fix a b
- assume "2 * (a::int) = 2 * (b::int) + 1"
- then have "2 * (a::int) - 2 * (b :: int) = 1"
- by arith
- then have "2 * (a - b) = 1"
- by (auto simp add: left_diff_distrib)
- moreover have "(2 * (a - b)):zEven"
- by (auto simp only: zEven_def)
- ultimately have False
- by (auto simp add: one_not_even)
- }
- then show ?thesis
- by (auto simp add: zOdd_def zEven_def)
-qed
-
-lemma even_odd_disj: "(x \<in> zOdd | x \<in> zEven)"
- by (simp add: zOdd_def zEven_def) arith
-
-lemma not_odd_impl_even: "~(x \<in> zOdd) ==> x \<in> zEven"
- using even_odd_disj by auto
-
-lemma odd_mult_odd_prop: "(x*y):zOdd ==> x \<in> zOdd"
-proof (rule classical)
- assume "\<not> ?thesis"
- then have "x \<in> zEven" by (rule not_odd_impl_even)
- then obtain a where a: "x = 2 * a" ..
- assume "x * y : zOdd"
- then obtain b where "x * y = 2 * b + 1" ..
- with a have "2 * a * y = 2 * b + 1" by simp
- then have "2 * a * y - 2 * b = 1"
- by arith
- then have "2 * (a * y - b) = 1"
- by (auto simp add: left_diff_distrib)
- moreover have "(2 * (a * y - b)):zEven"
- by (auto simp only: zEven_def)
- ultimately have False
- by (auto simp add: one_not_even)
- then show ?thesis ..
-qed
-
-lemma odd_minus_one_even: "x \<in> zOdd ==> (x - 1):zEven"
- by (auto simp add: zOdd_def zEven_def)
-
-lemma even_div_2_prop1: "x \<in> zEven ==> (x mod 2) = 0"
- by (auto simp add: zEven_def)
-
-lemma even_div_2_prop2: "x \<in> zEven ==> (2 * (x div 2)) = x"
- by (auto simp add: zEven_def)
-
-lemma even_plus_even: "[| x \<in> zEven; y \<in> zEven |] ==> x + y \<in> zEven"
- apply (auto simp add: zEven_def)
- apply (auto simp only: distrib_left [symmetric])
- done
-
-lemma even_times_either: "x \<in> zEven ==> x * y \<in> zEven"
- by (auto simp add: zEven_def)
-
-lemma even_minus_even: "[| x \<in> zEven; y \<in> zEven |] ==> x - y \<in> zEven"
- apply (auto simp add: zEven_def)
- apply (auto simp only: right_diff_distrib [symmetric])
- done
-
-lemma odd_minus_odd: "[| x \<in> zOdd; y \<in> zOdd |] ==> x - y \<in> zEven"
- apply (auto simp add: zOdd_def zEven_def)
- apply (auto simp only: right_diff_distrib [symmetric])
- done
-
-lemma even_minus_odd: "[| x \<in> zEven; y \<in> zOdd |] ==> x - y \<in> zOdd"
- apply (auto simp add: zOdd_def zEven_def)
- apply (rule_tac x = "k - ka - 1" in exI)
- apply auto
- done
-
-lemma odd_minus_even: "[| x \<in> zOdd; y \<in> zEven |] ==> x - y \<in> zOdd"
- apply (auto simp add: zOdd_def zEven_def)
- apply (auto simp only: right_diff_distrib [symmetric])
- done
-
-lemma odd_times_odd: "[| x \<in> zOdd; y \<in> zOdd |] ==> x * y \<in> zOdd"
- apply (auto simp add: zOdd_def distrib_right distrib_left)
- apply (rule_tac x = "2 * ka * k + ka + k" in exI)
- apply (auto simp add: distrib_right)
- done
-
-lemma odd_iff_not_even: "(x \<in> zOdd) = (~ (x \<in> zEven))"
- using even_odd_conj even_odd_disj by auto
-
-lemma even_product: "x * y \<in> zEven ==> x \<in> zEven | y \<in> zEven"
- using odd_iff_not_even odd_times_odd by auto
-
-lemma even_diff: "x - y \<in> zEven = ((x \<in> zEven) = (y \<in> zEven))"
-proof
- assume xy: "x - y \<in> zEven"
- {
- assume x: "x \<in> zEven"
- have "y \<in> zEven"
- proof (rule classical)
- assume "\<not> ?thesis"
- then have "y \<in> zOdd"
- by (simp add: odd_iff_not_even)
- with x have "x - y \<in> zOdd"
- by (simp add: even_minus_odd)
- with xy have False
- by (auto simp add: odd_iff_not_even)
- then show ?thesis ..
- qed
- } moreover {
- assume y: "y \<in> zEven"
- have "x \<in> zEven"
- proof (rule classical)
- assume "\<not> ?thesis"
- then have "x \<in> zOdd"
- by (auto simp add: odd_iff_not_even)
- with y have "x - y \<in> zOdd"
- by (simp add: odd_minus_even)
- with xy have False
- by (auto simp add: odd_iff_not_even)
- then show ?thesis ..
- qed
- }
- ultimately show "(x \<in> zEven) = (y \<in> zEven)"
- by (auto simp add: odd_iff_not_even even_minus_even odd_minus_odd
- even_minus_odd odd_minus_even)
-next
- assume "(x \<in> zEven) = (y \<in> zEven)"
- then show "x - y \<in> zEven"
- by (auto simp add: odd_iff_not_even even_minus_even odd_minus_odd
- even_minus_odd odd_minus_even)
-qed
-
-lemma neg_one_even_power: "[| x \<in> zEven; 0 \<le> x |] ==> (-1::int)^(nat x) = 1"
-proof -
- assume "x \<in> zEven" and "0 \<le> x"
- from \<open>x \<in> zEven\<close> obtain a where "x = 2 * a" ..
- with \<open>0 \<le> x\<close> have "0 \<le> a" by simp
- from \<open>0 \<le> x\<close> and \<open>x = 2 * a\<close> have "nat x = nat (2 * a)"
- by simp
- also from \<open>x = 2 * a\<close> have "nat (2 * a) = 2 * nat a"
- by (simp add: nat_mult_distrib)
- finally have "(-1::int)^nat x = (-1)^(2 * nat a)"
- by simp
- also have "... = (-1::int)\<^sup>2 ^ nat a"
- by (simp add: power_mult)
- also have "(-1::int)\<^sup>2 = 1"
- by simp
- finally show ?thesis
- by simp
-qed
-
-lemma neg_one_odd_power: "[| x \<in> zOdd; 0 \<le> x |] ==> (-1::int)^(nat x) = -1"
-proof -
- assume "x \<in> zOdd" and "0 \<le> x"
- from \<open>x \<in> zOdd\<close> obtain a where "x = 2 * a + 1" ..
- with \<open>0 \<le> x\<close> have a: "0 \<le> a" by simp
- with \<open>0 \<le> x\<close> and \<open>x = 2 * a + 1\<close> have "nat x = nat (2 * a + 1)"
- by simp
- also from a have "nat (2 * a + 1) = 2 * nat a + 1"
- by (auto simp add: nat_mult_distrib nat_add_distrib)
- finally have "(-1::int) ^ nat x = (-1)^(2 * nat a + 1)"
- by simp
- also have "... = ((-1::int)\<^sup>2) ^ nat a * (-1)^1"
- by (auto simp add: power_mult power_add)
- also have "(-1::int)\<^sup>2 = 1"
- by simp
- finally show ?thesis
- by simp
-qed
-
-lemma neg_one_power_parity: "[| 0 \<le> x; 0 \<le> y; (x \<in> zEven) = (y \<in> zEven) |] ==>
- (-1::int)^(nat x) = (-1::int)^(nat y)"
- using even_odd_disj [of x] even_odd_disj [of y]
- by (auto simp add: neg_one_even_power neg_one_odd_power)
-
-
-lemma one_not_neg_one_mod_m: "2 < m ==> ~([1 = -1] (mod m))"
- by (auto simp add: zcong_def zdvd_not_zless)
-
-lemma even_div_2_l: "[| y \<in> zEven; x < y |] ==> x div 2 < y div 2"
-proof -
- assume "y \<in> zEven" and "x < y"
- from \<open>y \<in> zEven\<close> obtain k where k: "y = 2 * k" ..
- with \<open>x < y\<close> have "x < 2 * k" by simp
- then have "x div 2 < k" by (auto simp add: div_prop1)
- also have "k = (2 * k) div 2" by simp
- finally have "x div 2 < 2 * k div 2" by simp
- with k show ?thesis by simp
-qed
-
-lemma even_sum_div_2: "[| x \<in> zEven; y \<in> zEven |] ==> (x + y) div 2 = x div 2 + y div 2"
- by (auto simp add: zEven_def)
-
-lemma even_prod_div_2: "[| x \<in> zEven |] ==> (x * y) div 2 = (x div 2) * y"
- by (auto simp add: zEven_def)
-
-(* An odd prime is greater than 2 *)
-
-lemma zprime_zOdd_eq_grt_2: "zprime p ==> (p \<in> zOdd) = (2 < p)"
- apply (auto simp add: zOdd_def zprime_def)
- apply (drule_tac x = 2 in allE)
- using odd_iff_not_even [of p]
- apply (auto simp add: zOdd_def zEven_def)
- done
-
-(* Powers of -1 and parity *)
-
-lemma neg_one_special: "finite A ==>
- ((- 1) ^ card A) * ((- 1) ^ card A) = (1 :: int)"
- unfolding power_add [symmetric] by simp
-
-lemma neg_one_power: "(-1::int)^n = 1 | (-1::int)^n = -1"
- by (induct n) auto
-
-lemma neg_one_power_eq_mod_m: "[| 2 < m; [(-1::int)^j = (-1::int)^k] (mod m) |]
- ==> ((-1::int)^j = (-1::int)^k)"
- using neg_one_power [of j] and ListMem.insert neg_one_power [of k]
- by (auto simp add: one_not_neg_one_mod_m zcong_sym)
-
-end
--- a/src/HOL/Old_Number_Theory/Factorization.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,339 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Factorization.thy
- Author: Thomas Marthedal Rasmussen
- Copyright 2000 University of Cambridge
-*)
-
-section \<open>Fundamental Theorem of Arithmetic (unique factorization into primes)\<close>
-
-theory Factorization
-imports Primes "~~/src/HOL/Library/Permutation"
-begin
-
-
-subsection \<open>Definitions\<close>
-
-definition primel :: "nat list => bool"
- where "primel xs = (\<forall>p \<in> set xs. prime p)"
-
-primrec nondec :: "nat list => bool"
-where
- "nondec [] = True"
-| "nondec (x # xs) = (case xs of [] => True | y # ys => x \<le> y \<and> nondec xs)"
-
-primrec prod :: "nat list => nat"
-where
- "prod [] = Suc 0"
-| "prod (x # xs) = x * prod xs"
-
-primrec oinsert :: "nat => nat list => nat list"
-where
- "oinsert x [] = [x]"
-| "oinsert x (y # ys) = (if x \<le> y then x # y # ys else y # oinsert x ys)"
-
-primrec sort :: "nat list => nat list"
-where
- "sort [] = []"
-| "sort (x # xs) = oinsert x (sort xs)"
-
-
-subsection \<open>Arithmetic\<close>
-
-lemma one_less_m: "(m::nat) \<noteq> m * k ==> m \<noteq> Suc 0 ==> Suc 0 < m"
- apply (cases m)
- apply auto
- done
-
-lemma one_less_k: "(m::nat) \<noteq> m * k ==> Suc 0 < m * k ==> Suc 0 < k"
- apply (cases k)
- apply auto
- done
-
-lemma mult_left_cancel: "(0::nat) < k ==> k * n = k * m ==> n = m"
- apply auto
- done
-
-lemma mn_eq_m_one: "(0::nat) < m ==> m * n = m ==> n = Suc 0"
- apply (cases n)
- apply auto
- done
-
-lemma prod_mn_less_k:
- "(0::nat) < n ==> 0 < k ==> Suc 0 < m ==> m * n = k ==> n < k"
- apply (induct m)
- apply auto
- done
-
-
-subsection \<open>Prime list and product\<close>
-
-lemma prod_append: "prod (xs @ ys) = prod xs * prod ys"
- apply (induct xs)
- apply (simp_all add: mult.assoc)
- done
-
-lemma prod_xy_prod:
- "prod (x # xs) = prod (y # ys) ==> x * prod xs = y * prod ys"
- apply auto
- done
-
-lemma primel_append: "primel (xs @ ys) = (primel xs \<and> primel ys)"
- apply (unfold primel_def)
- apply auto
- done
-
-lemma prime_primel: "prime n ==> primel [n] \<and> prod [n] = n"
- apply (unfold primel_def)
- apply auto
- done
-
-lemma prime_nd_one: "prime p ==> \<not> p dvd Suc 0"
- apply (unfold prime_def dvd_def)
- apply auto
- done
-
-lemma hd_dvd_prod: "prod (x # xs) = prod ys ==> x dvd (prod ys)"
- by (metis dvd_mult_left dvd_refl prod.simps(2))
-
-lemma primel_tl: "primel (x # xs) ==> primel xs"
- apply (unfold primel_def)
- apply auto
- done
-
-lemma primel_hd_tl: "(primel (x # xs)) = (prime x \<and> primel xs)"
- apply (unfold primel_def)
- apply auto
- done
-
-lemma primes_eq: "prime p ==> prime q ==> p dvd q ==> p = q"
- apply (unfold prime_def)
- apply auto
- done
-
-lemma primel_one_empty: "primel xs ==> prod xs = Suc 0 ==> xs = []"
- apply (cases xs)
- apply (simp_all add: primel_def prime_def)
- done
-
-lemma prime_g_one: "prime p ==> Suc 0 < p"
- apply (unfold prime_def)
- apply auto
- done
-
-lemma prime_g_zero: "prime p ==> 0 < p"
- apply (unfold prime_def)
- apply auto
- done
-
-lemma primel_nempty_g_one:
- "primel xs \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> Suc 0 < prod xs"
- apply (induct xs)
- apply simp
- apply (fastforce simp: primel_def prime_def elim: one_less_mult)
- done
-
-lemma primel_prod_gz: "primel xs ==> 0 < prod xs"
- apply (induct xs)
- apply (auto simp: primel_def prime_def)
- done
-
-
-subsection \<open>Sorting\<close>
-
-lemma nondec_oinsert: "nondec xs \<Longrightarrow> nondec (oinsert x xs)"
- apply (induct xs)
- apply simp
- apply (case_tac xs)
- apply (simp_all cong del: list.case_cong_weak)
- done
-
-lemma nondec_sort: "nondec (sort xs)"
- apply (induct xs)
- apply simp_all
- apply (erule nondec_oinsert)
- done
-
-lemma x_less_y_oinsert: "x \<le> y ==> l = y # ys ==> x # l = oinsert x l"
- apply simp_all
- done
-
-lemma nondec_sort_eq [rule_format]: "nondec xs \<longrightarrow> xs = sort xs"
- apply (induct xs)
- apply safe
- apply simp_all
- apply (case_tac xs)
- apply simp_all
- apply (case_tac xs)
- apply simp
- apply (rule_tac y = aa and ys = list in x_less_y_oinsert)
- apply simp_all
- done
-
-lemma oinsert_x_y: "oinsert x (oinsert y l) = oinsert y (oinsert x l)"
- apply (induct l)
- apply auto
- done
-
-
-subsection \<open>Permutation\<close>
-
-lemma perm_primel [rule_format]: "xs <~~> ys ==> primel xs --> primel ys"
- apply (unfold primel_def)
- apply (induct set: perm)
- apply simp
- apply simp
- apply (simp (no_asm))
- apply blast
- apply blast
- done
-
-lemma perm_prod: "xs <~~> ys ==> prod xs = prod ys"
- apply (induct set: perm)
- apply (simp_all add: ac_simps)
- done
-
-lemma perm_subst_oinsert: "xs <~~> ys ==> oinsert a xs <~~> oinsert a ys"
- apply (induct set: perm)
- apply auto
- done
-
-lemma perm_oinsert: "x # xs <~~> oinsert x xs"
- apply (induct xs)
- apply auto
- done
-
-lemma perm_sort: "xs <~~> sort xs"
- apply (induct xs)
- apply (auto intro: perm_oinsert elim: perm_subst_oinsert)
- done
-
-lemma perm_sort_eq: "xs <~~> ys ==> sort xs = sort ys"
- apply (induct set: perm)
- apply (simp_all add: oinsert_x_y)
- done
-
-
-subsection \<open>Existence\<close>
-
-lemma ex_nondec_lemma:
- "primel xs ==> \<exists>ys. primel ys \<and> nondec ys \<and> prod ys = prod xs"
- apply (blast intro: nondec_sort perm_prod perm_primel perm_sort perm_sym)
- done
-
-lemma not_prime_ex_mk:
- "Suc 0 < n \<and> \<not> prime n \<Longrightarrow>
- \<exists>m k. Suc 0 < m \<and> Suc 0 < k \<and> m < n \<and> k < n \<and> n = m * k"
- apply (unfold prime_def dvd_def)
- apply (auto intro: n_less_m_mult_n n_less_n_mult_m one_less_m one_less_k)
- using n_less_m_mult_n n_less_n_mult_m one_less_m one_less_k
- apply (metis Suc_lessD Suc_lessI mult.commute)
- done
-
-lemma split_primel:
- "primel xs \<Longrightarrow> primel ys \<Longrightarrow> \<exists>l. primel l \<and> prod l = prod xs * prod ys"
- apply (rule exI)
- apply safe
- apply (rule_tac [2] prod_append)
- apply (simp add: primel_append)
- done
-
-lemma factor_exists [rule_format]: "Suc 0 < n --> (\<exists>l. primel l \<and> prod l = n)"
- apply (induct n rule: nat_less_induct)
- apply (rule impI)
- apply (case_tac "prime n")
- apply (rule exI)
- apply (erule prime_primel)
- apply (cut_tac n = n in not_prime_ex_mk)
- apply (auto intro!: split_primel)
- done
-
-lemma nondec_factor_exists: "Suc 0 < n ==> \<exists>l. primel l \<and> nondec l \<and> prod l = n"
- apply (erule factor_exists [THEN exE])
- apply (blast intro!: ex_nondec_lemma)
- done
-
-
-subsection \<open>Uniqueness\<close>
-
-lemma prime_dvd_mult_list [rule_format]:
- "prime p ==> p dvd (prod xs) --> (\<exists>m. m:set xs \<and> p dvd m)"
- apply (induct xs)
- apply (force simp add: prime_def)
- apply (force dest: prime_dvd_mult)
- done
-
-lemma hd_xs_dvd_prod:
- "primel (x # xs) ==> primel ys ==> prod (x # xs) = prod ys
- ==> \<exists>m. m \<in> set ys \<and> x dvd m"
- apply (rule prime_dvd_mult_list)
- apply (simp add: primel_hd_tl)
- apply (erule hd_dvd_prod)
- done
-
-lemma prime_dvd_eq: "primel (x # xs) ==> primel ys ==> m \<in> set ys ==> x dvd m ==> x = m"
- apply (rule primes_eq)
- apply (auto simp add: primel_def primel_hd_tl)
- done
-
-lemma hd_xs_eq_prod:
- "primel (x # xs) ==>
- primel ys ==> prod (x # xs) = prod ys ==> x \<in> set ys"
- apply (frule hd_xs_dvd_prod)
- apply auto
- apply (drule prime_dvd_eq)
- apply auto
- done
-
-lemma perm_primel_ex:
- "primel (x # xs) ==>
- primel ys ==> prod (x # xs) = prod ys ==> \<exists>l. ys <~~> (x # l)"
- apply (rule exI)
- apply (rule perm_remove)
- apply (erule hd_xs_eq_prod)
- apply simp_all
- done
-
-lemma primel_prod_less:
- "primel (x # xs) ==>
- primel ys ==> prod (x # xs) = prod ys ==> prod xs < prod ys"
- by (metis less_asym linorder_neqE_nat mult_less_cancel2 nat_0_less_mult_iff
- nat_less_le nat_mult_1 prime_def primel_hd_tl primel_prod_gz prod.simps(2))
-
-lemma prod_one_empty:
- "primel xs ==> p * prod xs = p ==> prime p ==> xs = []"
- apply (auto intro: primel_one_empty simp add: prime_def)
- done
-
-lemma uniq_ex_aux:
- "\<forall>m. m < prod ys --> (\<forall>xs ys. primel xs \<and> primel ys \<and>
- prod xs = prod ys \<and> prod xs = m --> xs <~~> ys) ==>
- primel list ==> primel x ==> prod list = prod x ==> prod x < prod ys
- ==> x <~~> list"
- apply simp
- done
-
-lemma factor_unique [rule_format]:
- "\<forall>xs ys. primel xs \<and> primel ys \<and> prod xs = prod ys \<and> prod xs = n
- --> xs <~~> ys"
- apply (induct n rule: nat_less_induct)
- apply safe
- apply (case_tac xs)
- apply (force intro: primel_one_empty)
- apply (rule perm_primel_ex [THEN exE])
- apply simp_all
- apply (rule perm.trans [THEN perm_sym])
- apply assumption
- apply (rule perm.Cons)
- apply (case_tac "x = []")
- apply (metis perm_prod perm_refl prime_primel primel_hd_tl primel_tl prod_one_empty)
- apply (metis nat_0_less_mult_iff nat_mult_eq_cancel1 perm_primel perm_prod primel_prod_gz primel_prod_less primel_tl prod.simps(2))
- done
-
-lemma perm_nondec_unique:
- "xs <~~> ys ==> nondec xs ==> nondec ys ==> xs = ys"
- by (metis nondec_sort_eq perm_sort_eq)
-
-theorem unique_prime_factorization [rule_format]:
- "\<forall>n. Suc 0 < n --> (\<exists>!l. primel l \<and> nondec l \<and> prod l = n)"
- by (metis factor_unique nondec_factor_exists perm_nondec_unique)
-
-end
--- a/src/HOL/Old_Number_Theory/Fib.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,148 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Fib.thy
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1997 University of Cambridge
-*)
-
-section \<open>The Fibonacci function\<close>
-
-theory Fib
-imports Primes
-begin
-
-text \<open>
- Fibonacci numbers: proofs of laws taken from:
- R. L. Graham, D. E. Knuth, O. Patashnik. Concrete Mathematics.
- (Addison-Wesley, 1989)
-
- \bigskip
-\<close>
-
-fun fib :: "nat \<Rightarrow> nat"
-where
- "fib 0 = 0"
-| "fib (Suc 0) = 1"
-| fib_2: "fib (Suc (Suc n)) = fib n + fib (Suc n)"
-
-text \<open>
- \medskip The difficulty in these proofs is to ensure that the
- induction hypotheses are applied before the definition of @{term
- fib}. Towards this end, the @{term fib} equations are not declared
- to the Simplifier and are applied very selectively at first.
-\<close>
-
-text\<open>We disable \<open>fib.fib_2fib_2\<close> for simplification ...\<close>
-declare fib_2 [simp del]
-
-text\<open>...then prove a version that has a more restrictive pattern.\<close>
-lemma fib_Suc3: "fib (Suc (Suc (Suc n))) = fib (Suc n) + fib (Suc (Suc n))"
- by (rule fib_2)
-
-text \<open>\medskip Concrete Mathematics, page 280\<close>
-
-lemma fib_add: "fib (Suc (n + k)) = fib (Suc k) * fib (Suc n) + fib k * fib n"
-proof (induct n rule: fib.induct)
- case 1 show ?case by simp
-next
- case 2 show ?case by (simp add: fib_2)
-next
- case 3 thus ?case by (simp add: fib_2 add_mult_distrib2)
-qed
-
-lemma fib_Suc_neq_0: "fib (Suc n) \<noteq> 0"
- apply (induct n rule: fib.induct)
- apply (simp_all add: fib_2)
- done
-
-lemma fib_Suc_gr_0: "0 < fib (Suc n)"
- by (insert fib_Suc_neq_0 [of n], simp)
-
-lemma fib_gr_0: "0 < n ==> 0 < fib n"
- by (case_tac n, auto simp add: fib_Suc_gr_0)
-
-
-text \<open>
- \medskip Concrete Mathematics, page 278: Cassini's identity. The proof is
- much easier using integers, not natural numbers!
-\<close>
-
-lemma fib_Cassini_int:
- "int (fib (Suc (Suc n)) * fib n) =
- (if n mod 2 = 0 then int (fib (Suc n) * fib (Suc n)) - 1
- else int (fib (Suc n) * fib (Suc n)) + 1)"
-proof(induct n rule: fib.induct)
- case 1 thus ?case by (simp add: fib_2)
-next
- case 2 thus ?case by (simp add: fib_2 mod_Suc)
-next
- case (3 x)
- have "Suc 0 \<noteq> x mod 2 \<longrightarrow> x mod 2 = 0" by presburger
- with "3.hyps" show ?case by (simp add: fib.simps add_mult_distrib add_mult_distrib2)
-qed
-
-text\<open>We now obtain a version for the natural numbers via the coercion
- function @{term int}.\<close>
-theorem fib_Cassini:
- "fib (Suc (Suc n)) * fib n =
- (if n mod 2 = 0 then fib (Suc n) * fib (Suc n) - 1
- else fib (Suc n) * fib (Suc n) + 1)"
- apply (rule of_nat_eq_iff [where 'a = int, THEN iffD1])
- using fib_Cassini_int apply (auto simp add: Suc_leI fib_Suc_gr_0 of_nat_diff)
- done
-
-
-text \<open>\medskip Toward Law 6.111 of Concrete Mathematics\<close>
-
-lemma gcd_fib_Suc_eq_1: "gcd (fib n) (fib (Suc n)) = Suc 0"
- apply (induct n rule: fib.induct)
- prefer 3
- apply (simp add: gcd_commute fib_Suc3)
- apply (simp_all add: fib_2)
- done
-
-lemma gcd_fib_add: "gcd (fib m) (fib (n + m)) = gcd (fib m) (fib n)"
- apply (simp add: gcd_commute [of "fib m"])
- apply (case_tac m)
- apply simp
- apply (simp add: fib_add)
- apply (simp add: add.commute gcd_non_0 [OF fib_Suc_gr_0])
- apply (simp add: gcd_non_0 [OF fib_Suc_gr_0, symmetric])
- apply (simp add: gcd_fib_Suc_eq_1 gcd_mult_cancel)
- done
-
-lemma gcd_fib_diff: "m \<le> n ==> gcd (fib m) (fib (n - m)) = gcd (fib m) (fib n)"
- by (simp add: gcd_fib_add [symmetric, of _ "n-m"])
-
-lemma gcd_fib_mod: "0 < m ==> gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib n)"
-proof (induct n rule: less_induct)
- case (less n)
- from less.prems have pos_m: "0 < m" .
- show "gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib n)"
- proof (cases "m < n")
- case True note m_n = True
- then have m_n': "m \<le> n" by auto
- with pos_m have pos_n: "0 < n" by auto
- with pos_m m_n have diff: "n - m < n" by auto
- have "gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib ((n - m) mod m))"
- by (simp add: mod_if [of n]) (insert m_n, auto)
- also have "\<dots> = gcd (fib m) (fib (n - m))" by (simp add: less.hyps diff pos_m)
- also have "\<dots> = gcd (fib m) (fib n)" by (simp add: gcd_fib_diff m_n')
- finally show "gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib n)" .
- next
- case False then show "gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib n)"
- by (cases "m = n") auto
- qed
-qed
-
-lemma fib_gcd: "fib (gcd m n) = gcd (fib m) (fib n)" \<comment> \<open>Law 6.111\<close>
- apply (induct m n rule: gcd_induct)
- apply (simp_all add: gcd_non_0 gcd_commute gcd_fib_mod)
- done
-
-theorem fib_mult_eq_sum:
- "fib (Suc n) * fib n = (\<Sum>k \<in> {..n}. fib k * fib k)"
- apply (induct n rule: fib.induct)
- apply (auto simp add: atMost_Suc fib_2)
- apply (simp add: add_mult_distrib add_mult_distrib2)
- done
-
-end
--- a/src/HOL/Old_Number_Theory/Finite2.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,184 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Finite2.thy
- Authors: Jeremy Avigad, David Gray, and Adam Kramer
-*)
-
-section \<open>Finite Sets and Finite Sums\<close>
-
-theory Finite2
-imports IntFact "~~/src/HOL/Library/Infinite_Set"
-begin
-
-text\<open>
- These are useful for combinatorial and number-theoretic counting
- arguments.
-\<close>
-
-
-subsection \<open>Useful properties of sums and products\<close>
-
-lemma sum_same_function_zcong:
- assumes a: "\<forall>x \<in> S. [f x = g x](mod m)"
- shows "[sum f S = sum g S] (mod m)"
-proof cases
- assume "finite S"
- thus ?thesis using a by induct (simp_all add: zcong_zadd)
-next
- assume "infinite S" thus ?thesis by simp
-qed
-
-lemma prod_same_function_zcong:
- assumes a: "\<forall>x \<in> S. [f x = g x](mod m)"
- shows "[prod f S = prod g S] (mod m)"
-proof cases
- assume "finite S"
- thus ?thesis using a by induct (simp_all add: zcong_zmult)
-next
- assume "infinite S" thus ?thesis by simp
-qed
-
-lemma sum_const: "finite X ==> sum (%x. (c :: int)) X = c * int(card X)"
-by (simp add: of_nat_mult)
-
-lemma sum_const2: "finite X ==> int (sum (%x. (c :: nat)) X) =
- int(c) * int(card X)"
-by (simp add: of_nat_mult)
-
-lemma sum_const_mult: "finite A ==> sum (%x. c * ((f x)::int)) A =
- c * sum f A"
- by (induct set: finite) (auto simp add: distrib_left)
-
-
-subsection \<open>Cardinality of explicit finite sets\<close>
-
-lemma finite_surjI: "[| B \<subseteq> f ` A; finite A |] ==> finite B"
-by (simp add: finite_subset)
-
-lemma bdd_nat_set_l_finite: "finite {y::nat . y < x}"
- by (rule bounded_nat_set_is_finite) blast
-
-lemma bdd_nat_set_le_finite: "finite {y::nat . y \<le> x}"
-proof -
- have "{y::nat . y \<le> x} = {y::nat . y < Suc x}" by auto
- then show ?thesis by (auto simp add: bdd_nat_set_l_finite)
-qed
-
-lemma bdd_int_set_l_finite: "finite {x::int. 0 \<le> x & x < n}"
- apply (subgoal_tac " {(x :: int). 0 \<le> x & x < n} \<subseteq>
- int ` {(x :: nat). x < nat n}")
- apply (erule finite_surjI)
- apply (auto simp add: bdd_nat_set_l_finite image_def)
- apply (rule_tac x = "nat x" in exI, simp)
- done
-
-lemma bdd_int_set_le_finite: "finite {x::int. 0 \<le> x & x \<le> n}"
- apply (subgoal_tac "{x. 0 \<le> x & x \<le> n} = {x. 0 \<le> x & x < n + 1}")
- apply (erule ssubst)
- apply (rule bdd_int_set_l_finite)
- apply auto
- done
-
-lemma bdd_int_set_l_l_finite: "finite {x::int. 0 < x & x < n}"
-proof -
- have "{x::int. 0 < x & x < n} \<subseteq> {x::int. 0 \<le> x & x < n}"
- by auto
- then show ?thesis by (auto simp add: bdd_int_set_l_finite finite_subset)
-qed
-
-lemma bdd_int_set_l_le_finite: "finite {x::int. 0 < x & x \<le> n}"
-proof -
- have "{x::int. 0 < x & x \<le> n} \<subseteq> {x::int. 0 \<le> x & x \<le> n}"
- by auto
- then show ?thesis by (auto simp add: bdd_int_set_le_finite finite_subset)
-qed
-
-lemma card_bdd_nat_set_l: "card {y::nat . y < x} = x"
-proof (induct x)
- case 0
- show "card {y::nat . y < 0} = 0" by simp
-next
- case (Suc n)
- have "{y. y < Suc n} = insert n {y. y < n}"
- by auto
- then have "card {y. y < Suc n} = card (insert n {y. y < n})"
- by auto
- also have "... = Suc (card {y. y < n})"
- by (rule card_insert_disjoint) (auto simp add: bdd_nat_set_l_finite)
- finally show "card {y. y < Suc n} = Suc n"
- using \<open>card {y. y < n} = n\<close> by simp
-qed
-
-lemma card_bdd_nat_set_le: "card { y::nat. y \<le> x} = Suc x"
-proof -
- have "{y::nat. y \<le> x} = { y::nat. y < Suc x}"
- by auto
- then show ?thesis by (auto simp add: card_bdd_nat_set_l)
-qed
-
-lemma card_bdd_int_set_l: "0 \<le> (n::int) ==> card {y. 0 \<le> y & y < n} = nat n"
-proof -
- assume "0 \<le> n"
- have "inj_on (%y. int y) {y. y < nat n}"
- by (auto simp add: inj_on_def)
- hence "card (int ` {y. y < nat n}) = card {y. y < nat n}"
- by (rule card_image)
- also from \<open>0 \<le> n\<close> have "int ` {y. y < nat n} = {y. 0 \<le> y & y < n}"
- apply (auto simp add: zless_nat_eq_int_zless image_def)
- apply (rule_tac x = "nat x" in exI)
- apply (auto simp add: nat_0_le)
- done
- also have "card {y. y < nat n} = nat n"
- by (rule card_bdd_nat_set_l)
- finally show "card {y. 0 \<le> y & y < n} = nat n" .
-qed
-
-lemma card_bdd_int_set_le: "0 \<le> (n::int) ==> card {y. 0 \<le> y & y \<le> n} =
- nat n + 1"
-proof -
- assume "0 \<le> n"
- moreover have "{y. 0 \<le> y & y \<le> n} = {y. 0 \<le> y & y < n+1}" by auto
- ultimately show ?thesis
- using card_bdd_int_set_l [of "n + 1"]
- by (auto simp add: nat_add_distrib)
-qed
-
-lemma card_bdd_int_set_l_le: "0 \<le> (n::int) ==>
- card {x. 0 < x & x \<le> n} = nat n"
-proof -
- assume "0 \<le> n"
- have "inj_on (%x. x+1) {x. 0 \<le> x & x < n}"
- by (auto simp add: inj_on_def)
- hence "card ((%x. x+1) ` {x. 0 \<le> x & x < n}) =
- card {x. 0 \<le> x & x < n}"
- by (rule card_image)
- also from \<open>0 \<le> n\<close> have "... = nat n"
- by (rule card_bdd_int_set_l)
- also have "(%x. x + 1) ` {x. 0 \<le> x & x < n} = {x. 0 < x & x<= n}"
- apply (auto simp add: image_def)
- apply (rule_tac x = "x - 1" in exI)
- apply arith
- done
- finally show "card {x. 0 < x & x \<le> n} = nat n" .
-qed
-
-lemma card_bdd_int_set_l_l: "0 < (n::int) ==>
- card {x. 0 < x & x < n} = nat n - 1"
-proof -
- assume "0 < n"
- moreover have "{x. 0 < x & x < n} = {x. 0 < x & x \<le> n - 1}"
- by simp
- ultimately show ?thesis
- using insert card_bdd_int_set_l_le [of "n - 1"]
- by (auto simp add: nat_diff_distrib)
-qed
-
-lemma int_card_bdd_int_set_l_l: "0 < n ==>
- int(card {x. 0 < x & x < n}) = n - 1"
- apply (auto simp add: card_bdd_int_set_l_l)
- done
-
-lemma int_card_bdd_int_set_l_le: "0 \<le> n ==>
- int(card {x. 0 < x & x \<le> n}) = n"
- by (auto simp add: card_bdd_int_set_l_le)
-
-
-end
--- a/src/HOL/Old_Number_Theory/Gauss.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,504 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Gauss.thy
- Authors: Jeremy Avigad, David Gray, and Adam Kramer
-*)
-
-section \<open>Gauss' Lemma\<close>
-
-theory Gauss
-imports Euler
-begin
-
-locale GAUSS =
- fixes p :: "int"
- fixes a :: "int"
-
- assumes p_prime: "zprime p"
- assumes p_g_2: "2 < p"
- assumes p_a_relprime: "~[a = 0](mod p)"
- assumes a_nonzero: "0 < a"
-begin
-
-definition "A = {(x::int). 0 < x & x \<le> ((p - 1) div 2)}"
-definition "B = (%x. x * a) ` A"
-definition "C = StandardRes p ` B"
-definition "D = C \<inter> {x. x \<le> ((p - 1) div 2)}"
-definition "E = C \<inter> {x. ((p - 1) div 2) < x}"
-definition "F = (%x. (p - x)) ` E"
-
-
-subsection \<open>Basic properties of p\<close>
-
-lemma p_odd: "p \<in> zOdd"
- by (auto simp add: p_prime p_g_2 zprime_zOdd_eq_grt_2)
-
-lemma p_g_0: "0 < p"
- using p_g_2 by auto
-
-lemma int_nat: "int (nat ((p - 1) div 2)) = (p - 1) div 2"
- using ListMem.insert p_g_2 by (auto simp add: pos_imp_zdiv_nonneg_iff)
-
-lemma p_minus_one_l: "(p - 1) div 2 < p"
-proof -
- have "(p - 1) div 2 \<le> (p - 1) div 1"
- by (rule zdiv_mono2) (auto simp add: p_g_0)
- also have "\<dots> = p - 1" by simp
- finally show ?thesis by simp
-qed
-
-lemma p_eq: "p = (2 * (p - 1) div 2) + 1"
- using nonzero_mult_div_cancel_left [of 2 "p - 1"] by auto
-
-
-lemma (in -) zodd_imp_zdiv_eq: "x \<in> zOdd ==> 2 * (x - 1) div 2 = 2 * ((x - 1) div 2)"
- by (simp add: in_zEven_zOdd_iff)
-
-
-lemma p_eq2: "p = (2 * ((p - 1) div 2)) + 1"
- apply (insert p_eq p_prime p_g_2 zprime_zOdd_eq_grt_2 [of p], auto)
- apply (frule zodd_imp_zdiv_eq, auto)
- done
-
-
-subsection \<open>Basic Properties of the Gauss Sets\<close>
-
-lemma finite_A: "finite (A)"
-by (auto simp add: A_def)
-
-lemma finite_B: "finite (B)"
-by (auto simp add: B_def finite_A)
-
-lemma finite_C: "finite (C)"
-by (auto simp add: C_def finite_B)
-
-lemma finite_D: "finite (D)"
-by (auto simp add: D_def finite_C)
-
-lemma finite_E: "finite (E)"
-by (auto simp add: E_def finite_C)
-
-lemma finite_F: "finite (F)"
-by (auto simp add: F_def finite_E)
-
-lemma C_eq: "C = D \<union> E"
-by (auto simp add: C_def D_def E_def)
-
-lemma A_card_eq: "card A = nat ((p - 1) div 2)"
- apply (auto simp add: A_def)
- apply (insert int_nat)
- apply (erule subst)
- apply (auto simp add: card_bdd_int_set_l_le)
- done
-
-lemma inj_on_xa_A: "inj_on (%x. x * a) A"
- using a_nonzero by (simp add: A_def inj_on_def)
-
-lemma A_res: "ResSet p A"
- apply (auto simp add: A_def ResSet_def)
- apply (rule_tac m = p in zcong_less_eq)
- apply (insert p_g_2, auto)
- done
-
-lemma B_res: "ResSet p B"
- apply (insert p_g_2 p_a_relprime p_minus_one_l)
- apply (auto simp add: B_def)
- apply (rule ResSet_image)
- apply (auto simp add: A_res)
- apply (auto simp add: A_def)
-proof -
- fix x fix y
- assume a: "[x * a = y * a] (mod p)"
- assume b: "0 < x"
- assume c: "x \<le> (p - 1) div 2"
- assume d: "0 < y"
- assume e: "y \<le> (p - 1) div 2"
- from a p_a_relprime p_prime a_nonzero zcong_cancel [of p a x y]
- have "[x = y](mod p)"
- by (simp add: zprime_imp_zrelprime zcong_def p_g_0 order_le_less)
- with zcong_less_eq [of x y p] p_minus_one_l
- order_le_less_trans [of x "(p - 1) div 2" p]
- order_le_less_trans [of y "(p - 1) div 2" p] show "x = y"
- by (simp add: b c d e p_minus_one_l p_g_0)
-qed
-
-lemma SR_B_inj: "inj_on (StandardRes p) B"
- apply (auto simp add: B_def StandardRes_def inj_on_def A_def)
-proof -
- fix x fix y
- assume a: "x * a mod p = y * a mod p"
- assume b: "0 < x"
- assume c: "x \<le> (p - 1) div 2"
- assume d: "0 < y"
- assume e: "y \<le> (p - 1) div 2"
- assume f: "x \<noteq> y"
- from a have "[x * a = y * a](mod p)"
- by (simp add: zcong_zmod_eq p_g_0)
- with p_a_relprime p_prime a_nonzero zcong_cancel [of p a x y]
- have "[x = y](mod p)"
- by (simp add: zprime_imp_zrelprime zcong_def p_g_0 order_le_less)
- with zcong_less_eq [of x y p] p_minus_one_l
- order_le_less_trans [of x "(p - 1) div 2" p]
- order_le_less_trans [of y "(p - 1) div 2" p] have "x = y"
- by (simp add: b c d e p_minus_one_l p_g_0)
- then have False
- by (simp add: f)
- then show "a = 0"
- by simp
-qed
-
-lemma inj_on_pminusx_E: "inj_on (%x. p - x) E"
- apply (auto simp add: E_def C_def B_def A_def)
- apply (rule_tac g = "%x. -1 * (x - p)" in inj_on_inverseI)
- apply auto
- done
-
-lemma A_ncong_p: "x \<in> A ==> ~[x = 0](mod p)"
- apply (auto simp add: A_def)
- apply (frule_tac m = p in zcong_not_zero)
- apply (insert p_minus_one_l)
- apply auto
- done
-
-lemma A_greater_zero: "x \<in> A ==> 0 < x"
- by (auto simp add: A_def)
-
-lemma B_ncong_p: "x \<in> B ==> ~[x = 0](mod p)"
- apply (auto simp add: B_def)
- apply (frule A_ncong_p)
- apply (insert p_a_relprime p_prime a_nonzero)
- apply (frule_tac a = xa and b = a in zcong_zprime_prod_zero_contra)
- apply (auto simp add: A_greater_zero)
- done
-
-lemma B_greater_zero: "x \<in> B ==> 0 < x"
- using a_nonzero by (auto simp add: B_def A_greater_zero)
-
-lemma C_ncong_p: "x \<in> C ==> ~[x = 0](mod p)"
- apply (auto simp add: C_def)
- apply (frule B_ncong_p)
- apply (subgoal_tac "[xa = StandardRes p xa](mod p)")
- defer apply (simp add: StandardRes_prop1)
- apply (frule_tac a = xa and b = "StandardRes p xa" and c = 0 in zcong_trans)
- apply auto
- done
-
-lemma C_greater_zero: "y \<in> C ==> 0 < y"
- apply (auto simp add: C_def)
-proof -
- fix x
- assume a: "x \<in> B"
- from p_g_0 have "0 \<le> StandardRes p x"
- by (simp add: StandardRes_lbound)
- moreover have "~[x = 0] (mod p)"
- by (simp add: a B_ncong_p)
- then have "StandardRes p x \<noteq> 0"
- by (simp add: StandardRes_prop3)
- ultimately show "0 < StandardRes p x"
- by (simp add: order_le_less)
-qed
-
-lemma D_ncong_p: "x \<in> D ==> ~[x = 0](mod p)"
- by (auto simp add: D_def C_ncong_p)
-
-lemma E_ncong_p: "x \<in> E ==> ~[x = 0](mod p)"
- by (auto simp add: E_def C_ncong_p)
-
-lemma F_ncong_p: "x \<in> F ==> ~[x = 0](mod p)"
- apply (auto simp add: F_def)
-proof -
- fix x assume a: "x \<in> E" assume b: "[p - x = 0] (mod p)"
- from E_ncong_p have "~[x = 0] (mod p)"
- by (simp add: a)
- moreover from a have "0 < x"
- by (simp add: a E_def C_greater_zero)
- moreover from a have "x < p"
- by (auto simp add: E_def C_def p_g_0 StandardRes_ubound)
- ultimately have "~[p - x = 0] (mod p)"
- by (simp add: zcong_not_zero)
- from this show False by (simp add: b)
-qed
-
-lemma F_subset: "F \<subseteq> {x. 0 < x & x \<le> ((p - 1) div 2)}"
- apply (auto simp add: F_def E_def)
- apply (insert p_g_0)
- apply (frule_tac x = xa in StandardRes_ubound)
- apply (frule_tac x = x in StandardRes_ubound)
- apply (subgoal_tac "xa = StandardRes p xa")
- apply (auto simp add: C_def StandardRes_prop2 StandardRes_prop1)
-proof -
- from zodd_imp_zdiv_eq p_prime p_g_2 zprime_zOdd_eq_grt_2 have
- "2 * (p - 1) div 2 = 2 * ((p - 1) div 2)"
- by simp
- with p_eq2 show " !!x. [| (p - 1) div 2 < StandardRes p x; x \<in> B |]
- ==> p - StandardRes p x \<le> (p - 1) div 2"
- by simp
-qed
-
-lemma D_subset: "D \<subseteq> {x. 0 < x & x \<le> ((p - 1) div 2)}"
- by (auto simp add: D_def C_greater_zero)
-
-lemma F_eq: "F = {x. \<exists>y \<in> A. ( x = p - (StandardRes p (y*a)) & (p - 1) div 2 < StandardRes p (y*a))}"
- by (auto simp add: F_def E_def D_def C_def B_def A_def)
-
-lemma D_eq: "D = {x. \<exists>y \<in> A. ( x = StandardRes p (y*a) & StandardRes p (y*a) \<le> (p - 1) div 2)}"
- by (auto simp add: D_def C_def B_def A_def)
-
-lemma D_leq: "x \<in> D ==> x \<le> (p - 1) div 2"
- by (auto simp add: D_eq)
-
-lemma F_ge: "x \<in> F ==> x \<le> (p - 1) div 2"
- apply (auto simp add: F_eq A_def)
-proof -
- fix y
- assume "(p - 1) div 2 < StandardRes p (y * a)"
- then have "p - StandardRes p (y * a) < p - ((p - 1) div 2)"
- by arith
- also from p_eq2 have "... = 2 * ((p - 1) div 2) + 1 - ((p - 1) div 2)"
- by auto
- also have "2 * ((p - 1) div 2) + 1 - (p - 1) div 2 = (p - 1) div 2 + 1"
- by arith
- finally show "p - StandardRes p (y * a) \<le> (p - 1) div 2"
- using zless_add1_eq [of "p - StandardRes p (y * a)" "(p - 1) div 2"] by auto
-qed
-
-lemma all_A_relprime: "\<forall>x \<in> A. zgcd x p = 1"
- using p_prime p_minus_one_l by (auto simp add: A_def zless_zprime_imp_zrelprime)
-
-lemma A_prod_relprime: "zgcd (prod id A) p = 1"
-by(rule all_relprime_prod_relprime[OF finite_A all_A_relprime])
-
-
-subsection \<open>Relationships Between Gauss Sets\<close>
-
-lemma B_card_eq_A: "card B = card A"
- using finite_A by (simp add: finite_A B_def inj_on_xa_A card_image)
-
-lemma B_card_eq: "card B = nat ((p - 1) div 2)"
- by (simp add: B_card_eq_A A_card_eq)
-
-lemma F_card_eq_E: "card F = card E"
- using finite_E by (simp add: F_def inj_on_pminusx_E card_image)
-
-lemma C_card_eq_B: "card C = card B"
- apply (insert finite_B)
- apply (subgoal_tac "inj_on (StandardRes p) B")
- apply (simp add: B_def C_def card_image)
- apply (rule StandardRes_inj_on_ResSet)
- apply (simp add: B_res)
- done
-
-lemma D_E_disj: "D \<inter> E = {}"
- by (auto simp add: D_def E_def)
-
-lemma C_card_eq_D_plus_E: "card C = card D + card E"
- by (auto simp add: C_eq card_Un_disjoint D_E_disj finite_D finite_E)
-
-lemma C_prod_eq_D_times_E: "prod id E * prod id D = prod id C"
- apply (insert D_E_disj finite_D finite_E C_eq)
- apply (frule prod.union_disjoint [of D E id])
- apply auto
- done
-
-lemma C_B_zcong_prod: "[prod id C = prod id B] (mod p)"
- apply (auto simp add: C_def)
- apply (insert finite_B SR_B_inj)
- apply (frule prod.reindex [of "StandardRes p" B id])
- apply auto
- apply (rule prod_same_function_zcong)
- apply (auto simp add: StandardRes_prop1 zcong_sym p_g_0)
- done
-
-lemma F_Un_D_subset: "(F \<union> D) \<subseteq> A"
- apply (rule Un_least)
- apply (auto simp add: A_def F_subset D_subset)
- done
-
-lemma F_D_disj: "(F \<inter> D) = {}"
- apply (simp add: F_eq D_eq)
- apply (auto simp add: F_eq D_eq)
-proof -
- fix y fix ya
- assume "p - StandardRes p (y * a) = StandardRes p (ya * a)"
- then have "p = StandardRes p (y * a) + StandardRes p (ya * a)"
- by arith
- moreover have "p dvd p"
- by auto
- ultimately have "p dvd (StandardRes p (y * a) + StandardRes p (ya * a))"
- by auto
- then have a: "[StandardRes p (y * a) + StandardRes p (ya * a) = 0] (mod p)"
- by (auto simp add: zcong_def)
- have "[y * a = StandardRes p (y * a)] (mod p)"
- by (simp only: zcong_sym StandardRes_prop1)
- moreover have "[ya * a = StandardRes p (ya * a)] (mod p)"
- by (simp only: zcong_sym StandardRes_prop1)
- ultimately have "[y * a + ya * a =
- StandardRes p (y * a) + StandardRes p (ya * a)] (mod p)"
- by (rule zcong_zadd)
- with a have "[y * a + ya * a = 0] (mod p)"
- apply (elim zcong_trans)
- by (simp only: zcong_refl)
- also have "y * a + ya * a = a * (y + ya)"
- by (simp add: distrib_left mult.commute)
- finally have "[a * (y + ya) = 0] (mod p)" .
- with p_prime a_nonzero zcong_zprime_prod_zero [of p a "y + ya"]
- p_a_relprime
- have a: "[y + ya = 0] (mod p)"
- by auto
- assume b: "y \<in> A" and c: "ya: A"
- with A_def have "0 < y + ya"
- by auto
- moreover from b c A_def have "y + ya \<le> (p - 1) div 2 + (p - 1) div 2"
- by auto
- moreover from b c p_eq2 A_def have "y + ya < p"
- by auto
- ultimately show False
- apply simp
- apply (frule_tac m = p in zcong_not_zero)
- apply (auto simp add: a)
- done
-qed
-
-lemma F_Un_D_card: "card (F \<union> D) = nat ((p - 1) div 2)"
-proof -
- have "card (F \<union> D) = card E + card D"
- by (auto simp add: finite_F finite_D F_D_disj
- card_Un_disjoint F_card_eq_E)
- then have "card (F \<union> D) = card C"
- by (simp add: C_card_eq_D_plus_E)
- from this show "card (F \<union> D) = nat ((p - 1) div 2)"
- by (simp add: C_card_eq_B B_card_eq)
-qed
-
-lemma F_Un_D_eq_A: "F \<union> D = A"
- using finite_A F_Un_D_subset A_card_eq F_Un_D_card by (auto simp add: card_seteq)
-
-lemma prod_D_F_eq_prod_A:
- "(prod id D) * (prod id F) = prod id A"
- apply (insert F_D_disj finite_D finite_F)
- apply (frule prod.union_disjoint [of F D id])
- apply (auto simp add: F_Un_D_eq_A)
- done
-
-lemma prod_F_zcong:
- "[prod id F = ((-1) ^ (card E)) * (prod id E)] (mod p)"
-proof -
- have "prod id F = prod id (op - p ` E)"
- by (auto simp add: F_def)
- then have "prod id F = prod (op - p) E"
- apply simp
- apply (insert finite_E inj_on_pminusx_E)
- apply (frule prod.reindex [of "minus p" E id])
- apply auto
- done
- then have one:
- "[prod id F = prod (StandardRes p o (op - p)) E] (mod p)"
- apply simp
- apply (insert p_g_0 finite_E StandardRes_prod)
- by (auto)
- moreover have a: "\<forall>x \<in> E. [p - x = 0 - x] (mod p)"
- apply clarify
- apply (insert zcong_id [of p])
- apply (rule_tac a = p and m = p and c = x and d = x in zcong_zdiff, auto)
- done
- moreover have b: "\<forall>x \<in> E. [StandardRes p (p - x) = p - x](mod p)"
- apply clarify
- apply (simp add: StandardRes_prop1 zcong_sym)
- done
- moreover have "\<forall>x \<in> E. [StandardRes p (p - x) = - x](mod p)"
- apply clarify
- apply (insert a b)
- apply (rule_tac b = "p - x" in zcong_trans, auto)
- done
- ultimately have c:
- "[prod (StandardRes p o (op - p)) E = prod (uminus) E](mod p)"
- apply simp
- using finite_E p_g_0
- prod_same_function_zcong [of E "StandardRes p o (op - p)" uminus p]
- by auto
- then have two: "[prod id F = prod (uminus) E](mod p)"
- apply (insert one c)
- apply (rule zcong_trans [of "prod id F"
- "prod (StandardRes p o op - p) E" p
- "prod uminus E"], auto)
- done
- also have "prod uminus E = (prod id E) * (-1)^(card E)"
- using finite_E by (induct set: finite) auto
- then have "prod uminus E = (-1) ^ (card E) * (prod id E)"
- by (simp add: mult.commute)
- with two show ?thesis
- by simp
-qed
-
-
-subsection \<open>Gauss' Lemma\<close>
-
-lemma aux: "prod id A * (- 1) ^ card E * a ^ card A * (- 1) ^ card E = prod id A * a ^ card A"
- by (auto simp add: finite_E neg_one_special)
-
-theorem pre_gauss_lemma:
- "[a ^ nat((p - 1) div 2) = (-1) ^ (card E)] (mod p)"
-proof -
- have "[prod id A = prod id F * prod id D](mod p)"
- by (auto simp add: prod_D_F_eq_prod_A mult.commute cong del: prod.strong_cong)
- then have "[prod id A = ((-1)^(card E) * prod id E) *
- prod id D] (mod p)"
- by (rule zcong_trans) (auto simp add: prod_F_zcong zcong_scalar cong del: prod.strong_cong)
- then have "[prod id A = ((-1)^(card E) * prod id C)] (mod p)"
- apply (rule zcong_trans)
- apply (insert C_prod_eq_D_times_E, erule subst)
- apply (subst mult.assoc)
- apply auto
- done
- then have "[prod id A = ((-1)^(card E) * prod id B)] (mod p)"
- apply (rule zcong_trans)
- apply (simp add: C_B_zcong_prod zcong_scalar2 cong del: prod.strong_cong)
- done
- then have "[prod id A = ((-1)^(card E) *
- (prod id ((%x. x * a) ` A)))] (mod p)"
- by (simp add: B_def)
- then have "[prod id A = ((-1)^(card E) * (prod (%x. x * a) A))]
- (mod p)"
- by (simp add:finite_A inj_on_xa_A prod.reindex cong del: prod.strong_cong)
- moreover have "prod (%x. x * a) A =
- prod (%x. a) A * prod id A"
- using finite_A by (induct set: finite) auto
- ultimately have "[prod id A = ((-1)^(card E) * (prod (%x. a) A *
- prod id A))] (mod p)"
- by simp
- then have "[prod id A = ((-1)^(card E) * a^(card A) *
- prod id A)](mod p)"
- by (rule zcong_trans) (simp add: zcong_scalar2 zcong_scalar finite_A prod_constant mult.assoc)
- then have a: "[prod id A * (-1)^(card E) =
- ((-1)^(card E) * a^(card A) * prod id A * (-1)^(card E))](mod p)"
- by (rule zcong_scalar)
- then have "[prod id A * (-1)^(card E) = prod id A *
- (-1)^(card E) * a^(card A) * (-1)^(card E)](mod p)"
- by (rule zcong_trans) (simp add: a mult.commute mult.left_commute)
- then have "[prod id A * (-1)^(card E) = prod id A *
- a^(card A)](mod p)"
- by (rule zcong_trans) (simp add: aux cong del: prod.strong_cong)
- with this zcong_cancel2 [of p "prod id A" "(- 1) ^ card E" "a ^ card A"]
- p_g_0 A_prod_relprime have "[(- 1) ^ card E = a ^ card A](mod p)"
- by (simp add: order_less_imp_le)
- from this show ?thesis
- by (simp add: A_card_eq zcong_sym)
-qed
-
-theorem gauss_lemma: "(Legendre a p) = (-1) ^ (card E)"
-proof -
- from Euler_Criterion p_prime p_g_2 have
- "[(Legendre a p) = a^(nat (((p) - 1) div 2))] (mod p)"
- by auto
- moreover note pre_gauss_lemma
- ultimately have "[(Legendre a p) = (-1) ^ (card E)] (mod p)"
- by (rule zcong_trans)
- moreover from p_a_relprime have "(Legendre a p) = 1 | (Legendre a p) = (-1)"
- by (auto simp add: Legendre_def)
- moreover have "(-1::int) ^ (card E) = 1 | (-1::int) ^ (card E) = -1"
- by (rule neg_one_power)
- ultimately show ?thesis
- by (auto simp add: p_g_2 one_not_neg_one_mod_m zcong_sym)
-qed
-
-end
-
-end
--- a/src/HOL/Old_Number_Theory/Int2.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,299 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Int2.thy
- Authors: Jeremy Avigad, David Gray, and Adam Kramer
-*)
-
-section \<open>Integers: Divisibility and Congruences\<close>
-
-theory Int2
-imports Finite2 WilsonRuss
-begin
-
-definition MultInv :: "int => int => int"
- where "MultInv p x = x ^ nat (p - 2)"
-
-
-subsection \<open>Useful lemmas about dvd and powers\<close>
-
-lemma zpower_zdvd_prop1:
- "0 < n \<Longrightarrow> p dvd y \<Longrightarrow> p dvd ((y::int) ^ n)"
- by (induct n) (auto simp add: dvd_mult2 [of p y])
-
-lemma zdvd_bounds: "n dvd m ==> m \<le> (0::int) | n \<le> m"
-proof -
- assume "n dvd m"
- then have "~(0 < m & m < n)"
- using zdvd_not_zless [of m n] by auto
- then show ?thesis by auto
-qed
-
-lemma zprime_zdvd_zmult_better: "[| zprime p; p dvd (m * n) |] ==>
- (p dvd m) | (p dvd n)"
- apply (cases "0 \<le> m")
- apply (simp add: zprime_zdvd_zmult)
- apply (insert zprime_zdvd_zmult [of "-m" p n])
- apply auto
- done
-
-lemma zpower_zdvd_prop2:
- "zprime p \<Longrightarrow> p dvd ((y::int) ^ n) \<Longrightarrow> 0 < n \<Longrightarrow> p dvd y"
- apply (induct n)
- apply simp
- apply (frule zprime_zdvd_zmult_better)
- apply simp
- apply (force simp del:dvd_mult)
- done
-
-lemma div_prop1:
- assumes "0 < z" and "(x::int) < y * z"
- shows "x div z < y"
-proof -
- from \<open>0 < z\<close> have modth: "x mod z \<ge> 0" by simp
- have "(x div z) * z \<le> (x div z) * z" by simp
- then have "(x div z) * z \<le> (x div z) * z + x mod z" using modth by arith
- also have "\<dots> = x"
- by (auto simp add: mult_div_mod_eq ac_simps)
- also note \<open>x < y * z\<close>
- finally show ?thesis
- apply (auto simp add: mult_less_cancel_right)
- using assms apply arith
- done
-qed
-
-lemma div_prop2:
- assumes "0 < z" and "(x::int) < (y * z) + z"
- shows "x div z \<le> y"
-proof -
- from assms have "x < (y + 1) * z" by (auto simp add: int_distrib)
- then have "x div z < y + 1"
- apply (rule_tac y = "y + 1" in div_prop1)
- apply (auto simp add: \<open>0 < z\<close>)
- done
- then show ?thesis by auto
-qed
-
-lemma zdiv_leq_prop: assumes "0 < y" shows "y * (x div y) \<le> (x::int)"
-proof-
- from mult_div_mod_eq [symmetric] have "x = y * (x div y) + x mod y" by auto
- moreover have "0 \<le> x mod y" by (auto simp add: assms)
- ultimately show ?thesis by arith
-qed
-
-
-subsection \<open>Useful properties of congruences\<close>
-
-lemma zcong_eq_zdvd_prop: "[x = 0](mod p) = (p dvd x)"
- by (auto simp add: zcong_def)
-
-lemma zcong_id: "[m = 0] (mod m)"
- by (auto simp add: zcong_def)
-
-lemma zcong_shift: "[a = b] (mod m) ==> [a + c = b + c] (mod m)"
- by (auto simp add: zcong_zadd)
-
-lemma zcong_zpower: "[x = y](mod m) ==> [x^z = y^z](mod m)"
- by (induct z) (auto simp add: zcong_zmult)
-
-lemma zcong_eq_trans: "[| [a = b](mod m); b = c; [c = d](mod m) |] ==>
- [a = d](mod m)"
- apply (erule zcong_trans)
- apply simp
- done
-
-lemma aux1: "a - b = (c::int) ==> a = c + b"
- by auto
-
-lemma zcong_zmult_prop1: "[a = b](mod m) ==> ([c = a * d](mod m) =
- [c = b * d] (mod m))"
- apply (auto simp add: zcong_def dvd_def)
- apply (rule_tac x = "ka + k * d" in exI)
- apply (drule aux1)+
- apply (auto simp add: int_distrib)
- apply (rule_tac x = "ka - k * d" in exI)
- apply (drule aux1)+
- apply (auto simp add: int_distrib)
- done
-
-lemma zcong_zmult_prop2: "[a = b](mod m) ==>
- ([c = d * a](mod m) = [c = d * b] (mod m))"
- by (auto simp add: ac_simps zcong_zmult_prop1)
-
-lemma zcong_zmult_prop3: "[| zprime p; ~[x = 0] (mod p);
- ~[y = 0] (mod p) |] ==> ~[x * y = 0] (mod p)"
- apply (auto simp add: zcong_def)
- apply (drule zprime_zdvd_zmult_better, auto)
- done
-
-lemma zcong_less_eq: "[| 0 < x; 0 < y; 0 < m; [x = y] (mod m);
- x < m; y < m |] ==> x = y"
- by (metis zcong_not zcong_sym less_linear)
-
-lemma zcong_neg_1_impl_ne_1:
- assumes "2 < p" and "[x = -1] (mod p)"
- shows "~([x = 1] (mod p))"
-proof
- assume "[x = 1] (mod p)"
- with assms have "[1 = -1] (mod p)"
- apply (auto simp add: zcong_sym)
- apply (drule zcong_trans, auto)
- done
- then have "[1 + 1 = -1 + 1] (mod p)"
- by (simp only: zcong_shift)
- then have "[2 = 0] (mod p)"
- by auto
- then have "p dvd 2"
- by (auto simp add: dvd_def zcong_def)
- with \<open>2 < p\<close> show False
- by (auto simp add: zdvd_not_zless)
-qed
-
-lemma zcong_zero_equiv_div: "[a = 0] (mod m) = (m dvd a)"
- by (auto simp add: zcong_def)
-
-lemma zcong_zprime_prod_zero: "[| zprime p; 0 < a |] ==>
- [a * b = 0] (mod p) ==> [a = 0] (mod p) | [b = 0] (mod p)"
- by (auto simp add: zcong_zero_equiv_div zprime_zdvd_zmult)
-
-lemma zcong_zprime_prod_zero_contra: "[| zprime p; 0 < a |] ==>
- ~[a = 0](mod p) & ~[b = 0](mod p) ==> ~[a * b = 0] (mod p)"
- apply auto
- apply (frule_tac a = a and b = b and p = p in zcong_zprime_prod_zero)
- apply auto
- done
-
-lemma zcong_not_zero: "[| 0 < x; x < m |] ==> ~[x = 0] (mod m)"
- by (auto simp add: zcong_zero_equiv_div zdvd_not_zless)
-
-lemma zcong_zero: "[| 0 \<le> x; x < m; [x = 0](mod m) |] ==> x = 0"
- apply (drule order_le_imp_less_or_eq, auto)
- apply (frule_tac m = m in zcong_not_zero)
- apply auto
- done
-
-lemma all_relprime_prod_relprime: "[| finite A; \<forall>x \<in> A. zgcd x y = 1 |]
- ==> zgcd (prod id A) y = 1"
- by (induct set: finite) (auto simp add: zgcd_zgcd_zmult)
-
-
-subsection \<open>Some properties of MultInv\<close>
-
-lemma MultInv_prop1: "[| 2 < p; [x = y] (mod p) |] ==>
- [(MultInv p x) = (MultInv p y)] (mod p)"
- by (auto simp add: MultInv_def zcong_zpower)
-
-lemma MultInv_prop2: "[| 2 < p; zprime p; ~([x = 0](mod p)) |] ==>
- [(x * (MultInv p x)) = 1] (mod p)"
-proof (simp add: MultInv_def zcong_eq_zdvd_prop)
- assume 1: "2 < p" and 2: "zprime p" and 3: "~ p dvd x"
- have "x * x ^ nat (p - 2) = x ^ (nat (p - 2) + 1)"
- by auto
- also from 1 have "nat (p - 2) + 1 = nat (p - 2 + 1)"
- by (simp only: nat_add_distrib)
- also have "p - 2 + 1 = p - 1" by arith
- finally have "[x * x ^ nat (p - 2) = x ^ nat (p - 1)] (mod p)"
- by (rule ssubst, auto)
- also from 2 3 have "[x ^ nat (p - 1) = 1] (mod p)"
- by (auto simp add: Little_Fermat)
- finally (zcong_trans) show "[x * x ^ nat (p - 2) = 1] (mod p)" .
-qed
-
-lemma MultInv_prop2a: "[| 2 < p; zprime p; ~([x = 0](mod p)) |] ==>
- [(MultInv p x) * x = 1] (mod p)"
- by (auto simp add: MultInv_prop2 ac_simps)
-
-lemma aux_1: "2 < p ==> ((nat p) - 2) = (nat (p - 2))"
- by (simp add: nat_diff_distrib)
-
-lemma aux_2: "2 < p ==> 0 < nat (p - 2)"
- by auto
-
-lemma MultInv_prop3: "[| 2 < p; zprime p; ~([x = 0](mod p)) |] ==>
- ~([MultInv p x = 0](mod p))"
- apply (auto simp add: MultInv_def zcong_eq_zdvd_prop aux_1)
- apply (drule aux_2)
- apply (drule zpower_zdvd_prop2, auto)
- done
-
-lemma aux__1: "[| 2 < p; zprime p; ~([x = 0](mod p))|] ==>
- [(MultInv p (MultInv p x)) = (x * (MultInv p x) *
- (MultInv p (MultInv p x)))] (mod p)"
- apply (drule MultInv_prop2, auto)
- apply (drule_tac k = "MultInv p (MultInv p x)" in zcong_scalar, auto)
- apply (auto simp add: zcong_sym)
- done
-
-lemma aux__2: "[| 2 < p; zprime p; ~([x = 0](mod p))|] ==>
- [(x * (MultInv p x) * (MultInv p (MultInv p x))) = x] (mod p)"
- apply (frule MultInv_prop3, auto)
- apply (insert MultInv_prop2 [of p "MultInv p x"], auto)
- apply (drule MultInv_prop2, auto)
- apply (drule_tac k = x in zcong_scalar2, auto)
- apply (auto simp add: ac_simps)
- done
-
-lemma MultInv_prop4: "[| 2 < p; zprime p; ~([x = 0](mod p)) |] ==>
- [(MultInv p (MultInv p x)) = x] (mod p)"
- apply (frule aux__1, auto)
- apply (drule aux__2, auto)
- apply (drule zcong_trans, auto)
- done
-
-lemma MultInv_prop5: "[| 2 < p; zprime p; ~([x = 0](mod p));
- ~([y = 0](mod p)); [(MultInv p x) = (MultInv p y)] (mod p) |] ==>
- [x = y] (mod p)"
- apply (drule_tac a = "MultInv p x" and b = "MultInv p y" and
- m = p and k = x in zcong_scalar)
- apply (insert MultInv_prop2 [of p x], simp)
- apply (auto simp only: zcong_sym [of "MultInv p x * x"])
- apply (auto simp add: ac_simps)
- apply (drule zcong_trans, auto)
- apply (drule_tac a = "x * MultInv p y" and k = y in zcong_scalar, auto)
- apply (insert MultInv_prop2a [of p y], auto simp add: ac_simps)
- apply (insert zcong_zmult_prop2 [of "y * MultInv p y" 1 p y x])
- apply (auto simp add: zcong_sym)
- done
-
-lemma MultInv_zcong_prop1: "[| 2 < p; [j = k] (mod p) |] ==>
- [a * MultInv p j = a * MultInv p k] (mod p)"
- by (drule MultInv_prop1, auto simp add: zcong_scalar2)
-
-lemma aux___1: "[j = a * MultInv p k] (mod p) ==>
- [j * k = a * MultInv p k * k] (mod p)"
- by (auto simp add: zcong_scalar)
-
-lemma aux___2: "[|2 < p; zprime p; ~([k = 0](mod p));
- [j * k = a * MultInv p k * k] (mod p) |] ==> [j * k = a] (mod p)"
- apply (insert MultInv_prop2a [of p k] zcong_zmult_prop2
- [of "MultInv p k * k" 1 p "j * k" a])
- apply (auto simp add: ac_simps)
- done
-
-lemma aux___3: "[j * k = a] (mod p) ==> [(MultInv p j) * j * k =
- (MultInv p j) * a] (mod p)"
- by (auto simp add: mult.assoc zcong_scalar2)
-
-lemma aux___4: "[|2 < p; zprime p; ~([j = 0](mod p));
- [(MultInv p j) * j * k = (MultInv p j) * a] (mod p) |]
- ==> [k = a * (MultInv p j)] (mod p)"
- apply (insert MultInv_prop2a [of p j] zcong_zmult_prop1
- [of "MultInv p j * j" 1 p "MultInv p j * a" k])
- apply (auto simp add: ac_simps zcong_sym)
- done
-
-lemma MultInv_zcong_prop2: "[| 2 < p; zprime p; ~([k = 0](mod p));
- ~([j = 0](mod p)); [j = a * MultInv p k] (mod p) |] ==>
- [k = a * MultInv p j] (mod p)"
- apply (drule aux___1)
- apply (frule aux___2, auto)
- by (drule aux___3, drule aux___4, auto)
-
-lemma MultInv_zcong_prop3: "[| 2 < p; zprime p; ~([a = 0](mod p));
- ~([k = 0](mod p)); ~([j = 0](mod p));
- [a * MultInv p j = a * MultInv p k] (mod p) |] ==>
- [j = k] (mod p)"
- apply (auto simp add: zcong_eq_zdvd_prop [of a p])
- apply (frule zprime_imp_zrelprime, auto)
- apply (insert zcong_cancel2 [of p a "MultInv p j" "MultInv p k"], auto)
- apply (drule MultInv_prop5, auto)
- done
-
-end
--- a/src/HOL/Old_Number_Theory/IntFact.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,90 +0,0 @@
-(* Title: HOL/Old_Number_Theory/IntFact.thy
- Author: Thomas M. Rasmussen
- Copyright 2000 University of Cambridge
-*)
-
-section \<open>Factorial on integers\<close>
-
-theory IntFact
-imports IntPrimes
-begin
-
-text \<open>
- Factorial on integers and recursively defined set including all
- Integers from \<open>2\<close> up to \<open>a\<close>. Plus definition of product
- of finite set.
-
- \bigskip
-\<close>
-
-fun zfact :: "int => int"
- where "zfact n = (if n \<le> 0 then 1 else n * zfact (n - 1))"
-
-fun d22set :: "int => int set"
- where "d22set a = (if 1 < a then insert a (d22set (a - 1)) else {})"
-
-
-text \<open>
- \medskip @{term d22set} --- recursively defined set including all
- integers from \<open>2\<close> up to \<open>a\<close>
-\<close>
-
-declare d22set.simps [simp del]
-
-
-lemma d22set_induct:
- assumes "!!a. P {} a"
- and "!!a. 1 < (a::int) ==> P (d22set (a - 1)) (a - 1) ==> P (d22set a) a"
- shows "P (d22set u) u"
- apply (rule d22set.induct)
- apply (case_tac "1 < a")
- apply (rule_tac assms)
- apply (simp_all (no_asm_simp))
- apply (simp_all (no_asm_simp) add: d22set.simps assms)
- done
-
-lemma d22set_g_1 [rule_format]: "b \<in> d22set a --> 1 < b"
- apply (induct a rule: d22set_induct)
- apply simp
- apply (subst d22set.simps)
- apply auto
- done
-
-lemma d22set_le [rule_format]: "b \<in> d22set a --> b \<le> a"
- apply (induct a rule: d22set_induct)
- apply simp
- apply (subst d22set.simps)
- apply auto
- done
-
-lemma d22set_le_swap: "a < b ==> b \<notin> d22set a"
- by (auto dest: d22set_le)
-
-lemma d22set_mem: "1 < b \<Longrightarrow> b \<le> a \<Longrightarrow> b \<in> d22set a"
- apply (induct a rule: d22set.induct)
- apply auto
- apply (subst d22set.simps)
- apply (case_tac "b < a", auto)
- done
-
-lemma d22set_fin: "finite (d22set a)"
- apply (induct a rule: d22set_induct)
- prefer 2
- apply (subst d22set.simps)
- apply auto
- done
-
-
-declare zfact.simps [simp del]
-
-lemma d22set_prod_zfact: "\<Prod>(d22set a) = zfact a"
- apply (induct a rule: d22set.induct)
- apply (subst d22set.simps)
- apply (subst zfact.simps)
- apply (case_tac "1 < a")
- prefer 2
- apply (simp add: d22set.simps zfact.simps)
- apply (simp add: d22set_fin d22set_le_swap)
- done
-
-end
--- a/src/HOL/Old_Number_Theory/IntPrimes.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,412 +0,0 @@
-(* Title: HOL/Old_Number_Theory/IntPrimes.thy
- Author: Thomas M. Rasmussen
- Copyright 2000 University of Cambridge
-*)
-
-section \<open>Divisibility and prime numbers (on integers)\<close>
-
-theory IntPrimes
-imports Primes
-begin
-
-text \<open>
- The \<open>dvd\<close> relation, GCD, Euclid's extended algorithm, primes,
- congruences (all on the Integers). Comparable to theory \<open>Primes\<close>, but \<open>dvd\<close> is included here as it is not present in
- main HOL. Also includes extended GCD and congruences not present in
- \<open>Primes\<close>.
-\<close>
-
-
-subsection \<open>Definitions\<close>
-
-fun xzgcda :: "int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int => (int * int * int)"
-where
- "xzgcda m n r' r s' s t' t =
- (if r \<le> 0 then (r', s', t')
- else xzgcda m n r (r' mod r)
- s (s' - (r' div r) * s)
- t (t' - (r' div r) * t))"
-
-definition zprime :: "int \<Rightarrow> bool"
- where "zprime p = (1 < p \<and> (\<forall>m. 0 <= m & m dvd p --> m = 1 \<or> m = p))"
-
-definition xzgcd :: "int => int => int * int * int"
- where "xzgcd m n = xzgcda m n m n 1 0 0 1"
-
-definition zcong :: "int => int => int => bool" ("(1[_ = _] '(mod _'))")
- where "[a = b] (mod m) = (m dvd (a - b))"
-
-
-subsection \<open>Euclid's Algorithm and GCD\<close>
-
-
-lemma zrelprime_zdvd_zmult_aux:
- "zgcd n k = 1 ==> k dvd m * n ==> 0 \<le> m ==> k dvd m"
- by (metis abs_of_nonneg dvd_triv_right zgcd_greatest_iff zgcd_zmult_distrib2_abs mult_1_right)
-
-lemma zrelprime_zdvd_zmult: "zgcd n k = 1 ==> k dvd m * n ==> k dvd m"
- apply (case_tac "0 \<le> m")
- apply (blast intro: zrelprime_zdvd_zmult_aux)
- apply (subgoal_tac "k dvd -m")
- apply (rule_tac [2] zrelprime_zdvd_zmult_aux, auto)
- done
-
-lemma zgcd_geq_zero: "0 <= zgcd x y"
- by (auto simp add: zgcd_def)
-
-text\<open>This is merely a sanity check on zprime, since the previous version
- denoted the empty set.\<close>
-lemma "zprime 2"
- apply (auto simp add: zprime_def)
- apply (frule zdvd_imp_le, simp)
- apply (auto simp add: order_le_less dvd_def)
- done
-
-lemma zprime_imp_zrelprime:
- "zprime p ==> \<not> p dvd n ==> zgcd n p = 1"
- apply (auto simp add: zprime_def)
- apply (metis zgcd_geq_zero zgcd_zdvd1 zgcd_zdvd2)
- done
-
-lemma zless_zprime_imp_zrelprime:
- "zprime p ==> 0 < n ==> n < p ==> zgcd n p = 1"
- apply (erule zprime_imp_zrelprime)
- apply (erule zdvd_not_zless, assumption)
- done
-
-lemma zprime_zdvd_zmult:
- "0 \<le> (m::int) ==> zprime p ==> p dvd m * n ==> p dvd m \<or> p dvd n"
- by (metis zgcd_zdvd1 zgcd_zdvd2 zgcd_pos zprime_def zrelprime_dvd_mult)
-
-lemma zgcd_zadd_zmult [simp]: "zgcd (m + n * k) n = zgcd m n"
- apply (rule zgcd_eq [THEN trans])
- apply (simp add: mod_add_eq)
- apply (rule zgcd_eq [symmetric])
- done
-
-lemma zgcd_zdvd_zgcd_zmult: "zgcd m n dvd zgcd (k * m) n"
-by (simp add: zgcd_greatest_iff)
-
-lemma zgcd_zmult_zdvd_zgcd:
- "zgcd k n = 1 ==> zgcd (k * m) n dvd zgcd m n"
- apply (simp add: zgcd_greatest_iff)
- apply (rule_tac n = k in zrelprime_zdvd_zmult)
- prefer 2
- apply (simp add: mult.commute)
- apply (metis zgcd_1 zgcd_commute zgcd_left_commute)
- done
-
-lemma zgcd_zmult_cancel: "zgcd k n = 1 ==> zgcd (k * m) n = zgcd m n"
- by (simp add: zgcd_def nat_abs_mult_distrib gcd_mult_cancel)
-
-lemma zgcd_zgcd_zmult:
- "zgcd k m = 1 ==> zgcd n m = 1 ==> zgcd (k * n) m = 1"
- by (simp add: zgcd_zmult_cancel)
-
-lemma zdvd_iff_zgcd: "0 < m ==> m dvd n \<longleftrightarrow> zgcd n m = m"
- by (metis abs_of_pos dvd_mult_div_cancel zgcd_0 zgcd_commute zgcd_geq_zero zgcd_zdvd2 zgcd_zmult_eq_self)
-
-
-
-subsection \<open>Congruences\<close>
-
-lemma zcong_1 [simp]: "[a = b] (mod 1)"
- by (unfold zcong_def, auto)
-
-lemma zcong_refl [simp]: "[k = k] (mod m)"
- by (unfold zcong_def, auto)
-
-lemma zcong_sym: "[a = b] (mod m) = [b = a] (mod m)"
- unfolding zcong_def minus_diff_eq [of a, symmetric] dvd_minus_iff ..
-
-lemma zcong_zadd:
- "[a = b] (mod m) ==> [c = d] (mod m) ==> [a + c = b + d] (mod m)"
- apply (unfold zcong_def)
- apply (rule_tac s = "(a - b) + (c - d)" in subst)
- apply (rule_tac [2] dvd_add, auto)
- done
-
-lemma zcong_zdiff:
- "[a = b] (mod m) ==> [c = d] (mod m) ==> [a - c = b - d] (mod m)"
- apply (unfold zcong_def)
- apply (rule_tac s = "(a - b) - (c - d)" in subst)
- apply (rule_tac [2] dvd_diff, auto)
- done
-
-lemma zcong_trans:
- "[a = b] (mod m) ==> [b = c] (mod m) ==> [a = c] (mod m)"
-unfolding zcong_def by (auto elim!: dvdE simp add: algebra_simps)
-
-lemma zcong_zmult:
- "[a = b] (mod m) ==> [c = d] (mod m) ==> [a * c = b * d] (mod m)"
- apply (rule_tac b = "b * c" in zcong_trans)
- apply (unfold zcong_def)
- apply (metis right_diff_distrib dvd_mult mult.commute)
- apply (metis right_diff_distrib dvd_mult)
- done
-
-lemma zcong_scalar: "[a = b] (mod m) ==> [a * k = b * k] (mod m)"
- by (rule zcong_zmult, simp_all)
-
-lemma zcong_scalar2: "[a = b] (mod m) ==> [k * a = k * b] (mod m)"
- by (rule zcong_zmult, simp_all)
-
-lemma zcong_zmult_self: "[a * m = b * m] (mod m)"
- apply (unfold zcong_def)
- apply (rule dvd_diff, simp_all)
- done
-
-lemma zcong_square:
- "[| zprime p; 0 < a; [a * a = 1] (mod p)|]
- ==> [a = 1] (mod p) \<or> [a = p - 1] (mod p)"
- apply (unfold zcong_def)
- apply (rule zprime_zdvd_zmult)
- apply (rule_tac [3] s = "a * a - 1 + p * (1 - a)" in subst)
- prefer 4
- apply (simp add: zdvd_reduce)
- apply (simp_all add: left_diff_distrib mult.commute right_diff_distrib)
- done
-
-lemma zcong_cancel:
- "0 \<le> m ==>
- zgcd k m = 1 ==> [a * k = b * k] (mod m) = [a = b] (mod m)"
- apply safe
- prefer 2
- apply (blast intro: zcong_scalar)
- apply (case_tac "b < a")
- prefer 2
- apply (subst zcong_sym)
- apply (unfold zcong_def)
- apply (rule_tac [!] zrelprime_zdvd_zmult)
- apply (simp_all add: left_diff_distrib)
- apply (subgoal_tac "m dvd (-(a * k - b * k))")
- apply simp
- apply (subst dvd_minus_iff, assumption)
- done
-
-lemma zcong_cancel2:
- "0 \<le> m ==>
- zgcd k m = 1 ==> [k * a = k * b] (mod m) = [a = b] (mod m)"
- by (simp add: mult.commute zcong_cancel)
-
-lemma zcong_zgcd_zmult_zmod:
- "[a = b] (mod m) ==> [a = b] (mod n) ==> zgcd m n = 1
- ==> [a = b] (mod m * n)"
- apply (auto simp add: zcong_def dvd_def)
- apply (subgoal_tac "m dvd n * ka")
- apply (subgoal_tac "m dvd ka")
- apply (case_tac [2] "0 \<le> ka")
- apply (metis dvd_mult_div_cancel dvd_refl dvd_mult_left mult.commute zrelprime_zdvd_zmult)
- apply (metis abs_dvd_iff abs_of_nonneg add_0 zgcd_0_left zgcd_commute zgcd_zadd_zmult zgcd_zdvd_zgcd_zmult zgcd_zmult_distrib2_abs mult_1_right mult.commute)
- apply (metis mult_le_0_iff zdvd_mono zdvd_mult_cancel dvd_triv_left zero_le_mult_iff order_antisym linorder_linear order_refl mult.commute zrelprime_zdvd_zmult)
- apply (metis dvd_triv_left)
- done
-
-lemma zcong_zless_imp_eq:
- "0 \<le> a ==>
- a < m ==> 0 \<le> b ==> b < m ==> [a = b] (mod m) ==> a = b"
- apply (unfold zcong_def dvd_def, auto)
- apply (drule_tac f = "\<lambda>z. z mod m" in arg_cong)
- apply (metis diff_add_cancel mod_pos_pos_trivial add_0 add.commute zmod_eq_0_iff mod_add_right_eq)
- done
-
-lemma zcong_square_zless:
- "zprime p ==> 0 < a ==> a < p ==>
- [a * a = 1] (mod p) ==> a = 1 \<or> a = p - 1"
- apply (cut_tac p = p and a = a in zcong_square)
- apply (simp add: zprime_def)
- apply (auto intro: zcong_zless_imp_eq)
- done
-
-lemma zcong_not:
- "0 < a ==> a < m ==> 0 < b ==> b < a ==> \<not> [a = b] (mod m)"
- apply (unfold zcong_def)
- apply (rule zdvd_not_zless, auto)
- done
-
-lemma zcong_zless_0:
- "0 \<le> a ==> a < m ==> [a = 0] (mod m) ==> a = 0"
- apply (unfold zcong_def dvd_def, auto)
- apply (metis div_pos_pos_trivial linorder_not_less nonzero_mult_div_cancel_left)
- done
-
-lemma zcong_zless_unique:
- "0 < m ==> (\<exists>!b. 0 \<le> b \<and> b < m \<and> [a = b] (mod m))"
- apply auto
- prefer 2 apply (metis zcong_sym zcong_trans zcong_zless_imp_eq)
- apply (unfold zcong_def dvd_def)
- apply (rule_tac x = "a mod m" in exI, auto)
- apply (metis minus_mod_eq_mult_div [symmetric])
- done
-
-lemma zcong_iff_lin: "([a = b] (mod m)) = (\<exists>k. b = a + m * k)"
- unfolding zcong_def
- apply (auto elim!: dvdE simp add: algebra_simps)
- apply (rule_tac x = "-k" in exI) apply simp
- done
-
-lemma zgcd_zcong_zgcd:
- "0 < m ==>
- zgcd a m = 1 ==> [a = b] (mod m) ==> zgcd b m = 1"
- by (auto simp add: zcong_iff_lin)
-
-lemma zcong_zmod_aux:
- "a - b = (m::int) * (a div m - b div m) + (a mod m - b mod m)"
- by(simp add: right_diff_distrib add_diff_eq eq_diff_eq ac_simps)
-
-lemma zcong_zmod: "[a = b] (mod m) = [a mod m = b mod m] (mod m)"
- apply (unfold zcong_def)
- apply (rule_tac t = "a - b" in ssubst)
- apply (rule_tac m = m in zcong_zmod_aux)
- apply (rule trans)
- apply (rule_tac [2] k = m and m = "a div m - b div m" in zdvd_reduce)
- apply (simp add: add.commute)
- done
-
-lemma zcong_zmod_eq: "0 < m ==> [a = b] (mod m) = (a mod m = b mod m)"
- apply auto
- apply (metis pos_mod_conj zcong_zless_imp_eq zcong_zmod)
- apply (metis zcong_refl zcong_zmod)
- done
-
-lemma zcong_zminus [iff]: "[a = b] (mod -m) = [a = b] (mod m)"
- by (auto simp add: zcong_def)
-
-lemma zcong_zero [iff]: "[a = b] (mod 0) = (a = b)"
- by (auto simp add: zcong_def)
-
-lemma "[a = b] (mod m) = (a mod m = b mod m)"
- apply (cases "m = 0", simp)
- apply (simp add: linorder_neq_iff)
- apply (erule disjE)
- prefer 2 apply (simp add: zcong_zmod_eq)
- txt\<open>Remainding case: @{term "m<0"}\<close>
- apply (rule_tac t = m in minus_minus [THEN subst])
- apply (subst zcong_zminus)
- apply (subst zcong_zmod_eq, arith)
- apply (frule neg_mod_bound [of _ a], frule neg_mod_bound [of _ b])
- apply (simp add: zmod_zminus2_eq_if del: neg_mod_bound)
- done
-
-subsection \<open>Modulo\<close>
-
-lemma zmod_zdvd_zmod:
- "0 < (m::int) ==> m dvd b ==> (a mod b mod m) = (a mod m)"
- by (rule mod_mod_cancel)
-
-
-subsection \<open>Extended GCD\<close>
-
-declare xzgcda.simps [simp del]
-
-lemma xzgcd_correct_aux1:
- "zgcd r' r = k --> 0 < r -->
- (\<exists>sn tn. xzgcda m n r' r s' s t' t = (k, sn, tn))"
- apply (induct m n r' r s' s t' t rule: xzgcda.induct)
- apply (subst zgcd_eq)
- apply (subst xzgcda.simps, auto)
- apply (case_tac "r' mod r = 0")
- prefer 2
- apply (frule_tac a = "r'" in pos_mod_sign, auto)
- apply (rule exI)
- apply (rule exI)
- apply (subst xzgcda.simps, auto)
- done
-
-lemma xzgcd_correct_aux2:
- "(\<exists>sn tn. xzgcda m n r' r s' s t' t = (k, sn, tn)) --> 0 < r -->
- zgcd r' r = k"
- apply (induct m n r' r s' s t' t rule: xzgcda.induct)
- apply (subst zgcd_eq)
- apply (subst xzgcda.simps)
- apply (auto simp add: linorder_not_le)
- apply (case_tac "r' mod r = 0")
- prefer 2
- apply (frule_tac a = "r'" in pos_mod_sign, auto)
- apply (metis prod.inject xzgcda.simps order_refl)
- done
-
-lemma xzgcd_correct:
- "0 < n ==> (zgcd m n = k) = (\<exists>s t. xzgcd m n = (k, s, t))"
- apply (unfold xzgcd_def)
- apply (rule iffI)
- apply (rule_tac [2] xzgcd_correct_aux2 [THEN mp, THEN mp])
- apply (rule xzgcd_correct_aux1 [THEN mp, THEN mp], auto)
- done
-
-
-text \<open>\medskip @{term xzgcd} linear\<close>
-
-lemma xzgcda_linear_aux1:
- "(a - r * b) * m + (c - r * d) * (n::int) =
- (a * m + c * n) - r * (b * m + d * n)"
- by (simp add: left_diff_distrib distrib_left mult.assoc)
-
-lemma xzgcda_linear_aux2:
- "r' = s' * m + t' * n ==> r = s * m + t * n
- ==> (r' mod r) = (s' - (r' div r) * s) * m + (t' - (r' div r) * t) * (n::int)"
- apply (rule trans)
- apply (rule_tac [2] xzgcda_linear_aux1 [symmetric])
- apply (simp add: eq_diff_eq mult.commute)
- done
-
-lemma order_le_neq_implies_less: "(x::'a::order) \<le> y ==> x \<noteq> y ==> x < y"
- by (rule iffD2 [OF order_less_le conjI])
-
-lemma xzgcda_linear [rule_format]:
- "0 < r --> xzgcda m n r' r s' s t' t = (rn, sn, tn) -->
- r' = s' * m + t' * n --> r = s * m + t * n --> rn = sn * m + tn * n"
- apply (induct m n r' r s' s t' t rule: xzgcda.induct)
- apply (subst xzgcda.simps)
- apply (simp (no_asm))
- apply (rule impI)+
- apply (case_tac "r' mod r = 0")
- apply (simp add: xzgcda.simps, clarify)
- apply (subgoal_tac "0 < r' mod r")
- apply (rule_tac [2] order_le_neq_implies_less)
- apply (rule_tac [2] pos_mod_sign)
- apply (cut_tac m = m and n = n and r' = r' and r = r and s' = s' and
- s = s and t' = t' and t = t in xzgcda_linear_aux2, auto)
- done
-
-lemma xzgcd_linear:
- "0 < n ==> xzgcd m n = (r, s, t) ==> r = s * m + t * n"
- apply (unfold xzgcd_def)
- apply (erule xzgcda_linear, assumption, auto)
- done
-
-lemma zgcd_ex_linear:
- "0 < n ==> zgcd m n = k ==> (\<exists>s t. k = s * m + t * n)"
- apply (simp add: xzgcd_correct, safe)
- apply (rule exI)+
- apply (erule xzgcd_linear, auto)
- done
-
-lemma zcong_lineq_ex:
- "0 < n ==> zgcd a n = 1 ==> \<exists>x. [a * x = 1] (mod n)"
- apply (cut_tac m = a and n = n and k = 1 in zgcd_ex_linear, safe)
- apply (rule_tac x = s in exI)
- apply (rule_tac b = "s * a + t * n" in zcong_trans)
- prefer 2
- apply simp
- apply (unfold zcong_def)
- apply (simp (no_asm) add: mult.commute)
- done
-
-lemma zcong_lineq_unique:
- "0 < n ==>
- zgcd a n = 1 ==> \<exists>!x. 0 \<le> x \<and> x < n \<and> [a * x = b] (mod n)"
- apply auto
- apply (rule_tac [2] zcong_zless_imp_eq)
- apply (tactic \<open>stac @{context} (@{thm zcong_cancel2} RS sym) 6\<close>)
- apply (rule_tac [8] zcong_trans)
- apply (simp_all (no_asm_simp))
- prefer 2
- apply (simp add: zcong_sym)
- apply (cut_tac a = a and n = n in zcong_lineq_ex, auto)
- apply (rule_tac x = "x * b mod n" in exI, safe)
- apply (simp_all (no_asm_simp))
- apply (metis zcong_scalar zcong_zmod mod_mult_right_eq mult_1 mult.assoc)
- done
-
-end
--- a/src/HOL/Old_Number_Theory/Legacy_GCD.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,791 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Legacy_GCD.thy
- Author: Christophe Tabacznyj and Lawrence C Paulson
- Copyright 1996 University of Cambridge
-*)
-
-section \<open>The Greatest Common Divisor\<close>
-
-theory Legacy_GCD
-imports Main
-begin
-
-text \<open>
- See @{cite davenport92}. \bigskip
-\<close>
-
-subsection \<open>Specification of GCD on nats\<close>
-
-definition
- is_gcd :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where \<comment> \<open>@{term gcd} as a relation\<close>
- "is_gcd m n p \<longleftrightarrow> p dvd m \<and> p dvd n \<and>
- (\<forall>d. d dvd m \<longrightarrow> d dvd n \<longrightarrow> d dvd p)"
-
-text \<open>Uniqueness\<close>
-
-lemma is_gcd_unique: "is_gcd a b m \<Longrightarrow> is_gcd a b n \<Longrightarrow> m = n"
- by (simp add: is_gcd_def) (blast intro: dvd_antisym)
-
-text \<open>Connection to divides relation\<close>
-
-lemma is_gcd_dvd: "is_gcd a b m \<Longrightarrow> k dvd a \<Longrightarrow> k dvd b \<Longrightarrow> k dvd m"
- by (auto simp add: is_gcd_def)
-
-text \<open>Commutativity\<close>
-
-lemma is_gcd_commute: "is_gcd m n k = is_gcd n m k"
- by (auto simp add: is_gcd_def)
-
-
-subsection \<open>GCD on nat by Euclid's algorithm\<close>
-
-fun gcd :: "nat => nat => nat"
- where "gcd m n = (if n = 0 then m else gcd n (m mod n))"
-
-lemma gcd_induct [case_names "0" rec]:
- fixes m n :: nat
- assumes "\<And>m. P m 0"
- and "\<And>m n. 0 < n \<Longrightarrow> P n (m mod n) \<Longrightarrow> P m n"
- shows "P m n"
-proof (induct m n rule: gcd.induct)
- case (1 m n)
- with assms show ?case by (cases "n = 0") simp_all
-qed
-
-lemma gcd_0 [simp, algebra]: "gcd m 0 = m"
- by simp
-
-lemma gcd_0_left [simp,algebra]: "gcd 0 m = m"
- by simp
-
-lemma gcd_non_0: "n > 0 \<Longrightarrow> gcd m n = gcd n (m mod n)"
- by simp
-
-lemma gcd_1 [simp, algebra]: "gcd m (Suc 0) = Suc 0"
- by simp
-
-lemma nat_gcd_1_right [simp, algebra]: "gcd m 1 = 1"
- unfolding One_nat_def by (rule gcd_1)
-
-declare gcd.simps [simp del]
-
-text \<open>
- \medskip @{term "gcd m n"} divides \<open>m\<close> and \<open>n\<close>. The
- conjunctions don't seem provable separately.
-\<close>
-
-lemma gcd_dvd1 [iff, algebra]: "gcd m n dvd m"
- and gcd_dvd2 [iff, algebra]: "gcd m n dvd n"
- apply (induct m n rule: gcd_induct)
- apply (simp_all add: gcd_non_0)
- apply (blast dest: dvd_mod_imp_dvd)
- done
-
-text \<open>
- \medskip Maximality: for all @{term m}, @{term n}, @{term k}
- naturals, if @{term k} divides @{term m} and @{term k} divides
- @{term n} then @{term k} divides @{term "gcd m n"}.
-\<close>
-
-lemma gcd_greatest: "k dvd m \<Longrightarrow> k dvd n \<Longrightarrow> k dvd gcd m n"
- by (induct m n rule: gcd_induct) (simp_all add: gcd_non_0 dvd_mod)
-
-text \<open>
- \medskip Function gcd yields the Greatest Common Divisor.
-\<close>
-
-lemma is_gcd: "is_gcd m n (gcd m n) "
- by (simp add: is_gcd_def gcd_greatest)
-
-
-subsection \<open>Derived laws for GCD\<close>
-
-lemma gcd_greatest_iff [iff, algebra]: "k dvd gcd m n \<longleftrightarrow> k dvd m \<and> k dvd n"
- by (blast intro!: gcd_greatest intro: dvd_trans)
-
-lemma gcd_zero[algebra]: "gcd m n = 0 \<longleftrightarrow> m = 0 \<and> n = 0"
- by (simp only: dvd_0_left_iff [symmetric] gcd_greatest_iff)
-
-lemma gcd_commute: "gcd m n = gcd n m"
- apply (rule is_gcd_unique)
- apply (rule is_gcd)
- apply (subst is_gcd_commute)
- apply (simp add: is_gcd)
- done
-
-lemma gcd_assoc: "gcd (gcd k m) n = gcd k (gcd m n)"
- apply (rule is_gcd_unique)
- apply (rule is_gcd)
- apply (simp add: is_gcd_def)
- apply (blast intro: dvd_trans)
- done
-
-lemma gcd_1_left [simp, algebra]: "gcd (Suc 0) m = Suc 0"
- by (simp add: gcd_commute)
-
-lemma nat_gcd_1_left [simp, algebra]: "gcd 1 m = 1"
- unfolding One_nat_def by (rule gcd_1_left)
-
-text \<open>
- \medskip Multiplication laws
-\<close>
-
-lemma gcd_mult_distrib2: "k * gcd m n = gcd (k * m) (k * n)"
- \<comment> \<open>@{cite \<open>page 27\<close> davenport92}\<close>
- apply (induct m n rule: gcd_induct)
- apply simp
- apply (case_tac "k = 0")
- apply (simp_all add: gcd_non_0)
- done
-
-lemma gcd_mult [simp, algebra]: "gcd k (k * n) = k"
- apply (rule gcd_mult_distrib2 [of k 1 n, simplified, symmetric])
- done
-
-lemma gcd_self [simp, algebra]: "gcd k k = k"
- apply (rule gcd_mult [of k 1, simplified])
- done
-
-lemma relprime_dvd_mult: "gcd k n = 1 ==> k dvd m * n ==> k dvd m"
- apply (insert gcd_mult_distrib2 [of m k n])
- apply simp
- apply (erule_tac t = m in ssubst)
- apply simp
- done
-
-lemma relprime_dvd_mult_iff: "gcd k n = 1 ==> (k dvd m * n) = (k dvd m)"
- by (auto intro: relprime_dvd_mult dvd_mult2)
-
-lemma gcd_mult_cancel: "gcd k n = 1 ==> gcd (k * m) n = gcd m n"
- apply (rule dvd_antisym)
- apply (rule gcd_greatest)
- apply (rule_tac n = k in relprime_dvd_mult)
- apply (simp add: gcd_assoc)
- apply (simp add: gcd_commute)
- apply (simp_all add: mult.commute)
- done
-
-
-text \<open>\medskip Addition laws\<close>
-
-lemma gcd_add1 [simp, algebra]: "gcd (m + n) n = gcd m n"
- by (cases "n = 0") (auto simp add: gcd_non_0)
-
-lemma gcd_add2 [simp, algebra]: "gcd m (m + n) = gcd m n"
-proof -
- have "gcd m (m + n) = gcd (m + n) m" by (rule gcd_commute)
- also have "... = gcd (n + m) m" by (simp add: add.commute)
- also have "... = gcd n m" by simp
- also have "... = gcd m n" by (rule gcd_commute)
- finally show ?thesis .
-qed
-
-lemma gcd_add2' [simp, algebra]: "gcd m (n + m) = gcd m n"
- apply (subst add.commute)
- apply (rule gcd_add2)
- done
-
-lemma gcd_add_mult[algebra]: "gcd m (k * m + n) = gcd m n"
- by (induct k) (simp_all add: add.assoc)
-
-lemma gcd_dvd_prod: "gcd m n dvd m * n"
- using mult_dvd_mono [of 1] by auto
-
-text \<open>
- \medskip Division by gcd yields rrelatively primes.
-\<close>
-
-lemma div_gcd_relprime:
- assumes nz: "a \<noteq> 0 \<or> b \<noteq> 0"
- shows "gcd (a div gcd a b) (b div gcd a b) = 1"
-proof -
- let ?g = "gcd a b"
- let ?a' = "a div ?g"
- let ?b' = "b div ?g"
- let ?g' = "gcd ?a' ?b'"
- have dvdg: "?g dvd a" "?g dvd b" by simp_all
- have dvdg': "?g' dvd ?a'" "?g' dvd ?b'" by simp_all
- from dvdg dvdg' obtain ka kb ka' kb' where
- kab: "a = ?g * ka" "b = ?g * kb" "?a' = ?g' * ka'" "?b' = ?g' * kb'"
- unfolding dvd_def by blast
- from this(3-4) [symmetric] have "?g * ?a' = (?g * ?g') * ka'" "?g * ?b' = (?g * ?g') * kb'"
- by (simp_all only: ac_simps mult.left_commute [of _ "gcd a b"])
- then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b"
- by (auto simp add: dvd_mult_div_cancel [OF dvdg(1)]
- dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
- have "?g \<noteq> 0" using nz by (simp add: gcd_zero)
- then have gp: "?g > 0" by simp
- from gcd_greatest [OF dvdgg'] have "?g * ?g' dvd ?g" .
- with dvd_mult_cancel1 [OF gp] show "?g' = 1" by simp
-qed
-
-
-lemma gcd_unique: "d dvd a\<and>d dvd b \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
-proof(auto)
- assume H: "d dvd a" "d dvd b" "\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d"
- from H(3)[rule_format] gcd_dvd1[of a b] gcd_dvd2[of a b]
- have th: "gcd a b dvd d" by blast
- from dvd_antisym[OF th gcd_greatest[OF H(1,2)]] show "d = gcd a b" by blast
-qed
-
-lemma gcd_eq: assumes H: "\<forall>d. d dvd x \<and> d dvd y \<longleftrightarrow> d dvd u \<and> d dvd v"
- shows "gcd x y = gcd u v"
-proof-
- from H have "\<forall>d. d dvd x \<and> d dvd y \<longleftrightarrow> d dvd gcd u v" by simp
- with gcd_unique[of "gcd u v" x y] show ?thesis by auto
-qed
-
-lemma ind_euclid:
- assumes c: " \<forall>a b. P (a::nat) b \<longleftrightarrow> P b a" and z: "\<forall>a. P a 0"
- and add: "\<forall>a b. P a b \<longrightarrow> P a (a + b)"
- shows "P a b"
-proof(induct "a + b" arbitrary: a b rule: less_induct)
- case less
- have "a = b \<or> a < b \<or> b < a" by arith
- moreover {assume eq: "a= b"
- from add[rule_format, OF z[rule_format, of a]] have "P a b" using eq
- by simp}
- moreover
- {assume lt: "a < b"
- hence "a + b - a < a + b \<or> a = 0" by arith
- moreover
- {assume "a =0" with z c have "P a b" by blast }
- moreover
- {assume "a + b - a < a + b"
- also have th0: "a + b - a = a + (b - a)" using lt by arith
- finally have "a + (b - a) < a + b" .
- then have "P a (a + (b - a))" by (rule add[rule_format, OF less])
- then have "P a b" by (simp add: th0[symmetric])}
- ultimately have "P a b" by blast}
- moreover
- {assume lt: "a > b"
- hence "b + a - b < a + b \<or> b = 0" by arith
- moreover
- {assume "b =0" with z c have "P a b" by blast }
- moreover
- {assume "b + a - b < a + b"
- also have th0: "b + a - b = b + (a - b)" using lt by arith
- finally have "b + (a - b) < a + b" .
- then have "P b (b + (a - b))" by (rule add[rule_format, OF less])
- then have "P b a" by (simp add: th0[symmetric])
- hence "P a b" using c by blast }
- ultimately have "P a b" by blast}
-ultimately show "P a b" by blast
-qed
-
-lemma bezout_lemma:
- assumes ex: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x = b * y + d \<or> b * x = a * y + d)"
- shows "\<exists>d x y. d dvd a \<and> d dvd a + b \<and> (a * x = (a + b) * y + d \<or> (a + b) * x = a * y + d)"
-using ex
-apply clarsimp
-apply (rule_tac x="d" in exI, simp)
-apply (case_tac "a * x = b * y + d" , simp_all)
-apply (rule_tac x="x + y" in exI)
-apply (rule_tac x="y" in exI)
-apply algebra
-apply (rule_tac x="x" in exI)
-apply (rule_tac x="x + y" in exI)
-apply algebra
-done
-
-lemma bezout_add: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x = b * y + d \<or> b * x = a * y + d)"
-apply(induct a b rule: ind_euclid)
-apply blast
-apply clarify
-apply (rule_tac x="a" in exI, simp)
-apply clarsimp
-apply (rule_tac x="d" in exI)
-apply (case_tac "a * x = b * y + d", simp_all)
-apply (rule_tac x="x+y" in exI)
-apply (rule_tac x="y" in exI)
-apply algebra
-apply (rule_tac x="x" in exI)
-apply (rule_tac x="x+y" in exI)
-apply algebra
-done
-
-lemma bezout: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x - b * y = d \<or> b * x - a * y = d)"
-using bezout_add[of a b]
-apply clarsimp
-apply (rule_tac x="d" in exI, simp)
-apply (rule_tac x="x" in exI)
-apply (rule_tac x="y" in exI)
-apply auto
-done
-
-
-text \<open>We can get a stronger version with a nonzeroness assumption.\<close>
-lemma divides_le: "m dvd n ==> m <= n \<or> n = (0::nat)" by (auto simp add: dvd_def)
-
-lemma bezout_add_strong: assumes nz: "a \<noteq> (0::nat)"
- shows "\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d"
-proof-
- from nz have ap: "a > 0" by simp
- from bezout_add[of a b]
- have "(\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d) \<or> (\<exists>d x y. d dvd a \<and> d dvd b \<and> b * x = a * y + d)" by blast
- moreover
- {fix d x y assume H: "d dvd a" "d dvd b" "a * x = b * y + d"
- from H have ?thesis by blast }
- moreover
- {fix d x y assume H: "d dvd a" "d dvd b" "b * x = a * y + d"
- {assume b0: "b = 0" with H have ?thesis by simp}
- moreover
- {assume b: "b \<noteq> 0" hence bp: "b > 0" by simp
- from divides_le[OF H(2)] b have "d < b \<or> d = b" using le_less by blast
- moreover
- {assume db: "d=b"
- from nz H db have ?thesis apply simp
- apply (rule exI[where x = b], simp)
- apply (rule exI[where x = b])
- by (rule exI[where x = "a - 1"], simp add: diff_mult_distrib2)}
- moreover
- {assume db: "d < b"
- {assume "x=0" hence ?thesis using nz H by simp }
- moreover
- {assume x0: "x \<noteq> 0" hence xp: "x > 0" by simp
-
- from db have "d \<le> b - 1" by simp
- hence "d*b \<le> b*(b - 1)" by simp
- with xp mult_mono[of "1" "x" "d*b" "b*(b - 1)"]
- have dble: "d*b \<le> x*b*(b - 1)" using bp by simp
- from H (3) have "a * ((b - 1) * y) + d * (b - 1 + 1) = d + x*b*(b - 1)" by algebra
- hence "a * ((b - 1) * y) = d + x*b*(b - 1) - d*b" using bp by simp
- hence "a * ((b - 1) * y) = d + (x*b*(b - 1) - d*b)"
- by (simp only: diff_add_assoc[OF dble, of d, symmetric])
- hence "a * ((b - 1) * y) = b*(x*(b - 1) - d) + d"
- by (simp only: diff_mult_distrib2 ac_simps)
- hence ?thesis using H(1,2)
- apply -
- apply (rule exI[where x=d], simp)
- apply (rule exI[where x="(b - 1) * y"])
- by (rule exI[where x="x*(b - 1) - d"], simp)}
- ultimately have ?thesis by blast}
- ultimately have ?thesis by blast}
- ultimately have ?thesis by blast}
- ultimately show ?thesis by blast
-qed
-
-
-lemma bezout_gcd: "\<exists>x y. a * x - b * y = gcd a b \<or> b * x - a * y = gcd a b"
-proof-
- let ?g = "gcd a b"
- from bezout[of a b] obtain d x y where d: "d dvd a" "d dvd b" "a * x - b * y = d \<or> b * x - a * y = d" by blast
- from d(1,2) have "d dvd ?g" by simp
- then obtain k where k: "?g = d*k" unfolding dvd_def by blast
- from d(3) have "(a * x - b * y)*k = d*k \<or> (b * x - a * y)*k = d*k" by blast
- hence "a * x * k - b * y*k = d*k \<or> b * x * k - a * y*k = d*k"
- by (algebra add: diff_mult_distrib)
- hence "a * (x * k) - b * (y*k) = ?g \<or> b * (x * k) - a * (y*k) = ?g"
- by (simp add: k mult.assoc)
- thus ?thesis by blast
-qed
-
-lemma bezout_gcd_strong: assumes a: "a \<noteq> 0"
- shows "\<exists>x y. a * x = b * y + gcd a b"
-proof-
- let ?g = "gcd a b"
- from bezout_add_strong[OF a, of b]
- obtain d x y where d: "d dvd a" "d dvd b" "a * x = b * y + d" by blast
- from d(1,2) have "d dvd ?g" by simp
- then obtain k where k: "?g = d*k" unfolding dvd_def by blast
- from d(3) have "a * x * k = (b * y + d) *k " by algebra
- hence "a * (x * k) = b * (y*k) + ?g" by (algebra add: k)
- thus ?thesis by blast
-qed
-
-lemma gcd_mult_distrib: "gcd(a * c) (b * c) = c * gcd a b"
-by(simp add: gcd_mult_distrib2 mult.commute)
-
-lemma gcd_bezout: "(\<exists>x y. a * x - b * y = d \<or> b * x - a * y = d) \<longleftrightarrow> gcd a b dvd d"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- let ?g = "gcd a b"
- {assume H: ?rhs then obtain k where k: "d = ?g*k" unfolding dvd_def by blast
- from bezout_gcd[of a b] obtain x y where xy: "a * x - b * y = ?g \<or> b * x - a * y = ?g"
- by blast
- hence "(a * x - b * y)*k = ?g*k \<or> (b * x - a * y)*k = ?g*k" by auto
- hence "a * x*k - b * y*k = ?g*k \<or> b * x * k - a * y*k = ?g*k"
- by (simp only: diff_mult_distrib)
- hence "a * (x*k) - b * (y*k) = d \<or> b * (x * k) - a * (y*k) = d"
- by (simp add: k[symmetric] mult.assoc)
- hence ?lhs by blast}
- moreover
- {fix x y assume H: "a * x - b * y = d \<or> b * x - a * y = d"
- have dv: "?g dvd a*x" "?g dvd b * y" "?g dvd b*x" "?g dvd a * y"
- using dvd_mult2[OF gcd_dvd1[of a b]] dvd_mult2[OF gcd_dvd2[of a b]] by simp_all
- from dvd_diff_nat[OF dv(1,2)] dvd_diff_nat[OF dv(3,4)] H
- have ?rhs by auto}
- ultimately show ?thesis by blast
-qed
-
-lemma gcd_bezout_sum: assumes H:"a * x + b * y = d" shows "gcd a b dvd d"
-proof-
- let ?g = "gcd a b"
- have dv: "?g dvd a*x" "?g dvd b * y"
- using dvd_mult2[OF gcd_dvd1[of a b]] dvd_mult2[OF gcd_dvd2[of a b]] by simp_all
- from dvd_add[OF dv] H
- show ?thesis by auto
-qed
-
-lemma gcd_mult': "gcd b (a * b) = b"
-by (simp add: mult.commute[of a b])
-
-lemma gcd_add: "gcd(a + b) b = gcd a b"
- "gcd(b + a) b = gcd a b" "gcd a (a + b) = gcd a b" "gcd a (b + a) = gcd a b"
-by (simp_all add: gcd_commute)
-
-lemma gcd_sub: "b <= a ==> gcd(a - b) b = gcd a b" "a <= b ==> gcd a (b - a) = gcd a b"
-proof-
- {fix a b assume H: "b \<le> (a::nat)"
- hence th: "a - b + b = a" by arith
- from gcd_add(1)[of "a - b" b] th have "gcd(a - b) b = gcd a b" by simp}
- note th = this
-{
- assume ab: "b \<le> a"
- from th[OF ab] show "gcd (a - b) b = gcd a b" by blast
-next
- assume ab: "a \<le> b"
- from th[OF ab] show "gcd a (b - a) = gcd a b"
- by (simp add: gcd_commute)}
-qed
-
-
-subsection \<open>LCM defined by GCD\<close>
-
-
-definition
- lcm :: "nat \<Rightarrow> nat \<Rightarrow> nat"
-where
- lcm_def: "lcm m n = m * n div gcd m n"
-
-lemma prod_gcd_lcm:
- "m * n = gcd m n * lcm m n"
- unfolding lcm_def by (simp add: dvd_mult_div_cancel [OF gcd_dvd_prod])
-
-lemma lcm_0 [simp]: "lcm m 0 = 0"
- unfolding lcm_def by simp
-
-lemma lcm_1 [simp]: "lcm m 1 = m"
- unfolding lcm_def by simp
-
-lemma lcm_0_left [simp]: "lcm 0 n = 0"
- unfolding lcm_def by simp
-
-lemma lcm_1_left [simp]: "lcm 1 m = m"
- unfolding lcm_def by simp
-
-lemma dvd_pos:
- fixes n m :: nat
- assumes "n > 0" and "m dvd n"
- shows "m > 0"
-using assms by (cases m) auto
-
-lemma lcm_least:
- assumes "m dvd k" and "n dvd k"
- shows "lcm m n dvd k"
-proof (cases k)
- case 0 then show ?thesis by auto
-next
- case (Suc _) then have pos_k: "k > 0" by auto
- from assms dvd_pos [OF this] have pos_mn: "m > 0" "n > 0" by auto
- with gcd_zero [of m n] have pos_gcd: "gcd m n > 0" by simp
- from assms obtain p where k_m: "k = m * p" using dvd_def by blast
- from assms obtain q where k_n: "k = n * q" using dvd_def by blast
- from pos_k k_m have pos_p: "p > 0" by auto
- from pos_k k_n have pos_q: "q > 0" by auto
- have "k * k * gcd q p = k * gcd (k * q) (k * p)"
- by (simp add: ac_simps gcd_mult_distrib2)
- also have "\<dots> = k * gcd (m * p * q) (n * q * p)"
- by (simp add: k_m [symmetric] k_n [symmetric])
- also have "\<dots> = k * p * q * gcd m n"
- by (simp add: ac_simps gcd_mult_distrib2)
- finally have "(m * p) * (n * q) * gcd q p = k * p * q * gcd m n"
- by (simp only: k_m [symmetric] k_n [symmetric])
- then have "p * q * m * n * gcd q p = p * q * k * gcd m n"
- by (simp add: ac_simps)
- with pos_p pos_q have "m * n * gcd q p = k * gcd m n"
- by simp
- with prod_gcd_lcm [of m n]
- have "lcm m n * gcd q p * gcd m n = k * gcd m n"
- by (simp add: ac_simps)
- with pos_gcd have "lcm m n * gcd q p = k" by simp
- then show ?thesis using dvd_def by auto
-qed
-
-lemma lcm_dvd1 [iff]:
- "m dvd lcm m n"
-proof (cases m)
- case 0 then show ?thesis by simp
-next
- case (Suc _)
- then have mpos: "m > 0" by simp
- show ?thesis
- proof (cases n)
- case 0 then show ?thesis by simp
- next
- case (Suc _)
- then have npos: "n > 0" by simp
- have "gcd m n dvd n" by simp
- then obtain k where "n = gcd m n * k" using dvd_def by auto
- then have "m * n div gcd m n = m * (gcd m n * k) div gcd m n" by (simp add: ac_simps)
- also have "\<dots> = m * k" using mpos npos gcd_zero by simp
- finally show ?thesis by (simp add: lcm_def)
- qed
-qed
-
-lemma lcm_dvd2 [iff]:
- "n dvd lcm m n"
-proof (cases n)
- case 0 then show ?thesis by simp
-next
- case (Suc _)
- then have npos: "n > 0" by simp
- show ?thesis
- proof (cases m)
- case 0 then show ?thesis by simp
- next
- case (Suc _)
- then have mpos: "m > 0" by simp
- have "gcd m n dvd m" by simp
- then obtain k where "m = gcd m n * k" using dvd_def by auto
- then have "m * n div gcd m n = (gcd m n * k) * n div gcd m n" by (simp add: ac_simps)
- also have "\<dots> = n * k" using mpos npos gcd_zero by simp
- finally show ?thesis by (simp add: lcm_def)
- qed
-qed
-
-lemma gcd_add1_eq: "gcd (m + k) k = gcd (m + k) m"
- by (simp add: gcd_commute)
-
-lemma gcd_diff2: "m \<le> n ==> gcd n (n - m) = gcd n m"
- apply (subgoal_tac "n = m + (n - m)")
- apply (erule ssubst, rule gcd_add1_eq, simp)
- done
-
-
-subsection \<open>GCD and LCM on integers\<close>
-
-definition
- zgcd :: "int \<Rightarrow> int \<Rightarrow> int" where
- "zgcd i j = int (gcd (nat \<bar>i\<bar>) (nat \<bar>j\<bar>))"
-
-lemma zgcd_zdvd1 [iff, algebra]: "zgcd i j dvd i"
-by (simp add: zgcd_def int_dvd_iff)
-
-lemma zgcd_zdvd2 [iff, algebra]: "zgcd i j dvd j"
-by (simp add: zgcd_def int_dvd_iff)
-
-lemma zgcd_pos: "zgcd i j \<ge> 0"
-by (simp add: zgcd_def)
-
-lemma zgcd0 [simp,algebra]: "(zgcd i j = 0) = (i = 0 \<and> j = 0)"
-by (simp add: zgcd_def gcd_zero)
-
-lemma zgcd_commute: "zgcd i j = zgcd j i"
-unfolding zgcd_def by (simp add: gcd_commute)
-
-lemma zgcd_zminus [simp, algebra]: "zgcd (- i) j = zgcd i j"
-unfolding zgcd_def by simp
-
-lemma zgcd_zminus2 [simp, algebra]: "zgcd i (- j) = zgcd i j"
-unfolding zgcd_def by simp
-
- (* should be solved by algebra*)
-lemma zrelprime_dvd_mult: "zgcd i j = 1 \<Longrightarrow> i dvd k * j \<Longrightarrow> i dvd k"
- unfolding zgcd_def
-proof -
- assume "int (gcd (nat \<bar>i\<bar>) (nat \<bar>j\<bar>)) = 1" "i dvd k * j"
- then have g: "gcd (nat \<bar>i\<bar>) (nat \<bar>j\<bar>) = 1" by simp
- from \<open>i dvd k * j\<close> obtain h where h: "k*j = i*h" unfolding dvd_def by blast
- have th: "nat \<bar>i\<bar> dvd nat \<bar>k\<bar> * nat \<bar>j\<bar>"
- unfolding dvd_def
- by (rule_tac x= "nat \<bar>h\<bar>" in exI, simp add: h nat_abs_mult_distrib [symmetric])
- from relprime_dvd_mult [OF g th] obtain h' where h': "nat \<bar>k\<bar> = nat \<bar>i\<bar> * h'"
- unfolding dvd_def by blast
- from h' have "int (nat \<bar>k\<bar>) = int (nat \<bar>i\<bar> * h')" by simp
- then have "\<bar>k\<bar> = \<bar>i\<bar> * int h'" by (simp add: of_nat_mult)
- then show ?thesis
- apply (subst abs_dvd_iff [symmetric])
- apply (subst dvd_abs_iff [symmetric])
- apply (unfold dvd_def)
- apply (rule_tac x = "int h'" in exI, simp)
- done
-qed
-
-lemma int_nat_abs: "int (nat \<bar>x\<bar>) = \<bar>x\<bar>" by arith
-
-lemma zgcd_greatest:
- assumes "k dvd m" and "k dvd n"
- shows "k dvd zgcd m n"
-proof -
- let ?k' = "nat \<bar>k\<bar>"
- let ?m' = "nat \<bar>m\<bar>"
- let ?n' = "nat \<bar>n\<bar>"
- from \<open>k dvd m\<close> and \<open>k dvd n\<close> have dvd': "?k' dvd ?m'" "?k' dvd ?n'"
- unfolding zdvd_int by (simp_all only: int_nat_abs abs_dvd_iff dvd_abs_iff)
- from gcd_greatest [OF dvd'] have "int (nat \<bar>k\<bar>) dvd zgcd m n"
- unfolding zgcd_def by (simp only: zdvd_int)
- then have "\<bar>k\<bar> dvd zgcd m n" by (simp only: int_nat_abs)
- then show "k dvd zgcd m n" by simp
-qed
-
-lemma div_zgcd_relprime:
- assumes nz: "a \<noteq> 0 \<or> b \<noteq> 0"
- shows "zgcd (a div (zgcd a b)) (b div (zgcd a b)) = 1"
-proof -
- from nz have nz': "nat \<bar>a\<bar> \<noteq> 0 \<or> nat \<bar>b\<bar> \<noteq> 0" by arith
- let ?g = "zgcd a b"
- let ?a' = "a div ?g"
- let ?b' = "b div ?g"
- let ?g' = "zgcd ?a' ?b'"
- have dvdg: "?g dvd a" "?g dvd b" by simp_all
- have dvdg': "?g' dvd ?a'" "?g' dvd ?b'" by simp_all
- from dvdg dvdg' obtain ka kb ka' kb' where
- kab: "a = ?g*ka" "b = ?g*kb" "?a' = ?g'*ka'" "?b' = ?g' * kb'"
- unfolding dvd_def by blast
- from this(3-4) [symmetric] have "?g* ?a' = (?g * ?g') * ka'" "?g* ?b' = (?g * ?g') * kb'"
- by (simp_all only: ac_simps mult.left_commute [of _ "zgcd a b"])
- then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b"
- by (auto simp add: dvd_mult_div_cancel [OF dvdg(1)]
- dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
- have "?g \<noteq> 0" using nz by simp
- then have gp: "?g \<noteq> 0" using zgcd_pos[where i="a" and j="b"] by arith
- from zgcd_greatest [OF dvdgg'] have "?g * ?g' dvd ?g" .
- with zdvd_mult_cancel1 [OF gp] have "\<bar>?g'\<bar> = 1" by simp
- with zgcd_pos show "?g' = 1" by simp
-qed
-
-lemma zgcd_0 [simp, algebra]: "zgcd m 0 = \<bar>m\<bar>"
- by (simp add: zgcd_def abs_if)
-
-lemma zgcd_0_left [simp, algebra]: "zgcd 0 m = \<bar>m\<bar>"
- by (simp add: zgcd_def abs_if)
-
-lemma zgcd_non_0: "0 < n ==> zgcd m n = zgcd n (m mod n)"
- apply (frule_tac b = n and a = m in pos_mod_sign)
- apply (simp del: pos_mod_sign add: zgcd_def abs_if nat_mod_distrib)
- apply (auto simp add: gcd_non_0 nat_mod_distrib [symmetric] zmod_zminus1_eq_if)
- apply (frule_tac a = m in pos_mod_bound)
- apply (simp del: pos_mod_bound add: algebra_simps nat_diff_distrib gcd_diff2 nat_le_eq_zle)
- apply (metis dual_order.strict_implies_order gcd.simps gcd_0_left gcd_diff2 mod_by_0 nat_mono)
- done
-
-lemma zgcd_eq: "zgcd m n = zgcd n (m mod n)"
- apply (cases "n = 0", simp)
- apply (auto simp add: linorder_neq_iff zgcd_non_0)
- apply (cut_tac m = "-m" and n = "-n" in zgcd_non_0, auto)
- done
-
-lemma zgcd_1 [simp, algebra]: "zgcd m 1 = 1"
- by (simp add: zgcd_def abs_if)
-
-lemma zgcd_0_1_iff [simp, algebra]: "zgcd 0 m = 1 \<longleftrightarrow> \<bar>m\<bar> = 1"
- by (simp add: zgcd_def abs_if)
-
-lemma zgcd_greatest_iff[algebra]: "k dvd zgcd m n = (k dvd m \<and> k dvd n)"
- by (simp add: zgcd_def abs_if int_dvd_iff dvd_int_iff nat_dvd_iff)
-
-lemma zgcd_1_left [simp, algebra]: "zgcd 1 m = 1"
- by (simp add: zgcd_def)
-
-lemma zgcd_assoc: "zgcd (zgcd k m) n = zgcd k (zgcd m n)"
- by (simp add: zgcd_def gcd_assoc)
-
-lemma zgcd_left_commute: "zgcd k (zgcd m n) = zgcd m (zgcd k n)"
- apply (rule zgcd_commute [THEN trans])
- apply (rule zgcd_assoc [THEN trans])
- apply (rule zgcd_commute [THEN arg_cong])
- done
-
-lemmas zgcd_ac = zgcd_assoc zgcd_commute zgcd_left_commute
- \<comment> \<open>addition is an AC-operator\<close>
-
-lemma zgcd_zmult_distrib2: "0 \<le> k ==> k * zgcd m n = zgcd (k * m) (k * n)"
- by (simp del: minus_mult_right [symmetric]
- add: minus_mult_right nat_mult_distrib zgcd_def abs_if
- mult_less_0_iff gcd_mult_distrib2 [symmetric] of_nat_mult)
-
-lemma zgcd_zmult_distrib2_abs: "zgcd (k * m) (k * n) = \<bar>k\<bar> * zgcd m n"
- by (simp add: abs_if zgcd_zmult_distrib2)
-
-lemma zgcd_self [simp]: "0 \<le> m ==> zgcd m m = m"
- by (cut_tac k = m and m = 1 and n = 1 in zgcd_zmult_distrib2, simp_all)
-
-lemma zgcd_zmult_eq_self [simp]: "0 \<le> k ==> zgcd k (k * n) = k"
- by (cut_tac k = k and m = 1 and n = n in zgcd_zmult_distrib2, simp_all)
-
-lemma zgcd_zmult_eq_self2 [simp]: "0 \<le> k ==> zgcd (k * n) k = k"
- by (cut_tac k = k and m = n and n = 1 in zgcd_zmult_distrib2, simp_all)
-
-
-definition "zlcm i j = int (lcm (nat \<bar>i\<bar>) (nat \<bar>j\<bar>))"
-
-lemma dvd_zlcm_self1[simp, algebra]: "i dvd zlcm i j"
-by(simp add:zlcm_def dvd_int_iff)
-
-lemma dvd_zlcm_self2[simp, algebra]: "j dvd zlcm i j"
-by(simp add:zlcm_def dvd_int_iff)
-
-
-lemma dvd_imp_dvd_zlcm1:
- assumes "k dvd i" shows "k dvd (zlcm i j)"
-proof -
- have "nat \<bar>k\<bar> dvd nat \<bar>i\<bar>" using \<open>k dvd i\<close>
- by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
- thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
-qed
-
-lemma dvd_imp_dvd_zlcm2:
- assumes "k dvd j" shows "k dvd (zlcm i j)"
-proof -
- have "nat \<bar>k\<bar> dvd nat \<bar>j\<bar>" using \<open>k dvd j\<close>
- by(simp add:int_dvd_iff[symmetric] dvd_int_iff[symmetric])
- thus ?thesis by(simp add:zlcm_def dvd_int_iff)(blast intro: dvd_trans)
-qed
-
-
-lemma zdvd_self_abs1: "(d::int) dvd \<bar>d\<bar>"
-by (case_tac "d <0", simp_all)
-
-lemma zdvd_self_abs2: "\<bar>d::int\<bar> dvd d"
-by (case_tac "d<0", simp_all)
-
-(* lcm a b is positive for positive a and b *)
-
-lemma lcm_pos:
- assumes mpos: "m > 0"
- and npos: "n>0"
- shows "lcm m n > 0"
-proof (rule ccontr, simp add: lcm_def gcd_zero)
- assume h:"m*n div gcd m n = 0"
- from mpos npos have "gcd m n \<noteq> 0" using gcd_zero by simp
- hence gcdp: "gcd m n > 0" by simp
- with h
- have "m*n < gcd m n"
- by (cases "m * n < gcd m n") (auto simp add: div_if[OF gcdp, where m="m*n"])
- moreover
- have "gcd m n dvd m" by simp
- with mpos dvd_imp_le have t1:"gcd m n \<le> m" by simp
- with npos have t1:"gcd m n *n \<le> m*n" by simp
- have "gcd m n \<le> gcd m n*n" using npos by simp
- with t1 have "gcd m n \<le> m*n" by arith
- ultimately show "False" by simp
-qed
-
-lemma zlcm_pos:
- assumes anz: "a \<noteq> 0"
- and bnz: "b \<noteq> 0"
- shows "0 < zlcm a b"
-proof-
- let ?na = "nat \<bar>a\<bar>"
- let ?nb = "nat \<bar>b\<bar>"
- have nap: "?na >0" using anz by simp
- have nbp: "?nb >0" using bnz by simp
- have "0 < lcm ?na ?nb" by (rule lcm_pos[OF nap nbp])
- thus ?thesis by (simp add: zlcm_def)
-qed
-
-lemma zgcd_code [code]:
- "zgcd k l = \<bar>if l = 0 then k else zgcd l (\<bar>k\<bar> mod \<bar>l\<bar>)\<bar>"
- by (simp add: zgcd_def gcd.simps [of "nat \<bar>k\<bar>"] nat_mod_distrib)
-
-end
--- a/src/HOL/Old_Number_Theory/Pocklington.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1263 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Pocklington.thy
- Author: Amine Chaieb
-*)
-
-section \<open>Pocklington's Theorem for Primes\<close>
-
-theory Pocklington
-imports Primes
-begin
-
-definition modeq:: "nat => nat => nat => bool" ("(1[_ = _] '(mod _'))")
- where "[a = b] (mod p) == ((a mod p) = (b mod p))"
-
-definition modneq:: "nat => nat => nat => bool" ("(1[_ \<noteq> _] '(mod _'))")
- where "[a \<noteq> b] (mod p) == ((a mod p) \<noteq> (b mod p))"
-
-lemma modeq_trans:
- "\<lbrakk> [a = b] (mod p); [b = c] (mod p) \<rbrakk> \<Longrightarrow> [a = c] (mod p)"
- by (simp add:modeq_def)
-
-lemma modeq_sym[sym]:
- "[a = b] (mod p) \<Longrightarrow> [b = a] (mod p)"
- unfolding modeq_def by simp
-
-lemma modneq_sym[sym]:
- "[a \<noteq> b] (mod p) \<Longrightarrow> [b \<noteq> a] (mod p)"
- by (simp add: modneq_def)
-
-lemma nat_mod_lemma: assumes xyn: "[x = y] (mod n)" and xy:"y \<le> x"
- shows "\<exists>q. x = y + n * q"
-using xyn xy unfolding modeq_def using nat_mod_eq_lemma by blast
-
-lemma nat_mod[algebra]: "[x = y] (mod n) \<longleftrightarrow> (\<exists>q1 q2. x + n * q1 = y + n * q2)"
-unfolding modeq_def nat_mod_eq_iff ..
-
-(* Lemmas about previously defined terms. *)
-
-lemma prime: "prime p \<longleftrightarrow> p \<noteq> 0 \<and> p\<noteq>1 \<and> (\<forall>m. 0 < m \<and> m < p \<longrightarrow> coprime p m)"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- {assume "p=0 \<or> p=1" hence ?thesis using prime_0 prime_1 by (cases "p=0", simp_all)}
- moreover
- {assume p0: "p\<noteq>0" "p\<noteq>1"
- {assume H: "?lhs"
- {fix m assume m: "m > 0" "m < p"
- {assume "m=1" hence "coprime p m" by simp}
- moreover
- {assume "p dvd m" hence "p \<le> m" using dvd_imp_le m by blast with m(2)
- have "coprime p m" by simp}
- ultimately have "coprime p m" using prime_coprime[OF H, of m] by blast}
- hence ?rhs using p0 by auto}
- moreover
- { assume H: "\<forall>m. 0 < m \<and> m < p \<longrightarrow> coprime p m"
- from prime_factor[OF p0(2)] obtain q where q: "prime q" "q dvd p" by blast
- from prime_ge_2[OF q(1)] have q0: "q > 0" by arith
- from dvd_imp_le[OF q(2)] p0 have qp: "q \<le> p" by arith
- {assume "q = p" hence ?lhs using q(1) by blast}
- moreover
- {assume "q\<noteq>p" with qp have qplt: "q < p" by arith
- from H[rule_format, of q] qplt q0 have "coprime p q" by arith
- with coprime_prime[of p q q] q have False by simp hence ?lhs by blast}
- ultimately have ?lhs by blast}
- ultimately have ?thesis by blast}
- ultimately show ?thesis by (cases"p=0 \<or> p=1", auto)
-qed
-
-lemma finite_number_segment: "card { m. 0 < m \<and> m < n } = n - 1"
-proof-
- have "{ m. 0 < m \<and> m < n } = {1..<n}" by auto
- thus ?thesis by simp
-qed
-
-lemma coprime_mod: assumes n: "n \<noteq> 0" shows "coprime (a mod n) n \<longleftrightarrow> coprime a n"
- using n dvd_mod_iff[of _ n a] by (auto simp add: coprime)
-
-(* Congruences. *)
-
-lemma cong_mod_01[simp,presburger]:
- "[x = y] (mod 0) \<longleftrightarrow> x = y" "[x = y] (mod 1)" "[x = 0] (mod n) \<longleftrightarrow> n dvd x"
- by (simp_all add: modeq_def, presburger)
-
-lemma cong_sub_cases:
- "[x = y] (mod n) \<longleftrightarrow> (if x <= y then [y - x = 0] (mod n) else [x - y = 0] (mod n))"
-apply (auto simp add: nat_mod)
-apply (rule_tac x="q2" in exI)
-apply (rule_tac x="q1" in exI, simp)
-apply (rule_tac x="q2" in exI)
-apply (rule_tac x="q1" in exI, simp)
-apply (rule_tac x="q1" in exI)
-apply (rule_tac x="q2" in exI, simp)
-apply (rule_tac x="q1" in exI)
-apply (rule_tac x="q2" in exI, simp)
-done
-
-lemma cong_mult_lcancel: assumes an: "coprime a n" and axy:"[a * x = a * y] (mod n)"
- shows "[x = y] (mod n)"
-proof-
- {assume "a = 0" with an axy coprime_0'[of n] have ?thesis by (simp add: modeq_def) }
- moreover
- {assume az: "a\<noteq>0"
- {assume xy: "x \<le> y" hence axy': "a*x \<le> a*y" by simp
- with axy cong_sub_cases[of "a*x" "a*y" n] have "[a*(y - x) = 0] (mod n)"
- by (simp only: if_True diff_mult_distrib2)
- hence th: "n dvd a*(y -x)" by simp
- from coprime_divprod[OF th] an have "n dvd y - x"
- by (simp add: coprime_commute)
- hence ?thesis using xy cong_sub_cases[of x y n] by simp}
- moreover
- {assume H: "\<not>x \<le> y" hence xy: "y \<le> x" by arith
- from H az have axy': "\<not> a*x \<le> a*y" by auto
- with axy H cong_sub_cases[of "a*x" "a*y" n] have "[a*(x - y) = 0] (mod n)"
- by (simp only: if_False diff_mult_distrib2)
- hence th: "n dvd a*(x - y)" by simp
- from coprime_divprod[OF th] an have "n dvd x - y"
- by (simp add: coprime_commute)
- hence ?thesis using xy cong_sub_cases[of x y n] by simp}
- ultimately have ?thesis by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma cong_mult_rcancel: assumes an: "coprime a n" and axy:"[x*a = y*a] (mod n)"
- shows "[x = y] (mod n)"
- using cong_mult_lcancel[OF an axy[unfolded mult.commute[of _a]]] .
-
-lemma cong_refl: "[x = x] (mod n)" by (simp add: modeq_def)
-
-lemma eq_imp_cong: "a = b \<Longrightarrow> [a = b] (mod n)" by (simp add: cong_refl)
-
-lemma cong_commute: "[x = y] (mod n) \<longleftrightarrow> [y = x] (mod n)"
- by (auto simp add: modeq_def)
-
-lemma cong_trans[trans]: "[x = y] (mod n) \<Longrightarrow> [y = z] (mod n) \<Longrightarrow> [x = z] (mod n)"
- by (simp add: modeq_def)
-
-lemma cong_add: assumes xx': "[x = x'] (mod n)" and yy':"[y = y'] (mod n)"
- shows "[x + y = x' + y'] (mod n)"
-proof-
- have "(x + y) mod n = (x mod n + y mod n) mod n"
- by (simp add: mod_add_left_eq[of x y n] mod_add_right_eq[of "x mod n" y n])
- also have "\<dots> = (x' mod n + y' mod n) mod n" using xx' yy' modeq_def by simp
- also have "\<dots> = (x' + y') mod n"
- by (simp add: mod_add_left_eq[of x' y' n] mod_add_right_eq[of "x' mod n" y' n])
- finally show ?thesis unfolding modeq_def .
-qed
-
-lemma cong_mult: assumes xx': "[x = x'] (mod n)" and yy':"[y = y'] (mod n)"
- shows "[x * y = x' * y'] (mod n)"
-proof-
- have "(x * y) mod n = (x mod n) * (y mod n) mod n"
- by (simp add: mod_mult_left_eq[of x y n] mod_mult_right_eq[of "x mod n" y n])
- also have "\<dots> = (x' mod n) * (y' mod n) mod n" using xx'[unfolded modeq_def] yy'[unfolded modeq_def] by simp
- also have "\<dots> = (x' * y') mod n"
- by (simp add: mod_mult_left_eq[of x' y' n] mod_mult_right_eq[of "x' mod n" y' n])
- finally show ?thesis unfolding modeq_def .
-qed
-
-lemma cong_exp: "[x = y] (mod n) \<Longrightarrow> [x^k = y^k] (mod n)"
- by (induct k, auto simp add: cong_refl cong_mult)
-lemma cong_sub: assumes xx': "[x = x'] (mod n)" and yy': "[y = y'] (mod n)"
- and yx: "y <= x" and yx': "y' <= x'"
- shows "[x - y = x' - y'] (mod n)"
-proof-
- { fix x a x' a' y b y' b'
- have "(x::nat) + a = x' + a' \<Longrightarrow> y + b = y' + b' \<Longrightarrow> y <= x \<Longrightarrow> y' <= x'
- \<Longrightarrow> (x - y) + (a + b') = (x' - y') + (a' + b)" by arith}
- note th = this
- from xx' yy' obtain q1 q2 q1' q2' where q12: "x + n*q1 = x'+n*q2"
- and q12': "y + n*q1' = y'+n*q2'" unfolding nat_mod by blast+
- from th[OF q12 q12' yx yx']
- have "(x - y) + n*(q1 + q2') = (x' - y') + n*(q2 + q1')"
- by (simp add: distrib_left)
- thus ?thesis unfolding nat_mod by blast
-qed
-
-lemma cong_mult_lcancel_eq: assumes an: "coprime a n"
- shows "[a * x = a * y] (mod n) \<longleftrightarrow> [x = y] (mod n)" (is "?lhs \<longleftrightarrow> ?rhs")
-proof
- assume H: "?rhs" from cong_mult[OF cong_refl[of a n] H] show ?lhs .
-next
- assume H: "?lhs" hence H': "[x*a = y*a] (mod n)" by (simp add: mult.commute)
- from cong_mult_rcancel[OF an H'] show ?rhs .
-qed
-
-lemma cong_mult_rcancel_eq: assumes an: "coprime a n"
- shows "[x * a = y * a] (mod n) \<longleftrightarrow> [x = y] (mod n)"
-using cong_mult_lcancel_eq[OF an, of x y] by (simp add: mult.commute)
-
-lemma cong_add_lcancel_eq: "[a + x = a + y] (mod n) \<longleftrightarrow> [x = y] (mod n)"
- by (simp add: nat_mod)
-
-lemma cong_add_rcancel_eq: "[x + a = y + a] (mod n) \<longleftrightarrow> [x = y] (mod n)"
- by (simp add: nat_mod)
-
-lemma cong_add_rcancel: "[x + a = y + a] (mod n) \<Longrightarrow> [x = y] (mod n)"
- by (simp add: nat_mod)
-
-lemma cong_add_lcancel: "[a + x = a + y] (mod n) \<Longrightarrow> [x = y] (mod n)"
- by (simp add: nat_mod)
-
-lemma cong_add_lcancel_eq_0: "[a + x = a] (mod n) \<longleftrightarrow> [x = 0] (mod n)"
- by (simp add: nat_mod)
-
-lemma cong_add_rcancel_eq_0: "[x + a = a] (mod n) \<longleftrightarrow> [x = 0] (mod n)"
- by (simp add: nat_mod)
-
-lemma cong_imp_eq: assumes xn: "x < n" and yn: "y < n" and xy: "[x = y] (mod n)"
- shows "x = y"
- using xy[unfolded modeq_def mod_less[OF xn] mod_less[OF yn]] .
-
-lemma cong_divides_modulus: "[x = y] (mod m) \<Longrightarrow> n dvd m ==> [x = y] (mod n)"
- apply (auto simp add: nat_mod dvd_def)
- apply (rule_tac x="k*q1" in exI)
- apply (rule_tac x="k*q2" in exI)
- by simp
-
-lemma cong_0_divides: "[x = 0] (mod n) \<longleftrightarrow> n dvd x" by simp
-
-lemma cong_1_divides:"[x = 1] (mod n) ==> n dvd x - 1"
- apply (cases "x\<le>1", simp_all)
- using cong_sub_cases[of x 1 n] by auto
-
-lemma cong_divides: "[x = y] (mod n) \<Longrightarrow> n dvd x \<longleftrightarrow> n dvd y"
-apply (auto simp add: nat_mod dvd_def)
-apply (rule_tac x="k + q1 - q2" in exI, simp add: add_mult_distrib2 diff_mult_distrib2)
-apply (rule_tac x="k + q2 - q1" in exI, simp add: add_mult_distrib2 diff_mult_distrib2)
-done
-
-lemma cong_coprime: assumes xy: "[x = y] (mod n)"
- shows "coprime n x \<longleftrightarrow> coprime n y"
-proof-
- {assume "n=0" hence ?thesis using xy by simp}
- moreover
- {assume nz: "n \<noteq> 0"
- have "coprime n x \<longleftrightarrow> coprime (x mod n) n"
- by (simp add: coprime_mod[OF nz, of x] coprime_commute[of n x])
- also have "\<dots> \<longleftrightarrow> coprime (y mod n) n" using xy[unfolded modeq_def] by simp
- also have "\<dots> \<longleftrightarrow> coprime y n" by (simp add: coprime_mod[OF nz, of y])
- finally have ?thesis by (simp add: coprime_commute) }
-ultimately show ?thesis by blast
-qed
-
-lemma cong_mod: "~(n = 0) \<Longrightarrow> [a mod n = a] (mod n)" by (simp add: modeq_def)
-
-lemma mod_mult_cong: "~(a = 0) \<Longrightarrow> ~(b = 0)
- \<Longrightarrow> [x mod (a * b) = y] (mod a) \<longleftrightarrow> [x = y] (mod a)"
- by (simp add: modeq_def mod_mult2_eq mod_add_left_eq)
-
-lemma cong_mod_mult: "[x = y] (mod n) \<Longrightarrow> m dvd n \<Longrightarrow> [x = y] (mod m)"
- apply (auto simp add: nat_mod dvd_def)
- apply (rule_tac x="k*q1" in exI)
- apply (rule_tac x="k*q2" in exI, simp)
- done
-
-(* Some things when we know more about the order. *)
-
-lemma cong_le: "y <= x \<Longrightarrow> [x = y] (mod n) \<longleftrightarrow> (\<exists>q. x = q * n + y)"
- using nat_mod_lemma[of x y n]
- apply auto
- apply (simp add: nat_mod)
- apply (rule_tac x="q" in exI)
- apply (rule_tac x="q + q" in exI)
- by (auto simp: algebra_simps)
-
-lemma cong_to_1: "[a = 1] (mod n) \<longleftrightarrow> a = 0 \<and> n = 1 \<or> (\<exists>m. a = 1 + m * n)"
-proof-
- {assume "n = 0 \<or> n = 1\<or> a = 0 \<or> a = 1" hence ?thesis
- apply (cases "n=0", simp_all add: cong_commute)
- apply (cases "n=1", simp_all add: cong_commute modeq_def)
- apply arith
- apply (cases "a=1")
- apply (simp_all add: modeq_def cong_commute)
- done }
- moreover
- {assume n: "n\<noteq>0" "n\<noteq>1" and a:"a\<noteq>0" "a \<noteq> 1" hence a': "a \<ge> 1" by simp
- hence ?thesis using cong_le[OF a', of n] by auto }
- ultimately show ?thesis by auto
-qed
-
-(* Some basic theorems about solving congruences. *)
-
-
-lemma cong_solve: assumes an: "coprime a n" shows "\<exists>x. [a * x = b] (mod n)"
-proof-
- {assume "a=0" hence ?thesis using an by (simp add: modeq_def)}
- moreover
- {assume az: "a\<noteq>0"
- from bezout_add_strong[OF az, of n]
- obtain d x y where dxy: "d dvd a" "d dvd n" "a*x = n*y + d" by blast
- from an[unfolded coprime, rule_format, of d] dxy(1,2) have d1: "d = 1" by blast
- hence "a*x*b = (n*y + 1)*b" using dxy(3) by simp
- hence "a*(x*b) = n*(y*b) + b" by algebra
- hence "a*(x*b) mod n = (n*(y*b) + b) mod n" by simp
- hence "a*(x*b) mod n = b mod n" by (simp add: mod_add_left_eq)
- hence "[a*(x*b) = b] (mod n)" unfolding modeq_def .
- hence ?thesis by blast}
-ultimately show ?thesis by blast
-qed
-
-lemma cong_solve_unique: assumes an: "coprime a n" and nz: "n \<noteq> 0"
- shows "\<exists>!x. x < n \<and> [a * x = b] (mod n)"
-proof-
- let ?P = "\<lambda>x. x < n \<and> [a * x = b] (mod n)"
- from cong_solve[OF an] obtain x where x: "[a*x = b] (mod n)" by blast
- let ?x = "x mod n"
- from x have th: "[a * ?x = b] (mod n)"
- by (simp add: modeq_def mod_mult_right_eq[of a x n])
- from mod_less_divisor[ of n x] nz th have Px: "?P ?x" by simp
- {fix y assume Py: "y < n" "[a * y = b] (mod n)"
- from Py(2) th have "[a * y = a*?x] (mod n)" by (simp add: modeq_def)
- hence "[y = ?x] (mod n)" by (simp add: cong_mult_lcancel_eq[OF an])
- with mod_less[OF Py(1)] mod_less_divisor[ of n x] nz
- have "y = ?x" by (simp add: modeq_def)}
- with Px show ?thesis by blast
-qed
-
-lemma cong_solve_unique_nontrivial:
- assumes p: "prime p" and pa: "coprime p a" and x0: "0 < x" and xp: "x < p"
- shows "\<exists>!y. 0 < y \<and> y < p \<and> [x * y = a] (mod p)"
-proof-
- from p have p1: "p > 1" using prime_ge_2[OF p] by arith
- hence p01: "p \<noteq> 0" "p \<noteq> 1" by arith+
- from pa have ap: "coprime a p" by (simp add: coprime_commute)
- from prime_coprime[OF p, of x] dvd_imp_le[of p x] x0 xp have px:"coprime x p"
- by (auto simp add: coprime_commute)
- from cong_solve_unique[OF px p01(1)]
- obtain y where y: "y < p" "[x * y = a] (mod p)" "\<forall>z. z < p \<and> [x * z = a] (mod p) \<longrightarrow> z = y" by blast
- {assume y0: "y = 0"
- with y(2) have th: "p dvd a" by (simp add: cong_commute[of 0 a p])
- with p coprime_prime[OF pa, of p] have False by simp}
- with y show ?thesis unfolding Ex1_def using neq0_conv by blast
-qed
-lemma cong_unique_inverse_prime:
- assumes p: "prime p" and x0: "0 < x" and xp: "x < p"
- shows "\<exists>!y. 0 < y \<and> y < p \<and> [x * y = 1] (mod p)"
- using cong_solve_unique_nontrivial[OF p coprime_1[of p] x0 xp] .
-
-(* Forms of the Chinese remainder theorem. *)
-
-lemma cong_chinese:
- assumes ab: "coprime a b" and xya: "[x = y] (mod a)"
- and xyb: "[x = y] (mod b)"
- shows "[x = y] (mod a*b)"
- using ab xya xyb
- by (simp add: cong_sub_cases[of x y a] cong_sub_cases[of x y b]
- cong_sub_cases[of x y "a*b"])
-(cases "x \<le> y", simp_all add: divides_mul[of a _ b])
-
-lemma chinese_remainder_unique:
- assumes ab: "coprime a b" and az: "a \<noteq> 0" and bz: "b\<noteq>0"
- shows "\<exists>!x. x < a * b \<and> [x = m] (mod a) \<and> [x = n] (mod b)"
-proof-
- from az bz have abpos: "a*b > 0" by simp
- from chinese_remainder[OF ab az bz] obtain x q1 q2 where
- xq12: "x = m + q1 * a" "x = n + q2 * b" by blast
- let ?w = "x mod (a*b)"
- have wab: "?w < a*b" by (simp add: mod_less_divisor[OF abpos])
- from xq12(1) have "?w mod a = ((m + q1 * a) mod (a*b)) mod a" by simp
- also have "\<dots> = m mod a" by (simp add: mod_mult2_eq)
- finally have th1: "[?w = m] (mod a)" by (simp add: modeq_def)
- from xq12(2) have "?w mod b = ((n + q2 * b) mod (a*b)) mod b" by simp
- also have "\<dots> = ((n + q2 * b) mod (b*a)) mod b" by (simp add: mult.commute)
- also have "\<dots> = n mod b" by (simp add: mod_mult2_eq)
- finally have th2: "[?w = n] (mod b)" by (simp add: modeq_def)
- {fix y assume H: "y < a*b" "[y = m] (mod a)" "[y = n] (mod b)"
- with th1 th2 have H': "[y = ?w] (mod a)" "[y = ?w] (mod b)"
- by (simp_all add: modeq_def)
- from cong_chinese[OF ab H'] mod_less[OF H(1)] mod_less[OF wab]
- have "y = ?w" by (simp add: modeq_def)}
- with th1 th2 wab show ?thesis by blast
-qed
-
-lemma chinese_remainder_coprime_unique:
- assumes ab: "coprime a b" and az: "a \<noteq> 0" and bz: "b \<noteq> 0"
- and ma: "coprime m a" and nb: "coprime n b"
- shows "\<exists>!x. coprime x (a * b) \<and> x < a * b \<and> [x = m] (mod a) \<and> [x = n] (mod b)"
-proof-
- let ?P = "\<lambda>x. x < a * b \<and> [x = m] (mod a) \<and> [x = n] (mod b)"
- from chinese_remainder_unique[OF ab az bz]
- obtain x where x: "x < a * b" "[x = m] (mod a)" "[x = n] (mod b)"
- "\<forall>y. ?P y \<longrightarrow> y = x" by blast
- from ma nb cong_coprime[OF x(2)] cong_coprime[OF x(3)]
- have "coprime x a" "coprime x b" by (simp_all add: coprime_commute)
- with coprime_mul[of x a b] have "coprime x (a*b)" by simp
- with x show ?thesis by blast
-qed
-
-(* Euler totient function. *)
-
-definition phi_def: "\<phi> n = card { m. 0 < m \<and> m <= n \<and> coprime m n }"
-
-lemma phi_0[simp]: "\<phi> 0 = 0"
- unfolding phi_def by auto
-
-lemma phi_finite[simp]: "finite ({ m. 0 < m \<and> m <= n \<and> coprime m n })"
-proof-
- have "{ m. 0 < m \<and> m <= n \<and> coprime m n } \<subseteq> {0..n}" by auto
- thus ?thesis by (auto intro: finite_subset)
-qed
-
-declare coprime_1[presburger]
-lemma phi_1[simp]: "\<phi> 1 = 1"
-proof-
- {fix m
- have "0 < m \<and> m <= 1 \<and> coprime m 1 \<longleftrightarrow> m = 1" by presburger }
- thus ?thesis by (simp add: phi_def)
-qed
-
-lemma [simp]: "\<phi> (Suc 0) = Suc 0" using phi_1 by simp
-
-lemma phi_alt: "\<phi>(n) = card { m. coprime m n \<and> m < n}"
-proof-
- {assume "n=0 \<or> n=1" hence ?thesis by (cases "n=0", simp_all)}
- moreover
- {assume n: "n\<noteq>0" "n\<noteq>1"
- {fix m
- from n have "0 < m \<and> m <= n \<and> coprime m n \<longleftrightarrow> coprime m n \<and> m < n"
- apply (cases "m = 0", simp_all)
- apply (cases "m = 1", simp_all)
- apply (cases "m = n", auto)
- done }
- hence ?thesis unfolding phi_def by simp}
- ultimately show ?thesis by auto
-qed
-
-lemma phi_finite_lemma[simp]: "finite {m. coprime m n \<and> m < n}" (is "finite ?S")
- by (rule finite_subset[of "?S" "{0..n}"], auto)
-
-lemma phi_another: assumes n: "n\<noteq>1"
- shows "\<phi> n = card {m. 0 < m \<and> m < n \<and> coprime m n }"
-proof-
- {fix m
- from n have "0 < m \<and> m < n \<and> coprime m n \<longleftrightarrow> coprime m n \<and> m < n"
- by (cases "m=0", auto)}
- thus ?thesis unfolding phi_alt by auto
-qed
-
-lemma phi_limit: "\<phi> n \<le> n"
-proof-
- have "{ m. coprime m n \<and> m < n} \<subseteq> {0 ..<n}" by auto
- with card_mono[of "{0 ..<n}" "{ m. coprime m n \<and> m < n}"]
- show ?thesis unfolding phi_alt by auto
-qed
-
-lemma stupid[simp]: "{m. (0::nat) < m \<and> m < n} = {1..<n}"
- by auto
-
-lemma phi_limit_strong: assumes n: "n\<noteq>1"
- shows "\<phi>(n) \<le> n - 1"
-proof-
- show ?thesis
- unfolding phi_another[OF n] finite_number_segment[of n, symmetric]
- by (rule card_mono[of "{m. 0 < m \<and> m < n}" "{m. 0 < m \<and> m < n \<and> coprime m n}"], auto)
-qed
-
-lemma phi_lowerbound_1_strong: assumes n: "n \<ge> 1"
- shows "\<phi>(n) \<ge> 1"
-proof-
- let ?S = "{ m. 0 < m \<and> m <= n \<and> coprime m n }"
- from card_0_eq[of ?S] n have "\<phi> n \<noteq> 0" unfolding phi_alt
- apply auto
- apply (cases "n=1", simp_all)
- apply (rule exI[where x=1], simp)
- done
- thus ?thesis by arith
-qed
-
-lemma phi_lowerbound_1: "2 <= n ==> 1 <= \<phi>(n)"
- using phi_lowerbound_1_strong[of n] by auto
-
-lemma phi_lowerbound_2: assumes n: "3 <= n" shows "2 <= \<phi> (n)"
-proof-
- let ?S = "{ m. 0 < m \<and> m <= n \<and> coprime m n }"
- have inS: "{1, n - 1} \<subseteq> ?S" using n coprime_plus1[of "n - 1"]
- by (auto simp add: coprime_commute)
- from n have c2: "card {1, n - 1} = 2" by (auto simp add: card_insert_if)
- from card_mono[of ?S "{1, n - 1}", simplified inS c2] show ?thesis
- unfolding phi_def by auto
-qed
-
-lemma phi_prime: "\<phi> n = n - 1 \<and> n\<noteq>0 \<and> n\<noteq>1 \<longleftrightarrow> prime n"
-proof-
- {assume "n=0 \<or> n=1" hence ?thesis by (cases "n=1", simp_all)}
- moreover
- {assume n: "n\<noteq>0" "n\<noteq>1"
- let ?S = "{m. 0 < m \<and> m < n}"
- have fS: "finite ?S" by simp
- let ?S' = "{m. 0 < m \<and> m < n \<and> coprime m n}"
- have fS':"finite ?S'" apply (rule finite_subset[of ?S' ?S]) by auto
- {assume H: "\<phi> n = n - 1 \<and> n\<noteq>0 \<and> n\<noteq>1"
- hence ceq: "card ?S' = card ?S"
- using n finite_number_segment[of n] phi_another[OF n(2)] by simp
- {fix m assume m: "0 < m" "m < n" "\<not> coprime m n"
- hence mS': "m \<notin> ?S'" by auto
- have "insert m ?S' \<le> ?S" using m by auto
- have "card (insert m ?S') \<le> card ?S"
- by (rule card_mono[of ?S "insert m ?S'"]) (use m in auto)
- hence False
- unfolding card_insert_disjoint[of "?S'" m, OF fS' mS'] ceq
- by simp }
- hence "\<forall>m. 0 <m \<and> m < n \<longrightarrow> coprime m n" by blast
- hence "prime n" unfolding prime using n by (simp add: coprime_commute)}
- moreover
- {assume H: "prime n"
- hence "?S = ?S'" unfolding prime using n
- by (auto simp add: coprime_commute)
- hence "card ?S = card ?S'" by simp
- hence "\<phi> n = n - 1" unfolding phi_another[OF n(2)] by simp}
- ultimately have ?thesis using n by blast}
- ultimately show ?thesis by (cases "n=0") blast+
-qed
-
-(* Multiplicativity property. *)
-
-lemma phi_multiplicative: assumes ab: "coprime a b"
- shows "\<phi> (a * b) = \<phi> a * \<phi> b"
-proof-
- {assume "a = 0 \<or> b = 0 \<or> a = 1 \<or> b = 1"
- hence ?thesis
- by (cases "a=0", simp, cases "b=0", simp, cases"a=1", simp_all) }
- moreover
- {assume a: "a\<noteq>0" "a\<noteq>1" and b: "b\<noteq>0" "b\<noteq>1"
- hence ab0: "a*b \<noteq> 0" by simp
- let ?S = "\<lambda>k. {m. coprime m k \<and> m < k}"
- let ?f = "\<lambda>x. (x mod a, x mod b)"
- have eq: "?f ` (?S (a*b)) = (?S a \<times> ?S b)"
- proof-
- {fix x assume x:"x \<in> ?S (a*b)"
- hence x': "coprime x (a*b)" "x < a*b" by simp_all
- hence xab: "coprime x a" "coprime x b" by (simp_all add: coprime_mul_eq)
- from mod_less_divisor a b have xab':"x mod a < a" "x mod b < b" by auto
- from xab xab' have "?f x \<in> (?S a \<times> ?S b)"
- by (simp add: coprime_mod[OF a(1)] coprime_mod[OF b(1)])}
- moreover
- {fix x y assume x: "x \<in> ?S a" and y: "y \<in> ?S b"
- hence x': "coprime x a" "x < a" and y': "coprime y b" "y < b" by simp_all
- from chinese_remainder_coprime_unique[OF ab a(1) b(1) x'(1) y'(1)]
- obtain z where z: "coprime z (a * b)" "z < a * b" "[z = x] (mod a)"
- "[z = y] (mod b)" by blast
- hence "(x,y) \<in> ?f ` (?S (a*b))"
- using y'(2) mod_less_divisor[of b y] x'(2) mod_less_divisor[of a x]
- by (auto simp add: image_iff modeq_def)}
- ultimately show ?thesis by auto
- qed
- have finj: "inj_on ?f (?S (a*b))"
- unfolding inj_on_def
- proof(clarify)
- fix x y assume H: "coprime x (a * b)" "x < a * b" "coprime y (a * b)"
- "y < a * b" "x mod a = y mod a" "x mod b = y mod b"
- hence cp: "coprime x a" "coprime x b" "coprime y a" "coprime y b"
- by (simp_all add: coprime_mul_eq)
- from chinese_remainder_coprime_unique[OF ab a(1) b(1) cp(3,4)] H
- show "x = y" unfolding modeq_def by blast
- qed
- from card_image[OF finj, unfolded eq] have ?thesis
- unfolding phi_alt by simp }
- ultimately show ?thesis by auto
-qed
-
-(* Fermat's Little theorem / Fermat-Euler theorem. *)
-
-
-lemma nproduct_mod:
- assumes fS: "finite S" and n0: "n \<noteq> 0"
- shows "[prod (\<lambda>m. a(m) mod n) S = prod a S] (mod n)"
-proof-
- have th1:"[1 = 1] (mod n)" by (simp add: modeq_def)
- from cong_mult
- have th3:"\<forall>x1 y1 x2 y2.
- [x1 = x2] (mod n) \<and> [y1 = y2] (mod n) \<longrightarrow> [x1 * y1 = x2 * y2] (mod n)"
- by blast
- have th4:"\<forall>x\<in>S. [a x mod n = a x] (mod n)" by (simp add: modeq_def)
- from prod.related [where h="(\<lambda>m. a(m) mod n)" and g=a, OF th1 th3 fS, OF th4] show ?thesis by (simp add: fS)
-qed
-
-lemma nproduct_cmul:
- assumes fS:"finite S"
- shows "prod (\<lambda>m. (c::'a::{comm_monoid_mult})* a(m)) S = c ^ (card S) * prod a S"
-unfolding prod.distrib prod_constant [of c] ..
-
-lemma coprime_nproduct:
- assumes fS: "finite S" and Sn: "\<forall>x\<in>S. coprime n (a x)"
- shows "coprime n (prod a S)"
- using fS by (rule finite_subset_induct)
- (insert Sn, auto simp add: coprime_mul)
-
-lemma fermat_little: assumes an: "coprime a n"
- shows "[a ^ (\<phi> n) = 1] (mod n)"
-proof-
- {assume "n=0" hence ?thesis by simp}
- moreover
- {assume "n=1" hence ?thesis by (simp add: modeq_def)}
- moreover
- {assume nz: "n \<noteq> 0" and n1: "n \<noteq> 1"
- let ?S = "{m. coprime m n \<and> m < n}"
- let ?P = "\<Prod> ?S"
- have fS: "finite ?S" by simp
- have cardfS: "\<phi> n = card ?S" unfolding phi_alt ..
- {fix m assume m: "m \<in> ?S"
- hence "coprime m n" by simp
- with coprime_mul[of n a m] an have "coprime (a*m) n"
- by (simp add: coprime_commute)}
- hence Sn: "\<forall>m\<in> ?S. coprime (a*m) n " by blast
- from coprime_nproduct[OF fS, of n "\<lambda>m. m"] have nP:"coprime ?P n"
- by (simp add: coprime_commute)
- have Paphi: "[?P*a^ (\<phi> n) = ?P*1] (mod n)"
- proof-
- let ?h = "\<lambda>m. (a * m) mod n"
-
- have eq0: "(\<Prod>i\<in>?S. ?h i) = (\<Prod>i\<in>?S. i)"
- proof (rule prod.reindex_bij_betw)
- have "inj_on (\<lambda>i. ?h i) ?S"
- proof (rule inj_onI)
- fix x y assume "?h x = ?h y"
- then have "[a * x = a * y] (mod n)"
- by (simp add: modeq_def)
- moreover assume "x \<in> ?S" "y \<in> ?S"
- ultimately show "x = y"
- by (auto intro: cong_imp_eq cong_mult_lcancel an)
- qed
- moreover have "?h ` ?S = ?S"
- proof safe
- fix y assume "coprime y n" then show "coprime (?h y) n"
- by (metis an nz coprime_commute coprime_mod coprime_mul_eq)
- next
- fix y assume y: "coprime y n" "y < n"
- from cong_solve_unique[OF an nz] obtain x where x: "x < n" "[a * x = y] (mod n)"
- by blast
- then show "y \<in> ?h ` ?S"
- using cong_coprime[OF x(2)] coprime_mul_eq[of n a x] an y x
- by (intro image_eqI[of _ _ x]) (auto simp add: coprime_commute modeq_def)
- qed (insert nz, simp)
- ultimately show "bij_betw ?h ?S ?S"
- by (simp add: bij_betw_def)
- qed
- from nproduct_mod[OF fS nz, of "op * a"]
- have "[(\<Prod>i\<in>?S. a * i) = (\<Prod>i\<in>?S. ?h i)] (mod n)"
- by (simp add: cong_commute)
- also have "[(\<Prod>i\<in>?S. ?h i) = ?P] (mod n)"
- using eq0 fS an by (simp add: prod_def modeq_def)
- finally show "[?P*a^ (\<phi> n) = ?P*1] (mod n)"
- unfolding cardfS mult.commute[of ?P "a^ (card ?S)"]
- nproduct_cmul[OF fS, symmetric] mult_1_right by simp
- qed
- from cong_mult_lcancel[OF nP Paphi] have ?thesis . }
- ultimately show ?thesis by blast
-qed
-
-lemma fermat_little_prime: assumes p: "prime p" and ap: "coprime a p"
- shows "[a^ (p - 1) = 1] (mod p)"
- using fermat_little[OF ap] p[unfolded phi_prime[symmetric]]
-by simp
-
-
-(* Lucas's theorem. *)
-
-lemma lucas_coprime_lemma:
- assumes m: "m\<noteq>0" and am: "[a^m = 1] (mod n)"
- shows "coprime a n"
-proof-
- {assume "n=1" hence ?thesis by simp}
- moreover
- {assume "n = 0" hence ?thesis using am m exp_eq_1[of a m] by simp}
- moreover
- {assume n: "n\<noteq>0" "n\<noteq>1"
- from m obtain m' where m': "m = Suc m'" by (cases m, blast+)
- {fix d
- assume d: "d dvd a" "d dvd n"
- from n have n1: "1 < n" by arith
- from am mod_less[OF n1] have am1: "a^m mod n = 1" unfolding modeq_def by simp
- from dvd_mult2[OF d(1), of "a^m'"] have dam:"d dvd a^m" by (simp add: m')
- from dvd_mod_iff[OF d(2), of "a^m"] dam am1
- have "d = 1" by simp }
- hence ?thesis unfolding coprime by auto
- }
- ultimately show ?thesis by blast
-qed
-
-lemma lucas_weak:
- assumes n: "n \<ge> 2" and an:"[a^(n - 1) = 1] (mod n)"
- and nm: "\<forall>m. 0 <m \<and> m < n - 1 \<longrightarrow> \<not> [a^m = 1] (mod n)"
- shows "prime n"
-proof-
- from n have n1: "n \<noteq> 1" "n\<noteq>0" "n - 1 \<noteq> 0" "n - 1 > 0" "n - 1 < n" by arith+
- from lucas_coprime_lemma[OF n1(3) an] have can: "coprime a n" .
- from fermat_little[OF can] have afn: "[a ^ \<phi> n = 1] (mod n)" .
- {assume "\<phi> n \<noteq> n - 1"
- with phi_limit_strong[OF n1(1)] phi_lowerbound_1[OF n]
- have c:"\<phi> n > 0 \<and> \<phi> n < n - 1" by arith
- from nm[rule_format, OF c] afn have False ..}
- hence "\<phi> n = n - 1" by blast
- with phi_prime[of n] n1(1,2) show ?thesis by simp
-qed
-
-lemma nat_exists_least_iff: "(\<exists>(n::nat). P n) \<longleftrightarrow> (\<exists>n. P n \<and> (\<forall>m < n. \<not> P m))"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof
- assume ?rhs thus ?lhs by blast
-next
- assume H: ?lhs then obtain n where n: "P n" by blast
- let ?x = "Least P"
- {fix m assume m: "m < ?x"
- from not_less_Least[OF m] have "\<not> P m" .}
- with LeastI_ex[OF H] show ?rhs by blast
-qed
-
-lemma nat_exists_least_iff': "(\<exists>(n::nat). P n) \<longleftrightarrow> (P (Least P) \<and> (\<forall>m < (Least P). \<not> P m))"
- (is "?lhs \<longleftrightarrow> ?rhs")
-proof-
- {assume ?rhs hence ?lhs by blast}
- moreover
- { assume H: ?lhs then obtain n where n: "P n" by blast
- let ?x = "Least P"
- {fix m assume m: "m < ?x"
- from not_less_Least[OF m] have "\<not> P m" .}
- with LeastI_ex[OF H] have ?rhs by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma power_mod: "((x::nat) mod m)^n mod m = x^n mod m"
-proof(induct n)
- case 0 thus ?case by simp
-next
- case (Suc n)
- have "(x mod m)^(Suc n) mod m = ((x mod m) * (((x mod m) ^ n) mod m)) mod m"
- by (simp add: mod_mult_right_eq[symmetric])
- also have "\<dots> = ((x mod m) * (x^n mod m)) mod m" using Suc.hyps by simp
- also have "\<dots> = x^(Suc n) mod m"
- by (simp add: mod_mult_left_eq[symmetric] mod_mult_right_eq[symmetric])
- finally show ?case .
-qed
-
-lemma lucas:
- assumes n2: "n \<ge> 2" and an1: "[a^(n - 1) = 1] (mod n)"
- and pn: "\<forall>p. prime p \<and> p dvd n - 1 \<longrightarrow> \<not> [a^((n - 1) div p) = 1] (mod n)"
- shows "prime n"
-proof-
- from n2 have n01: "n\<noteq>0" "n\<noteq>1" "n - 1 \<noteq> 0" by arith+
- from mod_less_divisor[of n 1] n01 have onen: "1 mod n = 1" by simp
- from lucas_coprime_lemma[OF n01(3) an1] cong_coprime[OF an1]
- have an: "coprime a n" "coprime (a^(n - 1)) n" by (simp_all add: coprime_commute)
- {assume H0: "\<exists>m. 0 < m \<and> m < n - 1 \<and> [a ^ m = 1] (mod n)" (is "EX m. ?P m")
- from H0[unfolded nat_exists_least_iff[of ?P]] obtain m where
- m: "0 < m" "m < n - 1" "[a ^ m = 1] (mod n)" "\<forall>k <m. \<not>?P k" by blast
- {assume nm1: "(n - 1) mod m > 0"
- from mod_less_divisor[OF m(1)] have th0:"(n - 1) mod m < m" by blast
- let ?y = "a^ ((n - 1) div m * m)"
- note mdeq = div_mult_mod_eq[of "(n - 1)" m]
- from coprime_exp[OF an(1)[unfolded coprime_commute[of a n]],
- of "(n - 1) div m * m"]
- have yn: "coprime ?y n" by (simp add: coprime_commute)
- have "?y mod n = (a^m)^((n - 1) div m) mod n"
- by (simp add: algebra_simps power_mult)
- also have "\<dots> = (a^m mod n)^((n - 1) div m) mod n"
- using power_mod[of "a^m" n "(n - 1) div m"] by simp
- also have "\<dots> = 1" using m(3)[unfolded modeq_def onen] onen
- by (simp add: power_Suc0)
- finally have th3: "?y mod n = 1" .
- have th2: "[?y * a ^ ((n - 1) mod m) = ?y* 1] (mod n)"
- using an1[unfolded modeq_def onen] onen
- div_mult_mod_eq[of "(n - 1)" m, symmetric]
- by (simp add:power_add[symmetric] modeq_def th3 del: One_nat_def)
- from cong_mult_lcancel[of ?y n "a^((n - 1) mod m)" 1, OF yn th2]
- have th1: "[a ^ ((n - 1) mod m) = 1] (mod n)" .
- from m(4)[rule_format, OF th0] nm1
- less_trans[OF mod_less_divisor[OF m(1), of "n - 1"] m(2)] th1
- have False by blast }
- hence "(n - 1) mod m = 0" by auto
- then have mn: "m dvd n - 1" by presburger
- then obtain r where r: "n - 1 = m*r" unfolding dvd_def by blast
- from n01 r m(2) have r01: "r\<noteq>0" "r\<noteq>1" by auto
- from prime_factor[OF r01(2)] obtain p where p: "prime p" "p dvd r" by blast
- hence th: "prime p \<and> p dvd n - 1" unfolding r by (auto intro: dvd_mult)
- have "(a ^ ((n - 1) div p)) mod n = (a^(m*r div p)) mod n" using r
- by (simp add: power_mult)
- also have "\<dots> = (a^(m*(r div p))) mod n" using div_mult1_eq[of m r p] p(2)[unfolded dvd_eq_mod_eq_0] by simp
- also have "\<dots> = ((a^m)^(r div p)) mod n" by (simp add: power_mult)
- also have "\<dots> = ((a^m mod n)^(r div p)) mod n" using power_mod[of "a^m" "n" "r div p" ] ..
- also have "\<dots> = 1" using m(3) onen by (simp add: modeq_def power_Suc0)
- finally have "[(a ^ ((n - 1) div p))= 1] (mod n)"
- using onen by (simp add: modeq_def)
- with pn[rule_format, OF th] have False by blast}
- hence th: "\<forall>m. 0 < m \<and> m < n - 1 \<longrightarrow> \<not> [a ^ m = 1] (mod n)" by blast
- from lucas_weak[OF n2 an1 th] show ?thesis .
-qed
-
-(* Definition of the order of a number mod n (0 in non-coprime case). *)
-
-definition "ord n a = (if coprime n a then Least (\<lambda>d. d > 0 \<and> [a ^d = 1] (mod n)) else 0)"
-
-(* This has the expected properties. *)
-
-lemma coprime_ord:
- assumes na: "coprime n a"
- shows "ord n a > 0 \<and> [a ^(ord n a) = 1] (mod n) \<and> (\<forall>m. 0 < m \<and> m < ord n a \<longrightarrow> \<not> [a^ m = 1] (mod n))"
-proof-
- let ?P = "\<lambda>d. 0 < d \<and> [a ^ d = 1] (mod n)"
- from euclid[of a] obtain p where p: "prime p" "a < p" by blast
- from na have o: "ord n a = Least ?P" by (simp add: ord_def)
- {assume "n=0 \<or> n=1" with na have "\<exists>m>0. ?P m" apply auto apply (rule exI[where x=1]) by (simp add: modeq_def)}
- moreover
- {assume "n\<noteq>0 \<and> n\<noteq>1" hence n2:"n \<ge> 2" by arith
- from na have na': "coprime a n" by (simp add: coprime_commute)
- have ex: "\<exists>m>0. ?P m"
- by (rule exI[where x="\<phi> n"]) (use phi_lowerbound_1[OF n2] fermat_little[OF na'] in auto) }
- ultimately have ex: "\<exists>m>0. ?P m" by blast
- from nat_exists_least_iff'[of ?P] ex na show ?thesis
- unfolding o[symmetric] by auto
-qed
-(* With the special value 0 for non-coprime case, it's more convenient. *)
-lemma ord_works:
- "[a ^ (ord n a) = 1] (mod n) \<and> (\<forall>m. 0 < m \<and> m < ord n a \<longrightarrow> ~[a^ m = 1] (mod n))"
-apply (cases "coprime n a")
-using coprime_ord[of n a]
-by (blast, simp add: ord_def modeq_def)
-
-lemma ord: "[a^(ord n a) = 1] (mod n)" using ord_works by blast
-lemma ord_minimal: "0 < m \<Longrightarrow> m < ord n a \<Longrightarrow> ~[a^m = 1] (mod n)"
- using ord_works by blast
-lemma ord_eq_0: "ord n a = 0 \<longleftrightarrow> ~coprime n a"
-by (cases "coprime n a", simp add: coprime_ord, simp add: ord_def)
-
-lemma ord_divides:
- "[a ^ d = 1] (mod n) \<longleftrightarrow> ord n a dvd d" (is "?lhs \<longleftrightarrow> ?rhs")
-proof
- assume rh: ?rhs
- then obtain k where "d = ord n a * k" unfolding dvd_def by blast
- hence "[a ^ d = (a ^ (ord n a) mod n)^k] (mod n)"
- by (simp add : modeq_def power_mult power_mod)
- also have "[(a ^ (ord n a) mod n)^k = 1] (mod n)"
- using ord[of a n, unfolded modeq_def]
- by (simp add: modeq_def power_mod power_Suc0)
- finally show ?lhs .
-next
- assume lh: ?lhs
- { assume H: "\<not> coprime n a"
- hence o: "ord n a = 0" by (simp add: ord_def)
- {assume d: "d=0" with o H have ?rhs by (simp add: modeq_def)}
- moreover
- {assume d0: "d\<noteq>0" then obtain d' where d': "d = Suc d'" by (cases d, auto)
- from H[unfolded coprime]
- obtain p where p: "p dvd n" "p dvd a" "p \<noteq> 1" by auto
- from lh[unfolded nat_mod]
- obtain q1 q2 where q12:"a ^ d + n * q1 = 1 + n * q2" by blast
- hence "a ^ d + n * q1 - n * q2 = 1" by simp
- with dvd_diff_nat [OF dvd_add [OF divides_rexp[OF p(2), of d'] dvd_mult2[OF p(1), of q1]] dvd_mult2[OF p(1), of q2]] d' have "p dvd 1" by simp
- with p(3) have False by simp
- hence ?rhs ..}
- ultimately have ?rhs by blast}
- moreover
- {assume H: "coprime n a"
- let ?o = "ord n a"
- let ?q = "d div ord n a"
- let ?r = "d mod ord n a"
- from cong_exp[OF ord[of a n], of ?q]
- have eqo: "[(a^?o)^?q = 1] (mod n)" by (simp add: modeq_def power_Suc0)
- from H have onz: "?o \<noteq> 0" by (simp add: ord_eq_0)
- hence op: "?o > 0" by simp
- from div_mult_mod_eq[of d "ord n a"] lh
- have "[a^(?o*?q + ?r) = 1] (mod n)" by (simp add: modeq_def mult.commute)
- hence "[(a^?o)^?q * (a^?r) = 1] (mod n)"
- by (simp add: modeq_def power_mult[symmetric] power_add[symmetric])
- hence th: "[a^?r = 1] (mod n)"
- using eqo mod_mult_left_eq[of "(a^?o)^?q" "a^?r" n]
- apply (simp add: modeq_def del: One_nat_def)
- by (simp add: mod_mult_left_eq[symmetric])
- {assume r: "?r = 0" hence ?rhs by (simp add: dvd_eq_mod_eq_0)}
- moreover
- {assume r: "?r \<noteq> 0"
- with mod_less_divisor[OF op, of d] have r0o:"?r >0 \<and> ?r < ?o" by simp
- from conjunct2[OF ord_works[of a n], rule_format, OF r0o] th
- have ?rhs by blast}
- ultimately have ?rhs by blast}
- ultimately show ?rhs by blast
-qed
-
-lemma order_divides_phi: "coprime n a \<Longrightarrow> ord n a dvd \<phi> n"
-using ord_divides fermat_little coprime_commute by simp
-lemma order_divides_expdiff:
- assumes na: "coprime n a"
- shows "[a^d = a^e] (mod n) \<longleftrightarrow> [d = e] (mod (ord n a))"
-proof-
- {fix n a d e
- assume na: "coprime n a" and ed: "(e::nat) \<le> d"
- hence "\<exists>c. d = e + c" by arith
- then obtain c where c: "d = e + c" by arith
- from na have an: "coprime a n" by (simp add: coprime_commute)
- from coprime_exp[OF na, of e]
- have aen: "coprime (a^e) n" by (simp add: coprime_commute)
- from coprime_exp[OF na, of c]
- have acn: "coprime (a^c) n" by (simp add: coprime_commute)
- have "[a^d = a^e] (mod n) \<longleftrightarrow> [a^(e + c) = a^(e + 0)] (mod n)"
- using c by simp
- also have "\<dots> \<longleftrightarrow> [a^e* a^c = a^e *a^0] (mod n)" by (simp add: power_add)
- also have "\<dots> \<longleftrightarrow> [a ^ c = 1] (mod n)"
- using cong_mult_lcancel_eq[OF aen, of "a^c" "a^0"] by simp
- also have "\<dots> \<longleftrightarrow> ord n a dvd c" by (simp only: ord_divides)
- also have "\<dots> \<longleftrightarrow> [e + c = e + 0] (mod ord n a)"
- using cong_add_lcancel_eq[of e c 0 "ord n a", simplified cong_0_divides]
- by simp
- finally have "[a^d = a^e] (mod n) \<longleftrightarrow> [d = e] (mod (ord n a))"
- using c by simp }
- note th = this
- have "e \<le> d \<or> d \<le> e" by arith
- moreover
- {assume ed: "e \<le> d" from th[OF na ed] have ?thesis .}
- moreover
- {assume de: "d \<le> e"
- from th[OF na de] have ?thesis by (simp add: cong_commute) }
- ultimately show ?thesis by blast
-qed
-
-(* Another trivial primality characterization. *)
-
-lemma prime_prime_factor:
- "prime n \<longleftrightarrow> n \<noteq> 1\<and> (\<forall>p. prime p \<and> p dvd n \<longrightarrow> p = n)"
-proof-
- {assume n: "n=0 \<or> n=1" hence ?thesis using prime_0 two_is_prime by auto}
- moreover
- {assume n: "n\<noteq>0" "n\<noteq>1"
- {assume pn: "prime n"
-
- from pn[unfolded prime_def] have "\<forall>p. prime p \<and> p dvd n \<longrightarrow> p = n"
- using n
- apply (cases "n = 0 \<or> n=1",simp)
- by (clarsimp, erule_tac x="p" in allE, auto)}
- moreover
- {assume H: "\<forall>p. prime p \<and> p dvd n \<longrightarrow> p = n"
- from n have n1: "n > 1" by arith
- {fix m assume m: "m dvd n" "m\<noteq>1"
- from prime_factor[OF m(2)] obtain p where
- p: "prime p" "p dvd m" by blast
- from dvd_trans[OF p(2) m(1)] p(1) H have "p = n" by blast
- with p(2) have "n dvd m" by simp
- hence "m=n" using dvd_antisym[OF m(1)] by simp }
- with n1 have "prime n" unfolding prime_def by auto }
- ultimately have ?thesis using n by blast}
- ultimately show ?thesis by auto
-qed
-
-lemma prime_divisor_sqrt:
- "prime n \<longleftrightarrow> n \<noteq> 1 \<and> (\<forall>d. d dvd n \<and> d\<^sup>2 \<le> n \<longrightarrow> d = 1)"
-proof-
- {assume "n=0 \<or> n=1" hence ?thesis using prime_0 prime_1
- by (auto simp add: nat_power_eq_0_iff)}
- moreover
- {assume n: "n\<noteq>0" "n\<noteq>1"
- hence np: "n > 1" by arith
- {fix d assume d: "d dvd n" "d\<^sup>2 \<le> n" and H: "\<forall>m. m dvd n \<longrightarrow> m=1 \<or> m=n"
- from H d have d1n: "d = 1 \<or> d=n" by blast
- {assume dn: "d=n"
- have "n\<^sup>2 > n*1" using n by (simp add: power2_eq_square)
- with dn d(2) have "d=1" by simp}
- with d1n have "d = 1" by blast }
- moreover
- {fix d assume d: "d dvd n" and H: "\<forall>d'. d' dvd n \<and> d'\<^sup>2 \<le> n \<longrightarrow> d' = 1"
- from d n have "d \<noteq> 0" apply - apply (rule ccontr) by simp
- hence dp: "d > 0" by simp
- from d[unfolded dvd_def] obtain e where e: "n= d*e" by blast
- from n dp e have ep:"e > 0" by simp
- have "d\<^sup>2 \<le> n \<or> e\<^sup>2 \<le> n" using dp ep
- by (auto simp add: e power2_eq_square mult_le_cancel_left)
- moreover
- {assume h: "d\<^sup>2 \<le> n"
- from H[rule_format, of d] h d have "d = 1" by blast}
- moreover
- {assume h: "e\<^sup>2 \<le> n"
- from e have "e dvd n" unfolding dvd_def by (simp add: mult.commute)
- with H[rule_format, of e] h have "e=1" by simp
- with e have "d = n" by simp}
- ultimately have "d=1 \<or> d=n" by blast}
- ultimately have ?thesis unfolding prime_def using np n(2) by blast}
- ultimately show ?thesis by auto
-qed
-lemma prime_prime_factor_sqrt:
- "prime n \<longleftrightarrow> n \<noteq> 0 \<and> n \<noteq> 1 \<and> \<not> (\<exists>p. prime p \<and> p dvd n \<and> p\<^sup>2 \<le> n)"
- (is "?lhs \<longleftrightarrow>?rhs")
-proof-
- {assume "n=0 \<or> n=1" hence ?thesis using prime_0 prime_1 by auto}
- moreover
- {assume n: "n\<noteq>0" "n\<noteq>1"
- {assume H: ?lhs
- from H[unfolded prime_divisor_sqrt] n
- have ?rhs
- apply clarsimp
- apply (erule_tac x="p" in allE)
- apply simp
- done
- }
- moreover
- {assume H: ?rhs
- {fix d assume d: "d dvd n" "d\<^sup>2 \<le> n" "d\<noteq>1"
- from prime_factor[OF d(3)]
- obtain p where p: "prime p" "p dvd d" by blast
- from n have np: "n > 0" by arith
- have "d \<noteq> 0" by (rule ccontr) (use d(1) n in auto)
- hence dp: "d > 0" by arith
- from mult_mono[OF dvd_imp_le[OF p(2) dp] dvd_imp_le[OF p(2) dp]] d(2)
- have "p\<^sup>2 \<le> n" unfolding power2_eq_square by arith
- with H n p(1) dvd_trans[OF p(2) d(1)] have False by blast}
- with n prime_divisor_sqrt have ?lhs by auto}
- ultimately have ?thesis by blast }
- ultimately show ?thesis by (cases "n=0 \<or> n=1", auto)
-qed
-(* Pocklington theorem. *)
-
-lemma pocklington_lemma:
- assumes n: "n \<ge> 2" and nqr: "n - 1 = q*r" and an: "[a^ (n - 1) = 1] (mod n)"
- and aq:"\<forall>p. prime p \<and> p dvd q \<longrightarrow> coprime (a^ ((n - 1) div p) - 1) n"
- and pp: "prime p" and pn: "p dvd n"
- shows "[p = 1] (mod q)"
-proof-
- from pp prime_0 prime_1 have p01: "p \<noteq> 0" "p \<noteq> 1" by - (rule ccontr, simp)+
- from cong_1_divides[OF an, unfolded nqr, unfolded dvd_def]
- obtain k where k: "a ^ (q * r) - 1 = n*k" by blast
- from pn[unfolded dvd_def] obtain l where l: "n = p*l" by blast
- {assume a0: "a = 0"
- hence "a^ (n - 1) = 0" using n by (simp add: power_0_left)
- with n an mod_less[of 1 n] have False by (simp add: power_0_left modeq_def)}
- hence a0: "a\<noteq>0" ..
- from n nqr have aqr0: "a ^ (q * r) \<noteq> 0" using a0 by simp
- hence "(a ^ (q * r) - 1) + 1 = a ^ (q * r)" by simp
- with k l have "a ^ (q * r) = p*l*k + 1" by simp
- hence "a ^ (r * q) + p * 0 = 1 + p * (l*k)" by (simp add: ac_simps)
- hence odq: "ord p (a^r) dvd q"
- unfolding ord_divides[symmetric] power_mult[symmetric] nat_mod by blast
- from odq[unfolded dvd_def] obtain d where d: "q = ord p (a^r) * d" by blast
- {assume d1: "d \<noteq> 1"
- from prime_factor[OF d1] obtain P where P: "prime P" "P dvd d" by blast
- from d dvd_mult[OF P(2), of "ord p (a^r)"] have Pq: "P dvd q" by simp
- from aq P(1) Pq have caP:"coprime (a^ ((n - 1) div P) - 1) n" by blast
- from Pq obtain s where s: "q = P*s" unfolding dvd_def by blast
- have P0: "P \<noteq> 0" by (rule ccontr) (use P(1) prime_0 in simp)
- from P(2) obtain t where t: "d = P*t" unfolding dvd_def by blast
- from d s t P0 have s': "ord p (a^r) * t = s" by algebra
- have "ord p (a^r) * t*r = r * ord p (a^r) * t" by algebra
- hence exps: "a^(ord p (a^r) * t*r) = ((a ^ r) ^ ord p (a^r)) ^ t"
- by (simp only: power_mult)
- have "[((a ^ r) ^ ord p (a^r)) ^ t= 1^t] (mod p)"
- by (rule cong_exp, rule ord)
- then have th: "[((a ^ r) ^ ord p (a^r)) ^ t= 1] (mod p)"
- by (simp add: power_Suc0)
- from cong_1_divides[OF th] exps have pd0: "p dvd a^(ord p (a^r) * t*r) - 1" by simp
- from nqr s s' have "(n - 1) div P = ord p (a^r) * t*r" using P0 by simp
- with caP have "coprime (a^(ord p (a^r) * t*r) - 1) n" by simp
- with p01 pn pd0 have False unfolding coprime by auto}
- hence d1: "d = 1" by blast
- hence o: "ord p (a^r) = q" using d by simp
- from pp phi_prime[of p] have phip: " \<phi> p = p - 1" by simp
- {fix d assume d: "d dvd p" "d dvd a" "d \<noteq> 1"
- from pp[unfolded prime_def] d have dp: "d = p" by blast
- from n have n12:"Suc (n - 2) = n - 1" by arith
- with divides_rexp[OF d(2)[unfolded dp], of "n - 2"]
- have th0: "p dvd a ^ (n - 1)" by simp
- from n have n0: "n \<noteq> 0" by simp
- have a0: "a \<noteq> 0"
- by (rule ccontr) (use d(2) an n12[symmetric] in \<open>simp add: modeq_def\<close>)
- have th1: "a^ (n - 1) \<noteq> 0" using n d(2) dp a0 by auto
- from coprime_minus1[OF th1, unfolded coprime]
- dvd_trans[OF pn cong_1_divides[OF an]] th0 d(3) dp
- have False by auto}
- hence cpa: "coprime p a" using coprime by auto
- from coprime_exp[OF cpa, of r] coprime_commute
- have arp: "coprime (a^r) p" by blast
- from fermat_little[OF arp, simplified ord_divides] o phip
- have "q dvd (p - 1)" by simp
- then obtain d where d:"p - 1 = q * d" unfolding dvd_def by blast
- have p0: "p \<noteq> 0" by (rule ccontr) (use prime_0 pp in auto)
- from p0 d have "p + q * 0 = 1 + q * d" by simp
- with nat_mod[of p 1 q, symmetric]
- show ?thesis by blast
-qed
-
-lemma pocklington:
- assumes n: "n \<ge> 2" and nqr: "n - 1 = q*r" and sqr: "n \<le> q\<^sup>2"
- and an: "[a^ (n - 1) = 1] (mod n)"
- and aq:"\<forall>p. prime p \<and> p dvd q \<longrightarrow> coprime (a^ ((n - 1) div p) - 1) n"
- shows "prime n"
-unfolding prime_prime_factor_sqrt[of n]
-proof-
- let ?ths = "n \<noteq> 0 \<and> n \<noteq> 1 \<and> \<not> (\<exists>p. prime p \<and> p dvd n \<and> p\<^sup>2 \<le> n)"
- from n have n01: "n\<noteq>0" "n\<noteq>1" by arith+
- {fix p assume p: "prime p" "p dvd n" "p\<^sup>2 \<le> n"
- from p(3) sqr have "p^(Suc 1) \<le> q^(Suc 1)" by (simp add: power2_eq_square)
- hence pq: "p \<le> q" unfolding exp_mono_le .
- from pocklington_lemma[OF n nqr an aq p(1,2)] cong_1_divides
- have th: "q dvd p - 1" by blast
- have "p - 1 \<noteq> 0"using prime_ge_2[OF p(1)] by arith
- with divides_ge[OF th] pq have False by arith }
- with n01 show ?ths by blast
-qed
-
-(* Variant for application, to separate the exponentiation. *)
-lemma pocklington_alt:
- assumes n: "n \<ge> 2" and nqr: "n - 1 = q*r" and sqr: "n \<le> q\<^sup>2"
- and an: "[a^ (n - 1) = 1] (mod n)"
- and aq:"\<forall>p. prime p \<and> p dvd q \<longrightarrow> (\<exists>b. [a^((n - 1) div p) = b] (mod n) \<and> coprime (b - 1) n)"
- shows "prime n"
-proof-
- {fix p assume p: "prime p" "p dvd q"
- from aq[rule_format] p obtain b where
- b: "[a^((n - 1) div p) = b] (mod n)" "coprime (b - 1) n" by blast
- {assume a0: "a=0"
- from n an have "[0 = 1] (mod n)" unfolding a0 power_0_left by auto
- hence False using n by (simp add: modeq_def dvd_eq_mod_eq_0[symmetric])}
- hence a0: "a\<noteq> 0" ..
- hence a1: "a \<ge> 1" by arith
- from one_le_power[OF a1] have ath: "1 \<le> a ^ ((n - 1) div p)" .
- {assume b0: "b = 0"
- from p(2) nqr have "(n - 1) mod p = 0"
- apply (simp only: dvd_eq_mod_eq_0[symmetric]) by (rule dvd_mult2, simp)
- with div_mult_mod_eq[of "n - 1" p]
- have "(n - 1) div p * p= n - 1" by auto
- hence eq: "(a^((n - 1) div p))^p = a^(n - 1)"
- by (simp only: power_mult[symmetric])
- from prime_ge_2[OF p(1)] have pS: "Suc (p - 1) = p" by arith
- from b(1) have d: "n dvd a^((n - 1) div p)" unfolding b0 cong_0_divides .
- from divides_rexp[OF d, of "p - 1"] pS eq cong_divides[OF an] n
- have False by simp}
- then have b0: "b \<noteq> 0" ..
- hence b1: "b \<ge> 1" by arith
- from cong_coprime[OF cong_sub[OF b(1) cong_refl[of 1] ath b1]] b(2) nqr
- have "coprime (a ^ ((n - 1) div p) - 1) n" by (simp add: coprime_commute)}
- hence th: "\<forall>p. prime p \<and> p dvd q \<longrightarrow> coprime (a ^ ((n - 1) div p) - 1) n "
- by blast
- from pocklington[OF n nqr sqr an th] show ?thesis .
-qed
-
-(* Prime factorizations. *)
-
-definition "primefact ps n = (foldr op * ps 1 = n \<and> (\<forall>p\<in> set ps. prime p))"
-
-lemma primefact: assumes n: "n \<noteq> 0"
- shows "\<exists>ps. primefact ps n"
-using n
-proof(induct n rule: nat_less_induct)
- fix n assume H: "\<forall>m<n. m \<noteq> 0 \<longrightarrow> (\<exists>ps. primefact ps m)" and n: "n\<noteq>0"
- let ?ths = "\<exists>ps. primefact ps n"
- {assume "n = 1"
- hence "primefact [] n" by (simp add: primefact_def)
- hence ?ths by blast }
- moreover
- {assume n1: "n \<noteq> 1"
- with n have n2: "n \<ge> 2" by arith
- from prime_factor[OF n1] obtain p where p: "prime p" "p dvd n" by blast
- from p(2) obtain m where m: "n = p*m" unfolding dvd_def by blast
- from n m have m0: "m > 0" "m\<noteq>0" by auto
- from prime_ge_2[OF p(1)] have "1 < p" by arith
- with m0 m have mn: "m < n" by auto
- from H[rule_format, OF mn m0(2)] obtain ps where ps: "primefact ps m" ..
- from ps m p(1) have "primefact (p#ps) n" by (simp add: primefact_def)
- hence ?ths by blast}
- ultimately show ?ths by blast
-qed
-
-lemma primefact_contains:
- assumes pf: "primefact ps n" and p: "prime p" and pn: "p dvd n"
- shows "p \<in> set ps"
- using pf p pn
-proof(induct ps arbitrary: p n)
- case Nil thus ?case by (auto simp add: primefact_def)
-next
- case (Cons q qs p n)
- from Cons.prems[unfolded primefact_def]
- have q: "prime q" "q * foldr op * qs 1 = n" "\<forall>p \<in>set qs. prime p" and p: "prime p" "p dvd q * foldr op * qs 1" by simp_all
- {assume "p dvd q"
- with p(1) q(1) have "p = q" unfolding prime_def by auto
- hence ?case by simp}
- moreover
- { assume h: "p dvd foldr op * qs 1"
- from q(3) have pqs: "primefact qs (foldr op * qs 1)"
- by (simp add: primefact_def)
- from Cons.hyps[OF pqs p(1) h] have ?case by simp}
- ultimately show ?case using prime_divprod[OF p] by blast
-qed
-
-lemma primefact_variant: "primefact ps n \<longleftrightarrow> foldr op * ps 1 = n \<and> list_all prime ps"
- by (auto simp add: primefact_def list_all_iff)
-
-(* Variant of Lucas theorem. *)
-
-lemma lucas_primefact:
- assumes n: "n \<ge> 2" and an: "[a^(n - 1) = 1] (mod n)"
- and psn: "foldr op * ps 1 = n - 1"
- and psp: "list_all (\<lambda>p. prime p \<and> \<not> [a^((n - 1) div p) = 1] (mod n)) ps"
- shows "prime n"
-proof-
- {fix p assume p: "prime p" "p dvd n - 1" "[a ^ ((n - 1) div p) = 1] (mod n)"
- from psn psp have psn1: "primefact ps (n - 1)"
- by (auto simp add: list_all_iff primefact_variant)
- from p(3) primefact_contains[OF psn1 p(1,2)] psp
- have False by (induct ps, auto)}
- with lucas[OF n an] show ?thesis by blast
-qed
-
-(* Variant of Pocklington theorem. *)
-
-lemma mod_le: assumes n: "n \<noteq> (0::nat)" shows "m mod n \<le> m"
-proof-
- from div_mult_mod_eq[of m n]
- have "\<exists>x. x + m mod n = m" by blast
- then show ?thesis by auto
-qed
-
-
-lemma pocklington_primefact:
- assumes n: "n \<ge> 2" and qrn: "q*r = n - 1" and nq2: "n \<le> q\<^sup>2"
- and arnb: "(a^r) mod n = b" and psq: "foldr op * ps 1 = q"
- and bqn: "(b^q) mod n = 1"
- and psp: "list_all (\<lambda>p. prime p \<and> coprime ((b^(q div p)) mod n - 1) n) ps"
- shows "prime n"
-proof-
- from bqn psp qrn
- have bqn: "a ^ (n - 1) mod n = 1"
- and psp: "list_all (\<lambda>p. prime p \<and> coprime (a^(r *(q div p)) mod n - 1) n) ps" unfolding arnb[symmetric] power_mod
- by (simp_all add: power_mult[symmetric] algebra_simps)
- from n have n0: "n > 0" by arith
- from div_mult_mod_eq[of "a^(n - 1)" n]
- mod_less_divisor[OF n0, of "a^(n - 1)"]
- have an1: "[a ^ (n - 1) = 1] (mod n)"
- unfolding nat_mod bqn
- apply -
- apply (rule exI[where x="0"])
- apply (rule exI[where x="a^(n - 1) div n"])
- by (simp add: algebra_simps)
- {fix p assume p: "prime p" "p dvd q"
- from psp psq have pfpsq: "primefact ps q"
- by (auto simp add: primefact_variant list_all_iff)
- from psp primefact_contains[OF pfpsq p]
- have p': "coprime (a ^ (r * (q div p)) mod n - 1) n"
- by (simp add: list_all_iff)
- from prime_ge_2[OF p(1)] have p01: "p \<noteq> 0" "p \<noteq> 1" "p =Suc(p - 1)" by arith+
- from div_mult1_eq[of r q p] p(2)
- have eq1: "r* (q div p) = (n - 1) div p"
- unfolding qrn[symmetric] dvd_eq_mod_eq_0 by (simp add: mult.commute)
- have ath: "\<And>a (b::nat). a <= b \<Longrightarrow> a \<noteq> 0 ==> 1 <= a \<and> 1 <= b" by arith
- from n0 have n00: "n \<noteq> 0" by arith
- from mod_le[OF n00]
- have th10: "a ^ ((n - 1) div p) mod n \<le> a ^ ((n - 1) div p)" .
- {assume "a ^ ((n - 1) div p) mod n = 0"
- then obtain s where s: "a ^ ((n - 1) div p) = n*s"
- unfolding mod_eq_0_iff by blast
- hence eq0: "(a^((n - 1) div p))^p = (n*s)^p" by simp
- from qrn[symmetric] have qn1: "q dvd n - 1" unfolding dvd_def by auto
- with p(2) have npp: "(n - 1) div p * p = n - 1"
- by (auto intro: dvd_div_mult_self dvd_trans)
- with eq0 have "a^ (n - 1) = (n*s)^p"
- by (simp add: power_mult[symmetric])
- hence "1 = (n*s)^(Suc (p - 1)) mod n" using bqn p01 by simp
- also have "\<dots> = 0" by (simp add: mult.assoc)
- finally have False by simp }
- then have th11: "a ^ ((n - 1) div p) mod n \<noteq> 0" by auto
- have th1: "[a ^ ((n - 1) div p) mod n = a ^ ((n - 1) div p)] (mod n)"
- unfolding modeq_def by simp
- from cong_sub[OF th1 cong_refl[of 1]] ath[OF th10 th11]
- have th: "[a ^ ((n - 1) div p) mod n - 1 = a ^ ((n - 1) div p) - 1] (mod n)"
- by blast
- from cong_coprime[OF th] p'[unfolded eq1]
- have "coprime (a ^ ((n - 1) div p) - 1) n" by (simp add: coprime_commute) }
- with pocklington[OF n qrn[symmetric] nq2 an1]
- show ?thesis by blast
-qed
-
-end
--- a/src/HOL/Old_Number_Theory/Primes.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,840 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Primes.thy
- Author: Amine Chaieb, Christophe Tabacznyj and Lawrence C Paulson
- Copyright 1996 University of Cambridge
-*)
-
-section \<open>Primality on nat\<close>
-
-theory Primes
-imports Complex_Main Legacy_GCD
-begin
-
-definition coprime :: "nat => nat => bool"
- where "coprime m n \<longleftrightarrow> gcd m n = 1"
-
-definition prime :: "nat \<Rightarrow> bool"
- where "prime p \<longleftrightarrow> (1 < p \<and> (\<forall>m. m dvd p --> m = 1 \<or> m = p))"
-
-
-lemma two_is_prime: "prime 2"
- apply (auto simp add: prime_def)
- apply (case_tac m)
- apply (auto dest!: dvd_imp_le)
- done
-
-lemma prime_imp_relprime: "prime p ==> \<not> p dvd n ==> gcd p n = 1"
- apply (auto simp add: prime_def)
- apply (metis gcd_dvd1 gcd_dvd2)
- done
-
-text \<open>
- This theorem leads immediately to a proof of the uniqueness of
- factorization. If @{term p} divides a product of primes then it is
- one of those primes.
-\<close>
-
-lemma prime_dvd_mult: "prime p ==> p dvd m * n ==> p dvd m \<or> p dvd n"
- by (blast intro: relprime_dvd_mult prime_imp_relprime)
-
-lemma prime_dvd_square: "prime p ==> p dvd m^Suc (Suc 0) ==> p dvd m"
- by (auto dest: prime_dvd_mult)
-
-lemma prime_dvd_power_two: "prime p ==> p dvd m\<^sup>2 ==> p dvd m"
- by (rule prime_dvd_square) (simp_all add: power2_eq_square)
-
-
-lemma exp_eq_1:"(x::nat)^n = 1 \<longleftrightarrow> x = 1 \<or> n = 0"
-by (induct n, auto)
-
-lemma exp_mono_lt: "(x::nat) ^ (Suc n) < y ^ (Suc n) \<longleftrightarrow> x < y"
-by(metis linorder_not_less not_less0 power_le_imp_le_base power_less_imp_less_base)
-
-lemma exp_mono_le: "(x::nat) ^ (Suc n) \<le> y ^ (Suc n) \<longleftrightarrow> x \<le> y"
-by (simp only: linorder_not_less[symmetric] exp_mono_lt)
-
-lemma exp_mono_eq: "(x::nat) ^ Suc n = y ^ Suc n \<longleftrightarrow> x = y"
-using power_inject_base[of x n y] by auto
-
-
-lemma even_square: assumes e: "even (n::nat)" shows "\<exists>x. n\<^sup>2 = 4*x"
-proof-
- from e have "2 dvd n" by presburger
- then obtain k where k: "n = 2*k" using dvd_def by auto
- hence "n\<^sup>2 = 4 * k\<^sup>2" by (simp add: power2_eq_square)
- thus ?thesis by blast
-qed
-
-lemma odd_square: assumes e: "odd (n::nat)" shows "\<exists>x. n\<^sup>2 = 4*x + 1"
-proof-
- from e have np: "n > 0" by presburger
- from e have "2 dvd (n - 1)" by presburger
- then obtain k where "n - 1 = 2 * k" ..
- hence k: "n = 2*k + 1" using e by presburger
- hence "n\<^sup>2 = 4* (k\<^sup>2 + k) + 1" by algebra
- thus ?thesis by blast
-qed
-
-lemma diff_square: "(x::nat)\<^sup>2 - y\<^sup>2 = (x+y)*(x - y)"
-proof-
- have "x \<le> y \<or> y \<le> x" by (rule nat_le_linear)
- moreover
- {assume le: "x \<le> y"
- hence "x\<^sup>2 \<le> y\<^sup>2" by (simp only: numeral_2_eq_2 exp_mono_le Let_def)
- with le have ?thesis by simp }
- moreover
- {assume le: "y \<le> x"
- hence le2: "y\<^sup>2 \<le> x\<^sup>2" by (simp only: numeral_2_eq_2 exp_mono_le Let_def)
- from le have "\<exists>z. y + z = x" by presburger
- then obtain z where z: "x = y + z" by blast
- from le2 have "\<exists>z. x\<^sup>2 = y\<^sup>2 + z" by presburger
- then obtain z2 where z2: "x\<^sup>2 = y\<^sup>2 + z2" by blast
- from z z2 have ?thesis by simp algebra }
- ultimately show ?thesis by blast
-qed
-
-text \<open>Elementary theory of divisibility\<close>
-lemma divides_ge: "(a::nat) dvd b \<Longrightarrow> b = 0 \<or> a \<le> b" unfolding dvd_def by auto
-lemma divides_antisym: "(x::nat) dvd y \<and> y dvd x \<longleftrightarrow> x = y"
- using dvd_antisym[of x y] by auto
-
-lemma divides_add_revr: assumes da: "(d::nat) dvd a" and dab:"d dvd (a + b)"
- shows "d dvd b"
-proof-
- from da obtain k where k:"a = d*k" by (auto simp add: dvd_def)
- from dab obtain k' where k': "a + b = d*k'" by (auto simp add: dvd_def)
- from k k' have "b = d *(k' - k)" by (simp add : diff_mult_distrib2)
- thus ?thesis unfolding dvd_def by blast
-qed
-
-declare nat_mult_dvd_cancel_disj[presburger]
-lemma nat_mult_dvd_cancel_disj'[presburger]:
- "(m::nat)*k dvd n*k \<longleftrightarrow> k = 0 \<or> m dvd n" unfolding mult.commute[of m k] mult.commute[of n k] by presburger
-
-lemma divides_mul_l: "(a::nat) dvd b ==> (c * a) dvd (c * b)"
- by presburger
-
-lemma divides_mul_r: "(a::nat) dvd b ==> (a * c) dvd (b * c)" by presburger
-lemma divides_cases: "(n::nat) dvd m ==> m = 0 \<or> m = n \<or> 2 * n <= m"
- by (auto simp add: dvd_def)
-
-lemma divides_div_not: "(x::nat) = (q * n) + r \<Longrightarrow> 0 < r \<Longrightarrow> r < n ==> ~(n dvd x)"
-proof(auto simp add: dvd_def)
- fix k assume H: "0 < r" "r < n" "q * n + r = n * k"
- from H(3) have r: "r = n* (k -q)" by(simp add: diff_mult_distrib2 mult.commute)
- {assume "k - q = 0" with r H(1) have False by simp}
- moreover
- {assume "k - q \<noteq> 0" with r have "r \<ge> n" by auto
- with H(2) have False by simp}
- ultimately show False by blast
-qed
-lemma divides_exp: "(x::nat) dvd y ==> x ^ n dvd y ^ n"
- by (auto simp add: power_mult_distrib dvd_def)
-
-lemma divides_exp2: "n \<noteq> 0 \<Longrightarrow> (x::nat) ^ n dvd y \<Longrightarrow> x dvd y"
- by (induct n ,auto simp add: dvd_def)
-
-fun fact :: "nat \<Rightarrow> nat" where
- "fact 0 = 1"
-| "fact (Suc n) = Suc n * fact n"
-
-lemma fact_lt: "0 < fact n" by(induct n, simp_all)
-lemma fact_le: "fact n \<ge> 1" using fact_lt[of n] by simp
-lemma fact_mono: assumes le: "m \<le> n" shows "fact m \<le> fact n"
-proof-
- from le have "\<exists>i. n = m+i" by presburger
- then obtain i where i: "n = m+i" by blast
- have "fact m \<le> fact (m + i)"
- proof(induct m)
- case 0 thus ?case using fact_le[of i] by simp
- next
- case (Suc m)
- have "fact (Suc m) = Suc m * fact m" by simp
- have th1: "Suc m \<le> Suc (m + i)" by simp
- from mult_le_mono[of "Suc m" "Suc (m+i)" "fact m" "fact (m+i)", OF th1 Suc.hyps]
- show ?case by simp
- qed
- thus ?thesis using i by simp
-qed
-
-lemma divides_fact: "1 <= p \<Longrightarrow> p <= n ==> p dvd fact n"
-proof(induct n arbitrary: p)
- case 0 thus ?case by simp
-next
- case (Suc n p)
- from Suc.prems have "p = Suc n \<or> p \<le> n" by presburger
- moreover
- {assume "p = Suc n" hence ?case by (simp only: fact.simps dvd_triv_left)}
- moreover
- {assume "p \<le> n"
- with Suc.prems(1) Suc.hyps have th: "p dvd fact n" by simp
- from dvd_mult[OF th] have ?case by (simp only: fact.simps) }
- ultimately show ?case by blast
-qed
-
-declare dvd_triv_left[presburger]
-declare dvd_triv_right[presburger]
-lemma divides_rexp:
- "x dvd y \<Longrightarrow> (x::nat) dvd (y^(Suc n))" by (simp add: dvd_mult2[of x y])
-
-text \<open>Coprimality\<close>
-
-lemma coprime: "coprime a b \<longleftrightarrow> (\<forall>d. d dvd a \<and> d dvd b \<longleftrightarrow> d = 1)"
-using gcd_unique[of 1 a b, simplified] by (auto simp add: coprime_def)
-lemma coprime_commute: "coprime a b \<longleftrightarrow> coprime b a" by (simp add: coprime_def gcd_commute)
-
-lemma coprime_bezout: "coprime a b \<longleftrightarrow> (\<exists>x y. a * x - b * y = 1 \<or> b * x - a * y = 1)"
-using coprime_def gcd_bezout by auto
-
-lemma coprime_divprod: "d dvd a * b \<Longrightarrow> coprime d a \<Longrightarrow> d dvd b"
- using relprime_dvd_mult_iff[of d a b] by (auto simp add: coprime_def mult.commute)
-
-lemma coprime_1[simp]: "coprime a 1" by (simp add: coprime_def)
-lemma coprime_1'[simp]: "coprime 1 a" by (simp add: coprime_def)
-lemma coprime_Suc0[simp]: "coprime a (Suc 0)" by (simp add: coprime_def)
-lemma coprime_Suc0'[simp]: "coprime (Suc 0) a" by (simp add: coprime_def)
-
-lemma gcd_coprime:
- assumes z: "gcd a b \<noteq> 0" and a: "a = a' * gcd a b" and b: "b = b' * gcd a b"
- shows "coprime a' b'"
-proof-
- let ?g = "gcd a b"
- {assume bz: "a = 0" from b bz z a have ?thesis by (simp add: gcd_zero coprime_def)}
- moreover
- {assume az: "a\<noteq> 0"
- from z have z': "?g > 0" by simp
- from bezout_gcd_strong[OF az, of b]
- obtain x y where xy: "a*x = b*y + ?g" by blast
- from xy a b have "?g * a'*x = ?g * (b'*y + 1)" by (simp add: algebra_simps)
- hence "?g * (a'*x) = ?g * (b'*y + 1)" by (simp add: mult.assoc)
- hence "a'*x = (b'*y + 1)"
- by (simp only: nat_mult_eq_cancel1[OF z'])
- hence "a'*x - b'*y = 1" by simp
- with coprime_bezout[of a' b'] have ?thesis by auto}
- ultimately show ?thesis by blast
-qed
-lemma coprime_0: "coprime d 0 \<longleftrightarrow> d = 1" by (simp add: coprime_def)
-lemma coprime_mul: assumes da: "coprime d a" and db: "coprime d b"
- shows "coprime d (a * b)"
-proof-
- from da have th: "gcd a d = 1" by (simp add: coprime_def gcd_commute)
- from gcd_mult_cancel[of a d b, OF th] db[unfolded coprime_def] have "gcd d (a*b) = 1"
- by (simp add: gcd_commute)
- thus ?thesis unfolding coprime_def .
-qed
-lemma coprime_lmul2: assumes dab: "coprime d (a * b)" shows "coprime d b"
-using dab unfolding coprime_bezout
-apply clarsimp
-apply (case_tac "d * x - a * b * y = Suc 0 ", simp_all)
-apply (rule_tac x="x" in exI)
-apply (rule_tac x="a*y" in exI)
-apply (simp add: ac_simps)
-apply (rule_tac x="a*x" in exI)
-apply (rule_tac x="y" in exI)
-apply (simp add: ac_simps)
-done
-
-lemma coprime_rmul2: "coprime d (a * b) \<Longrightarrow> coprime d a"
-unfolding coprime_bezout
-apply clarsimp
-apply (case_tac "d * x - a * b * y = Suc 0 ", simp_all)
-apply (rule_tac x="x" in exI)
-apply (rule_tac x="b*y" in exI)
-apply (simp add: ac_simps)
-apply (rule_tac x="b*x" in exI)
-apply (rule_tac x="y" in exI)
-apply (simp add: ac_simps)
-done
-lemma coprime_mul_eq: "coprime d (a * b) \<longleftrightarrow> coprime d a \<and> coprime d b"
- using coprime_rmul2[of d a b] coprime_lmul2[of d a b] coprime_mul[of d a b]
- by blast
-
-lemma gcd_coprime_exists:
- assumes nz: "gcd a b \<noteq> 0"
- shows "\<exists>a' b'. a = a' * gcd a b \<and> b = b' * gcd a b \<and> coprime a' b'"
-proof-
- let ?g = "gcd a b"
- from gcd_dvd1[of a b] gcd_dvd2[of a b]
- obtain a' b' where "a = ?g*a'" "b = ?g*b'" unfolding dvd_def by blast
- hence ab': "a = a'*?g" "b = b'*?g" by algebra+
- from ab' gcd_coprime[OF nz ab'] show ?thesis by blast
-qed
-
-lemma coprime_exp: "coprime d a ==> coprime d (a^n)"
- by(induct n, simp_all add: coprime_mul)
-
-lemma coprime_exp_imp: "coprime a b ==> coprime (a ^n) (b ^n)"
- by (induct n, simp_all add: coprime_mul_eq coprime_commute coprime_exp)
-lemma coprime_refl[simp]: "coprime n n \<longleftrightarrow> n = 1" by (simp add: coprime_def)
-lemma coprime_plus1[simp]: "coprime (n + 1) n"
- apply (simp add: coprime_bezout)
- apply (rule exI[where x=1])
- apply (rule exI[where x=1])
- apply simp
- done
-lemma coprime_minus1: "n \<noteq> 0 ==> coprime (n - 1) n"
- using coprime_plus1[of "n - 1"] coprime_commute[of "n - 1" n] by auto
-
-lemma bezout_gcd_pow: "\<exists>x y. a ^n * x - b ^ n * y = gcd a b ^ n \<or> b ^ n * x - a ^ n * y = gcd a b ^ n"
-proof-
- let ?g = "gcd a b"
- {assume z: "?g = 0" hence ?thesis
- apply (cases n, simp)
- apply arith
- apply (simp only: z power_0_Suc)
- apply (rule exI[where x=0])
- apply (rule exI[where x=0])
- apply simp
- done }
- moreover
- {assume z: "?g \<noteq> 0"
- from gcd_dvd1[of a b] gcd_dvd2[of a b] obtain a' b' where
- ab': "a = a'*?g" "b = b'*?g" unfolding dvd_def by (auto simp add: ac_simps)
- hence ab'': "?g*a' = a" "?g * b' = b" by algebra+
- from coprime_exp_imp[OF gcd_coprime[OF z ab'], unfolded coprime_bezout, of n]
- obtain x y where "a'^n * x - b'^n * y = 1 \<or> b'^n * x - a'^n * y = 1" by blast
- hence "?g^n * (a'^n * x - b'^n * y) = ?g^n \<or> ?g^n*(b'^n * x - a'^n * y) = ?g^n"
- using z by auto
- then have "a^n * x - b^n * y = ?g^n \<or> b^n * x - a^n * y = ?g^n"
- using z ab'' by (simp only: power_mult_distrib[symmetric]
- diff_mult_distrib2 mult.assoc[symmetric])
- hence ?thesis by blast }
- ultimately show ?thesis by blast
-qed
-
-lemma gcd_exp: "gcd (a^n) (b^n) = gcd a b^n"
-proof-
- let ?g = "gcd (a^n) (b^n)"
- let ?gn = "gcd a b^n"
- {fix e assume H: "e dvd a^n" "e dvd b^n"
- from bezout_gcd_pow[of a n b] obtain x y
- where xy: "a ^ n * x - b ^ n * y = ?gn \<or> b ^ n * x - a ^ n * y = ?gn" by blast
- from dvd_diff_nat [OF dvd_mult2[OF H(1), of x] dvd_mult2[OF H(2), of y]]
- dvd_diff_nat [OF dvd_mult2[OF H(2), of x] dvd_mult2[OF H(1), of y]] xy
- have "e dvd ?gn" by (cases "a ^ n * x - b ^ n * y = gcd a b ^ n", simp_all)}
- hence th: "\<forall>e. e dvd a^n \<and> e dvd b^n \<longrightarrow> e dvd ?gn" by blast
- from divides_exp[OF gcd_dvd1[of a b], of n] divides_exp[OF gcd_dvd2[of a b], of n] th
- gcd_unique have "?gn = ?g" by blast thus ?thesis by simp
-qed
-
-lemma coprime_exp2: "coprime (a ^ Suc n) (b^ Suc n) \<longleftrightarrow> coprime a b"
-by (simp only: coprime_def gcd_exp exp_eq_1) simp
-
-lemma division_decomp: assumes dc: "(a::nat) dvd b * c"
- shows "\<exists>b' c'. a = b' * c' \<and> b' dvd b \<and> c' dvd c"
-proof-
- let ?g = "gcd a b"
- {assume "?g = 0" with dc have ?thesis apply (simp add: gcd_zero)
- apply (rule exI[where x="0"])
- by (rule exI[where x="c"], simp)}
- moreover
- {assume z: "?g \<noteq> 0"
- from gcd_coprime_exists[OF z]
- obtain a' b' where ab': "a = a' * ?g" "b = b' * ?g" "coprime a' b'" by blast
- from gcd_dvd2[of a b] have thb: "?g dvd b" .
- from ab'(1) have "a' dvd a" unfolding dvd_def by blast
- with dc have th0: "a' dvd b*c" using dvd_trans[of a' a "b*c"] by simp
- from dc ab'(1,2) have "a'*?g dvd (b'*?g) *c" by auto
- hence "?g*a' dvd ?g * (b' * c)" by (simp add: mult.assoc)
- with z have th_1: "a' dvd b'*c" by simp
- from coprime_divprod[OF th_1 ab'(3)] have thc: "a' dvd c" .
- from ab' have "a = ?g*a'" by algebra
- with thb thc have ?thesis by blast }
- ultimately show ?thesis by blast
-qed
-
-lemma nat_power_eq_0_iff: "(m::nat) ^ n = 0 \<longleftrightarrow> n \<noteq> 0 \<and> m = 0" by (induct n, auto)
-
-lemma divides_rev: assumes ab: "(a::nat) ^ n dvd b ^n" and n:"n \<noteq> 0" shows "a dvd b"
-proof-
- let ?g = "gcd a b"
- from n obtain m where m: "n = Suc m" by (cases n, simp_all)
- {assume "?g = 0" with ab n have ?thesis by (simp add: gcd_zero)}
- moreover
- {assume z: "?g \<noteq> 0"
- hence zn: "?g ^ n \<noteq> 0" using n by simp
- from gcd_coprime_exists[OF z]
- obtain a' b' where ab': "a = a' * ?g" "b = b' * ?g" "coprime a' b'" by blast
- from ab have "(a' * ?g) ^ n dvd (b' * ?g)^n" by (simp add: ab'(1,2)[symmetric])
- hence "?g^n*a'^n dvd ?g^n *b'^n" by (simp only: power_mult_distrib mult.commute)
- with zn z n have th0:"a'^n dvd b'^n" by (auto simp add: nat_power_eq_0_iff)
- have "a' dvd a'^n" by (simp add: m)
- with th0 have "a' dvd b'^n" using dvd_trans[of a' "a'^n" "b'^n"] by simp
- hence th1: "a' dvd b'^m * b'" by (simp add: m mult.commute)
- from coprime_divprod[OF th1 coprime_exp[OF ab'(3), of m]]
- have "a' dvd b'" .
- hence "a'*?g dvd b'*?g" by simp
- with ab'(1,2) have ?thesis by simp }
- ultimately show ?thesis by blast
-qed
-
-lemma divides_mul: assumes mr: "m dvd r" and nr: "n dvd r" and mn:"coprime m n"
- shows "m * n dvd r"
-proof-
- from mr nr obtain m' n' where m': "r = m*m'" and n': "r = n*n'"
- unfolding dvd_def by blast
- from mr n' have "m dvd n'*n" by (simp add: mult.commute)
- hence "m dvd n'" using relprime_dvd_mult_iff[OF mn[unfolded coprime_def]] by simp
- then obtain k where k: "n' = m*k" unfolding dvd_def by blast
- from n' k show ?thesis unfolding dvd_def by auto
-qed
-
-
-text \<open>A binary form of the Chinese Remainder Theorem.\<close>
-
-lemma chinese_remainder: assumes ab: "coprime a b" and a:"a \<noteq> 0" and b:"b \<noteq> 0"
- shows "\<exists>x q1 q2. x = u + q1 * a \<and> x = v + q2 * b"
-proof-
- from bezout_add_strong[OF a, of b] bezout_add_strong[OF b, of a]
- obtain d1 x1 y1 d2 x2 y2 where dxy1: "d1 dvd a" "d1 dvd b" "a * x1 = b * y1 + d1"
- and dxy2: "d2 dvd b" "d2 dvd a" "b * x2 = a * y2 + d2" by blast
- from gcd_unique[of 1 a b, simplified ab[unfolded coprime_def], simplified]
- dxy1(1,2) dxy2(1,2) have d12: "d1 = 1" "d2 =1" by auto
- let ?x = "v * a * x1 + u * b * x2"
- let ?q1 = "v * x1 + u * y2"
- let ?q2 = "v * y1 + u * x2"
- from dxy2(3)[simplified d12] dxy1(3)[simplified d12]
- have "?x = u + ?q1 * a" "?x = v + ?q2 * b" by algebra+
- thus ?thesis by blast
-qed
-
-text \<open>Primality\<close>
-
-text \<open>A few useful theorems about primes\<close>
-
-lemma prime_0[simp]: "~prime 0" by (simp add: prime_def)
-lemma prime_1[simp]: "~ prime 1" by (simp add: prime_def)
-lemma prime_Suc0[simp]: "~ prime (Suc 0)" by (simp add: prime_def)
-
-lemma prime_ge_2: "prime p ==> p \<ge> 2" by (simp add: prime_def)
-
-lemma prime_factor: "n \<noteq> 1 \<Longrightarrow> \<exists>p. prime p \<and> p dvd n"
-proof (induct n rule: nat_less_induct)
- fix n
- assume H: "\<forall>m<n. m \<noteq> 1 \<longrightarrow> (\<exists>p. prime p \<and> p dvd m)" "n \<noteq> 1"
- show "\<exists>p. prime p \<and> p dvd n"
- proof (cases "n = 0")
- case True
- with two_is_prime show ?thesis by auto
- next
- case nz: False
- show ?thesis
- proof (cases "prime n")
- case True
- then have "prime n \<and> n dvd n" by simp
- then show ?thesis ..
- next
- case n: False
- with nz H(2) obtain k where k: "k dvd n" "k \<noteq> 1" "k \<noteq> n"
- by (auto simp: prime_def)
- from dvd_imp_le[OF k(1)] nz k(3) have kn: "k < n" by simp
- from H(1)[rule_format, OF kn k(2)] obtain p where p: "prime p" "p dvd k" by blast
- from dvd_trans[OF p(2) k(1)] p(1) show ?thesis by blast
- qed
- qed
-qed
-
-lemma prime_factor_lt:
- assumes p: "prime p" and n: "n \<noteq> 0" and npm:"n = p * m"
- shows "m < n"
-proof (cases "m = 0")
- case True
- with n show ?thesis by simp
-next
- case m: False
- from npm have mn: "m dvd n" unfolding dvd_def by auto
- from npm m have "n \<noteq> m" using p by auto
- with dvd_imp_le[OF mn] n show ?thesis by simp
-qed
-
-lemma euclid_bound: "\<exists>p. prime p \<and> n < p \<and> p <= Suc (fact n)"
-proof-
- have f1: "fact n + 1 \<noteq> 1" using fact_le[of n] by arith
- from prime_factor[OF f1] obtain p where p: "prime p" "p dvd fact n + 1" by blast
- from dvd_imp_le[OF p(2)] have pfn: "p \<le> fact n + 1" by simp
- {assume np: "p \<le> n"
- from p(1) have p1: "p \<ge> 1" by (cases p, simp_all)
- from divides_fact[OF p1 np] have pfn': "p dvd fact n" .
- from divides_add_revr[OF pfn' p(2)] p(1) have False by simp}
- hence "n < p" by arith
- with p(1) pfn show ?thesis by auto
-qed
-
-lemma euclid: "\<exists>p. prime p \<and> p > n" using euclid_bound by auto
-
-lemma primes_infinite: "\<not> (finite {p. prime p})"
-apply(simp add: finite_nat_set_iff_bounded_le)
-apply (metis euclid linorder_not_le)
-done
-
-lemma coprime_prime: assumes ab: "coprime a b"
- shows "~(prime p \<and> p dvd a \<and> p dvd b)"
-proof
- assume "prime p \<and> p dvd a \<and> p dvd b"
- thus False using ab gcd_greatest[of p a b] by (simp add: coprime_def)
-qed
-lemma coprime_prime_eq: "coprime a b \<longleftrightarrow> (\<forall>p. ~(prime p \<and> p dvd a \<and> p dvd b))"
- (is "?lhs = ?rhs")
-proof-
- {assume "?lhs" with coprime_prime have ?rhs by blast}
- moreover
- {assume r: "?rhs" and c: "\<not> ?lhs"
- then obtain g where g: "g\<noteq>1" "g dvd a" "g dvd b" unfolding coprime_def by blast
- from prime_factor[OF g(1)] obtain p where p: "prime p" "p dvd g" by blast
- from dvd_trans [OF p(2) g(2)] dvd_trans [OF p(2) g(3)]
- have "p dvd a" "p dvd b" . with p(1) r have False by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma prime_coprime: assumes p: "prime p"
- shows "n = 1 \<or> p dvd n \<or> coprime p n"
-using p prime_imp_relprime[of p n] by (auto simp add: coprime_def)
-
-lemma prime_coprime_strong: "prime p \<Longrightarrow> p dvd n \<or> coprime p n"
- using prime_coprime[of p n] by auto
-
-declare coprime_0[simp]
-
-lemma coprime_0'[simp]: "coprime 0 d \<longleftrightarrow> d = 1" by (simp add: coprime_commute[of 0 d])
-lemma coprime_bezout_strong: assumes ab: "coprime a b" and b: "b \<noteq> 1"
- shows "\<exists>x y. a * x = b * y + 1"
-proof-
- have az: "a \<noteq> 0" by (rule ccontr) (use ab b in auto)
- from bezout_gcd_strong[OF az, of b] ab[unfolded coprime_def]
- show ?thesis by auto
-qed
-
-lemma bezout_prime: assumes p: "prime p" and pa: "\<not> p dvd a"
- shows "\<exists>x y. a*x = p*y + 1"
-proof-
- from p have p1: "p \<noteq> 1" using prime_1 by blast
- from prime_coprime[OF p, of a] p1 pa have ap: "coprime a p"
- by (auto simp add: coprime_commute)
- from coprime_bezout_strong[OF ap p1] show ?thesis .
-qed
-lemma prime_divprod: assumes p: "prime p" and pab: "p dvd a*b"
- shows "p dvd a \<or> p dvd b"
-proof-
- {assume "a=1" hence ?thesis using pab by simp }
- moreover
- {assume "p dvd a" hence ?thesis by blast}
- moreover
- {assume pa: "coprime p a" from coprime_divprod[OF pab pa] have ?thesis .. }
- ultimately show ?thesis using prime_coprime[OF p, of a] by blast
-qed
-
-lemma prime_divprod_eq: assumes p: "prime p"
- shows "p dvd a*b \<longleftrightarrow> p dvd a \<or> p dvd b"
-using p prime_divprod dvd_mult dvd_mult2 by auto
-
-lemma prime_divexp: assumes p:"prime p" and px: "p dvd x^n"
- shows "p dvd x"
-using px
-proof(induct n)
- case 0 thus ?case by simp
-next
- case (Suc n)
- hence th: "p dvd x*x^n" by simp
- {assume H: "p dvd x^n"
- from Suc.hyps[OF H] have ?case .}
- with prime_divprod[OF p th] show ?case by blast
-qed
-
-lemma prime_divexp_n: "prime p \<Longrightarrow> p dvd x^n \<Longrightarrow> p^n dvd x^n"
- using prime_divexp[of p x n] divides_exp[of p x n] by blast
-
-lemma coprime_prime_dvd_ex: assumes xy: "\<not>coprime x y"
- shows "\<exists>p. prime p \<and> p dvd x \<and> p dvd y"
-proof-
- from xy[unfolded coprime_def] obtain g where g: "g \<noteq> 1" "g dvd x" "g dvd y"
- by blast
- from prime_factor[OF g(1)] obtain p where p: "prime p" "p dvd g" by blast
- from g(2,3) dvd_trans[OF p(2)] p(1) show ?thesis by auto
-qed
-lemma coprime_sos: assumes xy: "coprime x y"
- shows "coprime (x * y) (x\<^sup>2 + y\<^sup>2)"
-proof-
- {assume c: "\<not> coprime (x * y) (x\<^sup>2 + y\<^sup>2)"
- from coprime_prime_dvd_ex[OF c] obtain p
- where p: "prime p" "p dvd x*y" "p dvd x\<^sup>2 + y\<^sup>2" by blast
- {assume px: "p dvd x"
- from dvd_mult[OF px, of x] p(3)
- obtain r s where "x * x = p * r" and "x\<^sup>2 + y\<^sup>2 = p * s"
- by (auto elim!: dvdE)
- then have "y\<^sup>2 = p * (s - r)"
- by (auto simp add: power2_eq_square diff_mult_distrib2)
- then have "p dvd y\<^sup>2" ..
- with prime_divexp[OF p(1), of y 2] have py: "p dvd y" .
- from p(1) px py xy[unfolded coprime, rule_format, of p] prime_1
- have False by simp }
- moreover
- {assume py: "p dvd y"
- from dvd_mult[OF py, of y] p(3)
- obtain r s where "y * y = p * r" and "x\<^sup>2 + y\<^sup>2 = p * s"
- by (auto elim!: dvdE)
- then have "x\<^sup>2 = p * (s - r)"
- by (auto simp add: power2_eq_square diff_mult_distrib2)
- then have "p dvd x\<^sup>2" ..
- with prime_divexp[OF p(1), of x 2] have px: "p dvd x" .
- from p(1) px py xy[unfolded coprime, rule_format, of p] prime_1
- have False by simp }
- ultimately have False using prime_divprod[OF p(1,2)] by blast}
- thus ?thesis by blast
-qed
-
-lemma distinct_prime_coprime: "prime p \<Longrightarrow> prime q \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q"
- unfolding prime_def coprime_prime_eq by blast
-
-lemma prime_coprime_lt:
- assumes p: "prime p" and x: "0 < x" and xp: "x < p"
- shows "coprime x p"
-proof (rule ccontr)
- assume c: "\<not> ?thesis"
- then obtain g where g: "g \<noteq> 1" "g dvd x" "g dvd p" unfolding coprime_def by blast
- from dvd_imp_le[OF g(2)] x xp have gp: "g < p" by arith
- have "g \<noteq> 0" by (rule ccontr) (use g(2) x in simp)
- with g gp p[unfolded prime_def] show False by blast
-qed
-
-lemma prime_odd: "prime p \<Longrightarrow> p = 2 \<or> odd p" unfolding prime_def by auto
-
-
-text \<open>One property of coprimality is easier to prove via prime factors.\<close>
-
-lemma prime_divprod_pow:
- assumes p: "prime p" and ab: "coprime a b" and pab: "p^n dvd a * b"
- shows "p^n dvd a \<or> p^n dvd b"
-proof-
- {assume "n = 0 \<or> a = 1 \<or> b = 1" with pab have ?thesis
- apply (cases "n=0", simp_all)
- apply (cases "a=1", simp_all) done}
- moreover
- {assume n: "n \<noteq> 0" and a: "a\<noteq>1" and b: "b\<noteq>1"
- then obtain m where m: "n = Suc m" by (cases n, auto)
- from divides_exp2[OF n pab] have pab': "p dvd a*b" .
- from prime_divprod[OF p pab']
- have "p dvd a \<or> p dvd b" .
- moreover
- {assume pa: "p dvd a"
- have pnba: "p^n dvd b*a" using pab by (simp add: mult.commute)
- from coprime_prime[OF ab, of p] p pa have "\<not> p dvd b" by blast
- with prime_coprime[OF p, of b] b
- have cpb: "coprime b p" using coprime_commute by blast
- from coprime_exp[OF cpb] have pnb: "coprime (p^n) b"
- by (simp add: coprime_commute)
- from coprime_divprod[OF pnba pnb] have ?thesis by blast }
- moreover
- {assume pb: "p dvd b"
- have pnba: "p^n dvd b*a" using pab by (simp add: mult.commute)
- from coprime_prime[OF ab, of p] p pb have "\<not> p dvd a" by blast
- with prime_coprime[OF p, of a] a
- have cpb: "coprime a p" using coprime_commute by blast
- from coprime_exp[OF cpb] have pnb: "coprime (p^n) a"
- by (simp add: coprime_commute)
- from coprime_divprod[OF pab pnb] have ?thesis by blast }
- ultimately have ?thesis by blast}
- ultimately show ?thesis by blast
-qed
-
-lemma nat_mult_eq_one: "(n::nat) * m = 1 \<longleftrightarrow> n = 1 \<and> m = 1" (is "?lhs \<longleftrightarrow> ?rhs")
-proof
- assume H: "?lhs"
- hence "n dvd 1" "m dvd 1" unfolding dvd_def by (auto simp add: mult.commute)
- thus ?rhs by auto
-next
- assume ?rhs then show ?lhs by auto
-qed
-
-lemma power_Suc0: "Suc 0 ^ n = Suc 0"
- unfolding One_nat_def[symmetric] power_one ..
-
-lemma coprime_pow: assumes ab: "coprime a b" and abcn: "a * b = c ^n"
- shows "\<exists>r s. a = r^n \<and> b = s ^n"
- using ab abcn
-proof(induct c arbitrary: a b rule: nat_less_induct)
- fix c a b
- assume H: "\<forall>m<c. \<forall>a b. coprime a b \<longrightarrow> a * b = m ^ n \<longrightarrow> (\<exists>r s. a = r ^ n \<and> b = s ^ n)" "coprime a b" "a * b = c ^ n"
- let ?ths = "\<exists>r s. a = r^n \<and> b = s ^n"
- {assume n: "n = 0"
- with H(3) power_one have "a*b = 1" by simp
- hence "a = 1 \<and> b = 1" by simp
- hence ?ths
- apply -
- apply (rule exI[where x=1])
- apply (rule exI[where x=1])
- using power_one[of n]
- by simp}
- moreover
- {assume n: "n \<noteq> 0" then obtain m where m: "n = Suc m" by (cases n, auto)
- {assume c: "c = 0"
- with H(3) m H(2) have ?ths apply simp
- apply (cases "a=0", simp_all)
- apply (rule exI[where x="0"], simp)
- apply (rule exI[where x="0"], simp)
- done}
- moreover
- {assume "c=1" with H(3) power_one have "a*b = 1" by simp
- hence "a = 1 \<and> b = 1" by simp
- hence ?ths
- apply -
- apply (rule exI[where x=1])
- apply (rule exI[where x=1])
- using power_one[of n]
- by simp}
- moreover
- {assume c: "c\<noteq>1" "c \<noteq> 0"
- from prime_factor[OF c(1)] obtain p where p: "prime p" "p dvd c" by blast
- from prime_divprod_pow[OF p(1) H(2), unfolded H(3), OF divides_exp[OF p(2), of n]]
- have pnab: "p ^ n dvd a \<or> p^n dvd b" .
- from p(2) obtain l where l: "c = p*l" unfolding dvd_def by blast
- have pn0: "p^n \<noteq> 0" using n prime_ge_2 [OF p(1)] by simp
- {assume pa: "p^n dvd a"
- then obtain k where k: "a = p^n * k" unfolding dvd_def by blast
- from l have "l dvd c" by auto
- with dvd_imp_le[of l c] c have "l \<le> c" by auto
- moreover {assume "l = c" with l c have "p = 1" by simp with p have False by simp}
- ultimately have lc: "l < c" by arith
- from coprime_lmul2 [OF H(2)[unfolded k coprime_commute[of "p^n*k" b]]]
- have kb: "coprime k b" by (simp add: coprime_commute)
- from H(3) l k pn0 have kbln: "k * b = l ^ n"
- by (auto simp add: power_mult_distrib)
- from H(1)[rule_format, OF lc kb kbln]
- obtain r s where rs: "k = r ^n" "b = s^n" by blast
- from k rs(1) have "a = (p*r)^n" by (simp add: power_mult_distrib)
- with rs(2) have ?ths by blast }
- moreover
- {assume pb: "p^n dvd b"
- then obtain k where k: "b = p^n * k" unfolding dvd_def by blast
- from l have "l dvd c" by auto
- with dvd_imp_le[of l c] c have "l \<le> c" by auto
- moreover {assume "l = c" with l c have "p = 1" by simp with p have False by simp}
- ultimately have lc: "l < c" by arith
- from coprime_lmul2 [OF H(2)[unfolded k coprime_commute[of "p^n*k" a]]]
- have kb: "coprime k a" by (simp add: coprime_commute)
- from H(3) l k pn0 n have kbln: "k * a = l ^ n"
- by (simp add: power_mult_distrib mult.commute)
- from H(1)[rule_format, OF lc kb kbln]
- obtain r s where rs: "k = r ^n" "a = s^n" by blast
- from k rs(1) have "b = (p*r)^n" by (simp add: power_mult_distrib)
- with rs(2) have ?ths by blast }
- ultimately have ?ths using pnab by blast}
- ultimately have ?ths by blast}
-ultimately show ?ths by blast
-qed
-
-text \<open>More useful lemmas.\<close>
-lemma prime_product:
- assumes "prime (p * q)"
- shows "p = 1 \<or> q = 1"
-proof -
- from assms have
- "1 < p * q" and P: "\<And>m. m dvd p * q \<Longrightarrow> m = 1 \<or> m = p * q"
- unfolding prime_def by auto
- from \<open>1 < p * q\<close> have "p \<noteq> 0" by (cases p) auto
- then have Q: "p = p * q \<longleftrightarrow> q = 1" by auto
- have "p dvd p * q" by simp
- then have "p = 1 \<or> p = p * q" by (rule P)
- then show ?thesis by (simp add: Q)
-qed
-
-lemma prime_exp: "prime (p^n) \<longleftrightarrow> prime p \<and> n = 1"
-proof(induct n)
- case 0 thus ?case by simp
-next
- case (Suc n)
- {assume "p = 0" hence ?case by simp}
- moreover
- {assume "p=1" hence ?case by simp}
- moreover
- {assume p: "p \<noteq> 0" "p\<noteq>1"
- {assume pp: "prime (p^Suc n)"
- hence "p = 1 \<or> p^n = 1" using prime_product[of p "p^n"] by simp
- with p have n: "n = 0"
- by (simp only: exp_eq_1 ) simp
- with pp have "prime p \<and> Suc n = 1" by simp}
- moreover
- {assume n: "prime p \<and> Suc n = 1" hence "prime (p^Suc n)" by simp}
- ultimately have ?case by blast}
- ultimately show ?case by blast
-qed
-
-lemma prime_power_mult:
- assumes p: "prime p" and xy: "x * y = p ^ k"
- shows "\<exists>i j. x = p ^i \<and> y = p^ j"
- using xy
-proof(induct k arbitrary: x y)
- case 0
- thus ?case apply simp by (rule exI[where x="0"], simp)
-next
- case (Suc k x y)
- have p0: "p \<noteq> 0" by (rule ccontr) (use p in simp)
- from Suc.prems have pxy: "p dvd x*y" by auto
- from prime_divprod[OF p pxy] show ?case
- proof
- assume px: "p dvd x"
- then obtain d where d: "x = p*d" unfolding dvd_def by blast
- from Suc.prems d have "p*d*y = p^Suc k" by simp
- hence th: "d*y = p^k" using p0 by simp
- from Suc.hyps[OF th] obtain i j where ij: "d = p^i" "y = p^j" by blast
- with d have "x = p^Suc i" by simp
- with ij(2) show ?thesis by blast
- next
- assume px: "p dvd y"
- then obtain d where d: "y = p*d" unfolding dvd_def by blast
- from Suc.prems d have "p*d*x = p^Suc k" by (simp add: mult.commute)
- hence th: "d*x = p^k" using p0 by simp
- from Suc.hyps[OF th] obtain i j where ij: "d = p^i" "x = p^j" by blast
- with d have "y = p^Suc i" by simp
- with ij(2) show ?thesis by blast
- qed
-qed
-
-lemma prime_power_exp: assumes p: "prime p" and n:"n \<noteq> 0"
- and xn: "x^n = p^k" shows "\<exists>i. x = p^i"
- using n xn
-proof(induct n arbitrary: k)
- case 0 thus ?case by simp
-next
- case (Suc n k) hence th: "x*x^n = p^k" by simp
- {assume "n = 0" with Suc have ?case by simp (rule exI[where x="k"], simp)}
- moreover
- {assume n: "n \<noteq> 0"
- from prime_power_mult[OF p th]
- obtain i j where ij: "x = p^i" "x^n = p^j"by blast
- from Suc.hyps[OF n ij(2)] have ?case .}
- ultimately show ?case by blast
-qed
-
-lemma divides_primepow: assumes p: "prime p"
- shows "d dvd p^k \<longleftrightarrow> (\<exists> i. i \<le> k \<and> d = p ^i)"
-proof
- assume H: "d dvd p^k" then obtain e where e: "d*e = p^k"
- unfolding dvd_def apply (auto simp add: mult.commute) by blast
- from prime_power_mult[OF p e] obtain i j where ij: "d = p^i" "e=p^j" by blast
- from prime_ge_2[OF p] have p1: "p > 1" by arith
- from e ij have "p^(i + j) = p^k" by (simp add: power_add)
- hence "i + j = k" using power_inject_exp[of p "i+j" k, OF p1] by simp
- hence "i \<le> k" by arith
- with ij(1) show "\<exists>i\<le>k. d = p ^ i" by blast
-next
- {fix i assume H: "i \<le> k" "d = p^i"
- hence "\<exists>j. k = i + j" by arith
- then obtain j where j: "k = i + j" by blast
- hence "p^k = p^j*d" using H(2) by (simp add: power_add)
- hence "d dvd p^k" unfolding dvd_def by auto}
- thus "\<exists>i\<le>k. d = p ^ i \<Longrightarrow> d dvd p ^ k" by blast
-qed
-
-lemma coprime_divisors: "d dvd a \<Longrightarrow> e dvd b \<Longrightarrow> coprime a b \<Longrightarrow> coprime d e"
- by (auto simp add: dvd_def coprime)
-
-lemma mult_inj_if_coprime_nat:
- "inj_on f A \<Longrightarrow> inj_on g B \<Longrightarrow> \<forall>a\<in>A. \<forall>b\<in>B. Primes.coprime (f a) (g b) \<Longrightarrow>
- inj_on (\<lambda>(a, b). f a * g b) (A \<times> B)"
-apply (auto simp add: inj_on_def)
-apply (metis coprime_def dvd_antisym dvd_triv_left relprime_dvd_mult_iff)
-apply (metis coprime_commute coprime_divprod dvd_antisym dvd_triv_right)
-done
-
-declare power_Suc0[simp del]
-
-end
--- a/src/HOL/Old_Number_Theory/Quadratic_Reciprocity.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,637 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Quadratic_Reciprocity.thy
- Authors: Jeremy Avigad, David Gray, and Adam Kramer
-*)
-
-section \<open>The law of Quadratic reciprocity\<close>
-
-theory Quadratic_Reciprocity
-imports Gauss
-begin
-
-text \<open>
- Lemmas leading up to the proof of theorem 3.3 in Niven and
- Zuckerman's presentation.
-\<close>
-
-context GAUSS
-begin
-
-lemma QRLemma1: "a * sum id A =
- p * sum (%x. ((x * a) div p)) A + sum id D + sum id E"
-proof -
- from finite_A have "a * sum id A = sum (%x. a * x) A"
- by (auto simp add: sum_const_mult id_def)
- also have "sum (%x. a * x) = sum (%x. x * a)"
- by (auto simp add: mult.commute)
- also have "sum (%x. x * a) A = sum id B"
- by (simp add: B_def sum.reindex [OF inj_on_xa_A])
- also have "... = sum (%x. p * (x div p) + StandardRes p x) B"
- by (auto simp add: StandardRes_def mult_div_mod_eq [symmetric])
- also have "... = sum (%x. p * (x div p)) B + sum (StandardRes p) B"
- by (rule sum.distrib)
- also have "sum (StandardRes p) B = sum id C"
- by (auto simp add: C_def sum.reindex [OF SR_B_inj])
- also from C_eq have "... = sum id (D \<union> E)"
- by auto
- also from finite_D finite_E have "... = sum id D + sum id E"
- by (rule sum.union_disjoint) (auto simp add: D_def E_def)
- also have "sum (%x. p * (x div p)) B =
- sum ((%x. p * (x div p)) o (%x. (x * a))) A"
- by (auto simp add: B_def sum.reindex inj_on_xa_A)
- also have "... = sum (%x. p * ((x * a) div p)) A"
- by (auto simp add: o_def)
- also from finite_A have "sum (%x. p * ((x * a) div p)) A =
- p * sum (%x. ((x * a) div p)) A"
- by (auto simp add: sum_const_mult)
- finally show ?thesis by arith
-qed
-
-lemma QRLemma2: "sum id A = p * int (card E) - sum id E +
- sum id D"
-proof -
- from F_Un_D_eq_A have "sum id A = sum id (D \<union> F)"
- by (simp add: Un_commute)
- also from F_D_disj finite_D finite_F
- have "... = sum id D + sum id F"
- by (auto simp add: Int_commute intro: sum.union_disjoint)
- also from F_def have "F = (%x. (p - x)) ` E"
- by auto
- also from finite_E inj_on_pminusx_E have "sum id ((%x. (p - x)) ` E) =
- sum (%x. (p - x)) E"
- by (auto simp add: sum.reindex)
- also from finite_E have "sum (op - p) E = sum (%x. p) E - sum id E"
- by (auto simp add: sum_subtractf id_def)
- also from finite_E have "sum (%x. p) E = p * int(card E)"
- by (intro sum_const)
- finally show ?thesis
- by arith
-qed
-
-lemma QRLemma3: "(a - 1) * sum id A =
- p * (sum (%x. ((x * a) div p)) A - int(card E)) + 2 * sum id E"
-proof -
- have "(a - 1) * sum id A = a * sum id A - sum id A"
- by (auto simp add: left_diff_distrib)
- also note QRLemma1
- also from QRLemma2 have "p * (\<Sum>x \<in> A. x * a div p) + sum id D +
- sum id E - sum id A =
- p * (\<Sum>x \<in> A. x * a div p) + sum id D +
- sum id E - (p * int (card E) - sum id E + sum id D)"
- by auto
- also have "... = p * (\<Sum>x \<in> A. x * a div p) -
- p * int (card E) + 2 * sum id E"
- by arith
- finally show ?thesis
- by (auto simp only: right_diff_distrib)
-qed
-
-lemma QRLemma4: "a \<in> zOdd ==>
- (sum (%x. ((x * a) div p)) A \<in> zEven) = (int(card E): zEven)"
-proof -
- assume a_odd: "a \<in> zOdd"
- from QRLemma3 have a: "p * (sum (%x. ((x * a) div p)) A - int(card E)) =
- (a - 1) * sum id A - 2 * sum id E"
- by arith
- from a_odd have "a - 1 \<in> zEven"
- by (rule odd_minus_one_even)
- hence "(a - 1) * sum id A \<in> zEven"
- by (rule even_times_either)
- moreover have "2 * sum id E \<in> zEven"
- by (auto simp add: zEven_def)
- ultimately have "(a - 1) * sum id A - 2 * sum id E \<in> zEven"
- by (rule even_minus_even)
- with a have "p * (sum (%x. ((x * a) div p)) A - int(card E)): zEven"
- by simp
- hence "p \<in> zEven | (sum (%x. ((x * a) div p)) A - int(card E)): zEven"
- by (rule EvenOdd.even_product)
- with p_odd have "(sum (%x. ((x * a) div p)) A - int(card E)): zEven"
- by (auto simp add: odd_iff_not_even)
- thus ?thesis
- by (auto simp only: even_diff [symmetric])
-qed
-
-lemma QRLemma5: "a \<in> zOdd ==>
- (-1::int)^(card E) = (-1::int)^(nat(sum (%x. ((x * a) div p)) A))"
-proof -
- assume "a \<in> zOdd"
- from QRLemma4 [OF this] have
- "(int(card E): zEven) = (sum (%x. ((x * a) div p)) A \<in> zEven)" ..
- moreover have "0 \<le> int(card E)"
- by auto
- moreover have "0 \<le> sum (%x. ((x * a) div p)) A"
- proof (intro sum_nonneg)
- show "\<forall>x \<in> A. 0 \<le> x * a div p"
- proof
- fix x
- assume "x \<in> A"
- then have "0 \<le> x"
- by (auto simp add: A_def)
- with a_nonzero have "0 \<le> x * a"
- by (auto simp add: zero_le_mult_iff)
- with p_g_2 show "0 \<le> x * a div p"
- by (auto simp add: pos_imp_zdiv_nonneg_iff)
- qed
- qed
- ultimately have "(-1::int)^nat((int (card E))) =
- (-1)^nat(((\<Sum>x \<in> A. x * a div p)))"
- by (intro neg_one_power_parity, auto)
- also have "nat (int(card E)) = card E"
- by auto
- finally show ?thesis .
-qed
-
-end
-
-lemma MainQRLemma: "[| a \<in> zOdd; 0 < a; ~([a = 0] (mod p)); zprime p; 2 < p;
- A = {x. 0 < x & x \<le> (p - 1) div 2} |] ==>
- (Legendre a p) = (-1::int)^(nat(sum (%x. ((x * a) div p)) A))"
- apply (subst GAUSS.gauss_lemma)
- apply (auto simp add: GAUSS_def)
- apply (subst GAUSS.QRLemma5)
- apply (auto simp add: GAUSS_def)
- apply (simp add: GAUSS.A_def [OF GAUSS.intro] GAUSS_def)
- done
-
-
-subsection \<open>Stuff about S, S1 and S2\<close>
-
-locale QRTEMP =
- fixes p :: "int"
- fixes q :: "int"
-
- assumes p_prime: "zprime p"
- assumes p_g_2: "2 < p"
- assumes q_prime: "zprime q"
- assumes q_g_2: "2 < q"
- assumes p_neq_q: "p \<noteq> q"
-begin
-
-definition P_set :: "int set"
- where "P_set = {x. 0 < x & x \<le> ((p - 1) div 2) }"
-
-definition Q_set :: "int set"
- where "Q_set = {x. 0 < x & x \<le> ((q - 1) div 2) }"
-
-definition S :: "(int * int) set"
- where "S = P_set \<times> Q_set"
-
-definition S1 :: "(int * int) set"
- where "S1 = { (x, y). (x, y):S & ((p * y) < (q * x)) }"
-
-definition S2 :: "(int * int) set"
- where "S2 = { (x, y). (x, y):S & ((q * x) < (p * y)) }"
-
-definition f1 :: "int => (int * int) set"
- where "f1 j = { (j1, y). (j1, y):S & j1 = j & (y \<le> (q * j) div p) }"
-
-definition f2 :: "int => (int * int) set"
- where "f2 j = { (x, j1). (x, j1):S & j1 = j & (x \<le> (p * j) div q) }"
-
-lemma p_fact: "0 < (p - 1) div 2"
-proof -
- from p_g_2 have "2 \<le> p - 1" by arith
- then have "2 div 2 \<le> (p - 1) div 2" by (rule zdiv_mono1, auto)
- then show ?thesis by auto
-qed
-
-lemma q_fact: "0 < (q - 1) div 2"
-proof -
- from q_g_2 have "2 \<le> q - 1" by arith
- then have "2 div 2 \<le> (q - 1) div 2" by (rule zdiv_mono1, auto)
- then show ?thesis by auto
-qed
-
-lemma pb_neq_qa:
- assumes "1 \<le> b" and "b \<le> (q - 1) div 2"
- shows "p * b \<noteq> q * a"
-proof
- assume "p * b = q * a"
- then have "q dvd (p * b)" by (auto simp add: dvd_def)
- with q_prime p_g_2 have "q dvd p | q dvd b"
- by (auto simp add: zprime_zdvd_zmult)
- moreover have "~ (q dvd p)"
- proof
- assume "q dvd p"
- with p_prime have "q = 1 | q = p"
- apply (auto simp add: zprime_def QRTEMP_def)
- apply (drule_tac x = q and R = False in allE)
- apply (simp add: QRTEMP_def)
- apply (subgoal_tac "0 \<le> q", simp add: QRTEMP_def)
- apply (insert assms)
- apply (auto simp add: QRTEMP_def)
- done
- with q_g_2 p_neq_q show False by auto
- qed
- ultimately have "q dvd b" by auto
- then have "q \<le> b"
- proof -
- assume "q dvd b"
- moreover from assms have "0 < b" by auto
- ultimately show ?thesis using zdvd_bounds [of q b] by auto
- qed
- with assms have "q \<le> (q - 1) div 2" by auto
- then have "2 * q \<le> 2 * ((q - 1) div 2)" by arith
- then have "2 * q \<le> q - 1"
- proof -
- assume a: "2 * q \<le> 2 * ((q - 1) div 2)"
- with assms have "q \<in> zOdd" by (auto simp add: QRTEMP_def zprime_zOdd_eq_grt_2)
- with odd_minus_one_even have "(q - 1):zEven" by auto
- with even_div_2_prop2 have "(q - 1) = 2 * ((q - 1) div 2)" by auto
- with a show ?thesis by auto
- qed
- then have p1: "q \<le> -1" by arith
- with q_g_2 show False by auto
-qed
-
-lemma P_set_finite: "finite (P_set)"
- using p_fact by (auto simp add: P_set_def bdd_int_set_l_le_finite)
-
-lemma Q_set_finite: "finite (Q_set)"
- using q_fact by (auto simp add: Q_set_def bdd_int_set_l_le_finite)
-
-lemma S_finite: "finite S"
- by (auto simp add: S_def P_set_finite Q_set_finite finite_cartesian_product)
-
-lemma S1_finite: "finite S1"
-proof -
- have "finite S" by (auto simp add: S_finite)
- moreover have "S1 \<subseteq> S" by (auto simp add: S1_def S_def)
- ultimately show ?thesis by (auto simp add: finite_subset)
-qed
-
-lemma S2_finite: "finite S2"
-proof -
- have "finite S" by (auto simp add: S_finite)
- moreover have "S2 \<subseteq> S" by (auto simp add: S2_def S_def)
- ultimately show ?thesis by (auto simp add: finite_subset)
-qed
-
-lemma P_set_card: "(p - 1) div 2 = int (card (P_set))"
- using p_fact by (auto simp add: P_set_def card_bdd_int_set_l_le)
-
-lemma Q_set_card: "(q - 1) div 2 = int (card (Q_set))"
- using q_fact by (auto simp add: Q_set_def card_bdd_int_set_l_le)
-
-lemma S_card: "((p - 1) div 2) * ((q - 1) div 2) = int (card(S))"
- using P_set_card Q_set_card P_set_finite Q_set_finite
- by (simp add: S_def)
-
-lemma S1_Int_S2_prop: "S1 \<inter> S2 = {}"
- by (auto simp add: S1_def S2_def)
-
-lemma S1_Union_S2_prop: "S = S1 \<union> S2"
- apply (auto simp add: S_def P_set_def Q_set_def S1_def S2_def)
-proof -
- fix a and b
- assume "~ q * a < p * b" and b1: "0 < b" and b2: "b \<le> (q - 1) div 2"
- with less_linear have "(p * b < q * a) | (p * b = q * a)" by auto
- moreover from pb_neq_qa b1 b2 have "(p * b \<noteq> q * a)" by auto
- ultimately show "p * b < q * a" by auto
-qed
-
-lemma card_sum_S1_S2: "((p - 1) div 2) * ((q - 1) div 2) =
- int(card(S1)) + int(card(S2))"
-proof -
- have "((p - 1) div 2) * ((q - 1) div 2) = int (card(S))"
- by (auto simp add: S_card)
- also have "... = int( card(S1) + card(S2))"
- apply (insert S1_finite S2_finite S1_Int_S2_prop S1_Union_S2_prop)
- apply (drule card_Un_disjoint, auto)
- done
- also have "... = int(card(S1)) + int(card(S2))" by auto
- finally show ?thesis .
-qed
-
-lemma aux1a:
- assumes "0 < a" and "a \<le> (p - 1) div 2"
- and "0 < b" and "b \<le> (q - 1) div 2"
- shows "(p * b < q * a) = (b \<le> q * a div p)"
-proof -
- have "p * b < q * a ==> b \<le> q * a div p"
- proof -
- assume "p * b < q * a"
- then have "p * b \<le> q * a" by auto
- then have "(p * b) div p \<le> (q * a) div p"
- by (rule zdiv_mono1) (insert p_g_2, auto)
- then show "b \<le> (q * a) div p"
- apply (subgoal_tac "p \<noteq> 0")
- apply (frule nonzero_mult_div_cancel_left, force)
- apply (insert p_g_2, auto)
- done
- qed
- moreover have "b \<le> q * a div p ==> p * b < q * a"
- proof -
- assume "b \<le> q * a div p"
- then have "p * b \<le> p * ((q * a) div p)"
- using p_g_2 by (auto simp add: mult_le_cancel_left)
- also have "... \<le> q * a"
- by (rule zdiv_leq_prop) (insert p_g_2, auto)
- finally have "p * b \<le> q * a" .
- then have "p * b < q * a | p * b = q * a"
- by (simp only: order_le_imp_less_or_eq)
- moreover have "p * b \<noteq> q * a"
- by (rule pb_neq_qa) (insert assms, auto)
- ultimately show ?thesis by auto
- qed
- ultimately show ?thesis ..
-qed
-
-lemma aux1b:
- assumes "0 < a" and "a \<le> (p - 1) div 2"
- and "0 < b" and "b \<le> (q - 1) div 2"
- shows "(q * a < p * b) = (a \<le> p * b div q)"
-proof -
- have "q * a < p * b ==> a \<le> p * b div q"
- proof -
- assume "q * a < p * b"
- then have "q * a \<le> p * b" by auto
- then have "(q * a) div q \<le> (p * b) div q"
- by (rule zdiv_mono1) (insert q_g_2, auto)
- then show "a \<le> (p * b) div q"
- apply (subgoal_tac "q \<noteq> 0")
- apply (frule nonzero_mult_div_cancel_left, force)
- apply (insert q_g_2, auto)
- done
- qed
- moreover have "a \<le> p * b div q ==> q * a < p * b"
- proof -
- assume "a \<le> p * b div q"
- then have "q * a \<le> q * ((p * b) div q)"
- using q_g_2 by (auto simp add: mult_le_cancel_left)
- also have "... \<le> p * b"
- by (rule zdiv_leq_prop) (insert q_g_2, auto)
- finally have "q * a \<le> p * b" .
- then have "q * a < p * b | q * a = p * b"
- by (simp only: order_le_imp_less_or_eq)
- moreover have "p * b \<noteq> q * a"
- by (rule pb_neq_qa) (insert assms, auto)
- ultimately show ?thesis by auto
- qed
- ultimately show ?thesis ..
-qed
-
-lemma (in -) aux2:
- assumes "zprime p" and "zprime q" and "2 < p" and "2 < q"
- shows "(q * ((p - 1) div 2)) div p \<le> (q - 1) div 2"
-proof-
- (* Set up what's even and odd *)
- from assms have "p \<in> zOdd & q \<in> zOdd"
- by (auto simp add: zprime_zOdd_eq_grt_2)
- then have even1: "(p - 1):zEven & (q - 1):zEven"
- by (auto simp add: odd_minus_one_even)
- then have even2: "(2 * p):zEven & ((q - 1) * p):zEven"
- by (auto simp add: zEven_def)
- then have even3: "(((q - 1) * p) + (2 * p)):zEven"
- by (auto simp: EvenOdd.even_plus_even)
- (* using these prove it *)
- from assms have "q * (p - 1) < ((q - 1) * p) + (2 * p)"
- by (auto simp add: int_distrib)
- then have "((p - 1) * q) div 2 < (((q - 1) * p) + (2 * p)) div 2"
- apply (rule_tac x = "((p - 1) * q)" in even_div_2_l)
- by (auto simp add: even3, auto simp add: ac_simps)
- also have "((p - 1) * q) div 2 = q * ((p - 1) div 2)"
- by (auto simp add: even1 even_prod_div_2)
- also have "(((q - 1) * p) + (2 * p)) div 2 = (((q - 1) div 2) * p) + p"
- by (auto simp add: even1 even2 even_prod_div_2 even_sum_div_2)
- finally show ?thesis
- apply (rule_tac x = " q * ((p - 1) div 2)" and
- y = "(q - 1) div 2" in div_prop2)
- using assms by auto
-qed
-
-lemma aux3a: "\<forall>j \<in> P_set. int (card (f1 j)) = (q * j) div p"
-proof
- fix j
- assume j_fact: "j \<in> P_set"
- have "int (card (f1 j)) = int (card {y. y \<in> Q_set & y \<le> (q * j) div p})"
- proof -
- have "finite (f1 j)"
- proof -
- have "(f1 j) \<subseteq> S" by (auto simp add: f1_def)
- with S_finite show ?thesis by (auto simp add: finite_subset)
- qed
- moreover have "inj_on (%(x,y). y) (f1 j)"
- by (auto simp add: f1_def inj_on_def)
- ultimately have "card ((%(x,y). y) ` (f1 j)) = card (f1 j)"
- by (auto simp add: f1_def card_image)
- moreover have "((%(x,y). y) ` (f1 j)) = {y. y \<in> Q_set & y \<le> (q * j) div p}"
- using j_fact by (auto simp add: f1_def S_def Q_set_def P_set_def image_def)
- ultimately show ?thesis by (auto simp add: f1_def)
- qed
- also have "... = int (card {y. 0 < y & y \<le> (q * j) div p})"
- proof -
- have "{y. y \<in> Q_set & y \<le> (q * j) div p} =
- {y. 0 < y & y \<le> (q * j) div p}"
- apply (auto simp add: Q_set_def)
- proof -
- fix x
- assume x: "0 < x" "x \<le> q * j div p"
- with j_fact P_set_def have "j \<le> (p - 1) div 2" by auto
- with q_g_2 have "q * j \<le> q * ((p - 1) div 2)"
- by (auto simp add: mult_le_cancel_left)
- with p_g_2 have "q * j div p \<le> q * ((p - 1) div 2) div p"
- by (auto simp add: zdiv_mono1)
- also from QRTEMP_axioms j_fact P_set_def have "... \<le> (q - 1) div 2"
- apply simp
- apply (insert aux2)
- apply (simp add: QRTEMP_def)
- done
- finally show "x \<le> (q - 1) div 2" using x by auto
- qed
- then show ?thesis by auto
- qed
- also have "... = (q * j) div p"
- proof -
- from j_fact P_set_def have "0 \<le> j" by auto
- with q_g_2 have "q * 0 \<le> q * j" by (auto simp only: mult_left_mono)
- then have "0 \<le> q * j" by auto
- then have "0 div p \<le> (q * j) div p"
- apply (rule_tac a = 0 in zdiv_mono1)
- apply (insert p_g_2, auto)
- done
- also have "0 div p = 0" by auto
- finally show ?thesis by (auto simp add: card_bdd_int_set_l_le)
- qed
- finally show "int (card (f1 j)) = q * j div p" .
-qed
-
-lemma aux3b: "\<forall>j \<in> Q_set. int (card (f2 j)) = (p * j) div q"
-proof
- fix j
- assume j_fact: "j \<in> Q_set"
- have "int (card (f2 j)) = int (card {y. y \<in> P_set & y \<le> (p * j) div q})"
- proof -
- have "finite (f2 j)"
- proof -
- have "(f2 j) \<subseteq> S" by (auto simp add: f2_def)
- with S_finite show ?thesis by (auto simp add: finite_subset)
- qed
- moreover have "inj_on (%(x,y). x) (f2 j)"
- by (auto simp add: f2_def inj_on_def)
- ultimately have "card ((%(x,y). x) ` (f2 j)) = card (f2 j)"
- by (auto simp add: f2_def card_image)
- moreover have "((%(x,y). x) ` (f2 j)) = {y. y \<in> P_set & y \<le> (p * j) div q}"
- using j_fact by (auto simp add: f2_def S_def Q_set_def P_set_def image_def)
- ultimately show ?thesis by (auto simp add: f2_def)
- qed
- also have "... = int (card {y. 0 < y & y \<le> (p * j) div q})"
- proof -
- have "{y. y \<in> P_set & y \<le> (p * j) div q} =
- {y. 0 < y & y \<le> (p * j) div q}"
- apply (auto simp add: P_set_def)
- proof -
- fix x
- assume x: "0 < x" "x \<le> p * j div q"
- with j_fact Q_set_def have "j \<le> (q - 1) div 2" by auto
- with p_g_2 have "p * j \<le> p * ((q - 1) div 2)"
- by (auto simp add: mult_le_cancel_left)
- with q_g_2 have "p * j div q \<le> p * ((q - 1) div 2) div q"
- by (auto simp add: zdiv_mono1)
- also from QRTEMP_axioms j_fact have "... \<le> (p - 1) div 2"
- by (auto simp add: aux2 QRTEMP_def)
- finally show "x \<le> (p - 1) div 2" using x by auto
- qed
- then show ?thesis by auto
- qed
- also have "... = (p * j) div q"
- proof -
- from j_fact Q_set_def have "0 \<le> j" by auto
- with p_g_2 have "p * 0 \<le> p * j" by (auto simp only: mult_left_mono)
- then have "0 \<le> p * j" by auto
- then have "0 div q \<le> (p * j) div q"
- apply (rule_tac a = 0 in zdiv_mono1)
- apply (insert q_g_2, auto)
- done
- also have "0 div q = 0" by auto
- finally show ?thesis by (auto simp add: card_bdd_int_set_l_le)
- qed
- finally show "int (card (f2 j)) = p * j div q" .
-qed
-
-lemma S1_card: "int (card(S1)) = sum (%j. (q * j) div p) P_set"
-proof -
- have "\<forall>x \<in> P_set. finite (f1 x)"
- proof
- fix x
- have "f1 x \<subseteq> S" by (auto simp add: f1_def)
- with S_finite show "finite (f1 x)" by (auto simp add: finite_subset)
- qed
- moreover have "(\<forall>x \<in> P_set. \<forall>y \<in> P_set. x \<noteq> y --> (f1 x) \<inter> (f1 y) = {})"
- by (auto simp add: f1_def)
- moreover note P_set_finite
- ultimately have "int(card (UNION P_set f1)) =
- sum (%x. int(card (f1 x))) P_set"
- by(simp add:card_UN_disjoint int_sum o_def)
- moreover have "S1 = UNION P_set f1"
- by (auto simp add: f1_def S_def S1_def S2_def P_set_def Q_set_def aux1a)
- ultimately have "int(card (S1)) = sum (%j. int(card (f1 j))) P_set"
- by auto
- also have "... = sum (%j. q * j div p) P_set"
- using aux3a by(fastforce intro: sum.cong)
- finally show ?thesis .
-qed
-
-lemma S2_card: "int (card(S2)) = sum (%j. (p * j) div q) Q_set"
-proof -
- have "\<forall>x \<in> Q_set. finite (f2 x)"
- proof
- fix x
- have "f2 x \<subseteq> S" by (auto simp add: f2_def)
- with S_finite show "finite (f2 x)" by (auto simp add: finite_subset)
- qed
- moreover have "(\<forall>x \<in> Q_set. \<forall>y \<in> Q_set. x \<noteq> y -->
- (f2 x) \<inter> (f2 y) = {})"
- by (auto simp add: f2_def)
- moreover note Q_set_finite
- ultimately have "int(card (UNION Q_set f2)) =
- sum (%x. int(card (f2 x))) Q_set"
- by(simp add:card_UN_disjoint int_sum o_def)
- moreover have "S2 = UNION Q_set f2"
- by (auto simp add: f2_def S_def S1_def S2_def P_set_def Q_set_def aux1b)
- ultimately have "int(card (S2)) = sum (%j. int(card (f2 j))) Q_set"
- by auto
- also have "... = sum (%j. p * j div q) Q_set"
- using aux3b by(fastforce intro: sum.cong)
- finally show ?thesis .
-qed
-
-lemma S1_carda: "int (card(S1)) =
- sum (%j. (j * q) div p) P_set"
- by (auto simp add: S1_card ac_simps)
-
-lemma S2_carda: "int (card(S2)) =
- sum (%j. (j * p) div q) Q_set"
- by (auto simp add: S2_card ac_simps)
-
-lemma pq_sum_prop: "(sum (%j. (j * p) div q) Q_set) +
- (sum (%j. (j * q) div p) P_set) = ((p - 1) div 2) * ((q - 1) div 2)"
-proof -
- have "(sum (%j. (j * p) div q) Q_set) +
- (sum (%j. (j * q) div p) P_set) = int (card S2) + int (card S1)"
- by (auto simp add: S1_carda S2_carda)
- also have "... = int (card S1) + int (card S2)"
- by auto
- also have "... = ((p - 1) div 2) * ((q - 1) div 2)"
- by (auto simp add: card_sum_S1_S2)
- finally show ?thesis .
-qed
-
-
-lemma (in -) pq_prime_neq: "[| zprime p; zprime q; p \<noteq> q |] ==> (~[p = 0] (mod q))"
- apply (auto simp add: zcong_eq_zdvd_prop zprime_def)
- apply (drule_tac x = q in allE)
- apply (drule_tac x = p in allE)
- apply auto
- done
-
-
-lemma QR_short: "(Legendre p q) * (Legendre q p) =
- (-1::int)^nat(((p - 1) div 2)*((q - 1) div 2))"
-proof -
- from QRTEMP_axioms have "~([p = 0] (mod q))"
- by (auto simp add: pq_prime_neq QRTEMP_def)
- with QRTEMP_axioms Q_set_def have a1: "(Legendre p q) = (-1::int) ^
- nat(sum (%x. ((x * p) div q)) Q_set)"
- apply (rule_tac p = q in MainQRLemma)
- apply (auto simp add: zprime_zOdd_eq_grt_2 QRTEMP_def)
- done
- from QRTEMP_axioms have "~([q = 0] (mod p))"
- apply (rule_tac p = q and q = p in pq_prime_neq)
- apply (simp add: QRTEMP_def)+
- done
- with QRTEMP_axioms P_set_def have a2: "(Legendre q p) =
- (-1::int) ^ nat(sum (%x. ((x * q) div p)) P_set)"
- apply (rule_tac p = p in MainQRLemma)
- apply (auto simp add: zprime_zOdd_eq_grt_2 QRTEMP_def)
- done
- from a1 a2 have "(Legendre p q) * (Legendre q p) =
- (-1::int) ^ nat(sum (%x. ((x * p) div q)) Q_set) *
- (-1::int) ^ nat(sum (%x. ((x * q) div p)) P_set)"
- by auto
- also have "... = (-1::int) ^ (nat(sum (%x. ((x * p) div q)) Q_set) +
- nat(sum (%x. ((x * q) div p)) P_set))"
- by (auto simp add: power_add)
- also have "nat(sum (%x. ((x * p) div q)) Q_set) +
- nat(sum (%x. ((x * q) div p)) P_set) =
- nat((sum (%x. ((x * p) div q)) Q_set) +
- (sum (%x. ((x * q) div p)) P_set))"
- apply (rule_tac z = "sum (%x. ((x * p) div q)) Q_set" in
- nat_add_distrib [symmetric])
- apply (auto simp add: S1_carda [symmetric] S2_carda [symmetric])
- done
- also have "... = nat(((p - 1) div 2) * ((q - 1) div 2))"
- by (auto simp add: pq_sum_prop)
- finally show ?thesis .
-qed
-
-end
-
-theorem Quadratic_Reciprocity:
- "[| p \<in> zOdd; zprime p; q \<in> zOdd; zprime q;
- p \<noteq> q |]
- ==> (Legendre p q) * (Legendre q p) =
- (-1::int)^nat(((p - 1) div 2)*((q - 1) div 2))"
- by (auto simp add: QRTEMP.QR_short zprime_zOdd_eq_grt_2 [symmetric]
- QRTEMP_def)
-
-end
--- a/src/HOL/Old_Number_Theory/Residues.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,166 +0,0 @@
-(* Title: HOL/Old_Number_Theory/Residues.thy
- Authors: Jeremy Avigad, David Gray, and Adam Kramer
-*)
-
-section \<open>Residue Sets\<close>
-
-theory Residues
-imports Int2
-begin
-
-text \<open>
- \medskip Define the residue of a set, the standard residue,
- quadratic residues, and prove some basic properties.\<close>
-
-definition ResSet :: "int => int set => bool"
- where "ResSet m X = (\<forall>y1 y2. (y1 \<in> X & y2 \<in> X & [y1 = y2] (mod m) --> y1 = y2))"
-
-definition StandardRes :: "int => int => int"
- where "StandardRes m x = x mod m"
-
-definition QuadRes :: "int => int => bool"
- where "QuadRes m x = (\<exists>y. ([y\<^sup>2 = x] (mod m)))"
-
-definition Legendre :: "int => int => int" where
- "Legendre a p = (if ([a = 0] (mod p)) then 0
- else if (QuadRes p a) then 1
- else -1)"
-
-definition SR :: "int => int set"
- where "SR p = {x. (0 \<le> x) & (x < p)}"
-
-definition SRStar :: "int => int set"
- where "SRStar p = {x. (0 < x) & (x < p)}"
-
-
-subsection \<open>Some useful properties of StandardRes\<close>
-
-lemma StandardRes_prop1: "[x = StandardRes m x] (mod m)"
- by (auto simp add: StandardRes_def zcong_zmod)
-
-lemma StandardRes_prop2: "0 < m ==> (StandardRes m x1 = StandardRes m x2)
- = ([x1 = x2] (mod m))"
- by (auto simp add: StandardRes_def zcong_zmod_eq)
-
-lemma StandardRes_prop3: "(~[x = 0] (mod p)) = (~(StandardRes p x = 0))"
- by (auto simp add: StandardRes_def zcong_def dvd_eq_mod_eq_0)
-
-lemma StandardRes_prop4: "2 < m
- ==> [StandardRes m x * StandardRes m y = (x * y)] (mod m)"
- by (auto simp add: StandardRes_def zcong_zmod_eq
- mod_mult_eq [of x y m])
-
-lemma StandardRes_lbound: "0 < p ==> 0 \<le> StandardRes p x"
- by (auto simp add: StandardRes_def)
-
-lemma StandardRes_ubound: "0 < p ==> StandardRes p x < p"
- by (auto simp add: StandardRes_def)
-
-lemma StandardRes_eq_zcong:
- "(StandardRes m x = 0) = ([x = 0](mod m))"
- by (auto simp add: StandardRes_def zcong_eq_zdvd_prop dvd_def)
-
-
-subsection \<open>Relations between StandardRes, SRStar, and SR\<close>
-
-lemma SRStar_SR_prop: "x \<in> SRStar p ==> x \<in> SR p"
- by (auto simp add: SRStar_def SR_def)
-
-lemma StandardRes_SR_prop: "x \<in> SR p ==> StandardRes p x = x"
- by (auto simp add: SR_def StandardRes_def mod_pos_pos_trivial)
-
-lemma StandardRes_SRStar_prop1: "2 < p ==> (StandardRes p x \<in> SRStar p)
- = (~[x = 0] (mod p))"
- apply (auto simp add: StandardRes_prop3 StandardRes_def SRStar_def)
- apply (subgoal_tac "0 < p")
- apply (drule_tac a = x in pos_mod_sign, arith, simp)
- done
-
-lemma StandardRes_SRStar_prop1a: "x \<in> SRStar p ==> ~([x = 0] (mod p))"
- by (auto simp add: SRStar_def zcong_def zdvd_not_zless)
-
-lemma StandardRes_SRStar_prop2: "[| 2 < p; zprime p; x \<in> SRStar p |]
- ==> StandardRes p (MultInv p x) \<in> SRStar p"
- apply (frule_tac x = "(MultInv p x)" in StandardRes_SRStar_prop1, simp)
- apply (rule MultInv_prop3)
- apply (auto simp add: SRStar_def zcong_def zdvd_not_zless)
- done
-
-lemma StandardRes_SRStar_prop3: "x \<in> SRStar p ==> StandardRes p x = x"
- by (auto simp add: SRStar_SR_prop StandardRes_SR_prop)
-
-lemma StandardRes_SRStar_prop4: "[| zprime p; 2 < p; x \<in> SRStar p |]
- ==> StandardRes p x \<in> SRStar p"
- by (frule StandardRes_SRStar_prop3, auto)
-
-lemma SRStar_mult_prop1: "[| zprime p; 2 < p; x \<in> SRStar p; y \<in> SRStar p|]
- ==> (StandardRes p (x * y)):SRStar p"
- apply (frule_tac x = x in StandardRes_SRStar_prop4, auto)
- apply (frule_tac x = y in StandardRes_SRStar_prop4, auto)
- apply (auto simp add: StandardRes_SRStar_prop1 zcong_zmult_prop3)
- done
-
-lemma SRStar_mult_prop2: "[| zprime p; 2 < p; ~([a = 0](mod p));
- x \<in> SRStar p |]
- ==> StandardRes p (a * MultInv p x) \<in> SRStar p"
- apply (frule_tac x = x in StandardRes_SRStar_prop2, auto)
- apply (frule_tac x = "MultInv p x" in StandardRes_SRStar_prop1)
- apply (auto simp add: StandardRes_SRStar_prop1 zcong_zmult_prop3)
- done
-
-lemma SRStar_card: "2 < p ==> int(card(SRStar p)) = p - 1"
- by (auto simp add: SRStar_def int_card_bdd_int_set_l_l)
-
-lemma SRStar_finite: "2 < p ==> finite( SRStar p)"
- by (auto simp add: SRStar_def bdd_int_set_l_l_finite)
-
-
-subsection \<open>Properties relating ResSets with StandardRes\<close>
-
-lemma aux: "x mod m = y mod m ==> [x = y] (mod m)"
- apply (subgoal_tac "x = y ==> [x = y](mod m)")
- apply (subgoal_tac "[x mod m = y mod m] (mod m) ==> [x = y] (mod m)")
- apply (auto simp add: zcong_zmod [of x y m])
- done
-
-lemma StandardRes_inj_on_ResSet: "ResSet m X ==> (inj_on (StandardRes m) X)"
- apply (auto simp add: ResSet_def StandardRes_def inj_on_def)
- apply (drule_tac m = m in aux, auto)
- done
-
-lemma StandardRes_Sum: "[| finite X; 0 < m |]
- ==> [sum f X = sum (StandardRes m o f) X](mod m)"
- apply (rule_tac F = X in finite_induct)
- apply (auto intro!: zcong_zadd simp add: StandardRes_prop1)
- done
-
-lemma SR_pos: "0 < m ==> (StandardRes m ` X) \<subseteq> {x. 0 \<le> x & x < m}"
- by (auto simp add: StandardRes_ubound StandardRes_lbound)
-
-lemma ResSet_finite: "0 < m ==> ResSet m X ==> finite X"
- apply (rule_tac f = "StandardRes m" in finite_imageD)
- apply (rule_tac B = "{x. (0 :: int) \<le> x & x < m}" in finite_subset)
- apply (auto simp add: StandardRes_inj_on_ResSet bdd_int_set_l_finite SR_pos)
- done
-
-lemma mod_mod_is_mod: "[x = x mod m](mod m)"
- by (auto simp add: zcong_zmod)
-
-lemma StandardRes_prod: "[| finite X; 0 < m |]
- ==> [prod f X = prod (StandardRes m o f) X] (mod m)"
- apply (rule_tac F = X in finite_induct)
- apply (auto intro!: zcong_zmult simp add: StandardRes_prop1)
- done
-
-lemma ResSet_image:
- "[| 0 < m; ResSet m A; \<forall>x \<in> A. \<forall>y \<in> A. ([f x = f y](mod m) --> x = y) |] ==>
- ResSet m (f ` A)"
- by (auto simp add: ResSet_def)
-
-
-subsection \<open>Property for SRStar\<close>
-
-lemma ResSet_SRStar_prop: "ResSet p (SRStar p)"
- by (auto simp add: SRStar_def ResSet_def zcong_zless_imp_eq)
-
-end
--- a/src/HOL/Old_Number_Theory/WilsonBij.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,256 +0,0 @@
-(* Title: HOL/Old_Number_Theory/WilsonBij.thy
- Author: Thomas M. Rasmussen
- Copyright 2000 University of Cambridge
-*)
-
-section \<open>Wilson's Theorem using a more abstract approach\<close>
-
-theory WilsonBij
-imports BijectionRel IntFact
-begin
-
-text \<open>
- Wilson's Theorem using a more ``abstract'' approach based on
- bijections between sets. Does not use Fermat's Little Theorem
- (unlike Russinoff).
-\<close>
-
-
-subsection \<open>Definitions and lemmas\<close>
-
-definition reciR :: "int => int => int => bool"
- where "reciR p = (\<lambda>a b. zcong (a * b) 1 p \<and> 1 < a \<and> a < p - 1 \<and> 1 < b \<and> b < p - 1)"
-
-definition inv :: "int => int => int" where
- "inv p a =
- (if zprime p \<and> 0 < a \<and> a < p then
- (SOME x. 0 \<le> x \<and> x < p \<and> zcong (a * x) 1 p)
- else 0)"
-
-
-text \<open>\medskip Inverse\<close>
-
-lemma inv_correct:
- "zprime p ==> 0 < a ==> a < p
- ==> 0 \<le> inv p a \<and> inv p a < p \<and> [a * inv p a = 1] (mod p)"
- apply (unfold inv_def)
- apply (simp (no_asm_simp))
- apply (rule zcong_lineq_unique [THEN ex1_implies_ex, THEN someI_ex])
- apply (erule_tac [2] zless_zprime_imp_zrelprime)
- apply (unfold zprime_def)
- apply auto
- done
-
-lemmas inv_ge = inv_correct [THEN conjunct1]
-lemmas inv_less = inv_correct [THEN conjunct2, THEN conjunct1]
-lemmas inv_is_inv = inv_correct [THEN conjunct2, THEN conjunct2]
-
-lemma inv_not_0:
- "zprime p ==> 1 < a ==> a < p - 1 ==> inv p a \<noteq> 0"
- \<comment> \<open>same as \<open>WilsonRuss\<close>\<close>
- apply safe
- apply (cut_tac a = a and p = p in inv_is_inv)
- apply (unfold zcong_def)
- apply auto
- done
-
-lemma inv_not_1:
- "zprime p ==> 1 < a ==> a < p - 1 ==> inv p a \<noteq> 1"
- \<comment> \<open>same as \<open>WilsonRuss\<close>\<close>
- apply safe
- apply (cut_tac a = a and p = p in inv_is_inv)
- prefer 4
- apply simp
- apply (subgoal_tac "a = 1")
- apply (rule_tac [2] zcong_zless_imp_eq)
- apply auto
- done
-
-lemma aux: "[a * (p - 1) = 1] (mod p) = [a = p - 1] (mod p)"
- \<comment> \<open>same as \<open>WilsonRuss\<close>\<close>
- apply (unfold zcong_def)
- apply (simp add: diff_diff_eq diff_diff_eq2 right_diff_distrib)
- apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans)
- apply (simp add: algebra_simps)
- apply (subst dvd_minus_iff)
- apply (subst zdvd_reduce)
- apply (rule_tac s = "p dvd (a + 1) + (p * -1)" in trans)
- apply (subst zdvd_reduce)
- apply auto
- done
-
-lemma inv_not_p_minus_1:
- "zprime p ==> 1 < a ==> a < p - 1 ==> inv p a \<noteq> p - 1"
- \<comment> \<open>same as \<open>WilsonRuss\<close>\<close>
- apply safe
- apply (cut_tac a = a and p = p in inv_is_inv)
- apply auto
- apply (simp add: aux)
- apply (subgoal_tac "a = p - 1")
- apply (rule_tac [2] zcong_zless_imp_eq)
- apply auto
- done
-
-text \<open>
- Below is slightly different as we don't expand @{term [source] inv}
- but use ``\<open>correct\<close>'' theorems.
-\<close>
-
-lemma inv_g_1: "zprime p ==> 1 < a ==> a < p - 1 ==> 1 < inv p a"
- apply (subgoal_tac "inv p a \<noteq> 1")
- apply (subgoal_tac "inv p a \<noteq> 0")
- apply (subst order_less_le)
- apply (subst zle_add1_eq_le [symmetric])
- apply (subst order_less_le)
- apply (rule_tac [2] inv_not_0)
- apply (rule_tac [5] inv_not_1)
- apply auto
- apply (rule inv_ge)
- apply auto
- done
-
-lemma inv_less_p_minus_1:
- "zprime p ==> 1 < a ==> a < p - 1 ==> inv p a < p - 1"
- \<comment> \<open>ditto\<close>
- apply (subst order_less_le)
- apply (simp add: inv_not_p_minus_1 inv_less)
- done
-
-
-text \<open>\medskip Bijection\<close>
-
-lemma aux1: "1 < x ==> 0 \<le> (x::int)"
- apply auto
- done
-
-lemma aux2: "1 < x ==> 0 < (x::int)"
- apply auto
- done
-
-lemma aux3: "x \<le> p - 2 ==> x < (p::int)"
- apply auto
- done
-
-lemma aux4: "x \<le> p - 2 ==> x < (p::int) - 1"
- apply auto
- done
-
-lemma inv_inj: "zprime p ==> inj_on (inv p) (d22set (p - 2))"
- apply (unfold inj_on_def)
- apply auto
- apply (rule zcong_zless_imp_eq)
- apply (tactic \<open>stac @{context} (@{thm zcong_cancel} RS sym) 5\<close>)
- apply (rule_tac [7] zcong_trans)
- apply (tactic \<open>stac @{context} @{thm zcong_sym} 8\<close>)
- apply (erule_tac [7] inv_is_inv)
- apply (tactic "asm_simp_tac @{context} 9")
- apply (erule_tac [9] inv_is_inv)
- apply (rule_tac [6] zless_zprime_imp_zrelprime)
- apply (rule_tac [8] inv_less)
- apply (rule_tac [7] inv_g_1 [THEN aux2])
- apply (unfold zprime_def)
- apply (auto intro: d22set_g_1 d22set_le
- aux1 aux2 aux3 aux4)
- done
-
-lemma inv_d22set_d22set:
- "zprime p ==> inv p ` d22set (p - 2) = d22set (p - 2)"
- apply (rule endo_inj_surj)
- apply (rule d22set_fin)
- apply (erule_tac [2] inv_inj)
- apply auto
- apply (rule d22set_mem)
- apply (erule inv_g_1)
- apply (subgoal_tac [3] "inv p xa < p - 1")
- apply (erule_tac [4] inv_less_p_minus_1)
- apply (auto intro: d22set_g_1 d22set_le aux4)
- done
-
-lemma d22set_d22set_bij:
- "zprime p ==> (d22set (p - 2), d22set (p - 2)) \<in> bijR (reciR p)"
- apply (unfold reciR_def)
- apply (rule_tac s = "(d22set (p - 2), inv p ` d22set (p - 2))" in subst)
- apply (simp add: inv_d22set_d22set)
- apply (rule inj_func_bijR)
- apply (rule_tac [3] d22set_fin)
- apply (erule_tac [2] inv_inj)
- apply auto
- apply (erule inv_is_inv)
- apply (erule_tac [5] inv_g_1)
- apply (erule_tac [7] inv_less_p_minus_1)
- apply (auto intro: d22set_g_1 d22set_le aux2 aux3 aux4)
- done
-
-lemma reciP_bijP: "zprime p ==> bijP (reciR p) (d22set (p - 2))"
- apply (unfold reciR_def bijP_def)
- apply auto
- apply (rule d22set_mem)
- apply auto
- done
-
-lemma reciP_uniq: "zprime p ==> uniqP (reciR p)"
- apply (unfold reciR_def uniqP_def)
- apply auto
- apply (rule zcong_zless_imp_eq)
- apply (tactic \<open>stac @{context} (@{thm zcong_cancel2} RS sym) 5\<close>)
- apply (rule_tac [7] zcong_trans)
- apply (tactic \<open>stac @{context} @{thm zcong_sym} 8\<close>)
- apply (rule_tac [6] zless_zprime_imp_zrelprime)
- apply auto
- apply (rule zcong_zless_imp_eq)
- apply (tactic \<open>stac @{context} (@{thm zcong_cancel} RS sym) 5\<close>)
- apply (rule_tac [7] zcong_trans)
- apply (tactic \<open>stac @{context} @{thm zcong_sym} 8\<close>)
- apply (rule_tac [6] zless_zprime_imp_zrelprime)
- apply auto
- done
-
-lemma reciP_sym: "zprime p ==> symP (reciR p)"
- apply (unfold reciR_def symP_def)
- apply (simp add: mult.commute)
- apply auto
- done
-
-lemma bijER_d22set: "zprime p ==> d22set (p - 2) \<in> bijER (reciR p)"
- apply (rule bijR_bijER)
- apply (erule d22set_d22set_bij)
- apply (erule reciP_bijP)
- apply (erule reciP_uniq)
- apply (erule reciP_sym)
- done
-
-
-subsection \<open>Wilson\<close>
-
-lemma bijER_zcong_prod_1:
- "zprime p ==> A \<in> bijER (reciR p) ==> [\<Prod>A = 1] (mod p)"
- apply (unfold reciR_def)
- apply (erule bijER.induct)
- apply (subgoal_tac [2] "a = 1 \<or> a = p - 1")
- apply (rule_tac [3] zcong_square_zless)
- apply auto
- apply (subst prod.insert)
- prefer 3
- apply (subst prod.insert)
- apply (auto simp add: fin_bijER)
- apply (subgoal_tac "zcong ((a * b) * \<Prod>A) (1 * 1) p")
- apply (simp add: mult.assoc)
- apply (rule zcong_zmult)
- apply auto
- done
-
-theorem Wilson_Bij: "zprime p ==> [zfact (p - 1) = -1] (mod p)"
- apply (subgoal_tac "zcong ((p - 1) * zfact (p - 2)) (-1 * 1) p")
- apply (rule_tac [2] zcong_zmult)
- apply (simp add: zprime_def)
- apply (subst zfact.simps)
- apply (rule_tac t = "p - 1 - 1" and s = "p - 2" in subst)
- apply auto
- apply (simp add: zcong_def)
- apply (subst d22set_prod_zfact [symmetric])
- apply (rule bijER_zcong_prod_1)
- apply (rule_tac [2] bijER_d22set)
- apply auto
- done
-
-end
--- a/src/HOL/Old_Number_Theory/WilsonRuss.thy Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,314 +0,0 @@
-(* Title: HOL/Old_Number_Theory/WilsonRuss.thy
- Author: Thomas M. Rasmussen
- Copyright 2000 University of Cambridge
-*)
-
-section \<open>Wilson's Theorem according to Russinoff\<close>
-
-theory WilsonRuss
-imports EulerFermat
-begin
-
-text \<open>
- Wilson's Theorem following quite closely Russinoff's approach
- using Boyer-Moore (using finite sets instead of lists, though).
-\<close>
-
-subsection \<open>Definitions and lemmas\<close>
-
-definition inv :: "int => int => int"
- where "inv p a = (a^(nat (p - 2))) mod p"
-
-fun wset :: "int \<Rightarrow> int => int set" where
- "wset a p =
- (if 1 < a then
- let ws = wset (a - 1) p
- in (if a \<in> ws then ws else insert a (insert (inv p a) ws)) else {})"
-
-
-text \<open>\medskip @{term [source] inv}\<close>
-
-lemma inv_is_inv_aux: "1 < m ==> Suc (nat (m - 2)) = nat (m - 1)"
- by simp
-
-lemma inv_is_inv:
- "zprime p \<Longrightarrow> 0 < a \<Longrightarrow> a < p ==> [a * inv p a = 1] (mod p)"
- apply (unfold inv_def)
- apply (subst zcong_zmod)
- apply (subst mod_mult_right_eq [symmetric])
- apply (subst zcong_zmod [symmetric])
- apply (subst power_Suc [symmetric])
- using Little_Fermat inv_is_inv_aux zdvd_not_zless apply auto
- done
-
-lemma inv_distinct:
- "zprime p \<Longrightarrow> 1 < a \<Longrightarrow> a < p - 1 ==> a \<noteq> inv p a"
- apply safe
- apply (cut_tac a = a and p = p in zcong_square)
- apply (cut_tac [3] a = a and p = p in inv_is_inv, auto)
- apply (subgoal_tac "a = 1")
- apply (rule_tac [2] m = p in zcong_zless_imp_eq)
- apply (subgoal_tac [7] "a = p - 1")
- apply (rule_tac [8] m = p in zcong_zless_imp_eq, auto)
- done
-
-lemma inv_not_0:
- "zprime p \<Longrightarrow> 1 < a \<Longrightarrow> a < p - 1 ==> inv p a \<noteq> 0"
- apply safe
- apply (cut_tac a = a and p = p in inv_is_inv)
- apply (unfold zcong_def, auto)
- done
-
-lemma inv_not_1:
- "zprime p \<Longrightarrow> 1 < a \<Longrightarrow> a < p - 1 ==> inv p a \<noteq> 1"
- apply safe
- apply (cut_tac a = a and p = p in inv_is_inv)
- prefer 4
- apply simp
- apply (subgoal_tac "a = 1")
- apply (rule_tac [2] zcong_zless_imp_eq, auto)
- done
-
-lemma inv_not_p_minus_1_aux:
- "[a * (p - 1) = 1] (mod p) = [a = p - 1] (mod p)"
- apply (unfold zcong_def)
- apply (simp add: diff_diff_eq diff_diff_eq2 right_diff_distrib)
- apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans)
- apply (simp add: algebra_simps)
- apply (subst dvd_minus_iff)
- apply (subst zdvd_reduce)
- apply (rule_tac s = "p dvd (a + 1) + (p * -1)" in trans)
- apply (subst zdvd_reduce, auto)
- done
-
-lemma inv_not_p_minus_1:
- "zprime p \<Longrightarrow> 1 < a \<Longrightarrow> a < p - 1 ==> inv p a \<noteq> p - 1"
- apply safe
- apply (cut_tac a = a and p = p in inv_is_inv, auto)
- apply (simp add: inv_not_p_minus_1_aux)
- apply (subgoal_tac "a = p - 1")
- apply (rule_tac [2] zcong_zless_imp_eq, auto)
- done
-
-lemma inv_g_1:
- "zprime p \<Longrightarrow> 1 < a \<Longrightarrow> a < p - 1 ==> 1 < inv p a"
- apply (case_tac "0\<le> inv p a")
- apply (subgoal_tac "inv p a \<noteq> 1")
- apply (subgoal_tac "inv p a \<noteq> 0")
- apply (subst order_less_le)
- apply (subst zle_add1_eq_le [symmetric])
- apply (subst order_less_le)
- apply (rule_tac [2] inv_not_0)
- apply (rule_tac [5] inv_not_1, auto)
- apply (unfold inv_def zprime_def, simp)
- done
-
-lemma inv_less_p_minus_1:
- "zprime p \<Longrightarrow> 1 < a \<Longrightarrow> a < p - 1 ==> inv p a < p - 1"
- apply (case_tac "inv p a < p")
- apply (subst order_less_le)
- apply (simp add: inv_not_p_minus_1, auto)
- apply (unfold inv_def zprime_def, simp)
- done
-
-lemma inv_inv_aux: "5 \<le> p ==>
- nat (p - 2) * nat (p - 2) = Suc (nat (p - 1) * nat (p - 3))"
- apply (subst of_nat_eq_iff [where 'a = int, symmetric])
- apply (simp add: left_diff_distrib right_diff_distrib)
- done
-
-lemma zcong_zpower_zmult:
- "[x^y = 1] (mod p) \<Longrightarrow> [x^(y * z) = 1] (mod p)"
- apply (induct z)
- apply (auto simp add: power_add)
- apply (subgoal_tac "zcong (x^y * x^(y * z)) (1 * 1) p")
- apply (rule_tac [2] zcong_zmult, simp_all)
- done
-
-lemma inv_inv: "zprime p \<Longrightarrow>
- 5 \<le> p \<Longrightarrow> 0 < a \<Longrightarrow> a < p ==> inv p (inv p a) = a"
- apply (unfold inv_def)
- apply (subst power_mod)
- apply (subst power_mult [symmetric])
- apply (rule zcong_zless_imp_eq)
- prefer 5
- apply (subst zcong_zmod)
- apply (subst mod_mod_trivial)
- apply (subst zcong_zmod [symmetric])
- apply (subst inv_inv_aux)
- apply (subgoal_tac [2]
- "zcong (a * a^(nat (p - 1) * nat (p - 3))) (a * 1) p")
- apply (rule_tac [3] zcong_zmult)
- apply (rule_tac [4] zcong_zpower_zmult)
- apply (erule_tac [4] Little_Fermat)
- apply (rule_tac [4] zdvd_not_zless, simp_all)
- done
-
-
-text \<open>\medskip @{term wset}\<close>
-
-declare wset.simps [simp del]
-
-lemma wset_induct:
- assumes "!!a p. P {} a p"
- and "!!a p. 1 < (a::int) \<Longrightarrow>
- P (wset (a - 1) p) (a - 1) p ==> P (wset a p) a p"
- shows "P (wset u v) u v"
- apply (rule wset.induct)
- apply (case_tac "1 < a")
- apply (rule assms)
- apply (simp_all add: wset.simps assms)
- done
-
-lemma wset_mem_imp_or [rule_format]:
- "1 < a \<Longrightarrow> b \<notin> wset (a - 1) p
- ==> b \<in> wset a p --> b = a \<or> b = inv p a"
- apply (subst wset.simps)
- apply (unfold Let_def, simp)
- done
-
-lemma wset_mem_mem [simp]: "1 < a ==> a \<in> wset a p"
- apply (subst wset.simps)
- apply (unfold Let_def, simp)
- done
-
-lemma wset_subset: "1 < a \<Longrightarrow> b \<in> wset (a - 1) p ==> b \<in> wset a p"
- apply (subst wset.simps)
- apply (unfold Let_def, auto)
- done
-
-lemma wset_g_1 [rule_format]:
- "zprime p --> a < p - 1 --> b \<in> wset a p --> 1 < b"
- apply (induct a p rule: wset_induct, auto)
- apply (case_tac "b = a")
- apply (case_tac [2] "b = inv p a")
- apply (subgoal_tac [3] "b = a \<or> b = inv p a")
- apply (rule_tac [4] wset_mem_imp_or)
- prefer 2
- apply simp
- apply (rule inv_g_1, auto)
- done
-
-lemma wset_less [rule_format]:
- "zprime p --> a < p - 1 --> b \<in> wset a p --> b < p - 1"
- apply (induct a p rule: wset_induct, auto)
- apply (case_tac "b = a")
- apply (case_tac [2] "b = inv p a")
- apply (subgoal_tac [3] "b = a \<or> b = inv p a")
- apply (rule_tac [4] wset_mem_imp_or)
- prefer 2
- apply simp
- apply (rule inv_less_p_minus_1, auto)
- done
-
-lemma wset_mem [rule_format]:
- "zprime p -->
- a < p - 1 --> 1 < b --> b \<le> a --> b \<in> wset a p"
- apply (induct a p rule: wset.induct, auto)
- apply (rule_tac wset_subset)
- apply (simp (no_asm_simp))
- apply auto
- done
-
-lemma wset_mem_inv_mem [rule_format]:
- "zprime p --> 5 \<le> p --> a < p - 1 --> b \<in> wset a p
- --> inv p b \<in> wset a p"
- apply (induct a p rule: wset_induct, auto)
- apply (case_tac "b = a")
- apply (subst wset.simps)
- apply (unfold Let_def)
- apply (rule_tac [3] wset_subset, auto)
- apply (case_tac "b = inv p a")
- apply (simp (no_asm_simp))
- apply (subst inv_inv)
- apply (subgoal_tac [6] "b = a \<or> b = inv p a")
- apply (rule_tac [7] wset_mem_imp_or, auto)
- done
-
-lemma wset_inv_mem_mem:
- "zprime p \<Longrightarrow> 5 \<le> p \<Longrightarrow> a < p - 1 \<Longrightarrow> 1 < b \<Longrightarrow> b < p - 1
- \<Longrightarrow> inv p b \<in> wset a p \<Longrightarrow> b \<in> wset a p"
- apply (rule_tac s = "inv p (inv p b)" and t = b in subst)
- apply (rule_tac [2] wset_mem_inv_mem)
- apply (rule inv_inv, simp_all)
- done
-
-lemma wset_fin: "finite (wset a p)"
- apply (induct a p rule: wset_induct)
- prefer 2
- apply (subst wset.simps)
- apply (unfold Let_def, auto)
- done
-
-lemma wset_zcong_prod_1 [rule_format]:
- "zprime p -->
- 5 \<le> p --> a < p - 1 --> [(\<Prod>x\<in>wset a p. x) = 1] (mod p)"
- apply (induct a p rule: wset_induct)
- prefer 2
- apply (subst wset.simps)
- apply (auto, unfold Let_def, auto)
- apply (subst prod.insert)
- apply (tactic \<open>stac @{context} @{thm prod.insert} 3\<close>)
- apply (subgoal_tac [5]
- "zcong (a * inv p a * (\<Prod>x\<in>wset (a - 1) p. x)) (1 * 1) p")
- prefer 5
- apply (simp add: mult.assoc)
- apply (rule_tac [5] zcong_zmult)
- apply (rule_tac [5] inv_is_inv)
- apply (tactic "clarify_tac @{context} 4")
- apply (subgoal_tac [4] "a \<in> wset (a - 1) p")
- apply (rule_tac [5] wset_inv_mem_mem)
- apply (simp_all add: wset_fin)
- apply (rule inv_distinct, auto)
- done
-
-lemma d22set_eq_wset: "zprime p ==> d22set (p - 2) = wset (p - 2) p"
- apply safe
- apply (erule wset_mem)
- apply (rule_tac [2] d22set_g_1)
- apply (rule_tac [3] d22set_le)
- apply (rule_tac [4] d22set_mem)
- apply (erule_tac [4] wset_g_1)
- prefer 6
- apply (subst zle_add1_eq_le [symmetric])
- apply (subgoal_tac "p - 2 + 1 = p - 1")
- apply (simp (no_asm_simp))
- apply (erule wset_less, auto)
- done
-
-
-subsection \<open>Wilson\<close>
-
-lemma prime_g_5: "zprime p \<Longrightarrow> p \<noteq> 2 \<Longrightarrow> p \<noteq> 3 ==> 5 \<le> p"
- apply (unfold zprime_def dvd_def)
- apply (case_tac "p = 4", auto)
- apply (rule notE)
- prefer 2
- apply assumption
- apply (simp (no_asm))
- apply (rule_tac x = 2 in exI)
- apply (safe, arith)
- apply (rule_tac x = 2 in exI, auto)
- done
-
-theorem Wilson_Russ:
- "zprime p ==> [zfact (p - 1) = -1] (mod p)"
- apply (subgoal_tac "[(p - 1) * zfact (p - 2) = -1 * 1] (mod p)")
- apply (rule_tac [2] zcong_zmult)
- apply (simp only: zprime_def)
- apply (subst zfact.simps)
- apply (rule_tac t = "p - 1 - 1" and s = "p - 2" in subst, auto)
- apply (simp only: zcong_def)
- apply (simp (no_asm_simp))
- apply (case_tac "p = 2")
- apply (simp add: zfact.simps)
- apply (case_tac "p = 3")
- apply (simp add: zfact.simps)
- apply (subgoal_tac "5 \<le> p")
- apply (erule_tac [2] prime_g_5)
- apply (subst d22set_prod_zfact [symmetric])
- apply (subst d22set_eq_wset)
- apply (rule_tac [2] wset_zcong_prod_1, auto)
- done
-
-end
--- a/src/HOL/Old_Number_Theory/document/root.bib Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,7 +0,0 @@
-@Book{davenport92,
- author = {H. Davenport},
- title = {The Higher Arithmetic},
- publisher = {Cambridge University Press},
- year = 1992
-}
-
--- a/src/HOL/Old_Number_Theory/document/root.tex Tue Oct 18 07:04:08 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,59 +0,0 @@
-\documentclass[11pt,a4paper]{article}
-\usepackage{graphicx}
-\usepackage{isabelle,isabellesym,pdfsetup}
-\usepackage{textcomp}
-
-\urlstyle{rm}
-\isabellestyle{it}
-
-\begin{document}
-
-\title{Some results of number theory}
-\author{Jeremy Avigad\\
- David Gray\\
- Adam Kramer\\
- Thomas M Rasmussen}
-
-\maketitle
-
-\begin{abstract}
-This is a collection of formalized proofs of many results of number theory.
-The proofs of the Chinese Remainder Theorem and Wilson's Theorem are due to
-Rasmussen. The proof of Gauss's law of quadratic reciprocity is due to
-Avigad, Gray and Kramer. Proofs can be found in most introductory number
-theory textbooks; Goldman's \emph{The Queen of Mathematics: a Historically
-Motivated Guide to Number Theory} provides some historical context.
-
-Avigad, Gray and Kramer have also provided library theories dealing with
-finite sets and finite sums, divisibility and congruences, parity and
-residues. The authors are engaged in redesigning and polishing these theories
-for more serious use. For the latest information in this respect, please see
-the web page \url{http://www.andrew.cmu.edu/~avigad/isabelle}. Other theories
-contain proofs of Euler's criteria, Gauss' lemma, and the law of quadratic
-reciprocity. The formalization follows Eisenstein's proof, which is the one
-most commonly found in introductory textbooks; in particular, it follows the
-presentation in Niven and Zuckerman, \emph{The Theory of Numbers}.
-
-To avoid having to count roots of polynomials, however, we relied on a trick
-previously used by David Russinoff in formalizing quadratic reciprocity for
-the Boyer-Moore theorem prover; see Russinoff, David, ``A mechanical proof
-of quadratic reciprocity,'' \emph{Journal of Automated Reasoning} 8:3-21,
-1992. We are grateful to Larry Paulson for calling our attention to this
-reference.
-\end{abstract}
-
-\tableofcontents
-
-\begin{center}
- \includegraphics[scale=0.5]{session_graph}
-\end{center}
-
-\newpage
-
-\parindent 0pt\parskip 0.5ex
-\input{session}
-
-\bibliographystyle{abbrv}
-\bibliography{root}
-
-\end{document}
--- a/src/HOL/ROOT Tue Oct 18 07:04:08 2016 +0200
+++ b/src/HOL/ROOT Mon Oct 17 15:20:06 2016 +0200
@@ -218,27 +218,6 @@
document_files
"root.tex"
-session "HOL-Old_Number_Theory" in Old_Number_Theory = HOL +
- description {*
- Fundamental Theorem of Arithmetic, Chinese Remainder Theorem, Fermat/Euler
- Theorem, Wilson's Theorem, Quadratic Reciprocity.
- *}
- theories [document = false]
- "~~/src/HOL/Library/Infinite_Set"
- "~~/src/HOL/Library/Permutation"
- theories
- Fib
- Factorization
- Chinese
- WilsonRuss
- WilsonBij
- Quadratic_Reciprocity
- Primes
- Pocklington
- document_files
- "root.bib"
- "root.tex"
-
session "HOL-Hoare" in Hoare = HOL +
description {*
Verification of imperative programs (verification conditions are generated