# HG changeset patch # User haftmann # Date 1251834259 -7200 # Node ID a4a1547a6f1e99e84a1e7620d01c182e369ba950 # Parent d2c97fc18704ebd6d6f756d925ebc3eb59a47579# Parent 522f04b719c826582b6976cc48a9aaa20663bf7a merged diff -r d2c97fc18704 -r a4a1547a6f1e NEWS --- a/NEWS Tue Sep 01 19:48:11 2009 +0200 +++ b/NEWS Tue Sep 01 21:44:19 2009 +0200 @@ -18,6 +18,15 @@ *** HOL *** +* Reorganization of number theory: + * former session NumberTheory now names Old_Number_Theory; former session NewNumberTheory + named NumberTheory; + * split off prime number ingredients from theory GCD to theory Number_Theory/Primes; + * moved legacy theories Legacy_GCD and Primes from Library/ to Old_Number_Theory/; + * moved theory Pocklington from Library/ to Old_Number_Theory/; + * removed various references to Old_Number_Theory from HOL distribution. +INCOMPATIBILITY. + * New testing tool "Mirabelle" for automated (proof) tools. Applies several tools and tactics like sledgehammer, metis, or quickcheck, to every proof step in a theory. To be used in batch mode via the diff -r d2c97fc18704 -r a4a1547a6f1e etc/components --- a/etc/components Tue Sep 01 19:48:11 2009 +0200 +++ b/etc/components Tue Sep 01 21:44:19 2009 +0200 @@ -11,6 +11,7 @@ src/LCF src/Sequents #misc components +src/Tools/Code src/HOL/Tools/ATP_Manager src/HOL/Tools/Mirabelle src/HOL/Library/Sum_Of_Squares diff -r d2c97fc18704 -r a4a1547a6f1e lib/Tools/codegen --- a/lib/Tools/codegen Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -#!/usr/bin/env bash -# -# Author: Florian Haftmann, TUM -# -# DESCRIPTION: issue code generation from shell - - -## diagnostics - -PRG="$(basename "$0")" - -function usage() -{ - echo - echo "Usage: isabelle $PRG IMAGE THY CMD" - echo - echo " Issues code generation using image IMAGE," - echo " theory THY," - echo " with Isar command 'export_code CMD'" - echo - exit 1 -} - - -## process command line - -[ "$#" -lt 2 -o "$1" = "-?" ] && usage - -IMAGE="$1"; shift -THY="$1"; shift -CMD="$1" - - -## main - -CODE_CMD=$(echo $CMD | perl -pe 's/\\/\\\\/g; s/"/\\\"/g') -CTXT_CMD="ML_Context.eval_in (SOME (ProofContext.init (theory \"HOL\"))) false Position.none \"Code_Target.shell_command thyname cmd\";" -FULL_CMD="val thyname = \"$THY\"; val cmd = \"$CODE_CMD\"; $CTXT_CMD" - -"$ISABELLE" -q -e "$FULL_CMD" "$IMAGE" || exit 1 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Algebra/Exponent.thy --- a/src/HOL/Algebra/Exponent.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Algebra/Exponent.thy Tue Sep 01 21:44:19 2009 +0200 @@ -1,16 +1,13 @@ (* Title: HOL/Algebra/Exponent.thy - ID: $Id$ Author: Florian Kammueller, with new proofs by L C Paulson exponent p s yields the greatest power of p that divides s. *) theory Exponent -imports Main Primes Binomial +imports Main "~~/src/HOL/Old_Number_Theory/Primes" Binomial begin -hide (open) const GCD.gcd GCD.coprime GCD.prime - section {*Sylow's Theorem*} subsection {*The Combinatorial Argument Underlying the First Sylow Theorem*} diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Algebra/IntRing.thy --- a/src/HOL/Algebra/IntRing.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Algebra/IntRing.thy Tue Sep 01 21:44:19 2009 +0200 @@ -4,7 +4,7 @@ *) theory IntRing -imports QuotRing Lattice Int Primes +imports QuotRing Lattice Int "~~/src/HOL/Old_Number_Theory/Primes" begin diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Algebra/ROOT.ML --- a/src/HOL/Algebra/ROOT.ML Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Algebra/ROOT.ML Tue Sep 01 21:44:19 2009 +0200 @@ -5,7 +5,7 @@ *) (* Preliminaries from set and number theory *) -no_document use_thys ["FuncSet", "Primes", "Binomial", "Permutation"]; +no_document use_thys ["FuncSet", "~~/src/HOL/Old_Number_Theory/Primes", "Binomial", "Permutation"]; (*** New development, based on explicit structures ***) diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Extraction/Euclid.thy --- a/src/HOL/Extraction/Euclid.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Extraction/Euclid.thy Tue Sep 01 21:44:19 2009 +0200 @@ -1,5 +1,4 @@ (* Title: HOL/Extraction/Euclid.thy - ID: $Id$ Author: Markus Wenzel, TU Muenchen Freek Wiedijk, Radboud University Nijmegen Stefan Berghofer, TU Muenchen @@ -8,7 +7,7 @@ header {* Euclid's theorem *} theory Euclid -imports "~~/src/HOL/NumberTheory/Factorization" Util Efficient_Nat +imports "~~/src/HOL/Old_Number_Theory/Factorization" Util Efficient_Nat begin text {* diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Extraction/ROOT.ML --- a/src/HOL/Extraction/ROOT.ML Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Extraction/ROOT.ML Tue Sep 01 21:44:19 2009 +0200 @@ -1,5 +1,4 @@ (* Title: HOL/Extraction/ROOT.ML - ID: $Id$ Examples for program extraction in Higher-Order Logic. *) @@ -8,5 +7,5 @@ warning "HOL proof terms required for running extraction examples" else (Proofterm.proofs := 2; - no_document use_thys ["Efficient_Nat", "~~/src/HOL/NumberTheory/Factorization"]; + no_document use_thys ["Efficient_Nat", "~~/src/HOL/Old_Number_Theory/Factorization"]; use_thys ["Greatest_Common_Divisor", "Warshall", "Higman", "Pigeonhole", "Euclid"]); diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/GCD.thy --- a/src/HOL/GCD.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/GCD.thy Tue Sep 01 21:44:19 2009 +0200 @@ -1,11 +1,9 @@ -(* Title: GCD.thy - Authors: Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb, +(* Authors: Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb, Thomas M. Rasmussen, Jeremy Avigad, Tobias Nipkow -This file deals with the functions gcd and lcm, and properties of -primes. Definitions and lemmas are proved uniformly for the natural -numbers and integers. +This file deals with the functions gcd and lcm. Definitions and +lemmas are proved uniformly for the natural numbers and integers. This file combines and revises a number of prior developments. @@ -52,11 +50,6 @@ end -class prime = one + - -fixes - prime :: "'a \ bool" - (* definitions for the natural numbers *) @@ -80,20 +73,6 @@ end -instantiation nat :: prime - -begin - -definition - prime_nat :: "nat \ bool" -where - [code del]: "prime_nat p = (1 < p \ (\m. m dvd p --> m = 1 \ m = p))" - -instance proof qed - -end - - (* definitions for the integers *) instantiation int :: gcd @@ -115,28 +94,13 @@ end -instantiation int :: prime - -begin - -definition - prime_int :: "int \ bool" -where - [code del]: "prime_int p = prime (nat p)" - -instance proof qed - -end - - subsection {* Set up Transfer *} lemma transfer_nat_int_gcd: "(x::int) >= 0 \ y >= 0 \ gcd (nat x) (nat y) = nat (gcd x y)" "(x::int) >= 0 \ y >= 0 \ lcm (nat x) (nat y) = nat (lcm x y)" - "(x::int) >= 0 \ prime (nat x) = prime x" - unfolding gcd_int_def lcm_int_def prime_int_def + unfolding gcd_int_def lcm_int_def by auto lemma transfer_nat_int_gcd_closures: @@ -150,8 +114,7 @@ lemma transfer_int_nat_gcd: "gcd (int x) (int y) = int (gcd x y)" "lcm (int x) (int y) = int (lcm x y)" - "prime (int x) = prime x" - by (unfold gcd_int_def lcm_int_def prime_int_def, auto) + by (unfold gcd_int_def lcm_int_def, auto) lemma transfer_int_nat_gcd_closures: "is_nat x \ is_nat y \ gcd x y >= 0" @@ -1003,20 +966,6 @@ apply (auto simp add: gcd_mult_cancel_int) done -lemma prime_odd_nat: "prime (p::nat) \ p > 2 \ odd p" - unfolding prime_nat_def - apply (subst even_mult_two_ex) - apply clarify - apply (drule_tac x = 2 in spec) - apply auto -done - -lemma prime_odd_int: "prime (p::int) \ p > 2 \ odd p" - unfolding prime_int_def - apply (frule prime_odd_nat) - apply (auto simp add: even_nat_def) -done - lemma coprime_common_divisor_nat: "coprime (a::nat) b \ x dvd a \ x dvd b \ x = 1" apply (subgoal_tac "x dvd gcd a b") @@ -1753,327 +1702,4 @@ show ?thesis by(simp add: Gcd_def fold_set gcd_commute_int) qed - -subsection {* Primes *} - -(* FIXME Is there a better way to handle these, rather than making them elim rules? *) - -lemma prime_ge_0_nat [elim]: "prime (p::nat) \ p >= 0" - by (unfold prime_nat_def, auto) - -lemma prime_gt_0_nat [elim]: "prime (p::nat) \ p > 0" - by (unfold prime_nat_def, auto) - -lemma prime_ge_1_nat [elim]: "prime (p::nat) \ p >= 1" - by (unfold prime_nat_def, auto) - -lemma prime_gt_1_nat [elim]: "prime (p::nat) \ p > 1" - by (unfold prime_nat_def, auto) - -lemma prime_ge_Suc_0_nat [elim]: "prime (p::nat) \ p >= Suc 0" - by (unfold prime_nat_def, auto) - -lemma prime_gt_Suc_0_nat [elim]: "prime (p::nat) \ p > Suc 0" - by (unfold prime_nat_def, auto) - -lemma prime_ge_2_nat [elim]: "prime (p::nat) \ p >= 2" - by (unfold prime_nat_def, auto) - -lemma prime_ge_0_int [elim]: "prime (p::int) \ p >= 0" - by (unfold prime_int_def prime_nat_def) auto - -lemma prime_gt_0_int [elim]: "prime (p::int) \ p > 0" - by (unfold prime_int_def prime_nat_def, auto) - -lemma prime_ge_1_int [elim]: "prime (p::int) \ p >= 1" - by (unfold prime_int_def prime_nat_def, auto) - -lemma prime_gt_1_int [elim]: "prime (p::int) \ p > 1" - by (unfold prime_int_def prime_nat_def, auto) - -lemma prime_ge_2_int [elim]: "prime (p::int) \ p >= 2" - by (unfold prime_int_def prime_nat_def, auto) - - -lemma prime_int_altdef: "prime (p::int) = (1 < p \ (\m \ 0. m dvd p \ - m = 1 \ m = p))" - using prime_nat_def [transferred] - apply (case_tac "p >= 0") - by (blast, auto simp add: prime_ge_0_int) - -lemma prime_imp_coprime_nat: "prime (p::nat) \ \ p dvd n \ coprime p n" - apply (unfold prime_nat_def) - apply (metis gcd_dvd1_nat gcd_dvd2_nat) - done - -lemma prime_imp_coprime_int: "prime (p::int) \ \ p dvd n \ coprime p n" - apply (unfold prime_int_altdef) - apply (metis gcd_dvd1_int gcd_dvd2_int gcd_ge_0_int) - done - -lemma prime_dvd_mult_nat: "prime (p::nat) \ p dvd m * n \ p dvd m \ p dvd n" - by (blast intro: coprime_dvd_mult_nat prime_imp_coprime_nat) - -lemma prime_dvd_mult_int: "prime (p::int) \ p dvd m * n \ p dvd m \ p dvd n" - by (blast intro: coprime_dvd_mult_int prime_imp_coprime_int) - -lemma prime_dvd_mult_eq_nat [simp]: "prime (p::nat) \ - p dvd m * n = (p dvd m \ p dvd n)" - by (rule iffI, rule prime_dvd_mult_nat, auto) - -lemma prime_dvd_mult_eq_int [simp]: "prime (p::int) \ - p dvd m * n = (p dvd m \ p dvd n)" - by (rule iffI, rule prime_dvd_mult_int, auto) - -lemma not_prime_eq_prod_nat: "(n::nat) > 1 \ ~ prime n \ - EX m k. n = m * k & 1 < m & m < n & 1 < k & k < n" - unfolding prime_nat_def dvd_def apply auto - by(metis mult_commute linorder_neq_iff linorder_not_le mult_1 n_less_n_mult_m one_le_mult_iff less_imp_le_nat) - -lemma not_prime_eq_prod_int: "(n::int) > 1 \ ~ prime n \ - EX m k. n = m * k & 1 < m & m < n & 1 < k & k < n" - unfolding prime_int_altdef dvd_def - apply auto - by(metis div_mult_self1_is_id div_mult_self2_is_id int_div_less_self int_one_le_iff_zero_less zero_less_mult_pos zless_le) - -lemma prime_dvd_power_nat [rule_format]: "prime (p::nat) --> - n > 0 --> (p dvd x^n --> p dvd x)" - by (induct n rule: nat_induct, auto) - -lemma prime_dvd_power_int [rule_format]: "prime (p::int) --> - n > 0 --> (p dvd x^n --> p dvd x)" - apply (induct n rule: nat_induct, auto) - apply (frule prime_ge_0_int) - apply auto -done - -subsubsection{* Make prime naively executable *} - -lemma zero_not_prime_nat [simp]: "~prime (0::nat)" - by (simp add: prime_nat_def) - -lemma zero_not_prime_int [simp]: "~prime (0::int)" - by (simp add: prime_int_def) - -lemma one_not_prime_nat [simp]: "~prime (1::nat)" - by (simp add: prime_nat_def) - -lemma Suc_0_not_prime_nat [simp]: "~prime (Suc 0)" - by (simp add: prime_nat_def One_nat_def) - -lemma one_not_prime_int [simp]: "~prime (1::int)" - by (simp add: prime_int_def) - -lemma prime_nat_code[code]: - "prime(p::nat) = (p > 1 & (ALL n : {1<.. 1 & (list_all (%n. ~ n dvd p) [2.. 1 & (ALL n : {1<.. 1 & (list_all (%n. ~ n dvd p) [2..p - 1]))" -apply(simp only:prime_int_code list_ball_code greaterThanLessThan_upto) -apply simp -done - -lemmas prime_int_simp_number_of[simp] = prime_int_simp[of "number_of m", standard] - -lemma two_is_prime_nat [simp]: "prime (2::nat)" -by simp - -lemma two_is_prime_int [simp]: "prime (2::int)" -by simp - -text{* A bit of regression testing: *} - -lemma "prime(97::nat)" -by simp - -lemma "prime(97::int)" -by simp - -lemma "prime(997::nat)" -by eval - -lemma "prime(997::int)" -by eval - - -lemma prime_imp_power_coprime_nat: "prime (p::nat) \ ~ p dvd a \ coprime a (p^m)" - apply (rule coprime_exp_nat) - apply (subst gcd_commute_nat) - apply (erule (1) prime_imp_coprime_nat) -done - -lemma prime_imp_power_coprime_int: "prime (p::int) \ ~ p dvd a \ coprime a (p^m)" - apply (rule coprime_exp_int) - apply (subst gcd_commute_int) - apply (erule (1) prime_imp_coprime_int) -done - -lemma primes_coprime_nat: "prime (p::nat) \ prime q \ p \ q \ coprime p q" - apply (rule prime_imp_coprime_nat, assumption) - apply (unfold prime_nat_def, auto) -done - -lemma primes_coprime_int: "prime (p::int) \ prime q \ p \ q \ coprime p q" - apply (rule prime_imp_coprime_int, assumption) - apply (unfold prime_int_altdef, clarify) - apply (drule_tac x = q in spec) - apply (drule_tac x = p in spec) - apply auto -done - -lemma primes_imp_powers_coprime_nat: "prime (p::nat) \ prime q \ p ~= q \ coprime (p^m) (q^n)" - by (rule coprime_exp2_nat, rule primes_coprime_nat) - -lemma primes_imp_powers_coprime_int: "prime (p::int) \ prime q \ p ~= q \ coprime (p^m) (q^n)" - by (rule coprime_exp2_int, rule primes_coprime_int) - -lemma prime_factor_nat: "n \ (1::nat) \ \ p. prime p \ p dvd n" - apply (induct n rule: nat_less_induct) - apply (case_tac "n = 0") - using two_is_prime_nat apply blast - apply (case_tac "prime n") - apply blast - apply (subgoal_tac "n > 1") - apply (frule (1) not_prime_eq_prod_nat) - apply (auto intro: dvd_mult dvd_mult2) -done - -(* An Isar version: - -lemma prime_factor_b_nat: - fixes n :: nat - assumes "n \ 1" - shows "\p. prime p \ p dvd n" - -using `n ~= 1` -proof (induct n rule: less_induct_nat) - fix n :: nat - assume "n ~= 1" and - ih: "\m 1 \ (\p. prime p \ p dvd m)" - thus "\p. prime p \ p dvd n" - proof - - { - assume "n = 0" - moreover note two_is_prime_nat - ultimately have ?thesis - by (auto simp del: two_is_prime_nat) - } - moreover - { - assume "prime n" - hence ?thesis by auto - } - moreover - { - assume "n ~= 0" and "~ prime n" - with `n ~= 1` have "n > 1" by auto - with `~ prime n` and not_prime_eq_prod_nat obtain m k where - "n = m * k" and "1 < m" and "m < n" by blast - with ih obtain p where "prime p" and "p dvd m" by blast - with `n = m * k` have ?thesis by auto - } - ultimately show ?thesis by blast - qed -qed - -*) - -text {* One property of coprimality is easier to prove via prime factors. *} - -lemma prime_divprod_pow_nat: - assumes p: "prime (p::nat)" and ab: "coprime a b" and pab: "p^n dvd a * b" - shows "p^n dvd a \ p^n dvd b" -proof- - {assume "n = 0 \ a = 1 \ b = 1" with pab have ?thesis - apply (cases "n=0", simp_all) - apply (cases "a=1", simp_all) done} - moreover - {assume n: "n \ 0" and a: "a\1" and b: "b\1" - then obtain m where m: "n = Suc m" by (cases n, auto) - from n have "p dvd p^n" by (intro dvd_power, auto) - also note pab - finally have pab': "p dvd a * b". - from prime_dvd_mult_nat[OF p pab'] - have "p dvd a \ 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_common_divisor_nat [OF ab, OF pa] p have "\ p dvd b" by auto - with p have "coprime b p" - by (subst gcd_commute_nat, intro prime_imp_coprime_nat) - hence pnb: "coprime (p^n) b" - by (subst gcd_commute_nat, rule coprime_exp_nat) - from coprime_divprod_nat[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_common_divisor_nat [OF ab, of p] pb p have "\ p dvd a" - by auto - with p have "coprime a p" - by (subst gcd_commute_nat, intro prime_imp_coprime_nat) - hence pna: "coprime (p^n) a" - by (subst gcd_commute_nat, rule coprime_exp_nat) - from coprime_divprod_nat[OF pab pna] have ?thesis by blast } - ultimately have ?thesis by blast} - ultimately show ?thesis by blast -qed - -subsection {* Infinitely many primes *} - -lemma next_prime_bound: "\(p::nat). prime p \ n < p \ p <= fact n + 1" -proof- - have f1: "fact n + 1 \ 1" using fact_ge_one_nat [of n] by arith - from prime_factor_nat [OF f1] - obtain p where "prime p" and "p dvd fact n + 1" by auto - hence "p \ fact n + 1" - by (intro dvd_imp_le, auto) - {assume "p \ n" - from `prime p` have "p \ 1" - by (cases p, simp_all) - with `p <= n` have "p dvd fact n" - by (intro dvd_fact_nat) - with `p dvd fact n + 1` have "p dvd fact n + 1 - fact n" - by (rule dvd_diff_nat) - hence "p dvd 1" by simp - hence "p <= 1" by auto - moreover from `prime p` have "p > 1" by auto - ultimately have False by auto} - hence "n < p" by arith - with `prime p` and `p <= fact n + 1` show ?thesis by auto -qed - -lemma bigger_prime: "\p. prime p \ p > (n::nat)" -using next_prime_bound by auto - -lemma primes_infinite: "\ (finite {(p::nat). prime p})" -proof - assume "finite {(p::nat). prime p}" - with Max_ge have "(EX b. (ALL x : {(p::nat). prime p}. x <= b))" - by auto - then obtain b where "ALL (x::nat). prime x \ x <= b" - by auto - with bigger_prime [of b] show False by auto -qed - - end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Import/HOL/ROOT.ML --- a/src/HOL/Import/HOL/ROOT.ML Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Import/HOL/ROOT.ML Tue Sep 01 21:44:19 2009 +0200 @@ -1,8 +1,4 @@ -(* Title: HOL/Import/HOL/ROOT.ML - ID: $Id$ - Author: Sebastian Skalberg (TU Muenchen) -*) -use_thy "Primes"; +use_thy "~~/src/HOL/Old_Number_Theory/Primes"; setmp_noncritical quick_and_dirty true use_thy "HOL4Prob"; setmp_noncritical quick_and_dirty true use_thy "HOL4"; diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Import/HOL4Compat.thy --- a/src/HOL/Import/HOL4Compat.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Import/HOL4Compat.thy Tue Sep 01 21:44:19 2009 +0200 @@ -3,7 +3,7 @@ *) theory HOL4Compat -imports HOL4Setup Complex_Main Primes ContNotDenum +imports HOL4Setup Complex_Main "~~/src/HOL/Old_Number_Theory/Primes" ContNotDenum begin no_notation differentiable (infixl "differentiable" 60) diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/IsaMakefile --- a/src/HOL/IsaMakefile Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/IsaMakefile Tue Sep 01 21:44:19 2009 +0200 @@ -34,8 +34,8 @@ HOL-Modelcheck \ HOL-NanoJava \ HOL-Nominal-Examples \ - HOL-NewNumberTheory \ - HOL-NumberTheory \ + HOL-Number_Theory \ + HOL-Old_Number_Theory \ HOL-Prolog \ HOL-SET-Protocol \ HOL-SizeChange \ @@ -282,11 +282,13 @@ Complex.thy \ Deriv.thy \ Fact.thy \ + GCD.thy \ Integration.thy \ Lim.thy \ Limits.thy \ Ln.thy \ Log.thy \ + Lubs.thy \ MacLaurin.thy \ NatTransfer.thy \ NthRoot.thy \ @@ -294,9 +296,7 @@ Series.thy \ Taylor.thy \ Transcendental.thy \ - GCD.thy \ Parity.thy \ - Lubs.thy \ PReal.thy \ Rational.thy \ RComplete.thy \ @@ -330,10 +330,10 @@ Library/Finite_Cartesian_Product.thy Library/FrechetDeriv.thy \ Library/Fraction_Field.thy Library/Fundamental_Theorem_Algebra.thy \ Library/Inner_Product.thy Library/Kleene_Algebra.thy \ - Library/Lattice_Syntax.thy Library/Legacy_GCD.thy \ + Library/Lattice_Syntax.thy \ Library/Library.thy Library/List_Prefix.thy Library/List_Set.thy \ Library/State_Monad.thy Library/Nat_Int_Bij.thy Library/Multiset.thy \ - Library/Permutation.thy Library/Primes.thy Library/Pocklington.thy \ + Library/Permutation.thy \ Library/Quotient.thy Library/Quicksort.thy Library/Nat_Infinity.thy \ Library/Word.thy Library/README.html Library/Continuity.thy \ Library/Order_Relation.thy Library/Nested_Environment.thy \ @@ -487,38 +487,39 @@ @cd Import/HOLLight; $(ISABELLE_TOOL) usedir -b $(OUT)/HOL HOLLight -## HOL-NewNumberTheory +## HOL-Number_Theory -HOL-NewNumberTheory: HOL $(LOG)/HOL-NewNumberTheory.gz +HOL-Number_Theory: HOL $(LOG)/HOL-Number_Theory.gz -$(LOG)/HOL-NewNumberTheory.gz: $(OUT)/HOL $(ALGEBRA_DEPENDENCIES) \ +$(LOG)/HOL-Number_Theory.gz: $(OUT)/HOL $(ALGEBRA_DEPENDENCIES) \ Library/Multiset.thy \ - NewNumberTheory/Binomial.thy \ - NewNumberTheory/Cong.thy \ - NewNumberTheory/Fib.thy \ - NewNumberTheory/MiscAlgebra.thy \ - NewNumberTheory/Residues.thy \ - NewNumberTheory/UniqueFactorization.thy \ - NewNumberTheory/ROOT.ML - @$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL NewNumberTheory + Number_Theory/Binomial.thy \ + Number_Theory/Cong.thy \ + Number_Theory/Fib.thy \ + Number_Theory/MiscAlgebra.thy \ + Number_Theory/Number_Theory.thy \ + Number_Theory/Residues.thy \ + Number_Theory/UniqueFactorization.thy \ + Number_Theory/ROOT.ML + @$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL Number_Theory -## HOL-NumberTheory +## HOL-Old_Number_Theory -HOL-NumberTheory: HOL $(LOG)/HOL-NumberTheory.gz +HOL-Old_Number_Theory: HOL $(LOG)/HOL-Old_Number_Theory.gz -$(LOG)/HOL-NumberTheory.gz: $(OUT)/HOL Library/Permutation.thy \ - Library/Primes.thy NumberTheory/Fib.thy \ - NumberTheory/Factorization.thy NumberTheory/BijectionRel.thy \ - NumberTheory/Chinese.thy NumberTheory/EulerFermat.thy \ - NumberTheory/IntFact.thy NumberTheory/IntPrimes.thy \ - NumberTheory/WilsonBij.thy NumberTheory/WilsonRuss.thy \ - NumberTheory/Finite2.thy NumberTheory/Int2.thy \ - NumberTheory/EvenOdd.thy NumberTheory/Residues.thy \ - NumberTheory/Euler.thy NumberTheory/Gauss.thy \ - NumberTheory/Quadratic_Reciprocity.thy Library/Infinite_Set.thy \ - NumberTheory/ROOT.ML - @$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL NumberTheory +$(LOG)/HOL-Old_Number_Theory.gz: $(OUT)/HOL Library/Permutation.thy \ + Old_Number_Theory/Primes.thy Old_Number_Theory/Fib.thy \ + Old_Number_Theory/Factorization.thy Old_Number_Theory/BijectionRel.thy \ + Old_Number_Theory/Chinese.thy Old_Number_Theory/EulerFermat.thy \ + Old_Number_Theory/IntFact.thy Old_Number_Theory/IntPrimes.thy \ + Old_Number_Theory/WilsonBij.thy Old_Number_Theory/WilsonRuss.thy \ + Old_Number_Theory/Finite2.thy Old_Number_Theory/Int2.thy \ + Old_Number_Theory/EvenOdd.thy Old_Number_Theory/Residues.thy \ + Old_Number_Theory/Euler.thy Old_Number_Theory/Gauss.thy \ + Old_Number_Theory/Quadratic_Reciprocity.thy Library/Infinite_Set.thy \ + Old_Number_Theory/Legacy_GCD.thy Old_Number_Theory/Pocklington.thy Old_Number_Theory/ROOT.ML + @$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL Old_Number_Theory ## HOL-Hoare @@ -573,7 +574,7 @@ Library/FuncSet.thy \ Library/Multiset.thy \ Library/Permutation.thy \ - Library/Primes.thy \ + Number_Theory/Primes.thy \ Algebra/AbelCoset.thy \ Algebra/Bij.thy \ Algebra/Congruence.thy \ @@ -876,7 +877,7 @@ HOL-ex: HOL $(LOG)/HOL-ex.gz $(LOG)/HOL-ex.gz: $(OUT)/HOL Library/Commutative_Ring.thy \ - Library/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy \ + Number_Theory/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy \ ex/Arith_Examples.thy \ ex/Arithmetic_Series_Complex.thy ex/BT.thy ex/BinEx.thy \ ex/Binary.thy ex/CTL.thy ex/Chinese.thy ex/Classical.thy \ diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Isar_examples/ROOT.ML --- a/src/HOL/Isar_examples/ROOT.ML Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Isar_examples/ROOT.ML Tue Sep 01 21:44:19 2009 +0200 @@ -4,7 +4,7 @@ Miscellaneous Isabelle/Isar examples for Higher-Order Logic. *) -no_document use_thys ["../NumberTheory/Primes", "../NumberTheory/Fibonacci"]; +no_document use_thys ["../Old_Number_Theory/Primes", "../Old_Number_Theory/Fibonacci"]; use_thys [ "Basic_Logic", diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Library/Legacy_GCD.thy --- a/src/HOL/Library/Legacy_GCD.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,787 +0,0 @@ -(* Title: HOL/GCD.thy - Author: Christophe Tabacznyj and Lawrence C Paulson - Copyright 1996 University of Cambridge -*) - -header {* The Greatest Common Divisor *} - -theory Legacy_GCD -imports Main -begin - -text {* - See \cite{davenport92}. \bigskip -*} - -subsection {* Specification of GCD on nats *} - -definition - is_gcd :: "nat \ nat \ nat \ bool" where -- {* @{term gcd} as a relation *} - [code del]: "is_gcd m n p \ p dvd m \ p dvd n \ - (\d. d dvd m \ d dvd n \ d dvd p)" - -text {* Uniqueness *} - -lemma is_gcd_unique: "is_gcd a b m \ is_gcd a b n \ m = n" - by (simp add: is_gcd_def) (blast intro: dvd_anti_sym) - -text {* Connection to divides relation *} - -lemma is_gcd_dvd: "is_gcd a b m \ k dvd a \ k dvd b \ k dvd m" - by (auto simp add: is_gcd_def) - -text {* Commutativity *} - -lemma is_gcd_commute: "is_gcd m n k = is_gcd n m k" - by (auto simp add: is_gcd_def) - - -subsection {* GCD on nat by Euclid's algorithm *} - -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 "\m. P m 0" - and "\m n. 0 < n \ P n (m mod n) \ 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 \ 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 {* - \medskip @{term "gcd m n"} divides @{text m} and @{text n}. The - conjunctions don't seem provable separately. -*} - -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 {* - \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"}. -*} - -lemma gcd_greatest: "k dvd m \ k dvd n \ k dvd gcd m n" - by (induct m n rule: gcd_induct) (simp_all add: gcd_non_0 dvd_mod) - -text {* - \medskip Function gcd yields the Greatest Common Divisor. -*} - -lemma is_gcd: "is_gcd m n (gcd m n) " - by (simp add: is_gcd_def gcd_greatest) - - -subsection {* Derived laws for GCD *} - -lemma gcd_greatest_iff [iff, algebra]: "k dvd gcd m n \ k dvd m \ k dvd n" - by (blast intro!: gcd_greatest intro: dvd_trans) - -lemma gcd_zero[algebra]: "gcd m n = 0 \ m = 0 \ 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 {* - \medskip Multiplication laws -*} - -lemma gcd_mult_distrib2: "k * gcd m n = gcd (k * m) (k * n)" - -- {* \cite[page 27]{davenport92} *} - apply (induct m n rule: gcd_induct) - apply simp - apply (case_tac "k = 0") - apply (simp_all add: mod_geq gcd_non_0 mod_mult_distrib2) - 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_anti_sym) - 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 {* \medskip Addition laws *} - -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 {* - \medskip Division by gcd yields rrelatively primes. -*} - -lemma div_gcd_relprime: - assumes nz: "a \ 0 \ b \ 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 - then have "?g * ?a' = (?g * ?g') * ka'" "?g * ?b' = (?g * ?g') * kb'" by simp_all - 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 \ 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\d dvd b \ (\e. e dvd a \ e dvd b \ e dvd d) \ d = gcd a b" -proof(auto) - assume H: "d dvd a" "d dvd b" "\e. e dvd a \ e dvd b \ 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_anti_sym[OF th gcd_greatest[OF H(1,2)]] show "d = gcd a b" by blast -qed - -lemma gcd_eq: assumes H: "\d. d dvd x \ d dvd y \ d dvd u \ d dvd v" - shows "gcd x y = gcd u v" -proof- - from H have "\d. d dvd x \ d dvd y \ 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: " \a b. P (a::nat) b \ P b a" and z: "\a. P a 0" - and add: "\a b. P a b \ P a (a + b)" - shows "P a b" -proof(induct n\"a+b" arbitrary: a b rule: nat_less_induct) - fix n a b - assume H: "\m < n. \a b. m = a + b \ P a b" "n = a + b" - have "a = b \ a < b \ 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 < n \ a = 0" using H(2) by arith - moreover - {assume "a =0" with z c have "P a b" by blast } - moreover - {assume ab: "a + b - a < n" - have th0: "a + b - a = a + (b - a)" using lt by arith - from add[rule_format, OF H(1)[rule_format, OF ab th0]] - 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 < n \ b = 0" using H(2) by arith - moreover - {assume "b =0" with z c have "P a b" by blast } - moreover - {assume ab: "b + a - b < n" - have th0: "b + a - b = b + (a - b)" using lt by arith - from add[rule_format, OF H(1)[rule_format, OF ab th0]] - 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: "\(d::nat) x y. d dvd a \ d dvd b \ (a * x = b * y + d \ b * x = a * y + d)" - shows "\d x y. d dvd a \ d dvd a + b \ (a * x = (a + b) * y + d \ (a + b) * x = a * y + d)" -using ex -apply clarsimp -apply (rule_tac x="d" in exI, simp add: dvd_add) -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: "\(d::nat) x y. d dvd a \ d dvd b \ (a * x = b * y + d \ b * x = a * y + d)" -apply(induct a b rule: ind_euclid) -apply blast -apply clarify -apply (rule_tac x="a" in exI, simp add: dvd_add) -apply clarsimp -apply (rule_tac x="d" in exI) -apply (case_tac "a * x = b * y + d", simp_all add: dvd_add) -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: "\(d::nat) x y. d dvd a \ d dvd b \ (a * x - b * y = d \ 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 {* We can get a stronger version with a nonzeroness assumption. *} -lemma divides_le: "m dvd n ==> m <= n \ n = (0::nat)" by (auto simp add: dvd_def) - -lemma bezout_add_strong: assumes nz: "a \ (0::nat)" - shows "\d x y. d dvd a \ d dvd b \ a * x = b * y + d" -proof- - from nz have ap: "a > 0" by simp - from bezout_add[of a b] - have "(\d x y. d dvd a \ d dvd b \ a * x = b * y + d) \ (\d x y. d dvd a \ d dvd b \ 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 \ 0" hence bp: "b > 0" by simp - from divides_le[OF H(2)] b have "d < b \ d = b" using le_less by blast - moreover - {assume db: "d=b" - from prems 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 prems by simp } - moreover - {assume x0: "x \ 0" hence xp: "x > 0" by simp - - from db have "d \ b - 1" by simp - hence "d*b \ b*(b - 1)" by simp - with xp mult_mono[of "1" "x" "d*b" "b*(b - 1)"] - have dble: "d*b \ 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 add_commute mult_ac) - 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: "\x y. a * x - b * y = gcd a b \ 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 \ 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 \ (b * x - a * y)*k = d*k" by blast - hence "a * x * k - b * y*k = d*k \ b * x * k - a * y*k = d*k" - by (algebra add: diff_mult_distrib) - hence "a * (x * k) - b * (y*k) = ?g \ 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 \ 0" - shows "\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: "(\x y. a * x - b * y = d \ b * x - a * y = d) \ gcd a b dvd d" - (is "?lhs \ ?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 \ b * x - a * y = ?g" - by blast - hence "(a * x - b * y)*k = ?g*k \ (b * x - a * y)*k = ?g*k" by auto - hence "a * x*k - b * y*k = ?g*k \ b * x * k - a * y*k = ?g*k" - by (simp only: diff_mult_distrib) - hence "a * (x*k) - b * (y*k) = d \ 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 \ 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: gcd_mult 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" -apply (simp_all add: gcd_add1) -by (simp add: gcd_commute gcd_add1) - -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 \ (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 \ a" - from th[OF ab] show "gcd (a - b) b = gcd a b" by blast -next - assume ab: "a \ b" - from th[OF ab] show "gcd a (b - a) = gcd a b" - by (simp add: gcd_commute)} -qed - - -subsection {* LCM defined by GCD *} - - -definition - lcm :: "nat \ nat \ 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: mult_ac gcd_mult_distrib2) - also have "\ = k * gcd (m * p * q) (n * q * p)" - by (simp add: k_m [symmetric] k_n [symmetric]) - also have "\ = k * p * q * gcd m n" - by (simp add: mult_ac 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: mult_ac) - 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: mult_ac) - 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: mult_ac) - also have "\ = 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: mult_ac) - also have "\ = 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 \ 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 {* GCD and LCM on integers *} - -definition - zgcd :: "int \ int \ int" where - "zgcd i j = int (gcd (nat (abs i)) (nat (abs j)))" - -lemma zgcd_zdvd1 [iff,simp, algebra]: "zgcd i j dvd i" -by (simp add: zgcd_def int_dvd_iff) - -lemma zgcd_zdvd2 [iff,simp, algebra]: "zgcd i j dvd j" -by (simp add: zgcd_def int_dvd_iff) - -lemma zgcd_pos: "zgcd i j \ 0" -by (simp add: zgcd_def) - -lemma zgcd0 [simp,algebra]: "(zgcd i j = 0) = (i = 0 \ 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 \ i dvd k * j \ i dvd k" - unfolding zgcd_def -proof - - assume "int (gcd (nat \i\) (nat \j\)) = 1" "i dvd k * j" - then have g: "gcd (nat \i\) (nat \j\) = 1" by simp - from `i dvd k * j` obtain h where h: "k*j = i*h" unfolding dvd_def by blast - have th: "nat \i\ dvd nat \k\ * nat \j\" - unfolding dvd_def - by (rule_tac x= "nat \h\" in exI, simp add: h nat_abs_mult_distrib [symmetric]) - from relprime_dvd_mult [OF g th] obtain h' where h': "nat \k\ = nat \i\ * h'" - unfolding dvd_def by blast - from h' have "int (nat \k\) = int (nat \i\ * h')" by simp - then have "\k\ = \i\ * int h'" by (simp add: int_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 (abs x)) = abs x" by arith - -lemma zgcd_greatest: - assumes "k dvd m" and "k dvd n" - shows "k dvd zgcd m n" -proof - - let ?k' = "nat \k\" - let ?m' = "nat \m\" - let ?n' = "nat \n\" - from `k dvd m` and `k dvd n` 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 \k\) dvd zgcd m n" - unfolding zgcd_def by (simp only: zdvd_int) - then have "\k\ 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 \ 0 \ b \ 0" - shows "zgcd (a div (zgcd a b)) (b div (zgcd a b)) = 1" -proof - - from nz have nz': "nat \a\ \ 0 \ nat \b\ \ 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 add: zgcd_zdvd1 zgcd_zdvd2) - have dvdg': "?g' dvd ?a'" "?g' dvd ?b'" by (simp_all add: zgcd_zdvd1 zgcd_zdvd2) - 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 - then have "?g* ?a' = (?g * ?g') * ka'" "?g* ?b' = (?g * ?g') * kb'" by simp_all - then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b" - by (auto simp add: zdvd_mult_div_cancel [OF dvdg(1)] - zdvd_mult_div_cancel [OF dvdg(2)] dvd_def) - have "?g \ 0" using nz by simp - then have gp: "?g \ 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 "\?g'\ = 1" by simp - with zgcd_pos show "?g' = 1" by simp -qed - -lemma zgcd_0 [simp, algebra]: "zgcd m 0 = abs m" - by (simp add: zgcd_def abs_if) - -lemma zgcd_0_left [simp, algebra]: "zgcd 0 m = abs m" - 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: nat_diff_distrib gcd_diff2 nat_le_eq_zle) - done - -lemma zgcd_eq: "zgcd m n = zgcd n (m mod n)" - apply (case_tac "n = 0", simp add: DIVISION_BY_ZERO) - 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 \ \m\ = 1" - by (simp add: zgcd_def abs_if) - -lemma zgcd_greatest_iff[algebra]: "k dvd zgcd m n = (k dvd m \ 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 gcd_1_left) - -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 - -- {* addition is an AC-operator *} - -lemma zgcd_zmult_distrib2: "0 \ 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] zmult_int [symmetric]) - -lemma zgcd_zmult_distrib2_abs: "zgcd (k * m) (k * n) = abs k * zgcd m n" - by (simp add: abs_if zgcd_zmult_distrib2) - -lemma zgcd_self [simp]: "0 \ 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 \ 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 \ 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(abs i)) (nat(abs j)))" - -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(abs k) dvd nat(abs i)" using `k dvd i` - 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(abs k) dvd nat(abs j)" using `k dvd j` - 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 (abs d)" -by (case_tac "d <0", simp_all) - -lemma zdvd_self_abs2: "(abs (d::int)) 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 \ 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 \ m" by simp - with npos have t1:"gcd m n *n \ m*n" by simp - have "gcd m n \ gcd m n*n" using npos by simp - with t1 have "gcd m n \ m*n" by arith -ultimately show "False" by simp -qed - -lemma zlcm_pos: - assumes anz: "a \ 0" - and bnz: "b \ 0" - shows "0 < zlcm a b" -proof- - let ?na = "nat (abs a)" - let ?nb = "nat (abs b)" - 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 = \if l = 0 then k else zgcd l (\k\ mod \l\)\" - by (simp add: zgcd_def gcd.simps [of "nat \k\"] nat_mod_distrib) - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Library/Library.thy --- a/src/HOL/Library/Library.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Library/Library.thy Tue Sep 01 21:44:19 2009 +0200 @@ -43,11 +43,9 @@ OptionalSugar Option_ord Permutation - Pocklington Poly_Deriv Polynomial Preorder - Primes Product_Vector Quicksort Quotient diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Library/Pocklington.thy --- a/src/HOL/Library/Pocklington.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1263 +0,0 @@ -(* Title: HOL/Library/Pocklington.thy - Author: Amine Chaieb -*) - -header {* Pocklington's Theorem for Primes *} - -theory Pocklington -imports Main 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[_ \ _] '(mod _'))") - where "[a \ b] (mod p) == ((a mod p) \ (b mod p))" - -lemma modeq_trans: - "\ [a = b] (mod p); [b = c] (mod p) \ \ [a = c] (mod p)" - by (simp add:modeq_def) - - -lemma nat_mod_lemma: assumes xyn: "[x = y] (mod n)" and xy:"y \ x" - shows "\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) \ (\q1 q2. x + n * q1 = y + n * q2)" -unfolding modeq_def nat_mod_eq_iff .. - -(* Lemmas about previously defined terms. *) - -lemma prime: "prime p \ p \ 0 \ p\1 \ (\m. 0 < m \ m < p \ coprime p m)" - (is "?lhs \ ?rhs") -proof- - {assume "p=0 \ p=1" hence ?thesis using prime_0 prime_1 by (cases "p=0", simp_all)} - moreover - {assume p0: "p\0" "p\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 \ 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: "\m. 0 < m \ m < p \ 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 \ p" by arith - {assume "q = p" hence ?lhs using q(1) by blast} - moreover - {assume "q\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 \ p=1", auto) -qed - -lemma finite_number_segment: "card { m. 0 < m \ m < n } = n - 1" -proof- - have "{ m. 0 < m \ m < n } = {1.. 0" shows "coprime (a mod n) n \ 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) \ x = y" "[x = y] (mod 1)" "[x = 0] (mod n) \ n dvd x" - by (simp_all add: modeq_def, presburger) - -lemma cong_sub_cases: - "[x = y] (mod n) \ (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\0" - {assume xy: "x \ y" hence axy': "a*x \ 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: "\x \ y" hence xy: "y \ x" by arith - from H az have axy': "\ a*x \ 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 \ [a = b] (mod n)" by (simp add: cong_refl) - -lemma cong_commute: "[x = y] (mod n) \ [y = x] (mod n)" - by (auto simp add: modeq_def) - -lemma cong_trans[trans]: "[x = y] (mod n) \ [y = z] (mod n) \ [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 "\ = (x' mod n + y' mod n) mod n" using xx' yy' modeq_def by simp - also have "\ = (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 "\ = (x' mod n) * (y' mod n) mod n" using xx'[unfolded modeq_def] yy'[unfolded modeq_def] by simp - also have "\ = (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) \ [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' \ y + b = y' + b' \ y <= x \ y' <= x' - \ (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: right_distrib) - 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) \ [x = y] (mod n)" (is "?lhs \ ?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) \ [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) \ [x = y] (mod n)" - by (simp add: nat_mod) - -lemma cong_add_rcancel_eq: "[x + a = y + a] (mod n) \ [x = y] (mod n)" - by (simp add: nat_mod) - -lemma cong_add_rcancel: "[x + a = y + a] (mod n) \ [x = y] (mod n)" - by (simp add: nat_mod) - -lemma cong_add_lcancel: "[a + x = a + y] (mod n) \ [x = y] (mod n)" - by (simp add: nat_mod) - -lemma cong_add_lcancel_eq_0: "[a + x = a] (mod n) \ [x = 0] (mod n)" - by (simp add: nat_mod) - -lemma cong_add_rcancel_eq_0: "[x + a = a] (mod n) \ [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) \ 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) \ n dvd x" by simp - -lemma cong_1_divides:"[x = 1] (mod n) ==> n dvd x - 1" - apply (cases "x\1", simp_all) - using cong_sub_cases[of x 1 n] by auto - -lemma cong_divides: "[x = y] (mod n) \ n dvd x \ 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 \ coprime n y" -proof- - {assume "n=0" hence ?thesis using xy by simp} - moreover - {assume nz: "n \ 0" - have "coprime n x \ coprime (x mod n) n" - by (simp add: coprime_mod[OF nz, of x] coprime_commute[of n x]) - also have "\ \ coprime (y mod n) n" using xy[unfolded modeq_def] by simp - also have "\ \ 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) \ [a mod n = a] (mod n)" by (simp add: modeq_def) - -lemma mod_mult_cong: "~(a = 0) \ ~(b = 0) - \ [x mod (a * b) = y] (mod a) \ [x = y] (mod a)" - by (simp add: modeq_def mod_mult2_eq mod_add_left_eq) - -lemma cong_mod_mult: "[x = y] (mod n) \ m dvd n \ [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 \ [x = y] (mod n) \ (\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) \ a = 0 \ n = 1 \ (\m. a = 1 + m * n)" -proof- - {assume "n = 0 \ n = 1\ a = 0 \ 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 - by (cases "a=1", simp_all add: modeq_def cong_commute)} - moreover - {assume n: "n\0" "n\1" and a:"a\0" "a \ 1" hence a': "a \ 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 "\x. [a * x = b] (mod n)" -proof- - {assume "a=0" hence ?thesis using an by (simp add: modeq_def)} - moreover - {assume az: "a\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 \ 0" - shows "\!x. x < n \ [a * x = b] (mod n)" -proof- - let ?P = "\x. x < n \ [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 "\!y. 0 < y \ y < p \ [x * y = a] (mod p)" -proof- - from p have p1: "p > 1" using prime_ge_2[OF p] by arith - hence p01: "p \ 0" "p \ 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)" "\z. z < p \ [x * z = a] (mod p) \ 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 "\!y. 0 < y \ y < p \ [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 \ y", simp_all add: divides_mul[of a _ b]) - -lemma chinese_remainder_unique: - assumes ab: "coprime a b" and az: "a \ 0" and bz: "b\0" - shows "\!x. x < a * b \ [x = m] (mod a) \ [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 "\ = m mod a" apply (simp add: mod_mult2_eq) - apply (subst mod_add_left_eq) - by simp - 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 "\ = ((n + q2 * b) mod (b*a)) mod b" by (simp add: mult_commute) - also have "\ = n mod b" apply (simp add: mod_mult2_eq) - apply (subst mod_add_left_eq) - by simp - 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 \ 0" and bz: "b \ 0" - and ma: "coprime m a" and nb: "coprime n b" - shows "\!x. coprime x (a * b) \ x < a * b \ [x = m] (mod a) \ [x = n] (mod b)" -proof- - let ?P = "\x. x < a * b \ [x = m] (mod a) \ [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)" - "\y. ?P y \ 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: "\ n = card { m. 0 < m \ m <= n \ coprime m n }" - -lemma phi_0[simp]: "\ 0 = 0" - unfolding phi_def by auto - -lemma phi_finite[simp]: "finite ({ m. 0 < m \ m <= n \ coprime m n })" -proof- - have "{ m. 0 < m \ m <= n \ coprime m n } \ {0..n}" by auto - thus ?thesis by (auto intro: finite_subset) -qed - -declare coprime_1[presburger] -lemma phi_1[simp]: "\ 1 = 1" -proof- - {fix m - have "0 < m \ m <= 1 \ coprime m 1 \ m = 1" by presburger } - thus ?thesis by (simp add: phi_def) -qed - -lemma [simp]: "\ (Suc 0) = Suc 0" using phi_1 by simp - -lemma phi_alt: "\(n) = card { m. coprime m n \ m < n}" -proof- - {assume "n=0 \ n=1" hence ?thesis by (cases "n=0", simp_all)} - moreover - {assume n: "n\0" "n\1" - {fix m - from n have "0 < m \ m <= n \ coprime m n \ coprime m n \ 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 \ m < n}" (is "finite ?S") - by (rule finite_subset[of "?S" "{0..n}"], auto) - -lemma phi_another: assumes n: "n\1" - shows "\ n = card {m. 0 < m \ m < n \ coprime m n }" -proof- - {fix m - from n have "0 < m \ m < n \ coprime m n \ coprime m n \ m < n" - by (cases "m=0", auto)} - thus ?thesis unfolding phi_alt by auto -qed - -lemma phi_limit: "\ n \ n" -proof- - have "{ m. coprime m n \ m < n} \ {0 .. m < n}"] - show ?thesis unfolding phi_alt by auto -qed - -lemma stupid[simp]: "{m. (0::nat) < m \ m < n} = {1..1" - shows "\(n) \ n - 1" -proof- - show ?thesis - unfolding phi_another[OF n] finite_number_segment[of n, symmetric] - by (rule card_mono[of "{m. 0 < m \ m < n}" "{m. 0 < m \ m < n \ coprime m n}"], auto) -qed - -lemma phi_lowerbound_1_strong: assumes n: "n \ 1" - shows "\(n) \ 1" -proof- - let ?S = "{ m. 0 < m \ m <= n \ coprime m n }" - from card_0_eq[of ?S] n have "\ n \ 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 <= \(n)" - using phi_lowerbound_1_strong[of n] by auto - -lemma phi_lowerbound_2: assumes n: "3 <= n" shows "2 <= \ (n)" -proof- - let ?S = "{ m. 0 < m \ m <= n \ coprime m n }" - have inS: "{1, n - 1} \ ?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: "\ n = n - 1 \ n\0 \ n\1 \ prime n" -proof- - {assume "n=0 \ n=1" hence ?thesis by (cases "n=1", simp_all)} - moreover - {assume n: "n\0" "n\1" - let ?S = "{m. 0 < m \ m < n}" - have fS: "finite ?S" by simp - let ?S' = "{m. 0 < m \ m < n \ coprime m n}" - have fS':"finite ?S'" apply (rule finite_subset[of ?S' ?S]) by auto - {assume H: "\ n = n - 1 \ n\0 \ n\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" "\ coprime m n" - hence mS': "m \ ?S'" by auto - have "insert m ?S' \ ?S" using m by auto - from m have "card (insert m ?S') \ card ?S" - by - (rule card_mono[of ?S "insert m ?S'"], auto) - hence False - unfolding card_insert_disjoint[of "?S'" m, OF fS' mS'] ceq - by simp } - hence "\m. 0 m < n \ 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 "\ 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 "\ (a * b) = \ a * \ b" -proof- - {assume "a = 0 \ b = 0 \ a = 1 \ b = 1" - hence ?thesis - by (cases "a=0", simp, cases "b=0", simp, cases"a=1", simp_all) } - moreover - {assume a: "a\0" "a\1" and b: "b\0" "b\1" - hence ab0: "a*b \ 0" by simp - let ?S = "\k. {m. coprime m k \ m < k}" - let ?f = "\x. (x mod a, x mod b)" - have eq: "?f ` (?S (a*b)) = (?S a \ ?S b)" - proof- - {fix x assume x:"x \ ?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 \ (?S a \ ?S b)" - by (simp add: coprime_mod[OF a(1)] coprime_mod[OF b(1)])} - moreover - {fix x y assume x: "x \ ?S a" and y: "y \ ?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) \ ?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 \ 0" - shows "[setprod (\m. a(m) mod n) S = setprod a S] (mod n)" -proof- - have th1:"[1 = 1] (mod n)" by (simp add: modeq_def) - from cong_mult - have th3:"\x1 y1 x2 y2. - [x1 = x2] (mod n) \ [y1 = y2] (mod n) \ [x1 * y1 = x2 * y2] (mod n)" - by blast - have th4:"\x\S. [a x mod n = a x] (mod n)" by (simp add: modeq_def) - from fold_image_related[where h="(\m. a(m) mod n)" and g=a, OF th1 th3 fS, OF th4] show ?thesis unfolding setprod_def by (simp add: fS) -qed - -lemma nproduct_cmul: - assumes fS:"finite S" - shows "setprod (\m. (c::'a::{comm_monoid_mult})* a(m)) S = c ^ (card S) * setprod a S" -unfolding setprod_timesf setprod_constant[OF fS, of c] .. - -lemma coprime_nproduct: - assumes fS: "finite S" and Sn: "\x\S. coprime n (a x)" - shows "coprime n (setprod a S)" - using fS unfolding setprod_def by (rule finite_subset_induct) - (insert Sn, auto simp add: coprime_mul) - -lemma fermat_little: assumes an: "coprime a n" - shows "[a ^ (\ 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 \ 0" and n1: "n \ 1" - let ?S = "{m. coprime m n \ m < n}" - let ?P = "\ ?S" - have fS: "finite ?S" by simp - have cardfS: "\ n = card ?S" unfolding phi_alt .. - {fix m assume m: "m \ ?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: "\m\ ?S. coprime (a*m) n " by blast - from coprime_nproduct[OF fS, of n "\m. m"] have nP:"coprime ?P n" - by (simp add: coprime_commute) - have Paphi: "[?P*a^ (\ n) = ?P*1] (mod n)" - proof- - let ?h = "\m. m mod n" - {fix m assume mS: "m\ ?S" - hence "?h m \ ?S" by simp} - hence hS: "?h ` ?S = ?S"by (auto simp add: image_iff) - have "a\0" using an n1 nz apply- apply (rule ccontr) by simp - hence inj: "inj_on (op * a) ?S" unfolding inj_on_def by simp - - have eq0: "fold_image op * (?h \ op * a) 1 {m. coprime m n \ m < n} = - fold_image op * (\m. m) 1 {m. coprime m n \ m < n}" - proof (rule fold_image_eq_general[where h="?h o (op * a)"]) - show "finite ?S" using fS . - next - {fix y assume yS: "y \ ?S" hence y: "coprime y n" "y < n" by simp_all - from cong_solve_unique[OF an nz, of y] - obtain x where x:"x < n" "[a * x = y] (mod n)" "\z. z < n \ [a * z = y] (mod n) \ z=x" by blast - from cong_coprime[OF x(2)] y(1) - have xm: "coprime x n" by (simp add: coprime_mul_eq coprime_commute) - {fix z assume "z \ ?S" "(?h \ op * a) z = y" - hence z: "coprime z n" "z < n" "(?h \ op * a) z = y" by simp_all - from x(3)[rule_format, of z] z(2,3) have "z=x" - unfolding modeq_def mod_less[OF y(2)] by simp} - with xm x(1,2) have "\!x. x \ ?S \ (?h \ op * a) x = y" - unfolding modeq_def mod_less[OF y(2)] by auto } - thus "\y\{m. coprime m n \ m < n}. - \!x. x \ {m. coprime m n \ m < n} \ ((\m. m mod n) \ op * a) x = y" by blast - next - {fix x assume xS: "x\ ?S" - hence x: "coprime x n" "x < n" by simp_all - with an have "coprime (a*x) n" - by (simp add: coprime_mul_eq[of n a x] coprime_commute) - hence "?h (a*x) \ ?S" using nz - by (simp add: coprime_mod[OF nz] mod_less_divisor)} - thus " \x\{m. coprime m n \ m < n}. - ((\m. m mod n) \ op * a) x \ {m. coprime m n \ m < n} \ - ((\m. m mod n) \ op * a) x = ((\m. m mod n) \ op * a) x" by simp - qed - from nproduct_mod[OF fS nz, of "op * a"] - have "[(setprod (op *a) ?S) = (setprod (?h o (op * a)) ?S)] (mod n)" - unfolding o_def - by (simp add: cong_commute) - also have "[setprod (?h o (op * a)) ?S = ?P ] (mod n)" - using eq0 fS an by (simp add: setprod_def modeq_def o_def) - finally show "[?P*a^ (\ 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\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\0" "n\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 \ 2" and an:"[a^(n - 1) = 1] (mod n)" - and nm: "\m. 0 m < n - 1 \ \ [a^m = 1] (mod n)" - shows "prime n" -proof- - from n have n1: "n \ 1" "n\0" "n - 1 \ 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 ^ \ n = 1] (mod n)" . - {assume "\ n \ n - 1" - with phi_limit_strong[OF n1(1)] phi_lowerbound_1[OF n] - have c:"\ n > 0 \ \ n < n - 1" by arith - from nm[rule_format, OF c] afn have False ..} - hence "\ n = n - 1" by blast - with phi_prime[of n] n1(1,2) show ?thesis by simp -qed - -lemma nat_exists_least_iff: "(\(n::nat). P n) \ (\n. P n \ (\m < n. \ P m))" - (is "?lhs \ ?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 "\ P m" .} - with LeastI_ex[OF H] show ?rhs by blast -qed - -lemma nat_exists_least_iff': "(\(n::nat). P n) \ (P (Least P) \ (\m < (Least P). \ P m))" - (is "?lhs \ ?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 "\ 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 "\ = ((x mod m) * (x^n mod m)) mod m" using Suc.hyps by simp - also have "\ = 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 \ 2" and an1: "[a^(n - 1) = 1] (mod n)" - and pn: "\p. prime p \ p dvd n - 1 \ \ [a^((n - 1) div p) = 1] (mod n)" - shows "prime n" -proof- - from n2 have n01: "n\0" "n\1" "n - 1 \ 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: "\m. 0 < m \ m < n - 1 \ [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)" "\k ?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 = mod_div_equality[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 "\ = (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 "\ = 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 - mod_div_equality[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\0" "r\1" by - (rule ccontr, simp)+ - from prime_factor[OF r01(2)] obtain p where p: "prime p" "p dvd r" by blast - hence th: "prime p \ 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 "\ = (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 "\ = ((a^m)^(r div p)) mod n" by (simp add: power_mult) - also have "\ = ((a^m mod n)^(r div p)) mod n" using power_mod[of "a^m" "n" "r div p" ] .. - also have "\ = 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: "\m. 0 < m \ m < n - 1 \ \ [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 (\d. d > 0 \ [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 \ [a ^(ord n a) = 1] (mod n) \ (\m. 0 < m \ m < ord n a \ \ [a^ m = 1] (mod n))" -proof- - let ?P = "\d. 0 < d \ [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 \ n=1" with na have "\m>0. ?P m" apply auto apply (rule exI[where x=1]) by (simp add: modeq_def)} - moreover - {assume "n\0 \ n\1" hence n2:"n \ 2" by arith - from na have na': "coprime a n" by (simp add: coprime_commute) - from phi_lowerbound_1[OF n2] fermat_little[OF na'] - have ex: "\m>0. ?P m" by - (rule exI[where x="\ n"], auto) } - ultimately have ex: "\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) \ (\m. 0 < m \ m < ord n a \ ~[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 \ m < ord n a \ ~[a^m = 1] (mod n)" - using ord_works by blast -lemma ord_eq_0: "ord n a = 0 \ ~coprime n a" -by (cases "coprime n a", simp add: neq0_conv coprime_ord, simp add: neq0_conv ord_def) - -lemma ord_divides: - "[a ^ d = 1] (mod n) \ ord n a dvd d" (is "?lhs \ ?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: "\ 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\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 \ 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 \ 0" by (simp add: ord_eq_0) - hence op: "?o > 0" by simp - from mod_div_equality[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 \ 0" - with mod_less_divisor[OF op, of d] have r0o:"?r >0 \ ?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 \ ord n a dvd \ 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) \ [d = e] (mod (ord n a))" -proof- - {fix n a d e - assume na: "coprime n a" and ed: "(e::nat) \ d" - hence "\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) \ [a^(e + c) = a^(e + 0)] (mod n)" - using c by simp - also have "\ \ [a^e* a^c = a^e *a^0] (mod n)" by (simp add: power_add) - also have "\ \ [a ^ c = 1] (mod n)" - using cong_mult_lcancel_eq[OF aen, of "a^c" "a^0"] by simp - also have "\ \ ord n a dvd c" by (simp only: ord_divides) - also have "\ \ [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) \ [d = e] (mod (ord n a))" - using c by simp } - note th = this - have "e \ d \ d \ e" by arith - moreover - {assume ed: "e \ d" from th[OF na ed] have ?thesis .} - moreover - {assume de: "d \ 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 \ n \ 1\ (\p. prime p \ p dvd n \ p = n)" -proof- - {assume n: "n=0 \ n=1" hence ?thesis using prime_0 two_is_prime by auto} - moreover - {assume n: "n\0" "n\1" - {assume pn: "prime n" - - from pn[unfolded prime_def] have "\p. prime p \ p dvd n \ p = n" - using n - apply (cases "n = 0 \ n=1",simp) - by (clarsimp, erule_tac x="p" in allE, auto)} - moreover - {assume H: "\p. prime p \ p dvd n \ p = n" - from n have n1: "n > 1" by arith - {fix m assume m: "m dvd n" "m\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_anti_sym[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 \ n \ 1 \ (\d. d dvd n \ d^2 \ n \ d = 1)" -proof- - {assume "n=0 \ n=1" hence ?thesis using prime_0 prime_1 - by (auto simp add: nat_power_eq_0_iff)} - moreover - {assume n: "n\0" "n\1" - hence np: "n > 1" by arith - {fix d assume d: "d dvd n" "d^2 \ n" and H: "\m. m dvd n \ m=1 \ m=n" - from H d have d1n: "d = 1 \ d=n" by blast - {assume dn: "d=n" - have "n^2 > n*1" using n - by (simp add: power2_eq_square mult_less_cancel1) - 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: "\d'. d' dvd n \ d'^2 \ n \ d' = 1" - from d n have "d \ 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^2 \ n \ e^2 \ n" using dp ep - by (auto simp add: e power2_eq_square mult_le_cancel_left) - moreover - {assume h: "d^2 \ n" - from H[rule_format, of d] h d have "d = 1" by blast} - moreover - {assume h: "e^2 \ 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 \ 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 \ n \ 0 \ n \ 1 \ \ (\p. prime p \ p dvd n \ p^2 \ n)" - (is "?lhs \?rhs") -proof- - {assume "n=0 \ n=1" hence ?thesis using prime_0 prime_1 by auto} - moreover - {assume n: "n\0" "n\1" - {assume H: ?lhs - from H[unfolded prime_divisor_sqrt] n - have ?rhs apply clarsimp by (erule_tac x="p" in allE, simp add: prime_1) - } - moreover - {assume H: ?rhs - {fix d assume d: "d dvd n" "d^2 \ n" "d\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 - from d(1) n have "d \ 0" by - (rule ccontr, 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^2 \ 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 \ n=1", auto) -qed -(* Pocklington theorem. *) - -lemma pocklington_lemma: - assumes n: "n \ 2" and nqr: "n - 1 = q*r" and an: "[a^ (n - 1) = 1] (mod n)" - and aq:"\p. prime p \ p dvd q \ 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 \ 0" "p \ 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\0" .. - from n nqr have aqr0: "a ^ (q * r) \ 0" using a0 by (simp add: neq0_conv) - 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: mult_ac) - 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 \ 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 \ 0" using P(1) prime_0 by - (rule ccontr, 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: " \ p = p - 1" by simp - {fix d assume d: "d dvd p" "d dvd a" "d \ 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 \ 0" by simp - from d(2) an n12[symmetric] have a0: "a \ 0" - by - (rule ccontr, simp add: modeq_def) - have th1: "a^ (n - 1) \ 0" using n d(2) dp a0 by (auto simp add: neq0_conv) - 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 - from prime_0 pp have p0:"p \ 0" by - (rule ccontr, 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 \ 2" and nqr: "n - 1 = q*r" and sqr: "n \ q^2" - and an: "[a^ (n - 1) = 1] (mod n)" - and aq:"\p. prime p \ p dvd q \ coprime (a^ ((n - 1) div p) - 1) n" - shows "prime n" -unfolding prime_prime_factor_sqrt[of n] -proof- - let ?ths = "n \ 0 \ n \ 1 \ \ (\p. prime p \ p dvd n \ p\ \ n)" - from n have n01: "n\0" "n\1" by arith+ - {fix p assume p: "prime p" "p dvd n" "p^2 \ n" - from p(3) sqr have "p^(Suc 1) \ q^(Suc 1)" by (simp add: power2_eq_square) - hence pq: "p \ 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 \ 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 \ 2" and nqr: "n - 1 = q*r" and sqr: "n \ q^2" - and an: "[a^ (n - 1) = 1] (mod n)" - and aq:"\p. prime p \ p dvd q \ (\b. [a^((n - 1) div p) = b] (mod n) \ 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\ 0" .. - hence a1: "a \ 1" by arith - from one_le_power[OF a1] have ath: "1 \ 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 mod_div_equality[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 \ 0" .. - hence b1: "b \ 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: "\p. prime p \ p dvd q \ 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 \ (\p\ set ps. prime p))" - -lemma primefact: assumes n: "n \ 0" - shows "\ps. primefact ps n" -using n -proof(induct n rule: nat_less_induct) - fix n assume H: "\m 0 \ (\ps. primefact ps m)" and n: "n\0" - let ?ths = "\ps. primefact ps n" - {assume "n = 1" - hence "primefact [] n" by (simp add: primefact_def) - hence ?ths by blast } - moreover - {assume n1: "n \ 1" - with n have n2: "n \ 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\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 \ 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" "\p \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 \ foldr op * ps 1 = n \ list_all prime ps" by (auto simp add: primefact_def list_all_iff) - -(* Variant of Lucas theorem. *) - -lemma lucas_primefact: - assumes n: "n \ 2" and an: "[a^(n - 1) = 1] (mod n)" - and psn: "foldr op * ps 1 = n - 1" - and psp: "list_all (\p. prime p \ \ [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 \ (0::nat)" shows "m mod n \ m" -proof- - from mod_div_equality[of m n] - have "\x. x + m mod n = m" by blast - then show ?thesis by auto -qed - - -lemma pocklington_primefact: - assumes n: "n \ 2" and qrn: "q*r = n - 1" and nq2: "n \ q^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 (\p. prime p \ 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 (\p. prime p \ 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 mod_div_equality[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 \ 0" "p \ 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: "\a (b::nat). a <= b \ a \ 0 ==> 1 <= a \ 1 <= b" by arith - from n0 have n00: "n \ 0" by arith - from mod_le[OF n00] - have th10: "a ^ ((n - 1) div p) mod n \ 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 - from dvd_trans[OF p(2) qn1] div_mod_equality'[of "n - 1" p] - have npp: "(n - 1) div p * p = n - 1" by (simp add: dvd_eq_mod_eq_0) - 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 "\ = 0" by (simp add: mult_assoc) - finally have False by simp } - then have th11: "a ^ ((n - 1) div p) mod n \ 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Library/Primes.thy --- a/src/HOL/Library/Primes.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,828 +0,0 @@ -(* Title: HOL/Library/Primes.thy - Author: Amine Chaieb, Christophe Tabacznyj and Lawrence C Paulson - Copyright 1996 University of Cambridge -*) - -header {* Primality on nat *} - -theory Primes -imports Complex_Main Legacy_GCD -begin - -hide (open) const GCD.gcd GCD.coprime GCD.prime - -definition - coprime :: "nat => nat => bool" where - "coprime m n \ gcd m n = 1" - -definition - prime :: "nat \ bool" where - [code del]: "prime p \ (1 < p \ (\m. m dvd p --> m = 1 \ 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 ==> \ p dvd n ==> gcd p n = 1" - apply (auto simp add: prime_def) - apply (metis One_nat_def gcd_dvd1 gcd_dvd2) - done - -text {* - 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. -*} - -lemma prime_dvd_mult: "prime p ==> p dvd m * n ==> p dvd m \ 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\ ==> p dvd m" - by (rule prime_dvd_square) (simp_all add: power2_eq_square) - - -lemma exp_eq_1:"(x::nat)^n = 1 \ x = 1 \ n = 0" -by (induct n, auto) - -lemma exp_mono_lt: "(x::nat) ^ (Suc n) < y ^ (Suc n) \ 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) \ y ^ (Suc n) \ x \ y" -by (simp only: linorder_not_less[symmetric] exp_mono_lt) - -lemma exp_mono_eq: "(x::nat) ^ Suc n = y ^ Suc n \ x = y" -using power_inject_base[of x n y] by auto - - -lemma even_square: assumes e: "even (n::nat)" shows "\x. n ^ 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^2 = 4* (k^2)" by (simp add: power2_eq_square) - thus ?thesis by blast -qed - -lemma odd_square: assumes e: "odd (n::nat)" shows "\x. n ^ 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" using dvd_def by auto - hence k: "n = 2*k + 1" using e by presburger - hence "n^2 = 4* (k^2 + k) + 1" by algebra - thus ?thesis by blast -qed - -lemma diff_square: "(x::nat)^2 - y^2 = (x+y)*(x - y)" -proof- - have "x \ y \ y \ x" by (rule nat_le_linear) - moreover - {assume le: "x \ y" - hence "x ^2 \ y^2" by (simp only: numeral_2_eq_2 exp_mono_le Let_def) - with le have ?thesis by simp } - moreover - {assume le: "y \ x" - hence le2: "y ^2 \ x^2" by (simp only: numeral_2_eq_2 exp_mono_le Let_def) - from le have "\z. y + z = x" by presburger - then obtain z where z: "x = y + z" by blast - from le2 have "\z. x^2 = y^2 + z" by presburger - then obtain z2 where z2: "x^2 = y^2 + z2" by blast - from z z2 have ?thesis apply simp by algebra } - ultimately show ?thesis by blast -qed - -text {* Elementary theory of divisibility *} -lemma divides_ge: "(a::nat) dvd b \ b = 0 \ a \ b" unfolding dvd_def by auto -lemma divides_antisym: "(x::nat) dvd y \ y dvd x \ x = y" - using dvd_anti_sym[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 \ k = 0 \ 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 \ m = n \ 2 * n <= m" - by (auto simp add: dvd_def) - -lemma divides_div_not: "(x::nat) = (q * n) + r \ 0 < r \ 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 \ 0" with r have "r \ 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 \ 0 \ (x::nat) ^ n dvd y \ x dvd y" - by (induct n ,auto simp add: dvd_def) - -fun fact :: "nat \ 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 \ 1" using fact_lt[of n] by simp -lemma fact_mono: assumes le: "m \ n" shows "fact m \ fact n" -proof- - from le have "\i. n = m+i" by presburger - then obtain i where i: "n = m+i" by blast - have "fact m \ 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 \ 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 \ 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 \ p \ n" by presburger - moreover - {assume "p = Suc n" hence ?case by (simp only: fact.simps dvd_triv_left)} - moreover - {assume "p \ 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 \ (x::nat) dvd (y^(Suc n))" by (simp add: dvd_mult2[of x y]) - -text {* Coprimality *} - -lemma coprime: "coprime a b \ (\d. d dvd a \ d dvd b \ d = 1)" -using gcd_unique[of 1 a b, simplified] by (auto simp add: coprime_def) -lemma coprime_commute: "coprime a b \ coprime b a" by (simp add: coprime_def gcd_commute) - -lemma coprime_bezout: "coprime a b \ (\x y. a * x - b * y = 1 \ b * x - a * y = 1)" -using coprime_def gcd_bezout by auto - -lemma coprime_divprod: "d dvd a * b \ coprime d a \ 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 \ 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\ 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 \ 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 prems 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: mult_ac) -apply (rule_tac x="a*x" in exI) -apply (rule_tac x="y" in exI) -apply (simp add: mult_ac) -done - -lemma coprime_rmul2: "coprime d (a * b) \ 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: mult_ac) -apply (rule_tac x="b*x" in exI) -apply (rule_tac x="y" in exI) -apply (simp add: mult_ac) -done -lemma coprime_mul_eq: "coprime d (a * b) \ coprime d a \ 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 \ 0" - shows "\a' b'. a = a' * gcd a b \ b = b' * gcd a b \ 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 \ 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 \ 0 ==> coprime (n - 1) n" - using coprime_plus1[of "n - 1"] coprime_commute[of "n - 1" n] by auto - -lemma bezout_gcd_pow: "\x y. a ^n * x - b ^ n * y = gcd a b ^ n \ 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]) - by simp} - moreover - {assume z: "?g \ 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: mult_ac) - 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 \ b'^n * x - a'^n * y = 1" by blast - hence "?g^n * (a'^n * x - b'^n * y) = ?g^n \ ?g^n*(b'^n * x - a'^n * y) = ?g^n" - using z by auto - then have "a^n * x - b^n * y = ?g^n \ 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 \ 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: "\e. e dvd a^n \ e dvd b^n \ 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) \ 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 "\b' c'. a = b' * c' \ b' dvd b \ 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 \ 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 \ n \ 0 \ m = 0" by (induct n, auto) - -lemma divides_rev: assumes ab: "(a::nat) ^ n dvd b ^n" and n:"n \ 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 \ 0" - hence zn: "?g ^ n \ 0" using n by (simp add: neq0_conv) - 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 {* A binary form of the Chinese Remainder Theorem. *} - -lemma chinese_remainder: assumes ab: "coprime a b" and a:"a \ 0" and b:"b \ 0" - shows "\x q1 q2. x = u + q1 * a \ 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 {* Primality *} - -text {* A few useful theorems about primes *} - -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 \ 2" by (simp add: prime_def) -lemma prime_factor: assumes n: "n \ 1" shows "\ p. prime p \ p dvd n" -using n -proof(induct n rule: nat_less_induct) - fix n - assume H: "\m 1 \ (\p. prime p \ p dvd m)" "n \ 1" - let ?ths = "\p. prime p \ p dvd n" - {assume "n=0" hence ?ths using two_is_prime by auto} - moreover - {assume nz: "n\0" - {assume "prime n" hence ?ths by - (rule exI[where x="n"], simp)} - moreover - {assume n: "\ prime n" - with nz H(2) - obtain k where k:"k dvd n" "k \ 1" "k \ n" by (auto simp add: 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) have ?ths by blast} - ultimately have ?ths by blast} - ultimately show ?ths by blast -qed - -lemma prime_factor_lt: assumes p: "prime p" and n: "n \ 0" and npm:"n = p * m" - shows "m < n" -proof- - {assume "m=0" with n have ?thesis by simp} - moreover - {assume m: "m \ 0" - from npm have mn: "m dvd n" unfolding dvd_def by auto - from npm m have "n \ m" using p by auto - with dvd_imp_le[OF mn] n have ?thesis by simp} - ultimately show ?thesis by blast -qed - -lemma euclid_bound: "\p. prime p \ n < p \ p <= Suc (fact n)" -proof- - have f1: "fact n + 1 \ 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 \ fact n + 1" by simp - {assume np: "p \ n" - from p(1) have p1: "p \ 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: "\p. prime p \ p > n" using euclid_bound by auto - -lemma primes_infinite: "\ (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 \ p dvd a \ p dvd b)" -proof - assume "prime p \ p dvd a \ 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 \ (\p. ~(prime p \ p dvd a \ p dvd b))" - (is "?lhs = ?rhs") -proof- - {assume "?lhs" with coprime_prime have ?rhs by blast} - moreover - {assume r: "?rhs" and c: "\ ?lhs" - then obtain g where g: "g\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 \ p dvd n \ coprime p n" -using p prime_imp_relprime[of p n] by (auto simp add: coprime_def) - -lemma prime_coprime_strong: "prime p \ p dvd n \ coprime p n" - using prime_coprime[of p n] by auto - -declare coprime_0[simp] - -lemma coprime_0'[simp]: "coprime 0 d \ d = 1" by (simp add: coprime_commute[of 0 d]) -lemma coprime_bezout_strong: assumes ab: "coprime a b" and b: "b \ 1" - shows "\x y. a * x = b * y + 1" -proof- - from ab b have az: "a \ 0" by - (rule ccontr, 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: "\ p dvd a" - shows "\x y. a*x = p*y + 1" -proof- - from p have p1: "p \ 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 \ 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 \ p dvd a \ 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 \ p dvd x^n \ 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: "\coprime x y" - shows "\p. prime p \ p dvd x \ p dvd y" -proof- - from xy[unfolded coprime_def] obtain g where g: "g \ 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^2 + y^2)" -proof- - {assume c: "\ coprime (x * y) (x^2 + y^2)" - from coprime_prime_dvd_ex[OF c] obtain p - where p: "prime p" "p dvd x*y" "p dvd x^2 + y^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^2 + y^2 = p * s" - by (auto elim!: dvdE) - then have "y^2 = p * (s - r)" - by (auto simp add: power2_eq_square diff_mult_distrib2) - then have "p dvd y^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^2 + y^2 = p * s" - by (auto elim!: dvdE) - then have "x^2 = p * (s - r)" - by (auto simp add: power2_eq_square diff_mult_distrib2) - then have "p dvd x^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 \ prime q \ p \ q \ 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- - {assume c: "\ coprime x p" - then obtain g where g: "g \ 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 - from g(2) x have "g \ 0" by - (rule ccontr, simp) - with g gp p[unfolded prime_def] have False by blast} -thus ?thesis by blast -qed - -lemma even_dvd[simp]: "even (n::nat) \ 2 dvd n" by presburger -lemma prime_odd: "prime p \ p = 2 \ odd p" unfolding prime_def by auto - - -text {* One property of coprimality is easier to prove via prime factors. *} - -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 \ p^n dvd b" -proof- - {assume "n = 0 \ a = 1 \ b = 1" with pab have ?thesis - apply (cases "n=0", simp_all) - apply (cases "a=1", simp_all) done} - moreover - {assume n: "n \ 0" and a: "a\1" and b: "b\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 \ 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 "\ 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 "\ 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 \ n = 1 \ m = 1" (is "?lhs \ ?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[simp]: "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 "\r s. a = r^n \ b = s ^n" - using ab abcn -proof(induct c arbitrary: a b rule: nat_less_induct) - fix c a b - assume H: "\ma b. coprime a b \ a * b = m ^ n \ (\r s. a = r ^ n \ b = s ^ n)" "coprime a b" "a * b = c ^ n" - let ?ths = "\r s. a = r^n \ b = s ^n" - {assume n: "n = 0" - with H(3) power_one have "a*b = 1" by simp - hence "a = 1 \ 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 \ 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 \ 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\1" "c \ 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 \ p^n dvd b" . - from p(2) obtain l where l: "c = p*l" unfolding dvd_def by blast - have pn0: "p^n \ 0" using n prime_ge_2 [OF p(1)] by (simp add: neq0_conv) - {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 \ 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 \ 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 {* More useful lemmas. *} -lemma prime_product: - assumes "prime (p * q)" - shows "p = 1 \ q = 1" -proof - - from assms have - "1 < p * q" and P: "\m. m dvd p * q \ m = 1 \ m = p * q" - unfolding prime_def by auto - from `1 < p * q` have "p \ 0" by (cases p) auto - then have Q: "p = p * q \ q = 1" by auto - have "p dvd p * q" by simp - then have "p = 1 \ p = p * q" by (rule P) - then show ?thesis by (simp add: Q) -qed - -lemma prime_exp: "prime (p^n) \ prime p \ 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 \ 0" "p\1" - {assume pp: "prime (p^Suc n)" - hence "p = 1 \ 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 \ Suc n = 1" by simp} - moreover - {assume n: "prime p \ 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 "\i j. x = p ^i \ 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) - from Suc.prems have pxy: "p dvd x*y" by auto - from prime_divprod[OF p pxy] have pxyc: "p dvd x \ p dvd y" . - from p have p0: "p \ 0" by - (rule ccontr, simp) - {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) have ?case by blast} - moreover - {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) have ?case by blast} - ultimately show ?case using pxyc by blast -qed - -lemma prime_power_exp: assumes p: "prime p" and n:"n \ 0" - and xn: "x^n = p^k" shows "\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 prems have ?case apply simp - by (rule exI[where x="k"],simp)} - moreover - {assume n: "n \ 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 \ (\ i. i \ k \ 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 \ k" by arith - with ij(1) show "\i\k. d = p ^ i" by blast -next - {fix i assume H: "i \ k" "d = p^i" - hence "\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 "\i\k. d = p ^ i \ d dvd p ^ k" by blast -qed - -lemma coprime_divisors: "d dvd a \ e dvd b \ coprime a b \ coprime d e" - by (auto simp add: dvd_def coprime) - -declare power_Suc0[simp del] -declare even_dvd[simp del] - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NSA/Examples/NSPrimes.thy --- a/src/HOL/NSA/Examples/NSPrimes.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/NSA/Examples/NSPrimes.thy Tue Sep 01 21:44:19 2009 +0200 @@ -7,7 +7,7 @@ header{*The Nonstandard Primes as an Extension of the Prime Numbers*} theory NSPrimes -imports "~~/src/HOL/NumberTheory/Factorization" Hyperreal +imports "~~/src/HOL/Old_Number_Theory/Factorization" Hyperreal begin text{*These can be used to derive an alternative proof of the infinitude of diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NewNumberTheory/Binomial.thy --- a/src/HOL/NewNumberTheory/Binomial.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,373 +0,0 @@ -(* Title: Binomial.thy - Authors: Lawrence C. Paulson, Jeremy Avigad, Tobias Nipkow - - -Defines the "choose" function, and establishes basic properties. - -The original theory "Binomial" was by Lawrence C. Paulson, based on -the work of Andy Gordon and Florian Kammueller. The approach here, -which derives the definition of binomial coefficients in terms of the -factorial function, is due to Jeremy Avigad. The binomial theorem was -formalized by Tobias Nipkow. - -*) - - -header {* Binomial *} - -theory Binomial -imports Cong Fact -begin - - -subsection {* Main definitions *} - -class binomial = - -fixes - binomial :: "'a \ 'a \ 'a" (infixl "choose" 65) - -(* definitions for the natural numbers *) - -instantiation nat :: binomial - -begin - -fun - binomial_nat :: "nat \ nat \ nat" -where - "binomial_nat n k = - (if k = 0 then 1 else - if n = 0 then 0 else - (binomial (n - 1) k) + (binomial (n - 1) (k - 1)))" - -instance proof qed - -end - -(* definitions for the integers *) - -instantiation int :: binomial - -begin - -definition - binomial_int :: "int => int \ int" -where - "binomial_int n k = (if n \ 0 \ k \ 0 then int (binomial (nat n) (nat k)) - else 0)" -instance proof qed - -end - - -subsection {* Set up Transfer *} - -lemma transfer_nat_int_binomial: - "(n::int) >= 0 \ k >= 0 \ binomial (nat n) (nat k) = - nat (binomial n k)" - unfolding binomial_int_def - by auto - -lemma transfer_nat_int_binomial_closure: - "n >= (0::int) \ k >= 0 \ binomial n k >= 0" - by (auto simp add: binomial_int_def) - -declare TransferMorphism_nat_int[transfer add return: - transfer_nat_int_binomial transfer_nat_int_binomial_closure] - -lemma transfer_int_nat_binomial: - "binomial (int n) (int k) = int (binomial n k)" - unfolding fact_int_def binomial_int_def by auto - -lemma transfer_int_nat_binomial_closure: - "is_nat n \ is_nat k \ binomial n k >= 0" - by (auto simp add: binomial_int_def) - -declare TransferMorphism_int_nat[transfer add return: - transfer_int_nat_binomial transfer_int_nat_binomial_closure] - - -subsection {* Binomial coefficients *} - -lemma choose_zero_nat [simp]: "(n::nat) choose 0 = 1" - by simp - -lemma choose_zero_int [simp]: "n \ 0 \ (n::int) choose 0 = 1" - by (simp add: binomial_int_def) - -lemma zero_choose_nat [rule_format,simp]: "ALL (k::nat) > n. n choose k = 0" - by (induct n rule: induct'_nat, auto) - -lemma zero_choose_int [rule_format,simp]: "(k::int) > n \ n choose k = 0" - unfolding binomial_int_def apply (case_tac "n < 0") - apply force - apply (simp del: binomial_nat.simps) -done - -lemma choose_reduce_nat: "(n::nat) > 0 \ 0 < k \ - (n choose k) = ((n - 1) choose k) + ((n - 1) choose (k - 1))" - by simp - -lemma choose_reduce_int: "(n::int) > 0 \ 0 < k \ - (n choose k) = ((n - 1) choose k) + ((n - 1) choose (k - 1))" - unfolding binomial_int_def apply (subst choose_reduce_nat) - apply (auto simp del: binomial_nat.simps - simp add: nat_diff_distrib) -done - -lemma choose_plus_one_nat: "((n::nat) + 1) choose (k + 1) = - (n choose (k + 1)) + (n choose k)" - by (simp add: choose_reduce_nat) - -lemma choose_Suc_nat: "(Suc n) choose (Suc k) = - (n choose (Suc k)) + (n choose k)" - by (simp add: choose_reduce_nat One_nat_def) - -lemma choose_plus_one_int: "n \ 0 \ k \ 0 \ ((n::int) + 1) choose (k + 1) = - (n choose (k + 1)) + (n choose k)" - by (simp add: binomial_int_def choose_plus_one_nat nat_add_distrib del: binomial_nat.simps) - -declare binomial_nat.simps [simp del] - -lemma choose_self_nat [simp]: "((n::nat) choose n) = 1" - by (induct n rule: induct'_nat, auto simp add: choose_plus_one_nat) - -lemma choose_self_int [simp]: "n \ 0 \ ((n::int) choose n) = 1" - by (auto simp add: binomial_int_def) - -lemma choose_one_nat [simp]: "(n::nat) choose 1 = n" - by (induct n rule: induct'_nat, auto simp add: choose_reduce_nat) - -lemma choose_one_int [simp]: "n \ 0 \ (n::int) choose 1 = n" - by (auto simp add: binomial_int_def) - -lemma plus_one_choose_self_nat [simp]: "(n::nat) + 1 choose n = n + 1" - apply (induct n rule: induct'_nat, force) - apply (case_tac "n = 0") - apply auto - apply (subst choose_reduce_nat) - apply (auto simp add: One_nat_def) - (* natdiff_cancel_numerals introduces Suc *) -done - -lemma Suc_choose_self_nat [simp]: "(Suc n) choose n = Suc n" - using plus_one_choose_self_nat by (simp add: One_nat_def) - -lemma plus_one_choose_self_int [rule_format, simp]: - "(n::int) \ 0 \ n + 1 choose n = n + 1" - by (auto simp add: binomial_int_def nat_add_distrib) - -(* bounded quantification doesn't work with the unicode characters? *) -lemma choose_pos_nat [rule_format]: "ALL k <= (n::nat). - ((n::nat) choose k) > 0" - apply (induct n rule: induct'_nat) - apply force - apply clarify - apply (case_tac "k = 0") - apply force - apply (subst choose_reduce_nat) - apply auto -done - -lemma choose_pos_int: "n \ 0 \ k >= 0 \ k \ n \ - ((n::int) choose k) > 0" - by (auto simp add: binomial_int_def choose_pos_nat) - -lemma binomial_induct [rule_format]: "(ALL (n::nat). P n n) \ - (ALL n. P (n + 1) 0) \ (ALL n. (ALL k < n. P n k \ P n (k + 1) \ - P (n + 1) (k + 1))) \ (ALL k <= n. P n k)" - apply (induct n rule: induct'_nat) - apply auto - apply (case_tac "k = 0") - apply auto - apply (case_tac "k = n + 1") - apply auto - apply (drule_tac x = n in spec) back back - apply (drule_tac x = "k - 1" in spec) back back back - apply auto -done - -lemma choose_altdef_aux_nat: "(k::nat) \ n \ - fact k * fact (n - k) * (n choose k) = fact n" - apply (rule binomial_induct [of _ k n]) - apply auto -proof - - fix k :: nat and n - assume less: "k < n" - assume ih1: "fact k * fact (n - k) * (n choose k) = fact n" - hence one: "fact (k + 1) * fact (n - k) * (n choose k) = (k + 1) * fact n" - by (subst fact_plus_one_nat, auto) - assume ih2: "fact (k + 1) * fact (n - (k + 1)) * (n choose (k + 1)) = - fact n" - with less have "fact (k + 1) * fact ((n - (k + 1)) + 1) * - (n choose (k + 1)) = (n - k) * fact n" - by (subst (2) fact_plus_one_nat, auto) - with less have two: "fact (k + 1) * fact (n - k) * (n choose (k + 1)) = - (n - k) * fact n" by simp - have "fact (k + 1) * fact (n - k) * (n + 1 choose (k + 1)) = - fact (k + 1) * fact (n - k) * (n choose (k + 1)) + - fact (k + 1) * fact (n - k) * (n choose k)" - by (subst choose_reduce_nat, auto simp add: ring_simps) - also note one - also note two - also with less have "(n - k) * fact n + (k + 1) * fact n= fact (n + 1)" - apply (subst fact_plus_one_nat) - apply (subst left_distrib [symmetric]) - apply simp - done - finally show "fact (k + 1) * fact (n - k) * (n + 1 choose (k + 1)) = - fact (n + 1)" . -qed - -lemma choose_altdef_nat: "(k::nat) \ n \ - n choose k = fact n div (fact k * fact (n - k))" - apply (frule choose_altdef_aux_nat) - apply (erule subst) - apply (simp add: mult_ac) -done - - -lemma choose_altdef_int: - assumes "(0::int) <= k" and "k <= n" - shows "n choose k = fact n div (fact k * fact (n - k))" - - apply (subst tsub_eq [symmetric], rule prems) - apply (rule choose_altdef_nat [transferred]) - using prems apply auto -done - -lemma choose_dvd_nat: "(k::nat) \ n \ fact k * fact (n - k) dvd fact n" - unfolding dvd_def apply (frule choose_altdef_aux_nat) - (* why don't blast and auto get this??? *) - apply (rule exI) - apply (erule sym) -done - -lemma choose_dvd_int: - assumes "(0::int) <= k" and "k <= n" - shows "fact k * fact (n - k) dvd fact n" - - apply (subst tsub_eq [symmetric], rule prems) - apply (rule choose_dvd_nat [transferred]) - using prems apply auto -done - -(* generalizes Tobias Nipkow's proof to any commutative semiring *) -theorem binomial: "(a+b::'a::{comm_ring_1,power})^n = - (SUM k=0..n. (of_nat (n choose k)) * a^k * b^(n-k))" (is "?P n") -proof (induct n rule: induct'_nat) - show "?P 0" by simp -next - fix n - assume ih: "?P n" - have decomp: "{0..n+1} = {0} Un {n+1} Un {1..n}" - by auto - have decomp2: "{0..n} = {0} Un {1..n}" - by auto - have decomp3: "{1..n+1} = {n+1} Un {1..n}" - by auto - have "(a+b)^(n+1) = - (a+b) * (SUM k=0..n. of_nat (n choose k) * a^k * b^(n-k))" - using ih by (simp add: power_plus_one) - also have "... = a*(SUM k=0..n. of_nat (n choose k) * a^k * b^(n-k)) + - b*(SUM k=0..n. of_nat (n choose k) * a^k * b^(n-k))" - by (rule distrib) - also have "... = (SUM k=0..n. of_nat (n choose k) * a^(k+1) * b^(n-k)) + - (SUM k=0..n. of_nat (n choose k) * a^k * b^(n-k+1))" - by (subst (1 2) power_plus_one, simp add: setsum_right_distrib mult_ac) - also have "... = (SUM k=0..n. of_nat (n choose k) * a^k * b^(n+1-k)) + - (SUM k=1..n+1. of_nat (n choose (k - 1)) * a^k * b^(n+1-k))" - by (simp add:setsum_shift_bounds_cl_Suc_ivl Suc_diff_le - power_Suc ring_simps One_nat_def del:setsum_cl_ivl_Suc) - also have "... = a^(n+1) + b^(n+1) + - (SUM k=1..n. of_nat (n choose (k - 1)) * a^k * b^(n+1-k)) + - (SUM k=1..n. of_nat (n choose k) * a^k * b^(n+1-k))" - by (simp add: decomp2 decomp3) - also have - "... = a^(n+1) + b^(n+1) + - (SUM k=1..n. of_nat(n+1 choose k) * a^k * b^(n+1-k))" - by (auto simp add: ring_simps setsum_addf [symmetric] - choose_reduce_nat) - also have "... = (SUM k=0..n+1. of_nat (n+1 choose k) * a^k * b^(n+1-k))" - using decomp by (simp add: ring_simps) - finally show "?P (n + 1)" by simp -qed - -lemma set_explicit: "{S. S = T \ P S} = (if P T then {T} else {})" - by auto - -lemma card_subsets_nat [rule_format]: - fixes S :: "'a set" - assumes "finite S" - shows "ALL k. card {T. T \ S \ card T = k} = card S choose k" - (is "?P S") -using `finite S` -proof (induct set: finite) - show "?P {}" by (auto simp add: set_explicit) - next fix x :: "'a" and F - assume iassms: "finite F" "x ~: F" - assume ih: "?P F" - show "?P (insert x F)" (is "ALL k. ?Q k") - proof - fix k - show "card {T. T \ (insert x F) \ card T = k} = - card (insert x F) choose k" (is "?Q k") - proof (induct k rule: induct'_nat) - from iassms have "{T. T \ (insert x F) \ card T = 0} = {{}}" - apply auto - apply (subst (asm) card_0_eq) - apply (auto elim: finite_subset) - done - thus "?Q 0" - by auto - next fix k - show "?Q (k + 1)" - proof - - from iassms have fin: "finite (insert x F)" by auto - hence "{ T. T \ insert x F \ card T = k + 1} = - {T. T \ F & card T = k + 1} Un - {T. T \ insert x F & x : T & card T = k + 1}" - by (auto intro!: subsetI) - with iassms fin have "card ({T. T \ insert x F \ card T = k + 1}) = - card ({T. T \ F \ card T = k + 1}) + - card ({T. T \ insert x F \ x : T \ card T = k + 1})" - apply (subst card_Un_disjoint [symmetric]) - apply auto - (* note: nice! Didn't have to say anything here *) - done - also from ih have "card ({T. T \ F \ card T = k + 1}) = - card F choose (k+1)" by auto - also have "card ({T. T \ insert x F \ x : T \ card T = k + 1}) = - card ({T. T <= F & card T = k})" - proof - - let ?f = "%T. T Un {x}" - from iassms have "inj_on ?f {T. T <= F & card T = k}" - unfolding inj_on_def by (auto intro!: subsetI) - hence "card ({T. T <= F & card T = k}) = - card(?f ` {T. T <= F & card T = k})" - by (rule card_image [symmetric]) - also from iassms fin have "?f ` {T. T <= F & card T = k} = - {T. T \ insert x F \ x : T \ card T = k + 1}" - unfolding image_def - (* I can't figure out why this next line takes so long *) - apply auto - apply (frule (1) finite_subset, force) - apply (rule_tac x = "xa - {x}" in exI) - apply (subst card_Diff_singleton) - apply (auto elim: finite_subset) - done - finally show ?thesis by (rule sym) - qed - also from ih have "card ({T. T <= F & card T = k}) = card F choose k" - by auto - finally have "card ({T. T \ insert x F \ card T = k + 1}) = - card F choose (k + 1) + (card F choose k)". - with iassms choose_plus_one_nat show ?thesis - by auto - qed - qed - qed -qed - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NewNumberTheory/Cong.thy --- a/src/HOL/NewNumberTheory/Cong.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1091 +0,0 @@ -(* Title: HOL/Library/Cong.thy - ID: - Authors: Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb, - Thomas M. Rasmussen, Jeremy Avigad - - -Defines congruence (notation: [x = y] (mod z)) for natural numbers and -integers. - -This file combines and revises a number of prior developments. - -The original theories "GCD" and "Primes" were by Christophe Tabacznyj -and Lawrence C. Paulson, based on \cite{davenport92}. They introduced -gcd, lcm, and prime for the natural numbers. - -The original theory "IntPrimes" was by Thomas M. Rasmussen, and -extended gcd, lcm, primes to the integers. Amine Chaieb provided -another extension of the notions to the integers, and added a number -of results to "Primes" and "GCD". - -The original theory, "IntPrimes", by Thomas M. Rasmussen, defined and -developed the congruence relations on the integers. The notion was -extended to the natural numbers by Chiaeb. Jeremy Avigad combined -these, revised and tidied them, made the development uniform for the -natural numbers and the integers, and added a number of new theorems. - -*) - - -header {* Congruence *} - -theory Cong -imports GCD -begin - -subsection {* Turn off One_nat_def *} - -lemma induct'_nat [case_names zero plus1, induct type: nat]: - "\ P (0::nat); !!n. P n \ P (n + 1)\ \ P n" -by (erule nat_induct) (simp add:One_nat_def) - -lemma cases_nat [case_names zero plus1, cases type: nat]: - "P (0::nat) \ (!!n. P (n + 1)) \ P n" -by(metis induct'_nat) - -lemma power_plus_one [simp]: "(x::'a::power)^(n + 1) = x * x^n" -by (simp add: One_nat_def) - -lemma power_eq_one_eq_nat [simp]: - "((x::nat)^m = 1) = (m = 0 | x = 1)" -by (induct m, auto) - -lemma card_insert_if' [simp]: "finite A \ - card (insert x A) = (if x \ A then (card A) else (card A) + 1)" -by (auto simp add: insert_absorb) - -(* why wasn't card_insert_if a simp rule? *) -declare card_insert_disjoint [simp del] - -lemma nat_1' [simp]: "nat 1 = 1" -by simp - -(* For those annoying moments where Suc reappears, use Suc_eq_plus1 *) - -declare nat_1 [simp del] -declare add_2_eq_Suc [simp del] -declare add_2_eq_Suc' [simp del] - - -declare mod_pos_pos_trivial [simp] - - -subsection {* Main definitions *} - -class cong = - -fixes - cong :: "'a \ 'a \ 'a \ bool" ("(1[_ = _] '(mod _'))") - -begin - -abbreviation - notcong :: "'a \ 'a \ 'a \ bool" ("(1[_ \ _] '(mod _'))") -where - "notcong x y m == (~cong x y m)" - -end - -(* definitions for the natural numbers *) - -instantiation nat :: cong - -begin - -definition - cong_nat :: "nat \ nat \ nat \ bool" -where - "cong_nat x y m = ((x mod m) = (y mod m))" - -instance proof qed - -end - - -(* definitions for the integers *) - -instantiation int :: cong - -begin - -definition - cong_int :: "int \ int \ int \ bool" -where - "cong_int x y m = ((x mod m) = (y mod m))" - -instance proof qed - -end - - -subsection {* Set up Transfer *} - - -lemma transfer_nat_int_cong: - "(x::int) >= 0 \ y >= 0 \ m >= 0 \ - ([(nat x) = (nat y)] (mod (nat m))) = ([x = y] (mod m))" - unfolding cong_int_def cong_nat_def - apply (auto simp add: nat_mod_distrib [symmetric]) - apply (subst (asm) eq_nat_nat_iff) - apply (case_tac "m = 0", force, rule pos_mod_sign, force)+ - apply assumption -done - -declare TransferMorphism_nat_int[transfer add return: - transfer_nat_int_cong] - -lemma transfer_int_nat_cong: - "[(int x) = (int y)] (mod (int m)) = [x = y] (mod m)" - apply (auto simp add: cong_int_def cong_nat_def) - apply (auto simp add: zmod_int [symmetric]) -done - -declare TransferMorphism_int_nat[transfer add return: - transfer_int_nat_cong] - - -subsection {* Congruence *} - -(* was zcong_0, etc. *) -lemma cong_0_nat [simp, presburger]: "([(a::nat) = b] (mod 0)) = (a = b)" - by (unfold cong_nat_def, auto) - -lemma cong_0_int [simp, presburger]: "([(a::int) = b] (mod 0)) = (a = b)" - by (unfold cong_int_def, auto) - -lemma cong_1_nat [simp, presburger]: "[(a::nat) = b] (mod 1)" - by (unfold cong_nat_def, auto) - -lemma cong_Suc_0_nat [simp, presburger]: "[(a::nat) = b] (mod Suc 0)" - by (unfold cong_nat_def, auto simp add: One_nat_def) - -lemma cong_1_int [simp, presburger]: "[(a::int) = b] (mod 1)" - by (unfold cong_int_def, auto) - -lemma cong_refl_nat [simp]: "[(k::nat) = k] (mod m)" - by (unfold cong_nat_def, auto) - -lemma cong_refl_int [simp]: "[(k::int) = k] (mod m)" - by (unfold cong_int_def, auto) - -lemma cong_sym_nat: "[(a::nat) = b] (mod m) \ [b = a] (mod m)" - by (unfold cong_nat_def, auto) - -lemma cong_sym_int: "[(a::int) = b] (mod m) \ [b = a] (mod m)" - by (unfold cong_int_def, auto) - -lemma cong_sym_eq_nat: "[(a::nat) = b] (mod m) = [b = a] (mod m)" - by (unfold cong_nat_def, auto) - -lemma cong_sym_eq_int: "[(a::int) = b] (mod m) = [b = a] (mod m)" - by (unfold cong_int_def, auto) - -lemma cong_trans_nat [trans]: - "[(a::nat) = b] (mod m) \ [b = c] (mod m) \ [a = c] (mod m)" - by (unfold cong_nat_def, auto) - -lemma cong_trans_int [trans]: - "[(a::int) = b] (mod m) \ [b = c] (mod m) \ [a = c] (mod m)" - by (unfold cong_int_def, auto) - -lemma cong_add_nat: - "[(a::nat) = b] (mod m) \ [c = d] (mod m) \ [a + c = b + d] (mod m)" - apply (unfold cong_nat_def) - apply (subst (1 2) mod_add_eq) - apply simp -done - -lemma cong_add_int: - "[(a::int) = b] (mod m) \ [c = d] (mod m) \ [a + c = b + d] (mod m)" - apply (unfold cong_int_def) - apply (subst (1 2) mod_add_left_eq) - apply (subst (1 2) mod_add_right_eq) - apply simp -done - -lemma cong_diff_int: - "[(a::int) = b] (mod m) \ [c = d] (mod m) \ [a - c = b - d] (mod m)" - apply (unfold cong_int_def) - apply (subst (1 2) mod_diff_eq) - apply simp -done - -lemma cong_diff_aux_int: - "(a::int) >= c \ b >= d \ [(a::int) = b] (mod m) \ - [c = d] (mod m) \ [tsub a c = tsub b d] (mod m)" - apply (subst (1 2) tsub_eq) - apply (auto intro: cong_diff_int) -done; - -lemma cong_diff_nat: - assumes "(a::nat) >= c" and "b >= d" and "[a = b] (mod m)" and - "[c = d] (mod m)" - shows "[a - c = b - d] (mod m)" - - using prems by (rule cong_diff_aux_int [transferred]); - -lemma cong_mult_nat: - "[(a::nat) = b] (mod m) \ [c = d] (mod m) \ [a * c = b * d] (mod m)" - apply (unfold cong_nat_def) - apply (subst (1 2) mod_mult_eq) - apply simp -done - -lemma cong_mult_int: - "[(a::int) = b] (mod m) \ [c = d] (mod m) \ [a * c = b * d] (mod m)" - apply (unfold cong_int_def) - apply (subst (1 2) zmod_zmult1_eq) - apply (subst (1 2) mult_commute) - apply (subst (1 2) zmod_zmult1_eq) - apply simp -done - -lemma cong_exp_nat: "[(x::nat) = y] (mod n) \ [x^k = y^k] (mod n)" - apply (induct k) - apply (auto simp add: cong_refl_nat cong_mult_nat) -done - -lemma cong_exp_int: "[(x::int) = y] (mod n) \ [x^k = y^k] (mod n)" - apply (induct k) - apply (auto simp add: cong_refl_int cong_mult_int) -done - -lemma cong_setsum_nat [rule_format]: - "(ALL x: A. [((f x)::nat) = g x] (mod m)) \ - [(SUM x:A. f x) = (SUM x:A. g x)] (mod m)" - apply (case_tac "finite A") - apply (induct set: finite) - apply (auto intro: cong_add_nat) -done - -lemma cong_setsum_int [rule_format]: - "(ALL x: A. [((f x)::int) = g x] (mod m)) \ - [(SUM x:A. f x) = (SUM x:A. g x)] (mod m)" - apply (case_tac "finite A") - apply (induct set: finite) - apply (auto intro: cong_add_int) -done - -lemma cong_setprod_nat [rule_format]: - "(ALL x: A. [((f x)::nat) = g x] (mod m)) \ - [(PROD x:A. f x) = (PROD x:A. g x)] (mod m)" - apply (case_tac "finite A") - apply (induct set: finite) - apply (auto intro: cong_mult_nat) -done - -lemma cong_setprod_int [rule_format]: - "(ALL x: A. [((f x)::int) = g x] (mod m)) \ - [(PROD x:A. f x) = (PROD x:A. g x)] (mod m)" - apply (case_tac "finite A") - apply (induct set: finite) - apply (auto intro: cong_mult_int) -done - -lemma cong_scalar_nat: "[(a::nat)= b] (mod m) \ [a * k = b * k] (mod m)" - by (rule cong_mult_nat, simp_all) - -lemma cong_scalar_int: "[(a::int)= b] (mod m) \ [a * k = b * k] (mod m)" - by (rule cong_mult_int, simp_all) - -lemma cong_scalar2_nat: "[(a::nat)= b] (mod m) \ [k * a = k * b] (mod m)" - by (rule cong_mult_nat, simp_all) - -lemma cong_scalar2_int: "[(a::int)= b] (mod m) \ [k * a = k * b] (mod m)" - by (rule cong_mult_int, simp_all) - -lemma cong_mult_self_nat: "[(a::nat) * m = 0] (mod m)" - by (unfold cong_nat_def, auto) - -lemma cong_mult_self_int: "[(a::int) * m = 0] (mod m)" - by (unfold cong_int_def, auto) - -lemma cong_eq_diff_cong_0_int: "[(a::int) = b] (mod m) = [a - b = 0] (mod m)" - apply (rule iffI) - apply (erule cong_diff_int [of a b m b b, simplified]) - apply (erule cong_add_int [of "a - b" 0 m b b, simplified]) -done - -lemma cong_eq_diff_cong_0_aux_int: "a >= b \ - [(a::int) = b] (mod m) = [tsub a b = 0] (mod m)" - by (subst tsub_eq, assumption, rule cong_eq_diff_cong_0_int) - -lemma cong_eq_diff_cong_0_nat: - assumes "(a::nat) >= b" - shows "[a = b] (mod m) = [a - b = 0] (mod m)" - - using prems by (rule cong_eq_diff_cong_0_aux_int [transferred]) - -lemma cong_diff_cong_0'_nat: - "[(x::nat) = y] (mod n) \ - (if x <= y then [y - x = 0] (mod n) else [x - y = 0] (mod n))" - apply (case_tac "y <= x") - apply (frule cong_eq_diff_cong_0_nat [where m = n]) - apply auto [1] - apply (subgoal_tac "x <= y") - apply (frule cong_eq_diff_cong_0_nat [where m = n]) - apply (subst cong_sym_eq_nat) - apply auto -done - -lemma cong_altdef_nat: "(a::nat) >= b \ [a = b] (mod m) = (m dvd (a - b))" - apply (subst cong_eq_diff_cong_0_nat, assumption) - apply (unfold cong_nat_def) - apply (simp add: dvd_eq_mod_eq_0 [symmetric]) -done - -lemma cong_altdef_int: "[(a::int) = b] (mod m) = (m dvd (a - b))" - apply (subst cong_eq_diff_cong_0_int) - apply (unfold cong_int_def) - apply (simp add: dvd_eq_mod_eq_0 [symmetric]) -done - -lemma cong_abs_int: "[(x::int) = y] (mod abs m) = [x = y] (mod m)" - by (simp add: cong_altdef_int) - -lemma cong_square_int: - "\ prime (p::int); 0 < a; [a * a = 1] (mod p) \ - \ [a = 1] (mod p) \ [a = - 1] (mod p)" - apply (simp only: cong_altdef_int) - apply (subst prime_dvd_mult_eq_int [symmetric], assumption) - (* any way around this? *) - apply (subgoal_tac "a * a - 1 = (a - 1) * (a - -1)") - apply (auto simp add: ring_simps) -done - -lemma cong_mult_rcancel_int: - "coprime k (m::int) \ [a * k = b * k] (mod m) = [a = b] (mod m)" - apply (subst (1 2) cong_altdef_int) - apply (subst left_diff_distrib [symmetric]) - apply (rule coprime_dvd_mult_iff_int) - apply (subst gcd_commute_int, assumption) -done - -lemma cong_mult_rcancel_nat: - assumes "coprime k (m::nat)" - shows "[a * k = b * k] (mod m) = [a = b] (mod m)" - - apply (rule cong_mult_rcancel_int [transferred]) - using prems apply auto -done - -lemma cong_mult_lcancel_nat: - "coprime k (m::nat) \ [k * a = k * b ] (mod m) = [a = b] (mod m)" - by (simp add: mult_commute cong_mult_rcancel_nat) - -lemma cong_mult_lcancel_int: - "coprime k (m::int) \ [k * a = k * b] (mod m) = [a = b] (mod m)" - by (simp add: mult_commute cong_mult_rcancel_int) - -(* was zcong_zgcd_zmult_zmod *) -lemma coprime_cong_mult_int: - "[(a::int) = b] (mod m) \ [a = b] (mod n) \ coprime m n - \ [a = b] (mod m * n)" - apply (simp only: cong_altdef_int) - apply (erule (2) divides_mult_int) -done - -lemma coprime_cong_mult_nat: - assumes "[(a::nat) = b] (mod m)" and "[a = b] (mod n)" and "coprime m n" - shows "[a = b] (mod m * n)" - - apply (rule coprime_cong_mult_int [transferred]) - using prems apply auto -done - -lemma cong_less_imp_eq_nat: "0 \ (a::nat) \ - a < m \ 0 \ b \ b < m \ [a = b] (mod m) \ a = b" - by (auto simp add: cong_nat_def mod_pos_pos_trivial) - -lemma cong_less_imp_eq_int: "0 \ (a::int) \ - a < m \ 0 \ b \ b < m \ [a = b] (mod m) \ a = b" - by (auto simp add: cong_int_def mod_pos_pos_trivial) - -lemma cong_less_unique_nat: - "0 < (m::nat) \ (\!b. 0 \ b \ b < m \ [a = b] (mod m))" - apply auto - apply (rule_tac x = "a mod m" in exI) - apply (unfold cong_nat_def, auto) -done - -lemma cong_less_unique_int: - "0 < (m::int) \ (\!b. 0 \ b \ b < m \ [a = b] (mod m))" - apply auto - apply (rule_tac x = "a mod m" in exI) - apply (unfold cong_int_def, auto simp add: mod_pos_pos_trivial) -done - -lemma cong_iff_lin_int: "([(a::int) = b] (mod m)) = (\k. b = a + m * k)" - apply (auto simp add: cong_altdef_int dvd_def ring_simps) - apply (rule_tac [!] x = "-k" in exI, auto) -done - -lemma cong_iff_lin_nat: "([(a::nat) = b] (mod m)) = - (\k1 k2. b + k1 * m = a + k2 * m)" - apply (rule iffI) - apply (case_tac "b <= a") - apply (subst (asm) cong_altdef_nat, assumption) - apply (unfold dvd_def, auto) - apply (rule_tac x = k in exI) - apply (rule_tac x = 0 in exI) - apply (auto simp add: ring_simps) - apply (subst (asm) cong_sym_eq_nat) - apply (subst (asm) cong_altdef_nat) - apply force - apply (unfold dvd_def, auto) - apply (rule_tac x = 0 in exI) - apply (rule_tac x = k in exI) - apply (auto simp add: ring_simps) - apply (unfold cong_nat_def) - apply (subgoal_tac "a mod m = (a + k2 * m) mod m") - apply (erule ssubst)back - apply (erule subst) - apply auto -done - -lemma cong_gcd_eq_int: "[(a::int) = b] (mod m) \ gcd a m = gcd b m" - apply (subst (asm) cong_iff_lin_int, auto) - apply (subst add_commute) - apply (subst (2) gcd_commute_int) - apply (subst mult_commute) - apply (subst gcd_add_mult_int) - apply (rule gcd_commute_int) -done - -lemma cong_gcd_eq_nat: - assumes "[(a::nat) = b] (mod m)" - shows "gcd a m = gcd b m" - - apply (rule cong_gcd_eq_int [transferred]) - using prems apply auto -done - -lemma cong_imp_coprime_nat: "[(a::nat) = b] (mod m) \ coprime a m \ - coprime b m" - by (auto simp add: cong_gcd_eq_nat) - -lemma cong_imp_coprime_int: "[(a::int) = b] (mod m) \ coprime a m \ - coprime b m" - by (auto simp add: cong_gcd_eq_int) - -lemma cong_cong_mod_nat: "[(a::nat) = b] (mod m) = - [a mod m = b mod m] (mod m)" - by (auto simp add: cong_nat_def) - -lemma cong_cong_mod_int: "[(a::int) = b] (mod m) = - [a mod m = b mod m] (mod m)" - by (auto simp add: cong_int_def) - -lemma cong_minus_int [iff]: "[(a::int) = b] (mod -m) = [a = b] (mod m)" - by (subst (1 2) cong_altdef_int, auto) - -lemma cong_zero_nat [iff]: "[(a::nat) = b] (mod 0) = (a = b)" - by (auto simp add: cong_nat_def) - -lemma cong_zero_int [iff]: "[(a::int) = b] (mod 0) = (a = b)" - by (auto simp add: cong_int_def) - -(* -lemma mod_dvd_mod_int: - "0 < (m::int) \ m dvd b \ (a mod b mod m) = (a mod m)" - apply (unfold dvd_def, auto) - apply (rule mod_mod_cancel) - apply auto -done - -lemma mod_dvd_mod: - assumes "0 < (m::nat)" and "m dvd b" - shows "(a mod b mod m) = (a mod m)" - - apply (rule mod_dvd_mod_int [transferred]) - using prems apply auto -done -*) - -lemma cong_add_lcancel_nat: - "[(a::nat) + x = a + y] (mod n) \ [x = y] (mod n)" - by (simp add: cong_iff_lin_nat) - -lemma cong_add_lcancel_int: - "[(a::int) + x = a + y] (mod n) \ [x = y] (mod n)" - by (simp add: cong_iff_lin_int) - -lemma cong_add_rcancel_nat: "[(x::nat) + a = y + a] (mod n) \ [x = y] (mod n)" - by (simp add: cong_iff_lin_nat) - -lemma cong_add_rcancel_int: "[(x::int) + a = y + a] (mod n) \ [x = y] (mod n)" - by (simp add: cong_iff_lin_int) - -lemma cong_add_lcancel_0_nat: "[(a::nat) + x = a] (mod n) \ [x = 0] (mod n)" - by (simp add: cong_iff_lin_nat) - -lemma cong_add_lcancel_0_int: "[(a::int) + x = a] (mod n) \ [x = 0] (mod n)" - by (simp add: cong_iff_lin_int) - -lemma cong_add_rcancel_0_nat: "[x + (a::nat) = a] (mod n) \ [x = 0] (mod n)" - by (simp add: cong_iff_lin_nat) - -lemma cong_add_rcancel_0_int: "[x + (a::int) = a] (mod n) \ [x = 0] (mod n)" - by (simp add: cong_iff_lin_int) - -lemma cong_dvd_modulus_nat: "[(x::nat) = y] (mod m) \ n dvd m \ - [x = y] (mod n)" - apply (auto simp add: cong_iff_lin_nat dvd_def) - apply (rule_tac x="k1 * k" in exI) - apply (rule_tac x="k2 * k" in exI) - apply (simp add: ring_simps) -done - -lemma cong_dvd_modulus_int: "[(x::int) = y] (mod m) \ n dvd m \ - [x = y] (mod n)" - by (auto simp add: cong_altdef_int dvd_def) - -lemma cong_dvd_eq_nat: "[(x::nat) = y] (mod n) \ n dvd x \ n dvd y" - by (unfold cong_nat_def, auto simp add: dvd_eq_mod_eq_0) - -lemma cong_dvd_eq_int: "[(x::int) = y] (mod n) \ n dvd x \ n dvd y" - by (unfold cong_int_def, auto simp add: dvd_eq_mod_eq_0) - -lemma cong_mod_nat: "(n::nat) ~= 0 \ [a mod n = a] (mod n)" - by (simp add: cong_nat_def) - -lemma cong_mod_int: "(n::int) ~= 0 \ [a mod n = a] (mod n)" - by (simp add: cong_int_def) - -lemma mod_mult_cong_nat: "(a::nat) ~= 0 \ b ~= 0 - \ [x mod (a * b) = y] (mod a) \ [x = y] (mod a)" - by (simp add: cong_nat_def mod_mult2_eq mod_add_left_eq) - -lemma neg_cong_int: "([(a::int) = b] (mod m)) = ([-a = -b] (mod m))" - apply (simp add: cong_altdef_int) - apply (subst dvd_minus_iff [symmetric]) - apply (simp add: ring_simps) -done - -lemma cong_modulus_neg_int: "([(a::int) = b] (mod m)) = ([a = b] (mod -m))" - by (auto simp add: cong_altdef_int) - -lemma mod_mult_cong_int: "(a::int) ~= 0 \ b ~= 0 - \ [x mod (a * b) = y] (mod a) \ [x = y] (mod a)" - apply (case_tac "b > 0") - apply (simp add: cong_int_def mod_mod_cancel mod_add_left_eq) - apply (subst (1 2) cong_modulus_neg_int) - apply (unfold cong_int_def) - apply (subgoal_tac "a * b = (-a * -b)") - apply (erule ssubst) - apply (subst zmod_zmult2_eq) - apply (auto simp add: mod_add_left_eq) -done - -lemma cong_to_1_nat: "([(a::nat) = 1] (mod n)) \ (n dvd (a - 1))" - apply (case_tac "a = 0") - apply force - apply (subst (asm) cong_altdef_nat) - apply auto -done - -lemma cong_0_1_nat: "[(0::nat) = 1] (mod n) = (n = 1)" - by (unfold cong_nat_def, auto) - -lemma cong_0_1_int: "[(0::int) = 1] (mod n) = ((n = 1) | (n = -1))" - by (unfold cong_int_def, auto simp add: zmult_eq_1_iff) - -lemma cong_to_1'_nat: "[(a::nat) = 1] (mod n) \ - a = 0 \ n = 1 \ (\m. a = 1 + m * n)" - apply (case_tac "n = 1") - apply auto [1] - apply (drule_tac x = "a - 1" in spec) - apply force - apply (case_tac "a = 0") - apply (auto simp add: cong_0_1_nat) [1] - apply (rule iffI) - apply (drule cong_to_1_nat) - apply (unfold dvd_def) - apply auto [1] - apply (rule_tac x = k in exI) - apply (auto simp add: ring_simps) [1] - apply (subst cong_altdef_nat) - apply (auto simp add: dvd_def) -done - -lemma cong_le_nat: "(y::nat) <= x \ [x = y] (mod n) \ (\q. x = q * n + y)" - apply (subst cong_altdef_nat) - apply assumption - apply (unfold dvd_def, auto simp add: ring_simps) - apply (rule_tac x = k in exI) - apply auto -done - -lemma cong_solve_nat: "(a::nat) \ 0 \ EX x. [a * x = gcd a n] (mod n)" - apply (case_tac "n = 0") - apply force - apply (frule bezout_nat [of a n], auto) - apply (rule exI, erule ssubst) - apply (rule cong_trans_nat) - apply (rule cong_add_nat) - apply (subst mult_commute) - apply (rule cong_mult_self_nat) - prefer 2 - apply simp - apply (rule cong_refl_nat) - apply (rule cong_refl_nat) -done - -lemma cong_solve_int: "(a::int) \ 0 \ EX x. [a * x = gcd a n] (mod n)" - apply (case_tac "n = 0") - apply (case_tac "a \ 0") - apply auto - apply (rule_tac x = "-1" in exI) - apply auto - apply (insert bezout_int [of a n], auto) - apply (rule exI) - apply (erule subst) - apply (rule cong_trans_int) - prefer 2 - apply (rule cong_add_int) - apply (rule cong_refl_int) - apply (rule cong_sym_int) - apply (rule cong_mult_self_int) - apply simp - apply (subst mult_commute) - apply (rule cong_refl_int) -done - -lemma cong_solve_dvd_nat: - assumes a: "(a::nat) \ 0" and b: "gcd a n dvd d" - shows "EX x. [a * x = d] (mod n)" -proof - - from cong_solve_nat [OF a] obtain x where - "[a * x = gcd a n](mod n)" - by auto - hence "[(d div gcd a n) * (a * x) = (d div gcd a n) * gcd a n] (mod n)" - by (elim cong_scalar2_nat) - also from b have "(d div gcd a n) * gcd a n = d" - by (rule dvd_div_mult_self) - also have "(d div gcd a n) * (a * x) = a * (d div gcd a n * x)" - by auto - finally show ?thesis - by auto -qed - -lemma cong_solve_dvd_int: - assumes a: "(a::int) \ 0" and b: "gcd a n dvd d" - shows "EX x. [a * x = d] (mod n)" -proof - - from cong_solve_int [OF a] obtain x where - "[a * x = gcd a n](mod n)" - by auto - hence "[(d div gcd a n) * (a * x) = (d div gcd a n) * gcd a n] (mod n)" - by (elim cong_scalar2_int) - also from b have "(d div gcd a n) * gcd a n = d" - by (rule dvd_div_mult_self) - also have "(d div gcd a n) * (a * x) = a * (d div gcd a n * x)" - by auto - finally show ?thesis - by auto -qed - -lemma cong_solve_coprime_nat: "coprime (a::nat) n \ - EX x. [a * x = 1] (mod n)" - apply (case_tac "a = 0") - apply force - apply (frule cong_solve_nat [of a n]) - apply auto -done - -lemma cong_solve_coprime_int: "coprime (a::int) n \ - EX x. [a * x = 1] (mod n)" - apply (case_tac "a = 0") - apply auto - apply (case_tac "n \ 0") - apply auto - apply (subst cong_int_def, auto) - apply (frule cong_solve_int [of a n]) - apply auto -done - -lemma coprime_iff_invertible_nat: "m > (1::nat) \ coprime a m = - (EX x. [a * x = 1] (mod m))" - apply (auto intro: cong_solve_coprime_nat) - apply (unfold cong_nat_def, auto intro: invertible_coprime_nat) -done - -lemma coprime_iff_invertible_int: "m > (1::int) \ coprime a m = - (EX x. [a * x = 1] (mod m))" - apply (auto intro: cong_solve_coprime_int) - apply (unfold cong_int_def) - apply (auto intro: invertible_coprime_int) -done - -lemma coprime_iff_invertible'_int: "m > (1::int) \ coprime a m = - (EX x. 0 <= x & x < m & [a * x = 1] (mod m))" - apply (subst coprime_iff_invertible_int) - apply auto - apply (auto simp add: cong_int_def) - apply (rule_tac x = "x mod m" in exI) - apply (auto simp add: mod_mult_right_eq [symmetric]) -done - - -lemma cong_cong_lcm_nat: "[(x::nat) = y] (mod a) \ - [x = y] (mod b) \ [x = y] (mod lcm a b)" - apply (case_tac "y \ x") - apply (auto simp add: cong_altdef_nat lcm_least_nat) [1] - apply (rule cong_sym_nat) - apply (subst (asm) (1 2) cong_sym_eq_nat) - apply (auto simp add: cong_altdef_nat lcm_least_nat) -done - -lemma cong_cong_lcm_int: "[(x::int) = y] (mod a) \ - [x = y] (mod b) \ [x = y] (mod lcm a b)" - by (auto simp add: cong_altdef_int lcm_least_int) [1] - -lemma cong_cong_coprime_nat: "coprime a b \ [(x::nat) = y] (mod a) \ - [x = y] (mod b) \ [x = y] (mod a * b)" - apply (frule (1) cong_cong_lcm_nat)back - apply (simp add: lcm_nat_def) -done - -lemma cong_cong_coprime_int: "coprime a b \ [(x::int) = y] (mod a) \ - [x = y] (mod b) \ [x = y] (mod a * b)" - apply (frule (1) cong_cong_lcm_int)back - apply (simp add: lcm_altdef_int cong_abs_int abs_mult [symmetric]) -done - -lemma cong_cong_setprod_coprime_nat [rule_format]: "finite A \ - (ALL i:A. (ALL j:A. i \ j \ coprime (m i) (m j))) \ - (ALL i:A. [(x::nat) = y] (mod m i)) \ - [x = y] (mod (PROD i:A. m i))" - apply (induct set: finite) - apply auto - apply (rule cong_cong_coprime_nat) - apply (subst gcd_commute_nat) - apply (rule setprod_coprime_nat) - apply auto -done - -lemma cong_cong_setprod_coprime_int [rule_format]: "finite A \ - (ALL i:A. (ALL j:A. i \ j \ coprime (m i) (m j))) \ - (ALL i:A. [(x::int) = y] (mod m i)) \ - [x = y] (mod (PROD i:A. m i))" - apply (induct set: finite) - apply auto - apply (rule cong_cong_coprime_int) - apply (subst gcd_commute_int) - apply (rule setprod_coprime_int) - apply auto -done - -lemma binary_chinese_remainder_aux_nat: - assumes a: "coprime (m1::nat) m2" - shows "EX b1 b2. [b1 = 1] (mod m1) \ [b1 = 0] (mod m2) \ - [b2 = 0] (mod m1) \ [b2 = 1] (mod m2)" -proof - - from cong_solve_coprime_nat [OF a] - obtain x1 where one: "[m1 * x1 = 1] (mod m2)" - by auto - from a have b: "coprime m2 m1" - by (subst gcd_commute_nat) - from cong_solve_coprime_nat [OF b] - obtain x2 where two: "[m2 * x2 = 1] (mod m1)" - by auto - have "[m1 * x1 = 0] (mod m1)" - by (subst mult_commute, rule cong_mult_self_nat) - moreover have "[m2 * x2 = 0] (mod m2)" - by (subst mult_commute, rule cong_mult_self_nat) - moreover note one two - ultimately show ?thesis by blast -qed - -lemma binary_chinese_remainder_aux_int: - assumes a: "coprime (m1::int) m2" - shows "EX b1 b2. [b1 = 1] (mod m1) \ [b1 = 0] (mod m2) \ - [b2 = 0] (mod m1) \ [b2 = 1] (mod m2)" -proof - - from cong_solve_coprime_int [OF a] - obtain x1 where one: "[m1 * x1 = 1] (mod m2)" - by auto - from a have b: "coprime m2 m1" - by (subst gcd_commute_int) - from cong_solve_coprime_int [OF b] - obtain x2 where two: "[m2 * x2 = 1] (mod m1)" - by auto - have "[m1 * x1 = 0] (mod m1)" - by (subst mult_commute, rule cong_mult_self_int) - moreover have "[m2 * x2 = 0] (mod m2)" - by (subst mult_commute, rule cong_mult_self_int) - moreover note one two - ultimately show ?thesis by blast -qed - -lemma binary_chinese_remainder_nat: - assumes a: "coprime (m1::nat) m2" - shows "EX x. [x = u1] (mod m1) \ [x = u2] (mod m2)" -proof - - from binary_chinese_remainder_aux_nat [OF a] obtain b1 b2 - where "[b1 = 1] (mod m1)" and "[b1 = 0] (mod m2)" and - "[b2 = 0] (mod m1)" and "[b2 = 1] (mod m2)" - by blast - let ?x = "u1 * b1 + u2 * b2" - have "[?x = u1 * 1 + u2 * 0] (mod m1)" - apply (rule cong_add_nat) - apply (rule cong_scalar2_nat) - apply (rule `[b1 = 1] (mod m1)`) - apply (rule cong_scalar2_nat) - apply (rule `[b2 = 0] (mod m1)`) - done - hence "[?x = u1] (mod m1)" by simp - have "[?x = u1 * 0 + u2 * 1] (mod m2)" - apply (rule cong_add_nat) - apply (rule cong_scalar2_nat) - apply (rule `[b1 = 0] (mod m2)`) - apply (rule cong_scalar2_nat) - apply (rule `[b2 = 1] (mod m2)`) - done - hence "[?x = u2] (mod m2)" by simp - with `[?x = u1] (mod m1)` show ?thesis by blast -qed - -lemma binary_chinese_remainder_int: - assumes a: "coprime (m1::int) m2" - shows "EX x. [x = u1] (mod m1) \ [x = u2] (mod m2)" -proof - - from binary_chinese_remainder_aux_int [OF a] obtain b1 b2 - where "[b1 = 1] (mod m1)" and "[b1 = 0] (mod m2)" and - "[b2 = 0] (mod m1)" and "[b2 = 1] (mod m2)" - by blast - let ?x = "u1 * b1 + u2 * b2" - have "[?x = u1 * 1 + u2 * 0] (mod m1)" - apply (rule cong_add_int) - apply (rule cong_scalar2_int) - apply (rule `[b1 = 1] (mod m1)`) - apply (rule cong_scalar2_int) - apply (rule `[b2 = 0] (mod m1)`) - done - hence "[?x = u1] (mod m1)" by simp - have "[?x = u1 * 0 + u2 * 1] (mod m2)" - apply (rule cong_add_int) - apply (rule cong_scalar2_int) - apply (rule `[b1 = 0] (mod m2)`) - apply (rule cong_scalar2_int) - apply (rule `[b2 = 1] (mod m2)`) - done - hence "[?x = u2] (mod m2)" by simp - with `[?x = u1] (mod m1)` show ?thesis by blast -qed - -lemma cong_modulus_mult_nat: "[(x::nat) = y] (mod m * n) \ - [x = y] (mod m)" - apply (case_tac "y \ x") - apply (simp add: cong_altdef_nat) - apply (erule dvd_mult_left) - apply (rule cong_sym_nat) - apply (subst (asm) cong_sym_eq_nat) - apply (simp add: cong_altdef_nat) - apply (erule dvd_mult_left) -done - -lemma cong_modulus_mult_int: "[(x::int) = y] (mod m * n) \ - [x = y] (mod m)" - apply (simp add: cong_altdef_int) - apply (erule dvd_mult_left) -done - -lemma cong_less_modulus_unique_nat: - "[(x::nat) = y] (mod m) \ x < m \ y < m \ x = y" - by (simp add: cong_nat_def) - -lemma binary_chinese_remainder_unique_nat: - assumes a: "coprime (m1::nat) m2" and - nz: "m1 \ 0" "m2 \ 0" - shows "EX! x. x < m1 * m2 \ [x = u1] (mod m1) \ [x = u2] (mod m2)" -proof - - from binary_chinese_remainder_nat [OF a] obtain y where - "[y = u1] (mod m1)" and "[y = u2] (mod m2)" - by blast - let ?x = "y mod (m1 * m2)" - from nz have less: "?x < m1 * m2" - by auto - have one: "[?x = u1] (mod m1)" - apply (rule cong_trans_nat) - prefer 2 - apply (rule `[y = u1] (mod m1)`) - apply (rule cong_modulus_mult_nat) - apply (rule cong_mod_nat) - using nz apply auto - done - have two: "[?x = u2] (mod m2)" - apply (rule cong_trans_nat) - prefer 2 - apply (rule `[y = u2] (mod m2)`) - apply (subst mult_commute) - apply (rule cong_modulus_mult_nat) - apply (rule cong_mod_nat) - using nz apply auto - done - have "ALL z. z < m1 * m2 \ [z = u1] (mod m1) \ [z = u2] (mod m2) \ - z = ?x" - proof (clarify) - fix z - assume "z < m1 * m2" - assume "[z = u1] (mod m1)" and "[z = u2] (mod m2)" - have "[?x = z] (mod m1)" - apply (rule cong_trans_nat) - apply (rule `[?x = u1] (mod m1)`) - apply (rule cong_sym_nat) - apply (rule `[z = u1] (mod m1)`) - done - moreover have "[?x = z] (mod m2)" - apply (rule cong_trans_nat) - apply (rule `[?x = u2] (mod m2)`) - apply (rule cong_sym_nat) - apply (rule `[z = u2] (mod m2)`) - done - ultimately have "[?x = z] (mod m1 * m2)" - by (auto intro: coprime_cong_mult_nat a) - with `z < m1 * m2` `?x < m1 * m2` show "z = ?x" - apply (intro cong_less_modulus_unique_nat) - apply (auto, erule cong_sym_nat) - done - qed - with less one two show ?thesis - by auto - qed - -lemma chinese_remainder_aux_nat: - fixes A :: "'a set" and - m :: "'a \ nat" - assumes fin: "finite A" and - cop: "ALL i : A. (ALL j : A. i \ j \ coprime (m i) (m j))" - shows "EX b. (ALL i : A. - [b i = 1] (mod m i) \ [b i = 0] (mod (PROD j : A - {i}. m j)))" -proof (rule finite_set_choice, rule fin, rule ballI) - fix i - assume "i : A" - with cop have "coprime (PROD j : A - {i}. m j) (m i)" - by (intro setprod_coprime_nat, auto) - hence "EX x. [(PROD j : A - {i}. m j) * x = 1] (mod m i)" - by (elim cong_solve_coprime_nat) - then obtain x where "[(PROD j : A - {i}. m j) * x = 1] (mod m i)" - by auto - moreover have "[(PROD j : A - {i}. m j) * x = 0] - (mod (PROD j : A - {i}. m j))" - by (subst mult_commute, rule cong_mult_self_nat) - ultimately show "\a. [a = 1] (mod m i) \ [a = 0] - (mod setprod m (A - {i}))" - by blast -qed - -lemma chinese_remainder_nat: - fixes A :: "'a set" and - m :: "'a \ nat" and - u :: "'a \ nat" - assumes - fin: "finite A" and - cop: "ALL i:A. (ALL j : A. i \ j \ coprime (m i) (m j))" - shows "EX x. (ALL i:A. [x = u i] (mod m i))" -proof - - from chinese_remainder_aux_nat [OF fin cop] obtain b where - bprop: "ALL i:A. [b i = 1] (mod m i) \ - [b i = 0] (mod (PROD j : A - {i}. m j))" - by blast - let ?x = "SUM i:A. (u i) * (b i)" - show "?thesis" - proof (rule exI, clarify) - fix i - assume a: "i : A" - show "[?x = u i] (mod m i)" - proof - - from fin a have "?x = (SUM j:{i}. u j * b j) + - (SUM j:A-{i}. u j * b j)" - by (subst setsum_Un_disjoint [symmetric], auto intro: setsum_cong) - hence "[?x = u i * b i + (SUM j:A-{i}. u j * b j)] (mod m i)" - by auto - also have "[u i * b i + (SUM j:A-{i}. u j * b j) = - u i * 1 + (SUM j:A-{i}. u j * 0)] (mod m i)" - apply (rule cong_add_nat) - apply (rule cong_scalar2_nat) - using bprop a apply blast - apply (rule cong_setsum_nat) - apply (rule cong_scalar2_nat) - using bprop apply auto - apply (rule cong_dvd_modulus_nat) - apply (drule (1) bspec) - apply (erule conjE) - apply assumption - apply (rule dvd_setprod) - using fin a apply auto - done - finally show ?thesis - by simp - qed - qed -qed - -lemma coprime_cong_prod_nat [rule_format]: "finite A \ - (ALL i: A. (ALL j: A. i \ j \ coprime (m i) (m j))) \ - (ALL i: A. [(x::nat) = y] (mod m i)) \ - [x = y] (mod (PROD i:A. m i))" - apply (induct set: finite) - apply auto - apply (erule (1) coprime_cong_mult_nat) - apply (subst gcd_commute_nat) - apply (rule setprod_coprime_nat) - apply auto -done - -lemma chinese_remainder_unique_nat: - fixes A :: "'a set" and - m :: "'a \ nat" and - u :: "'a \ nat" - assumes - fin: "finite A" and - nz: "ALL i:A. m i \ 0" and - cop: "ALL i:A. (ALL j : A. i \ j \ coprime (m i) (m j))" - shows "EX! x. x < (PROD i:A. m i) \ (ALL i:A. [x = u i] (mod m i))" -proof - - from chinese_remainder_nat [OF fin cop] obtain y where - one: "(ALL i:A. [y = u i] (mod m i))" - by blast - let ?x = "y mod (PROD i:A. m i)" - from fin nz have prodnz: "(PROD i:A. m i) \ 0" - by auto - hence less: "?x < (PROD i:A. m i)" - by auto - have cong: "ALL i:A. [?x = u i] (mod m i)" - apply auto - apply (rule cong_trans_nat) - prefer 2 - using one apply auto - apply (rule cong_dvd_modulus_nat) - apply (rule cong_mod_nat) - using prodnz apply auto - apply (rule dvd_setprod) - apply (rule fin) - apply assumption - done - have unique: "ALL z. z < (PROD i:A. m i) \ - (ALL i:A. [z = u i] (mod m i)) \ z = ?x" - proof (clarify) - fix z - assume zless: "z < (PROD i:A. m i)" - assume zcong: "(ALL i:A. [z = u i] (mod m i))" - have "ALL i:A. [?x = z] (mod m i)" - apply clarify - apply (rule cong_trans_nat) - using cong apply (erule bspec) - apply (rule cong_sym_nat) - using zcong apply auto - done - with fin cop have "[?x = z] (mod (PROD i:A. m i))" - by (intro coprime_cong_prod_nat, auto) - with zless less show "z = ?x" - apply (intro cong_less_modulus_unique_nat) - apply (auto, erule cong_sym_nat) - done - qed - from less cong unique show ?thesis - by blast -qed - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NewNumberTheory/Fib.thy --- a/src/HOL/NewNumberTheory/Fib.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,319 +0,0 @@ -(* Title: Fib.thy - Authors: Lawrence C. Paulson, Jeremy Avigad - - -Defines the fibonacci function. - -The original "Fib" is due to Lawrence C. Paulson, and was adapted by -Jeremy Avigad. -*) - - -header {* Fib *} - -theory Fib -imports Binomial -begin - - -subsection {* Main definitions *} - -class fib = - -fixes - fib :: "'a \ 'a" - - -(* definition for the natural numbers *) - -instantiation nat :: fib - -begin - -fun - fib_nat :: "nat \ nat" -where - "fib_nat n = - (if n = 0 then 0 else - (if n = 1 then 1 else - fib (n - 1) + fib (n - 2)))" - -instance proof qed - -end - -(* definition for the integers *) - -instantiation int :: fib - -begin - -definition - fib_int :: "int \ int" -where - "fib_int n = (if n >= 0 then int (fib (nat n)) else 0)" - -instance proof qed - -end - - -subsection {* Set up Transfer *} - - -lemma transfer_nat_int_fib: - "(x::int) >= 0 \ fib (nat x) = nat (fib x)" - unfolding fib_int_def by auto - -lemma transfer_nat_int_fib_closure: - "n >= (0::int) \ fib n >= 0" - by (auto simp add: fib_int_def) - -declare TransferMorphism_nat_int[transfer add return: - transfer_nat_int_fib transfer_nat_int_fib_closure] - -lemma transfer_int_nat_fib: - "fib (int n) = int (fib n)" - unfolding fib_int_def by auto - -lemma transfer_int_nat_fib_closure: - "is_nat n \ fib n >= 0" - unfolding fib_int_def by auto - -declare TransferMorphism_int_nat[transfer add return: - transfer_int_nat_fib transfer_int_nat_fib_closure] - - -subsection {* Fibonacci numbers *} - -lemma fib_0_nat [simp]: "fib (0::nat) = 0" - by simp - -lemma fib_0_int [simp]: "fib (0::int) = 0" - unfolding fib_int_def by simp - -lemma fib_1_nat [simp]: "fib (1::nat) = 1" - by simp - -lemma fib_Suc_0_nat [simp]: "fib (Suc 0) = Suc 0" - by simp - -lemma fib_1_int [simp]: "fib (1::int) = 1" - unfolding fib_int_def by simp - -lemma fib_reduce_nat: "(n::nat) >= 2 \ fib n = fib (n - 1) + fib (n - 2)" - by simp - -declare fib_nat.simps [simp del] - -lemma fib_reduce_int: "(n::int) >= 2 \ fib n = fib (n - 1) + fib (n - 2)" - unfolding fib_int_def - by (auto simp add: fib_reduce_nat nat_diff_distrib) - -lemma fib_neg_int [simp]: "(n::int) < 0 \ fib n = 0" - unfolding fib_int_def by auto - -lemma fib_2_nat [simp]: "fib (2::nat) = 1" - by (subst fib_reduce_nat, auto) - -lemma fib_2_int [simp]: "fib (2::int) = 1" - by (subst fib_reduce_int, auto) - -lemma fib_plus_2_nat: "fib ((n::nat) + 2) = fib (n + 1) + fib n" - by (subst fib_reduce_nat, auto simp add: One_nat_def) -(* the need for One_nat_def is due to the natdiff_cancel_numerals - procedure *) - -lemma fib_induct_nat: "P (0::nat) \ P (1::nat) \ - (!!n. P n \ P (n + 1) \ P (n + 2)) \ P n" - apply (atomize, induct n rule: nat_less_induct) - apply auto - apply (case_tac "n = 0", force) - apply (case_tac "n = 1", force) - apply (subgoal_tac "n >= 2") - apply (frule_tac x = "n - 1" in spec) - apply (drule_tac x = "n - 2" in spec) - apply (drule_tac x = "n - 2" in spec) - apply auto - apply (auto simp add: One_nat_def) (* again, natdiff_cancel *) -done - -lemma fib_add_nat: "fib ((n::nat) + k + 1) = fib (k + 1) * fib (n + 1) + - fib k * fib n" - apply (induct n rule: fib_induct_nat) - apply auto - apply (subst fib_reduce_nat) - apply (auto simp add: ring_simps) - apply (subst (1 3 5) fib_reduce_nat) - apply (auto simp add: ring_simps Suc_eq_plus1) -(* hmmm. Why doesn't "n + (1 + (1 + k))" simplify to "n + k + 2"? *) - apply (subgoal_tac "n + (k + 2) = n + (1 + (1 + k))") - apply (erule ssubst) back back - apply (erule ssubst) back - apply auto -done - -lemma fib_add'_nat: "fib (n + Suc k) = fib (Suc k) * fib (Suc n) + - fib k * fib n" - using fib_add_nat by (auto simp add: One_nat_def) - - -(* transfer from nats to ints *) -lemma fib_add_int [rule_format]: "(n::int) >= 0 \ k >= 0 \ - fib (n + k + 1) = fib (k + 1) * fib (n + 1) + - fib k * fib n " - - by (rule fib_add_nat [transferred]) - -lemma fib_neq_0_nat: "(n::nat) > 0 \ fib n ~= 0" - apply (induct n rule: fib_induct_nat) - apply (auto simp add: fib_plus_2_nat) -done - -lemma fib_gr_0_nat: "(n::nat) > 0 \ fib n > 0" - by (frule fib_neq_0_nat, simp) - -lemma fib_gr_0_int: "(n::int) > 0 \ fib n > 0" - unfolding fib_int_def by (simp add: fib_gr_0_nat) - -text {* - \medskip Concrete Mathematics, page 278: Cassini's identity. The proof is - much easier using integers, not natural numbers! -*} - -lemma fib_Cassini_aux_int: "fib (int n + 2) * fib (int n) - - (fib (int n + 1))^2 = (-1)^(n + 1)" - apply (induct n) - apply (auto simp add: ring_simps power2_eq_square fib_reduce_int - power_add) -done - -lemma fib_Cassini_int: "n >= 0 \ fib (n + 2) * fib n - - (fib (n + 1))^2 = (-1)^(nat n + 1)" - by (insert fib_Cassini_aux_int [of "nat n"], auto) - -(* -lemma fib_Cassini'_int: "n >= 0 \ fib (n + 2) * fib n = - (fib (n + 1))^2 + (-1)^(nat n + 1)" - by (frule fib_Cassini_int, simp) -*) - -lemma fib_Cassini'_int: "n >= 0 \ fib ((n::int) + 2) * fib n = - (if even n then tsub ((fib (n + 1))^2) 1 - else (fib (n + 1))^2 + 1)" - apply (frule fib_Cassini_int, auto simp add: pos_int_even_equiv_nat_even) - apply (subst tsub_eq) - apply (insert fib_gr_0_int [of "n + 1"], force) - apply auto -done - -lemma fib_Cassini_nat: "fib ((n::nat) + 2) * fib n = - (if even n then (fib (n + 1))^2 - 1 - else (fib (n + 1))^2 + 1)" - - by (rule fib_Cassini'_int [transferred, of n], auto) - - -text {* \medskip Toward Law 6.111 of Concrete Mathematics *} - -lemma coprime_fib_plus_1_nat: "coprime (fib (n::nat)) (fib (n + 1))" - apply (induct n rule: fib_induct_nat) - apply auto - apply (subst (2) fib_reduce_nat) - apply (auto simp add: Suc_eq_plus1) (* again, natdiff_cancel *) - apply (subst add_commute, auto) - apply (subst gcd_commute_nat, auto simp add: ring_simps) -done - -lemma coprime_fib_Suc_nat: "coprime (fib n) (fib (Suc n))" - using coprime_fib_plus_1_nat by (simp add: One_nat_def) - -lemma coprime_fib_plus_1_int: - "n >= 0 \ coprime (fib (n::int)) (fib (n + 1))" - by (erule coprime_fib_plus_1_nat [transferred]) - -lemma gcd_fib_add_nat: "gcd (fib (m::nat)) (fib (n + m)) = gcd (fib m) (fib n)" - apply (simp add: gcd_commute_nat [of "fib m"]) - apply (rule cases_nat [of _ m]) - apply simp - apply (subst add_assoc [symmetric]) - apply (simp add: fib_add_nat) - apply (subst gcd_commute_nat) - apply (subst mult_commute) - apply (subst gcd_add_mult_nat) - apply (subst gcd_commute_nat) - apply (rule gcd_mult_cancel_nat) - apply (rule coprime_fib_plus_1_nat) -done - -lemma gcd_fib_add_int [rule_format]: "m >= 0 \ n >= 0 \ - gcd (fib (m::int)) (fib (n + m)) = gcd (fib m) (fib n)" - by (erule gcd_fib_add_nat [transferred]) - -lemma gcd_fib_diff_nat: "(m::nat) \ n \ - gcd (fib m) (fib (n - m)) = gcd (fib m) (fib n)" - by (simp add: gcd_fib_add_nat [symmetric, of _ "n-m"]) - -lemma gcd_fib_diff_int: "0 <= (m::int) \ m \ n \ - gcd (fib m) (fib (n - m)) = gcd (fib m) (fib n)" - by (simp add: gcd_fib_add_int [symmetric, of _ "n-m"]) - -lemma gcd_fib_mod_nat: "0 < (m::nat) \ - 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 \ 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 "\ = gcd (fib m) (fib (n - m))" - by (simp add: less.hyps diff pos_m) - also have "\ = gcd (fib m) (fib n)" by (simp add: gcd_fib_diff_nat 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 gcd_fib_mod_int: - assumes "0 < (m::int)" and "0 <= n" - shows "gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib n)" - - apply (rule gcd_fib_mod_nat [transferred]) - using prems apply auto -done - -lemma fib_gcd_nat: "fib (gcd (m::nat) n) = gcd (fib m) (fib n)" - -- {* Law 6.111 *} - apply (induct m n rule: gcd_nat_induct) - apply (simp_all add: gcd_non_0_nat gcd_commute_nat gcd_fib_mod_nat) -done - -lemma fib_gcd_int: "m >= 0 \ n >= 0 \ - fib (gcd (m::int) n) = gcd (fib m) (fib n)" - by (erule fib_gcd_nat [transferred]) - -lemma atMost_plus_one_nat: "{..(k::nat) + 1} = insert (k + 1) {..k}" - by auto - -theorem fib_mult_eq_setsum_nat: - "fib ((n::nat) + 1) * fib n = (\k \ {..n}. fib k * fib k)" - apply (induct n) - apply (auto simp add: atMost_plus_one_nat fib_plus_2_nat ring_simps) -done - -theorem fib_mult_eq_setsum'_nat: - "fib (Suc n) * fib n = (\k \ {..n}. fib k * fib k)" - using fib_mult_eq_setsum_nat by (simp add: One_nat_def) - -theorem fib_mult_eq_setsum_int [rule_format]: - "n >= 0 \ fib ((n::int) + 1) * fib n = (\k \ {0..n}. fib k * fib k)" - by (erule fib_mult_eq_setsum_nat [transferred]) - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NewNumberTheory/MiscAlgebra.thy --- a/src/HOL/NewNumberTheory/MiscAlgebra.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,355 +0,0 @@ -(* Title: MiscAlgebra.thy - Author: Jeremy Avigad - -These are things that can be added to the Algebra library. -*) - -theory MiscAlgebra -imports - "~~/src/HOL/Algebra/Ring" - "~~/src/HOL/Algebra/FiniteProduct" -begin; - -(* finiteness stuff *) - -lemma bounded_set1_int [intro]: "finite {(x::int). a < x & x < b & P x}" - apply (subgoal_tac "{x. a < x & x < b & P x} <= {a<.. 'a monoid" - "units_of G == (| carrier = Units G, - Group.monoid.mult = Group.monoid.mult G, - one = one G |)"; - -(* - -lemma (in monoid) Units_mult_closed [intro]: - "x : Units G ==> y : Units G ==> x \ y : Units G" - apply (unfold Units_def) - apply (clarsimp) - apply (rule_tac x = "xaa \ xa" in bexI) - apply auto - apply (subst m_assoc) - apply auto - apply (subst (2) m_assoc [symmetric]) - apply auto - apply (subst m_assoc) - apply auto - apply (subst (2) m_assoc [symmetric]) - apply auto -done - -*) - -lemma (in monoid) units_group: "group(units_of G)" - apply (unfold units_of_def) - apply (rule groupI) - apply auto - apply (subst m_assoc) - apply auto - apply (rule_tac x = "inv x" in bexI) - apply auto -done - -lemma (in comm_monoid) units_comm_group: "comm_group(units_of G)" - apply (rule group.group_comm_groupI) - apply (rule units_group) - apply (insert prems) - apply (unfold units_of_def Units_def comm_monoid_def comm_monoid_axioms_def) - apply auto; -done; - -lemma units_of_carrier: "carrier (units_of G) = Units G" - by (unfold units_of_def, auto) - -lemma units_of_mult: "mult(units_of G) = mult G" - by (unfold units_of_def, auto) - -lemma units_of_one: "one(units_of G) = one G" - by (unfold units_of_def, auto) - -lemma (in monoid) units_of_inv: "x : Units G ==> - m_inv (units_of G) x = m_inv G x" - apply (rule sym) - apply (subst m_inv_def) - apply (rule the1_equality) - apply (rule ex_ex1I) - apply (subst (asm) Units_def) - apply auto - apply (erule inv_unique) - apply auto - apply (rule Units_closed) - apply (simp_all only: units_of_carrier [symmetric]) - apply (insert units_group) - apply auto - apply (subst units_of_mult [symmetric]) - apply (subst units_of_one [symmetric]) - apply (erule group.r_inv, assumption) - apply (subst units_of_mult [symmetric]) - apply (subst units_of_one [symmetric]) - apply (erule group.l_inv, assumption) -done - -lemma (in group) inj_on_const_mult: "a: (carrier G) ==> - inj_on (%x. a \ x) (carrier G)" - by (unfold inj_on_def, auto) - -lemma (in group) surj_const_mult: "a : (carrier G) ==> - (%x. a \ x) ` (carrier G) = (carrier G)" - apply (auto simp add: image_def) - apply (rule_tac x = "(m_inv G a) \ x" in bexI) - apply auto -(* auto should get this. I suppose we need "comm_monoid_simprules" - for mult_ac rewriting. *) - apply (subst m_assoc [symmetric]) - apply auto -done - -lemma (in group) l_cancel_one [simp]: "x : carrier G \ a : carrier G \ - (x \ a = x) = (a = one G)" - apply auto - apply (subst l_cancel [symmetric]) - prefer 4 - apply (erule ssubst) - apply auto -done - -lemma (in group) r_cancel_one [simp]: "x : carrier G \ a : carrier G \ - (a \ x = x) = (a = one G)" - apply auto - apply (subst r_cancel [symmetric]) - prefer 4 - apply (erule ssubst) - apply auto -done - -(* Is there a better way to do this? *) - -lemma (in group) l_cancel_one' [simp]: "x : carrier G \ a : carrier G \ - (x = x \ a) = (a = one G)" - by (subst eq_commute, simp) - -lemma (in group) r_cancel_one' [simp]: "x : carrier G \ a : carrier G \ - (x = a \ x) = (a = one G)" - by (subst eq_commute, simp) - -(* This should be generalized to arbitrary groups, not just commutative - ones, using Lagrange's theorem. *) - -lemma (in comm_group) power_order_eq_one: - assumes fin [simp]: "finite (carrier G)" - and a [simp]: "a : carrier G" - shows "a (^) card(carrier G) = one G" -proof - - have "(\x:carrier G. x) = (\x:carrier G. a \ x)" - by (subst (2) finprod_reindex [symmetric], - auto simp add: Pi_def inj_on_const_mult surj_const_mult) - also have "\ = (\x:carrier G. a) \ (\x:carrier G. x)" - by (auto simp add: finprod_multf Pi_def) - also have "(\x:carrier G. a) = a (^) card(carrier G)" - by (auto simp add: finprod_const) - finally show ?thesis -(* uses the preceeding lemma *) - by auto -qed - - -(* Miscellaneous *) - -lemma (in cring) field_intro2: "\\<^bsub>R\<^esub> ~= \\<^bsub>R\<^esub> \ ALL x : carrier R - {\\<^bsub>R\<^esub>}. - x : Units R \ field R" - apply (unfold_locales) - apply (insert prems, auto) - apply (rule trans) - apply (subgoal_tac "a = (a \ b) \ inv b") - apply assumption - apply (subst m_assoc) - apply (auto simp add: Units_r_inv) - apply (unfold Units_def) - apply auto -done - -lemma (in monoid) inv_char: "x : carrier G \ y : carrier G \ - x \ y = \ \ y \ x = \ \ inv x = y" - apply (subgoal_tac "x : Units G") - apply (subgoal_tac "y = inv x \ \") - apply simp - apply (erule subst) - apply (subst m_assoc [symmetric]) - apply auto - apply (unfold Units_def) - apply auto -done - -lemma (in comm_monoid) comm_inv_char: "x : carrier G \ y : carrier G \ - x \ y = \ \ inv x = y" - apply (rule inv_char) - apply auto - apply (subst m_comm, auto) -done - -lemma (in ring) inv_neg_one [simp]: "inv (\ \) = \ \" - apply (rule inv_char) - apply (auto simp add: l_minus r_minus) -done - -lemma (in monoid) inv_eq_imp_eq: "x : Units G \ y : Units G \ - inv x = inv y \ x = y" - apply (subgoal_tac "inv(inv x) = inv(inv y)") - apply (subst (asm) Units_inv_inv)+ - apply auto -done - -lemma (in ring) Units_minus_one_closed [intro]: "\ \ : Units R" - apply (unfold Units_def) - apply auto - apply (rule_tac x = "\ \" in bexI) - apply auto - apply (simp add: l_minus r_minus) -done - -lemma (in monoid) inv_one [simp]: "inv \ = \" - apply (rule inv_char) - apply auto -done - -lemma (in ring) inv_eq_neg_one_eq: "x : Units R \ (inv x = \ \) = (x = \ \)" - apply auto - apply (subst Units_inv_inv [symmetric]) - apply auto -done - -lemma (in monoid) inv_eq_one_eq: "x : Units G \ (inv x = \) = (x = \)" - apply auto - apply (subst Units_inv_inv [symmetric]) - apply auto -done - - -(* This goes in FiniteProduct *) - -lemma (in comm_monoid) finprod_UN_disjoint: - "finite I \ (ALL i:I. finite (A i)) \ (ALL i:I. ALL j:I. i ~= j \ - (A i) Int (A j) = {}) \ - (ALL i:I. ALL x: (A i). g x : carrier G) \ - finprod G g (UNION I A) = finprod G (%i. finprod G g (A i)) I" - apply (induct set: finite) - apply force - apply clarsimp - apply (subst finprod_Un_disjoint) - apply blast - apply (erule finite_UN_I) - apply blast - apply (fastsimp) - apply (auto intro!: funcsetI finprod_closed) -done - -lemma (in comm_monoid) finprod_Union_disjoint: - "[| finite C; (ALL A:C. finite A & (ALL x:A. f x : carrier G)); - (ALL A:C. ALL B:C. A ~= B --> A Int B = {}) |] - ==> finprod G f (Union C) = finprod G (finprod G f) C" - apply (frule finprod_UN_disjoint [of C id f]) - apply (unfold Union_def id_def, auto) -done - -lemma (in comm_monoid) finprod_one [rule_format]: - "finite A \ (ALL x:A. f x = \) \ - finprod G f A = \" -by (induct set: finite) auto - - -(* need better simplification rules for rings *) -(* the next one holds more generally for abelian groups *) - -lemma (in cring) sum_zero_eq_neg: - "x : carrier R \ y : carrier R \ x \ y = \ \ x = \ y" - apply (subgoal_tac "\ y = \ \ \ y") - apply (erule ssubst)back - apply (erule subst) - apply (simp add: ring_simprules)+ -done - -(* there's a name conflict -- maybe "domain" should be - "integral_domain" *) - -lemma (in Ring.domain) square_eq_one: - fixes x - assumes [simp]: "x : carrier R" and - "x \ x = \" - shows "x = \ | x = \\" -proof - - have "(x \ \) \ (x \ \ \) = x \ x \ \ \" - by (simp add: ring_simprules) - also with `x \ x = \` have "\ = \" - by (simp add: ring_simprules) - finally have "(x \ \) \ (x \ \ \) = \" . - hence "(x \ \) = \ | (x \ \ \) = \" - by (intro integral, auto) - thus ?thesis - apply auto - apply (erule notE) - apply (rule sum_zero_eq_neg) - apply auto - apply (subgoal_tac "x = \ (\ \)") - apply (simp add: ring_simprules) - apply (rule sum_zero_eq_neg) - apply auto - done -qed - -lemma (in Ring.domain) inv_eq_self: "x : Units R \ - x = inv x \ x = \ | x = \ \" - apply (rule square_eq_one) - apply auto - apply (erule ssubst)back - apply (erule Units_r_inv) -done - - -(* - The following translates theorems about groups to the facts about - the units of a ring. (The list should be expanded as more things are - needed.) -*) - -lemma (in ring) finite_ring_finite_units [intro]: "finite (carrier R) \ - finite (Units R)" - by (rule finite_subset, auto) - -(* this belongs with MiscAlgebra.thy *) -lemma (in monoid) units_of_pow: - "x : Units G \ x (^)\<^bsub>units_of G\<^esub> (n::nat) = x (^)\<^bsub>G\<^esub> n" - apply (induct n) - apply (auto simp add: units_group group.is_monoid - monoid.nat_pow_0 monoid.nat_pow_Suc units_of_one units_of_mult - One_nat_def) -done - -lemma (in cring) units_power_order_eq_one: "finite (Units R) \ a : Units R - \ a (^) card(Units R) = \" - apply (subst units_of_carrier [symmetric]) - apply (subst units_of_one [symmetric]) - apply (subst units_of_pow [symmetric]) - apply assumption - apply (rule comm_group.power_order_eq_one) - apply (rule units_comm_group) - apply (unfold units_of_def, auto) -done - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NewNumberTheory/ROOT.ML --- a/src/HOL/NewNumberTheory/ROOT.ML Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -use_thys ["Fib","Residues"]; diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NewNumberTheory/Residues.thy --- a/src/HOL/NewNumberTheory/Residues.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,466 +0,0 @@ -(* Title: HOL/Library/Residues.thy - ID: - Author: Jeremy Avigad - - An algebraic treatment of residue rings, and resulting proofs of - Euler's theorem and Wilson's theorem. -*) - -header {* Residue rings *} - -theory Residues -imports - UniqueFactorization - Binomial - MiscAlgebra -begin - - -(* - - A locale for residue rings - -*) - -constdefs - residue_ring :: "int => int ring" - "residue_ring m == (| - carrier = {0..m - 1}, - mult = (%x y. (x * y) mod m), - one = 1, - zero = 0, - add = (%x y. (x + y) mod m) |)" - -locale residues = - fixes m :: int and R (structure) - assumes m_gt_one: "m > 1" - defines "R == residue_ring m" - -context residues begin - -lemma abelian_group: "abelian_group R" - apply (insert m_gt_one) - apply (rule abelian_groupI) - apply (unfold R_def residue_ring_def) - apply (auto simp add: mod_pos_pos_trivial mod_add_right_eq [symmetric] - add_ac) - apply (case_tac "x = 0") - apply force - apply (subgoal_tac "(x + (m - x)) mod m = 0") - apply (erule bexI) - apply auto -done - -lemma comm_monoid: "comm_monoid R" - apply (insert m_gt_one) - apply (unfold R_def residue_ring_def) - apply (rule comm_monoidI) - apply auto - apply (subgoal_tac "x * y mod m * z mod m = z * (x * y mod m) mod m") - apply (erule ssubst) - apply (subst zmod_zmult1_eq [symmetric])+ - apply (simp_all only: mult_ac) -done - -lemma cring: "cring R" - apply (rule cringI) - apply (rule abelian_group) - apply (rule comm_monoid) - apply (unfold R_def residue_ring_def, auto) - apply (subst mod_add_eq [symmetric]) - apply (subst mult_commute) - apply (subst zmod_zmult1_eq [symmetric]) - apply (simp add: ring_simps) -done - -end - -sublocale residues < cring - by (rule cring) - - -context residues begin - -(* These lemmas translate back and forth between internal and - external concepts *) - -lemma res_carrier_eq: "carrier R = {0..m - 1}" - by (unfold R_def residue_ring_def, auto) - -lemma res_add_eq: "x \ y = (x + y) mod m" - by (unfold R_def residue_ring_def, auto) - -lemma res_mult_eq: "x \ y = (x * y) mod m" - by (unfold R_def residue_ring_def, auto) - -lemma res_zero_eq: "\ = 0" - by (unfold R_def residue_ring_def, auto) - -lemma res_one_eq: "\ = 1" - by (unfold R_def residue_ring_def units_of_def residue_ring_def, auto) - -lemma res_units_eq: "Units R = { x. 0 < x & x < m & coprime x m}" - apply (insert m_gt_one) - apply (unfold Units_def R_def residue_ring_def) - apply auto - apply (subgoal_tac "x ~= 0") - apply auto - apply (rule invertible_coprime_int) - apply (subgoal_tac "x ~= 0") - apply auto - apply (subst (asm) coprime_iff_invertible'_int) - apply (rule m_gt_one) - apply (auto simp add: cong_int_def mult_commute) -done - -lemma res_neg_eq: "\ x = (- x) mod m" - apply (insert m_gt_one) - apply (unfold R_def a_inv_def m_inv_def residue_ring_def) - apply auto - apply (rule the_equality) - apply auto - apply (subst mod_add_right_eq [symmetric]) - apply auto - apply (subst mod_add_left_eq [symmetric]) - apply auto - apply (subgoal_tac "y mod m = - x mod m") - apply simp - apply (subst zmod_eq_dvd_iff) - apply auto -done - -lemma finite [iff]: "finite(carrier R)" - by (subst res_carrier_eq, auto) - -lemma finite_Units [iff]: "finite(Units R)" - by (subst res_units_eq, auto) - -(* The function a -> a mod m maps the integers to the - residue classes. The following lemmas show that this mapping - respects addition and multiplication on the integers. *) - -lemma mod_in_carrier [iff]: "a mod m : carrier R" - apply (unfold res_carrier_eq) - apply (insert m_gt_one, auto) -done - -lemma add_cong: "(x mod m) \ (y mod m) = (x + y) mod m" - by (unfold R_def residue_ring_def, auto, arith) - -lemma mult_cong: "(x mod m) \ (y mod m) = (x * y) mod m" - apply (unfold R_def residue_ring_def, auto) - apply (subst zmod_zmult1_eq [symmetric]) - apply (subst mult_commute) - apply (subst zmod_zmult1_eq [symmetric]) - apply (subst mult_commute) - apply auto -done - -lemma zero_cong: "\ = 0" - apply (unfold R_def residue_ring_def, auto) -done - -lemma one_cong: "\ = 1 mod m" - apply (insert m_gt_one) - apply (unfold R_def residue_ring_def, auto) -done - -(* revise algebra library to use 1? *) -lemma pow_cong: "(x mod m) (^) n = x^n mod m" - apply (insert m_gt_one) - apply (induct n) - apply (auto simp add: nat_pow_def one_cong One_nat_def) - apply (subst mult_commute) - apply (rule mult_cong) -done - -lemma neg_cong: "\ (x mod m) = (- x) mod m" - apply (rule sym) - apply (rule sum_zero_eq_neg) - apply auto - apply (subst add_cong) - apply (subst zero_cong) - apply auto -done - -lemma (in residues) prod_cong: - "finite A \ (\ i:A. (f i) mod m) = (PROD i:A. f i) mod m" - apply (induct set: finite) - apply (auto simp: one_cong mult_cong) -done - -lemma (in residues) sum_cong: - "finite A \ (\ i:A. (f i) mod m) = (SUM i: A. f i) mod m" - apply (induct set: finite) - apply (auto simp: zero_cong add_cong) -done - -lemma mod_in_res_units [simp]: "1 < m \ coprime a m \ - a mod m : Units R" - apply (subst res_units_eq, auto) - apply (insert pos_mod_sign [of m a]) - apply (subgoal_tac "a mod m ~= 0") - apply arith - apply auto - apply (subst (asm) gcd_red_int) - apply (subst gcd_commute_int, assumption) -done - -lemma res_eq_to_cong: "((a mod m) = (b mod m)) = [a = b] (mod (m::int))" - unfolding cong_int_def by auto - -(* Simplifying with these will translate a ring equation in R to a - congruence. *) - -lemmas res_to_cong_simps = add_cong mult_cong pow_cong one_cong - prod_cong sum_cong neg_cong res_eq_to_cong - -(* Other useful facts about the residue ring *) - -lemma one_eq_neg_one: "\ = \ \ \ m = 2" - apply (simp add: res_one_eq res_neg_eq) - apply (insert m_gt_one) - apply (subgoal_tac "~(m > 2)") - apply arith - apply (rule notI) - apply (subgoal_tac "-1 mod m = m - 1") - apply force - apply (subst mod_add_self2 [symmetric]) - apply (subst mod_pos_pos_trivial) - apply auto -done - -end - - -(* prime residues *) - -locale residues_prime = - fixes p :: int and R (structure) - assumes p_prime [intro]: "prime p" - defines "R == residue_ring p" - -sublocale residues_prime < residues p - apply (unfold R_def residues_def) - using p_prime apply auto -done - -context residues_prime begin - -lemma is_field: "field R" - apply (rule cring.field_intro2) - apply (rule cring) - apply (auto simp add: res_carrier_eq res_one_eq res_zero_eq - res_units_eq) - apply (rule classical) - apply (erule notE) - apply (subst gcd_commute_int) - apply (rule prime_imp_coprime_int) - apply (rule p_prime) - apply (rule notI) - apply (frule zdvd_imp_le) - apply auto -done - -lemma res_prime_units_eq: "Units R = {1..p - 1}" - apply (subst res_units_eq) - apply auto - apply (subst gcd_commute_int) - apply (rule prime_imp_coprime_int) - apply (rule p_prime) - apply (rule zdvd_not_zless) - apply auto -done - -end - -sublocale residues_prime < field - by (rule is_field) - - -(* - Test cases: Euler's theorem and Wilson's theorem. -*) - - -subsection{* Euler's theorem *} - -(* the definition of the phi function *) - -constdefs - phi :: "int => nat" - "phi m == card({ x. 0 < x & x < m & gcd x m = 1})" - -lemma phi_zero [simp]: "phi 0 = 0" - apply (subst phi_def) -(* Auto hangs here. Once again, where is the simplification rule - 1 == Suc 0 coming from? *) - apply (auto simp add: card_eq_0_iff) -(* Add card_eq_0_iff as a simp rule? delete card_empty_imp? *) -done - -lemma phi_one [simp]: "phi 1 = 0" - apply (auto simp add: phi_def card_eq_0_iff) -done - -lemma (in residues) phi_eq: "phi m = card(Units R)" - by (simp add: phi_def res_units_eq) - -lemma (in residues) euler_theorem1: - assumes a: "gcd a m = 1" - shows "[a^phi m = 1] (mod m)" -proof - - from a m_gt_one have [simp]: "a mod m : Units R" - by (intro mod_in_res_units) - from phi_eq have "(a mod m) (^) (phi m) = (a mod m) (^) (card (Units R))" - by simp - also have "\ = \" - by (intro units_power_order_eq_one, auto) - finally show ?thesis - by (simp add: res_to_cong_simps) -qed - -(* In fact, there is a two line proof! - -lemma (in residues) euler_theorem1: - assumes a: "gcd a m = 1" - shows "[a^phi m = 1] (mod m)" -proof - - have "(a mod m) (^) (phi m) = \" - by (simp add: phi_eq units_power_order_eq_one a m_gt_one) - thus ?thesis - by (simp add: res_to_cong_simps) -qed - -*) - -(* outside the locale, we can relax the restriction m > 1 *) - -lemma euler_theorem: - assumes "m >= 0" and "gcd a m = 1" - shows "[a^phi m = 1] (mod m)" -proof (cases) - assume "m = 0 | m = 1" - thus ?thesis by auto -next - assume "~(m = 0 | m = 1)" - with prems show ?thesis - by (intro residues.euler_theorem1, unfold residues_def, auto) -qed - -lemma (in residues_prime) phi_prime: "phi p = (nat p - 1)" - apply (subst phi_eq) - apply (subst res_prime_units_eq) - apply auto -done - -lemma phi_prime: "prime p \ phi p = (nat p - 1)" - apply (rule residues_prime.phi_prime) - apply (erule residues_prime.intro) -done - -lemma fermat_theorem: - assumes "prime p" and "~ (p dvd a)" - shows "[a^(nat p - 1) = 1] (mod p)" -proof - - from prems have "[a^phi p = 1] (mod p)" - apply (intro euler_theorem) - (* auto should get this next part. matching across - substitutions is needed. *) - apply (frule prime_gt_1_int, arith) - apply (subst gcd_commute_int, erule prime_imp_coprime_int, assumption) - done - also have "phi p = nat p - 1" - by (rule phi_prime, rule prems) - finally show ?thesis . -qed - - -subsection {* Wilson's theorem *} - -lemma (in field) inv_pair_lemma: "x : Units R \ y : Units R \ - {x, inv x} ~= {y, inv y} \ {x, inv x} Int {y, inv y} = {}" - apply auto - apply (erule notE) - apply (erule inv_eq_imp_eq) - apply auto - apply (erule notE) - apply (erule inv_eq_imp_eq) - apply auto -done - -lemma (in residues_prime) wilson_theorem1: - assumes a: "p > 2" - shows "[fact (p - 1) = - 1] (mod p)" -proof - - let ?InversePairs = "{ {x, inv x} | x. x : Units R - {\, \ \}}" - have UR: "Units R = {\, \ \} Un (Union ?InversePairs)" - by auto - have "(\i: Units R. i) = - (\i: {\, \ \}. i) \ (\i: Union ?InversePairs. i)" - apply (subst UR) - apply (subst finprod_Un_disjoint) - apply (auto intro:funcsetI) - apply (drule sym, subst (asm) inv_eq_one_eq) - apply auto - apply (drule sym, subst (asm) inv_eq_neg_one_eq) - apply auto - done - also have "(\i: {\, \ \}. i) = \ \" - apply (subst finprod_insert) - apply auto - apply (frule one_eq_neg_one) - apply (insert a, force) - done - also have "(\i:(Union ?InversePairs). i) = - (\ A: ?InversePairs. (\ y:A. y))" - apply (subst finprod_Union_disjoint) - apply force - apply force - apply clarify - apply (rule inv_pair_lemma) - apply auto - done - also have "\ = \" - apply (rule finprod_one) - apply auto - apply (subst finprod_insert) - apply auto - apply (frule inv_eq_self) - apply (auto) - done - finally have "(\i: Units R. i) = \ \" - by simp - also have "(\i: Units R. i) = (\i: Units R. i mod p)" - apply (rule finprod_cong') - apply (auto) - apply (subst (asm) res_prime_units_eq) - apply auto - done - also have "\ = (PROD i: Units R. i) mod p" - apply (rule prod_cong) - apply auto - done - also have "\ = fact (p - 1) mod p" - apply (subst fact_altdef_int) - apply (insert prems, force) - apply (subst res_prime_units_eq, rule refl) - done - finally have "fact (p - 1) mod p = \ \". - thus ?thesis - by (simp add: res_to_cong_simps) -qed - -lemma wilson_theorem: "prime (p::int) \ [fact (p - 1) = - 1] (mod p)" - apply (frule prime_gt_1_int) - apply (case_tac "p = 2") - apply (subst fact_altdef_int, simp) - apply (subst cong_int_def) - apply simp - apply (rule residues_prime.wilson_theorem1) - apply (rule residues_prime.intro) - apply auto -done - - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NewNumberTheory/UniqueFactorization.thy --- a/src/HOL/NewNumberTheory/UniqueFactorization.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,967 +0,0 @@ -(* Title: UniqueFactorization.thy - ID: - Author: Jeremy Avigad - - - Unique factorization for the natural numbers and the integers. - - Note: there were previous Isabelle formalizations of unique - factorization due to Thomas Marthedal Rasmussen, and, building on - that, by Jeremy Avigad and David Gray. -*) - -header {* UniqueFactorization *} - -theory UniqueFactorization -imports Cong Multiset -begin - -(* inherited from Multiset *) -declare One_nat_def [simp del] - -(* As a simp or intro rule, - - prime p \ p > 0 - - wreaks havoc here. When the premise includes ALL x :# M. prime x, it - leads to the backchaining - - x > 0 - prime x - x :# M which is, unfortunately, - count M x > 0 -*) - - -(* useful facts *) - -lemma setsum_Un2: "finite (A Un B) \ - setsum f (A Un B) = setsum f (A - B) + setsum f (B - A) + - setsum f (A Int B)" - apply (subgoal_tac "A Un B = (A - B) Un (B - A) Un (A Int B)") - apply (erule ssubst) - apply (subst setsum_Un_disjoint) - apply auto - apply (subst setsum_Un_disjoint) - apply auto -done - -lemma setprod_Un2: "finite (A Un B) \ - setprod f (A Un B) = setprod f (A - B) * setprod f (B - A) * - setprod f (A Int B)" - apply (subgoal_tac "A Un B = (A - B) Un (B - A) Un (A Int B)") - apply (erule ssubst) - apply (subst setprod_Un_disjoint) - apply auto - apply (subst setprod_Un_disjoint) - apply auto -done - -(* Should this go in Multiset.thy? *) -(* TN: No longer an intro-rule; needed only once and might get in the way *) -lemma multiset_eqI: "[| !!x. count M x = count N x |] ==> M = N" - by (subst multiset_eq_conv_count_eq, blast) - -(* Here is a version of set product for multisets. Is it worth moving - to multiset.thy? If so, one should similarly define msetsum for abelian - semirings, using of_nat. Also, is it worth developing bounded quantifiers - "ALL i :# M. P i"? -*) - -constdefs - msetprod :: "('a => ('b::{power,comm_monoid_mult})) => 'a multiset => 'b" - "msetprod f M == setprod (%x. (f x)^(count M x)) (set_of M)" - -syntax - "_msetprod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult" - ("(3PROD _:#_. _)" [0, 51, 10] 10) - -translations - "PROD i :# A. b" == "msetprod (%i. b) A" - -lemma msetprod_Un: "msetprod f (A+B) = msetprod f A * msetprod f B" - apply (simp add: msetprod_def power_add) - apply (subst setprod_Un2) - apply auto - apply (subgoal_tac - "(PROD x:set_of A - set_of B. f x ^ count A x * f x ^ count B x) = - (PROD x:set_of A - set_of B. f x ^ count A x)") - apply (erule ssubst) - apply (subgoal_tac - "(PROD x:set_of B - set_of A. f x ^ count A x * f x ^ count B x) = - (PROD x:set_of B - set_of A. f x ^ count B x)") - apply (erule ssubst) - apply (subgoal_tac "(PROD x:set_of A. f x ^ count A x) = - (PROD x:set_of A - set_of B. f x ^ count A x) * - (PROD x:set_of A Int set_of B. f x ^ count A x)") - apply (erule ssubst) - apply (subgoal_tac "(PROD x:set_of B. f x ^ count B x) = - (PROD x:set_of B - set_of A. f x ^ count B x) * - (PROD x:set_of A Int set_of B. f x ^ count B x)") - apply (erule ssubst) - apply (subst setprod_timesf) - apply (force simp add: mult_ac) - apply (subst setprod_Un_disjoint [symmetric]) - apply (auto intro: setprod_cong) - apply (subst setprod_Un_disjoint [symmetric]) - apply (auto intro: setprod_cong) -done - - -subsection {* unique factorization: multiset version *} - -lemma multiset_prime_factorization_exists [rule_format]: "n > 0 --> - (EX M. (ALL (p::nat) : set_of M. prime p) & n = (PROD i :# M. i))" -proof (rule nat_less_induct, clarify) - fix n :: nat - assume ih: "ALL m < n. 0 < m --> (EX M. (ALL p : set_of M. prime p) & m = - (PROD i :# M. i))" - assume "(n::nat) > 0" - then have "n = 1 | (n > 1 & prime n) | (n > 1 & ~ prime n)" - by arith - moreover - { - assume "n = 1" - then have "(ALL p : set_of {#}. prime p) & n = (PROD i :# {#}. i)" - by (auto simp add: msetprod_def) - } - moreover - { - assume "n > 1" and "prime n" - then have "(ALL p : set_of {# n #}. prime p) & n = (PROD i :# {# n #}. i)" - by (auto simp add: msetprod_def) - } - moreover - { - assume "n > 1" and "~ prime n" - from prems not_prime_eq_prod_nat - obtain m k where "n = m * k & 1 < m & m < n & 1 < k & k < n" - by blast - with ih obtain Q R where "(ALL p : set_of Q. prime p) & m = (PROD i:#Q. i)" - and "(ALL p: set_of R. prime p) & k = (PROD i:#R. i)" - by blast - hence "(ALL p: set_of (Q + R). prime p) & n = (PROD i :# Q + R. i)" - by (auto simp add: prems msetprod_Un set_of_union) - then have "EX M. (ALL p : set_of M. prime p) & n = (PROD i :# M. i)".. - } - ultimately show "EX M. (ALL p : set_of M. prime p) & n = (PROD i::nat:#M. i)" - by blast -qed - -lemma multiset_prime_factorization_unique_aux: - fixes a :: nat - assumes "(ALL p : set_of M. prime p)" and - "(ALL p : set_of N. prime p)" and - "(PROD i :# M. i) dvd (PROD i:# N. i)" - shows - "count M a <= count N a" -proof cases - assume "a : set_of M" - with prems have a: "prime a" - by auto - with prems have "a ^ count M a dvd (PROD i :# M. i)" - by (auto intro: dvd_setprod simp add: msetprod_def) - also have "... dvd (PROD i :# N. i)" - by (rule prems) - also have "... = (PROD i : (set_of N). i ^ (count N i))" - by (simp add: msetprod_def) - also have "... = - a^(count N a) * (PROD i : (set_of N - {a}). i ^ (count N i))" - proof (cases) - assume "a : set_of N" - hence b: "set_of N = {a} Un (set_of N - {a})" - by auto - thus ?thesis - by (subst (1) b, subst setprod_Un_disjoint, auto) - next - assume "a ~: set_of N" - thus ?thesis - by auto - qed - finally have "a ^ count M a dvd - a^(count N a) * (PROD i : (set_of N - {a}). i ^ (count N i))". - moreover have "coprime (a ^ count M a) - (PROD i : (set_of N - {a}). i ^ (count N i))" - apply (subst gcd_commute_nat) - apply (rule setprod_coprime_nat) - apply (rule primes_imp_powers_coprime_nat) - apply (insert prems, auto) - done - ultimately have "a ^ count M a dvd a^(count N a)" - by (elim coprime_dvd_mult_nat) - with a show ?thesis - by (intro power_dvd_imp_le, auto) -next - assume "a ~: set_of M" - thus ?thesis by auto -qed - -lemma multiset_prime_factorization_unique: - assumes "(ALL (p::nat) : set_of M. prime p)" and - "(ALL p : set_of N. prime p)" and - "(PROD i :# M. i) = (PROD i:# N. i)" - shows - "M = N" -proof - - { - fix a - from prems have "count M a <= count N a" - by (intro multiset_prime_factorization_unique_aux, auto) - moreover from prems have "count N a <= count M a" - by (intro multiset_prime_factorization_unique_aux, auto) - ultimately have "count M a = count N a" - by auto - } - thus ?thesis by (simp add:multiset_eq_conv_count_eq) -qed - -constdefs - multiset_prime_factorization :: "nat => nat multiset" - "multiset_prime_factorization n == - if n > 0 then (THE M. ((ALL p : set_of M. prime p) & - n = (PROD i :# M. i))) - else {#}" - -lemma multiset_prime_factorization: "n > 0 ==> - (ALL p : set_of (multiset_prime_factorization n). prime p) & - n = (PROD i :# (multiset_prime_factorization n). i)" - apply (unfold multiset_prime_factorization_def) - apply clarsimp - apply (frule multiset_prime_factorization_exists) - apply clarify - apply (rule theI) - apply (insert multiset_prime_factorization_unique, blast)+ -done - - -subsection {* Prime factors and multiplicity for nats and ints *} - -class unique_factorization = - -fixes - multiplicity :: "'a \ 'a \ nat" and - prime_factors :: "'a \ 'a set" - -(* definitions for the natural numbers *) - -instantiation nat :: unique_factorization - -begin - -definition - multiplicity_nat :: "nat \ nat \ nat" -where - "multiplicity_nat p n = count (multiset_prime_factorization n) p" - -definition - prime_factors_nat :: "nat \ nat set" -where - "prime_factors_nat n = set_of (multiset_prime_factorization n)" - -instance proof qed - -end - -(* definitions for the integers *) - -instantiation int :: unique_factorization - -begin - -definition - multiplicity_int :: "int \ int \ nat" -where - "multiplicity_int p n = multiplicity (nat p) (nat n)" - -definition - prime_factors_int :: "int \ int set" -where - "prime_factors_int n = int ` (prime_factors (nat n))" - -instance proof qed - -end - - -subsection {* Set up transfer *} - -lemma transfer_nat_int_prime_factors: - "prime_factors (nat n) = nat ` prime_factors n" - unfolding prime_factors_int_def apply auto - by (subst transfer_int_nat_set_return_embed, assumption) - -lemma transfer_nat_int_prime_factors_closure: "n >= 0 \ - nat_set (prime_factors n)" - by (auto simp add: nat_set_def prime_factors_int_def) - -lemma transfer_nat_int_multiplicity: "p >= 0 \ n >= 0 \ - multiplicity (nat p) (nat n) = multiplicity p n" - by (auto simp add: multiplicity_int_def) - -declare TransferMorphism_nat_int[transfer add return: - transfer_nat_int_prime_factors transfer_nat_int_prime_factors_closure - transfer_nat_int_multiplicity] - - -lemma transfer_int_nat_prime_factors: - "prime_factors (int n) = int ` prime_factors n" - unfolding prime_factors_int_def by auto - -lemma transfer_int_nat_prime_factors_closure: "is_nat n \ - nat_set (prime_factors n)" - by (simp only: transfer_nat_int_prime_factors_closure is_nat_def) - -lemma transfer_int_nat_multiplicity: - "multiplicity (int p) (int n) = multiplicity p n" - by (auto simp add: multiplicity_int_def) - -declare TransferMorphism_int_nat[transfer add return: - transfer_int_nat_prime_factors transfer_int_nat_prime_factors_closure - transfer_int_nat_multiplicity] - - -subsection {* Properties of prime factors and multiplicity for nats and ints *} - -lemma prime_factors_ge_0_int [elim]: "p : prime_factors (n::int) \ p >= 0" - by (unfold prime_factors_int_def, auto) - -lemma prime_factors_prime_nat [intro]: "p : prime_factors (n::nat) \ prime p" - apply (case_tac "n = 0") - apply (simp add: prime_factors_nat_def multiset_prime_factorization_def) - apply (auto simp add: prime_factors_nat_def multiset_prime_factorization) -done - -lemma prime_factors_prime_int [intro]: - assumes "n >= 0" and "p : prime_factors (n::int)" - shows "prime p" - - apply (rule prime_factors_prime_nat [transferred, of n p]) - using prems apply auto -done - -lemma prime_factors_gt_0_nat [elim]: "p : prime_factors x \ p > (0::nat)" - by (frule prime_factors_prime_nat, auto) - -lemma prime_factors_gt_0_int [elim]: "x >= 0 \ p : prime_factors x \ - p > (0::int)" - by (frule (1) prime_factors_prime_int, auto) - -lemma prime_factors_finite_nat [iff]: "finite (prime_factors (n::nat))" - by (unfold prime_factors_nat_def, auto) - -lemma prime_factors_finite_int [iff]: "finite (prime_factors (n::int))" - by (unfold prime_factors_int_def, auto) - -lemma prime_factors_altdef_nat: "prime_factors (n::nat) = - {p. multiplicity p n > 0}" - by (force simp add: prime_factors_nat_def multiplicity_nat_def) - -lemma prime_factors_altdef_int: "prime_factors (n::int) = - {p. p >= 0 & multiplicity p n > 0}" - apply (unfold prime_factors_int_def multiplicity_int_def) - apply (subst prime_factors_altdef_nat) - apply (auto simp add: image_def) -done - -lemma prime_factorization_nat: "(n::nat) > 0 \ - n = (PROD p : prime_factors n. p^(multiplicity p n))" - by (frule multiset_prime_factorization, - simp add: prime_factors_nat_def multiplicity_nat_def msetprod_def) - -thm prime_factorization_nat [transferred] - -lemma prime_factorization_int: - assumes "(n::int) > 0" - shows "n = (PROD p : prime_factors n. p^(multiplicity p n))" - - apply (rule prime_factorization_nat [transferred, of n]) - using prems apply auto -done - -lemma neq_zero_eq_gt_zero_nat: "((x::nat) ~= 0) = (x > 0)" - by auto - -lemma prime_factorization_unique_nat: - "S = { (p::nat) . f p > 0} \ finite S \ (ALL p : S. prime p) \ - n = (PROD p : S. p^(f p)) \ - S = prime_factors n & (ALL p. f p = multiplicity p n)" - apply (subgoal_tac "multiset_prime_factorization n = Abs_multiset - f") - apply (unfold prime_factors_nat_def multiplicity_nat_def) - apply (simp add: set_of_def count_def Abs_multiset_inverse multiset_def) - apply (unfold multiset_prime_factorization_def) - apply (subgoal_tac "n > 0") - prefer 2 - apply force - apply (subst if_P, assumption) - apply (rule the1_equality) - apply (rule ex_ex1I) - apply (rule multiset_prime_factorization_exists, assumption) - apply (rule multiset_prime_factorization_unique) - apply force - apply force - apply force - unfolding set_of_def count_def msetprod_def - apply (subgoal_tac "f : multiset") - apply (auto simp only: Abs_multiset_inverse) - unfolding multiset_def apply force -done - -lemma prime_factors_characterization_nat: "S = {p. 0 < f (p::nat)} \ - finite S \ (ALL p:S. prime p) \ n = (PROD p:S. p ^ f p) \ - prime_factors n = S" - by (rule prime_factorization_unique_nat [THEN conjunct1, symmetric], - assumption+) - -lemma prime_factors_characterization'_nat: - "finite {p. 0 < f (p::nat)} \ - (ALL p. 0 < f p \ prime p) \ - prime_factors (PROD p | 0 < f p . p ^ f p) = {p. 0 < f p}" - apply (rule prime_factors_characterization_nat) - apply auto -done - -(* A minor glitch:*) - -thm prime_factors_characterization'_nat - [where f = "%x. f (int (x::nat))", - transferred direction: nat "op <= (0::int)", rule_format] - -(* - Transfer isn't smart enough to know that the "0 < f p" should - remain a comparison between nats. But the transfer still works. -*) - -lemma primes_characterization'_int [rule_format]: - "finite {p. p >= 0 & 0 < f (p::int)} \ - (ALL p. 0 < f p \ prime p) \ - prime_factors (PROD p | p >=0 & 0 < f p . p ^ f p) = - {p. p >= 0 & 0 < f p}" - - apply (insert prime_factors_characterization'_nat - [where f = "%x. f (int (x::nat))", - transferred direction: nat "op <= (0::int)"]) - apply auto -done - -lemma prime_factors_characterization_int: "S = {p. 0 < f (p::int)} \ - finite S \ (ALL p:S. prime p) \ n = (PROD p:S. p ^ f p) \ - prime_factors n = S" - apply simp - apply (subgoal_tac "{p. 0 < f p} = {p. 0 <= p & 0 < f p}") - apply (simp only:) - apply (subst primes_characterization'_int) - apply auto - apply (auto simp add: prime_ge_0_int) -done - -lemma multiplicity_characterization_nat: "S = {p. 0 < f (p::nat)} \ - finite S \ (ALL p:S. prime p) \ n = (PROD p:S. p ^ f p) \ - multiplicity p n = f p" - by (frule prime_factorization_unique_nat [THEN conjunct2, rule_format, - symmetric], auto) - -lemma multiplicity_characterization'_nat: "finite {p. 0 < f (p::nat)} \ - (ALL p. 0 < f p \ prime p) \ - multiplicity p (PROD p | 0 < f p . p ^ f p) = f p" - apply (rule impI)+ - apply (rule multiplicity_characterization_nat) - apply auto -done - -lemma multiplicity_characterization'_int [rule_format]: - "finite {p. p >= 0 & 0 < f (p::int)} \ - (ALL p. 0 < f p \ prime p) \ p >= 0 \ - multiplicity p (PROD p | p >= 0 & 0 < f p . p ^ f p) = f p" - - apply (insert multiplicity_characterization'_nat - [where f = "%x. f (int (x::nat))", - transferred direction: nat "op <= (0::int)", rule_format]) - apply auto -done - -lemma multiplicity_characterization_int: "S = {p. 0 < f (p::int)} \ - finite S \ (ALL p:S. prime p) \ n = (PROD p:S. p ^ f p) \ - p >= 0 \ multiplicity p n = f p" - apply simp - apply (subgoal_tac "{p. 0 < f p} = {p. 0 <= p & 0 < f p}") - apply (simp only:) - apply (subst multiplicity_characterization'_int) - apply auto - apply (auto simp add: prime_ge_0_int) -done - -lemma multiplicity_zero_nat [simp]: "multiplicity (p::nat) 0 = 0" - by (simp add: multiplicity_nat_def multiset_prime_factorization_def) - -lemma multiplicity_zero_int [simp]: "multiplicity (p::int) 0 = 0" - by (simp add: multiplicity_int_def) - -lemma multiplicity_one_nat [simp]: "multiplicity p (1::nat) = 0" - by (subst multiplicity_characterization_nat [where f = "%x. 0"], auto) - -lemma multiplicity_one_int [simp]: "multiplicity p (1::int) = 0" - by (simp add: multiplicity_int_def) - -lemma multiplicity_prime_nat [simp]: "prime (p::nat) \ multiplicity p p = 1" - apply (subst multiplicity_characterization_nat - [where f = "(%q. if q = p then 1 else 0)"]) - apply auto - apply (case_tac "x = p") - apply auto -done - -lemma multiplicity_prime_int [simp]: "prime (p::int) \ multiplicity p p = 1" - unfolding prime_int_def multiplicity_int_def by auto - -lemma multiplicity_prime_power_nat [simp]: "prime (p::nat) \ - multiplicity p (p^n) = n" - apply (case_tac "n = 0") - apply auto - apply (subst multiplicity_characterization_nat - [where f = "(%q. if q = p then n else 0)"]) - apply auto - apply (case_tac "x = p") - apply auto -done - -lemma multiplicity_prime_power_int [simp]: "prime (p::int) \ - multiplicity p (p^n) = n" - apply (frule prime_ge_0_int) - apply (auto simp add: prime_int_def multiplicity_int_def nat_power_eq) -done - -lemma multiplicity_nonprime_nat [simp]: "~ prime (p::nat) \ - multiplicity p n = 0" - apply (case_tac "n = 0") - apply auto - apply (frule multiset_prime_factorization) - apply (auto simp add: set_of_def multiplicity_nat_def) -done - -lemma multiplicity_nonprime_int [simp]: "~ prime (p::int) \ multiplicity p n = 0" - by (unfold multiplicity_int_def prime_int_def, auto) - -lemma multiplicity_not_factor_nat [simp]: - "p ~: prime_factors (n::nat) \ multiplicity p n = 0" - by (subst (asm) prime_factors_altdef_nat, auto) - -lemma multiplicity_not_factor_int [simp]: - "p >= 0 \ p ~: prime_factors (n::int) \ multiplicity p n = 0" - by (subst (asm) prime_factors_altdef_int, auto) - -lemma multiplicity_product_aux_nat: "(k::nat) > 0 \ l > 0 \ - (prime_factors k) Un (prime_factors l) = prime_factors (k * l) & - (ALL p. multiplicity p k + multiplicity p l = multiplicity p (k * l))" - apply (rule prime_factorization_unique_nat) - apply (simp only: prime_factors_altdef_nat) - apply auto - apply (subst power_add) - apply (subst setprod_timesf) - apply (rule arg_cong2)back back - apply (subgoal_tac "prime_factors k Un prime_factors l = prime_factors k Un - (prime_factors l - prime_factors k)") - apply (erule ssubst) - apply (subst setprod_Un_disjoint) - apply auto - apply (subgoal_tac "(\p\prime_factors l - prime_factors k. p ^ multiplicity p k) = - (\p\prime_factors l - prime_factors k. 1)") - apply (erule ssubst) - apply (simp add: setprod_1) - apply (erule prime_factorization_nat) - apply (rule setprod_cong, auto) - apply (subgoal_tac "prime_factors k Un prime_factors l = prime_factors l Un - (prime_factors k - prime_factors l)") - apply (erule ssubst) - apply (subst setprod_Un_disjoint) - apply auto - apply (subgoal_tac "(\p\prime_factors k - prime_factors l. p ^ multiplicity p l) = - (\p\prime_factors k - prime_factors l. 1)") - apply (erule ssubst) - apply (simp add: setprod_1) - apply (erule prime_factorization_nat) - apply (rule setprod_cong, auto) -done - -(* transfer doesn't have the same problem here with the right - choice of rules. *) - -lemma multiplicity_product_aux_int: - assumes "(k::int) > 0" and "l > 0" - shows - "(prime_factors k) Un (prime_factors l) = prime_factors (k * l) & - (ALL p >= 0. multiplicity p k + multiplicity p l = multiplicity p (k * l))" - - apply (rule multiplicity_product_aux_nat [transferred, of l k]) - using prems apply auto -done - -lemma prime_factors_product_nat: "(k::nat) > 0 \ l > 0 \ prime_factors (k * l) = - prime_factors k Un prime_factors l" - by (rule multiplicity_product_aux_nat [THEN conjunct1, symmetric]) - -lemma prime_factors_product_int: "(k::int) > 0 \ l > 0 \ prime_factors (k * l) = - prime_factors k Un prime_factors l" - by (rule multiplicity_product_aux_int [THEN conjunct1, symmetric]) - -lemma multiplicity_product_nat: "(k::nat) > 0 \ l > 0 \ multiplicity p (k * l) = - multiplicity p k + multiplicity p l" - by (rule multiplicity_product_aux_nat [THEN conjunct2, rule_format, - symmetric]) - -lemma multiplicity_product_int: "(k::int) > 0 \ l > 0 \ p >= 0 \ - multiplicity p (k * l) = multiplicity p k + multiplicity p l" - by (rule multiplicity_product_aux_int [THEN conjunct2, rule_format, - symmetric]) - -lemma multiplicity_setprod_nat: "finite S \ (ALL x : S. f x > 0) \ - multiplicity (p::nat) (PROD x : S. f x) = - (SUM x : S. multiplicity p (f x))" - apply (induct set: finite) - apply auto - apply (subst multiplicity_product_nat) - apply auto -done - -(* Transfer is delicate here for two reasons: first, because there is - an implicit quantifier over functions (f), and, second, because the - product over the multiplicity should not be translated to an integer - product. - - The way to handle the first is to use quantifier rules for functions. - The way to handle the second is to turn off the offending rule. -*) - -lemma transfer_nat_int_sum_prod_closure3: - "(SUM x : A. int (f x)) >= 0" - "(PROD x : A. int (f x)) >= 0" - apply (rule setsum_nonneg, auto) - apply (rule setprod_nonneg, auto) -done - -declare TransferMorphism_nat_int[transfer - add return: transfer_nat_int_sum_prod_closure3 - del: transfer_nat_int_sum_prod2 (1)] - -lemma multiplicity_setprod_int: "p >= 0 \ finite S \ - (ALL x : S. f x > 0) \ - multiplicity (p::int) (PROD x : S. f x) = - (SUM x : S. multiplicity p (f x))" - - apply (frule multiplicity_setprod_nat - [where f = "%x. nat(int(nat(f x)))", - transferred direction: nat "op <= (0::int)"]) - apply auto - apply (subst (asm) setprod_cong) - apply (rule refl) - apply (rule if_P) - apply auto - apply (rule setsum_cong) - apply auto -done - -declare TransferMorphism_nat_int[transfer - add return: transfer_nat_int_sum_prod2 (1)] - -lemma multiplicity_prod_prime_powers_nat: - "finite S \ (ALL p : S. prime (p::nat)) \ - multiplicity p (PROD p : S. p ^ f p) = (if p : S then f p else 0)" - apply (subgoal_tac "(PROD p : S. p ^ f p) = - (PROD p : S. p ^ (%x. if x : S then f x else 0) p)") - apply (erule ssubst) - apply (subst multiplicity_characterization_nat) - prefer 5 apply (rule refl) - apply (rule refl) - apply auto - apply (subst setprod_mono_one_right) - apply assumption - prefer 3 - apply (rule setprod_cong) - apply (rule refl) - apply auto -done - -(* Here the issue with transfer is the implicit quantifier over S *) - -lemma multiplicity_prod_prime_powers_int: - "(p::int) >= 0 \ finite S \ (ALL p : S. prime p) \ - multiplicity p (PROD p : S. p ^ f p) = (if p : S then f p else 0)" - - apply (subgoal_tac "int ` nat ` S = S") - apply (frule multiplicity_prod_prime_powers_nat [where f = "%x. f(int x)" - and S = "nat ` S", transferred]) - apply auto - apply (subst prime_int_def [symmetric]) - apply auto - apply (subgoal_tac "xb >= 0") - apply force - apply (rule prime_ge_0_int) - apply force - apply (subst transfer_nat_int_set_return_embed) - apply (unfold nat_set_def, auto) -done - -lemma multiplicity_distinct_prime_power_nat: "prime (p::nat) \ prime q \ - p ~= q \ multiplicity p (q^n) = 0" - apply (subgoal_tac "q^n = setprod (%x. x^n) {q}") - apply (erule ssubst) - apply (subst multiplicity_prod_prime_powers_nat) - apply auto -done - -lemma multiplicity_distinct_prime_power_int: "prime (p::int) \ prime q \ - p ~= q \ multiplicity p (q^n) = 0" - apply (frule prime_ge_0_int [of q]) - apply (frule multiplicity_distinct_prime_power_nat [transferred leaving: n]) - prefer 4 - apply assumption - apply auto -done - -lemma dvd_multiplicity_nat: - "(0::nat) < y \ x dvd y \ multiplicity p x <= multiplicity p y" - apply (case_tac "x = 0") - apply (auto simp add: dvd_def multiplicity_product_nat) -done - -lemma dvd_multiplicity_int: - "(0::int) < y \ 0 <= x \ x dvd y \ p >= 0 \ - multiplicity p x <= multiplicity p y" - apply (case_tac "x = 0") - apply (auto simp add: dvd_def) - apply (subgoal_tac "0 < k") - apply (auto simp add: multiplicity_product_int) - apply (erule zero_less_mult_pos) - apply arith -done - -lemma dvd_prime_factors_nat [intro]: - "0 < (y::nat) \ x dvd y \ prime_factors x <= prime_factors y" - apply (simp only: prime_factors_altdef_nat) - apply auto - apply (frule dvd_multiplicity_nat) - apply auto -(* It is a shame that auto and arith don't get this. *) - apply (erule order_less_le_trans)back - apply assumption -done - -lemma dvd_prime_factors_int [intro]: - "0 < (y::int) \ 0 <= x \ x dvd y \ prime_factors x <= prime_factors y" - apply (auto simp add: prime_factors_altdef_int) - apply (erule order_less_le_trans) - apply (rule dvd_multiplicity_int) - apply auto -done - -lemma multiplicity_dvd_nat: "0 < (x::nat) \ 0 < y \ - ALL p. multiplicity p x <= multiplicity p y \ - x dvd y" - apply (subst prime_factorization_nat [of x], assumption) - apply (subst prime_factorization_nat [of y], assumption) - apply (rule setprod_dvd_setprod_subset2) - apply force - apply (subst prime_factors_altdef_nat)+ - apply auto -(* Again, a shame that auto and arith don't get this. *) - apply (drule_tac x = xa in spec, auto) - apply (rule le_imp_power_dvd) - apply blast -done - -lemma multiplicity_dvd_int: "0 < (x::int) \ 0 < y \ - ALL p >= 0. multiplicity p x <= multiplicity p y \ - x dvd y" - apply (subst prime_factorization_int [of x], assumption) - apply (subst prime_factorization_int [of y], assumption) - apply (rule setprod_dvd_setprod_subset2) - apply force - apply (subst prime_factors_altdef_int)+ - apply auto - apply (rule dvd_power_le) - apply auto - apply (drule_tac x = xa in spec) - apply (erule impE) - apply auto -done - -lemma multiplicity_dvd'_nat: "(0::nat) < x \ - \p. prime p \ multiplicity p x \ multiplicity p y \ x dvd y" - apply (cases "y = 0") - apply auto - apply (rule multiplicity_dvd_nat, auto) - apply (case_tac "prime p") - apply auto -done - -lemma multiplicity_dvd'_int: "(0::int) < x \ 0 <= y \ - \p. prime p \ multiplicity p x \ multiplicity p y \ x dvd y" - apply (cases "y = 0") - apply auto - apply (rule multiplicity_dvd_int, auto) - apply (case_tac "prime p") - apply auto -done - -lemma dvd_multiplicity_eq_nat: "0 < (x::nat) \ 0 < y \ - (x dvd y) = (ALL p. multiplicity p x <= multiplicity p y)" - by (auto intro: dvd_multiplicity_nat multiplicity_dvd_nat) - -lemma dvd_multiplicity_eq_int: "0 < (x::int) \ 0 < y \ - (x dvd y) = (ALL p >= 0. multiplicity p x <= multiplicity p y)" - by (auto intro: dvd_multiplicity_int multiplicity_dvd_int) - -lemma prime_factors_altdef2_nat: "(n::nat) > 0 \ - (p : prime_factors n) = (prime p & p dvd n)" - apply (case_tac "prime p") - apply auto - apply (subst prime_factorization_nat [where n = n], assumption) - apply (rule dvd_trans) - apply (rule dvd_power [where x = p and n = "multiplicity p n"]) - apply (subst (asm) prime_factors_altdef_nat, force) - apply (rule dvd_setprod) - apply auto - apply (subst prime_factors_altdef_nat) - apply (subst (asm) dvd_multiplicity_eq_nat) - apply auto - apply (drule spec [where x = p]) - apply auto -done - -lemma prime_factors_altdef2_int: - assumes "(n::int) > 0" - shows "(p : prime_factors n) = (prime p & p dvd n)" - - apply (case_tac "p >= 0") - apply (rule prime_factors_altdef2_nat [transferred]) - using prems apply auto - apply (auto simp add: prime_ge_0_int prime_factors_ge_0_int) -done - -lemma multiplicity_eq_nat: - fixes x and y::nat - assumes [arith]: "x > 0" "y > 0" and - mult_eq [simp]: "!!p. prime p \ multiplicity p x = multiplicity p y" - shows "x = y" - - apply (rule dvd_anti_sym) - apply (auto intro: multiplicity_dvd'_nat) -done - -lemma multiplicity_eq_int: - fixes x and y::int - assumes [arith]: "x > 0" "y > 0" and - mult_eq [simp]: "!!p. prime p \ multiplicity p x = multiplicity p y" - shows "x = y" - - apply (rule dvd_anti_sym [transferred]) - apply (auto intro: multiplicity_dvd'_int) -done - - -subsection {* An application *} - -lemma gcd_eq_nat: - assumes pos [arith]: "x > 0" "y > 0" - shows "gcd (x::nat) y = - (PROD p: prime_factors x Un prime_factors y. - p ^ (min (multiplicity p x) (multiplicity p y)))" -proof - - def z == "(PROD p: prime_factors (x::nat) Un prime_factors y. - p ^ (min (multiplicity p x) (multiplicity p y)))" - have [arith]: "z > 0" - unfolding z_def by (rule setprod_pos_nat, auto) - have aux: "!!p. prime p \ multiplicity p z = - min (multiplicity p x) (multiplicity p y)" - unfolding z_def - apply (subst multiplicity_prod_prime_powers_nat) - apply (auto simp add: multiplicity_not_factor_nat) - done - have "z dvd x" - by (intro multiplicity_dvd'_nat, auto simp add: aux) - moreover have "z dvd y" - by (intro multiplicity_dvd'_nat, auto simp add: aux) - moreover have "ALL w. w dvd x & w dvd y \ w dvd z" - apply auto - apply (case_tac "w = 0", auto) - apply (erule multiplicity_dvd'_nat) - apply (auto intro: dvd_multiplicity_nat simp add: aux) - done - ultimately have "z = gcd x y" - by (subst gcd_unique_nat [symmetric], blast) - thus ?thesis - unfolding z_def by auto -qed - -lemma lcm_eq_nat: - assumes pos [arith]: "x > 0" "y > 0" - shows "lcm (x::nat) y = - (PROD p: prime_factors x Un prime_factors y. - p ^ (max (multiplicity p x) (multiplicity p y)))" -proof - - def z == "(PROD p: prime_factors (x::nat) Un prime_factors y. - p ^ (max (multiplicity p x) (multiplicity p y)))" - have [arith]: "z > 0" - unfolding z_def by (rule setprod_pos_nat, auto) - have aux: "!!p. prime p \ multiplicity p z = - max (multiplicity p x) (multiplicity p y)" - unfolding z_def - apply (subst multiplicity_prod_prime_powers_nat) - apply (auto simp add: multiplicity_not_factor_nat) - done - have "x dvd z" - by (intro multiplicity_dvd'_nat, auto simp add: aux) - moreover have "y dvd z" - by (intro multiplicity_dvd'_nat, auto simp add: aux) - moreover have "ALL w. x dvd w & y dvd w \ z dvd w" - apply auto - apply (case_tac "w = 0", auto) - apply (rule multiplicity_dvd'_nat) - apply (auto intro: dvd_multiplicity_nat simp add: aux) - done - ultimately have "z = lcm x y" - by (subst lcm_unique_nat [symmetric], blast) - thus ?thesis - unfolding z_def by auto -qed - -lemma multiplicity_gcd_nat: - assumes [arith]: "x > 0" "y > 0" - shows "multiplicity (p::nat) (gcd x y) = - min (multiplicity p x) (multiplicity p y)" - - apply (subst gcd_eq_nat) - apply auto - apply (subst multiplicity_prod_prime_powers_nat) - apply auto -done - -lemma multiplicity_lcm_nat: - assumes [arith]: "x > 0" "y > 0" - shows "multiplicity (p::nat) (lcm x y) = - max (multiplicity p x) (multiplicity p y)" - - apply (subst lcm_eq_nat) - apply auto - apply (subst multiplicity_prod_prime_powers_nat) - apply auto -done - -lemma gcd_lcm_distrib_nat: "gcd (x::nat) (lcm y z) = lcm (gcd x y) (gcd x z)" - apply (case_tac "x = 0 | y = 0 | z = 0") - apply auto - apply (rule multiplicity_eq_nat) - apply (auto simp add: multiplicity_gcd_nat multiplicity_lcm_nat - lcm_pos_nat) -done - -lemma gcd_lcm_distrib_int: "gcd (x::int) (lcm y z) = lcm (gcd x y) (gcd x z)" - apply (subst (1 2 3) gcd_abs_int) - apply (subst lcm_abs_int) - apply (subst (2) abs_of_nonneg) - apply force - apply (rule gcd_lcm_distrib_nat [transferred]) - apply auto -done - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/BijectionRel.thy --- a/src/HOL/NumberTheory/BijectionRel.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,231 +0,0 @@ -(* Title: HOL/NumberTheory/BijectionRel.thy - ID: $Id$ - Author: Thomas M. Rasmussen - Copyright 2000 University of Cambridge -*) - -header {* Bijections between sets *} - -theory BijectionRel imports Main begin - -text {* - Inductive definitions of bijections between two different sets and - between the same set. Theorem for relating the two definitions. - - \bigskip -*} - -inductive_set - bijR :: "('a => 'b => bool) => ('a set * 'b set) set" - for P :: "'a => 'b => bool" -where - empty [simp]: "({}, {}) \ bijR P" -| insert: "P a b ==> a \ A ==> b \ B ==> (A, B) \ bijR P - ==> (insert a A, insert b B) \ bijR P" - -text {* - Add extra condition to @{term insert}: @{term "\b \ B. \ P a b"} - (and similar for @{term A}). -*} - -definition - bijP :: "('a => 'a => bool) => 'a set => bool" where - "bijP P F = (\a b. a \ F \ P a b --> b \ F)" - -definition - uniqP :: "('a => 'a => bool) => bool" where - "uniqP P = (\a b c d. P a b \ P c d --> (a = c) = (b = d))" - -definition - symP :: "('a => 'a => bool) => bool" where - "symP P = (\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]: "{} \ bijER P" -| insert1: "P a a ==> a \ A ==> A \ bijER P ==> insert a A \ bijER P" -| insert2: "P a b ==> a \ b ==> a \ A ==> b \ A ==> A \ bijER P - ==> insert a (insert b A) \ bijER P" - - -text {* \medskip @{term bijR} *} - -lemma fin_bijRl: "(A, B) \ bijR P ==> finite A" - apply (erule bijR.induct) - apply auto - done - -lemma fin_bijRr: "(A, B) \ bijR P ==> finite B" - apply (erule bijR.induct) - apply auto - done - -lemma aux_induct: - assumes major: "finite F" - and subs: "F \ A" - and cases: "P {}" - "!!F a. F \ A ==> a \ A ==> a \ 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 \ B ==> a \ A ==> a \ B ==> inj_on f B ==> f a \ f ` A" - apply (unfold inj_on_def) - apply auto - done - -lemma inj_func_bijR_aux2: - "\a. a \ A --> P a (f a) ==> inj_on f A ==> finite A ==> F <= A - ==> (F, f ` F) \ 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: - "\a. a \ A --> P a (f a) ==> inj_on f A ==> finite A - ==> (A, f ` A) \ bijR P" - apply (rule inj_func_bijR_aux2) - apply auto - done - - -text {* \medskip @{term bijER} *} - -lemma fin_bijER: "A \ bijER P ==> finite A" - apply (erule bijER.induct) - apply auto - done - -lemma aux1: - "a \ A ==> a \ B ==> F \ insert a A ==> F \ insert a B ==> a \ F - ==> \C. F = insert a C \ a \ C \ C <= A \ C <= B" - apply (rule_tac x = "F - {a}" in exI) - apply auto - done - -lemma aux2: "a \ b ==> a \ A ==> b \ B ==> a \ F ==> b \ F - ==> F \ insert a A ==> F \ insert b B - ==> \C. F = insert a (insert b C) \ a \ C \ b \ C \ C \ A \ C \ 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 \ C ==> P b b ==> bijP P (insert b C) ==> bijP P C" - apply (unfold bijP_def) - apply auto - apply (subgoal_tac "b \ a") - prefer 2 - apply clarify - apply (simp add: aux_uniq) - apply auto - done - -lemma aux_in2: - "symP P ==> uniqP P ==> a \ C ==> b \ C ==> a \ b ==> P a b - ==> bijP P (insert a (insert b C)) ==> bijP P C" - apply (unfold bijP_def) - apply auto - apply (subgoal_tac "aa \ a") - prefer 2 - apply clarify - apply (subgoal_tac "aa \ b") - prefer 2 - apply clarify - apply (simp add: aux_uniq) - apply (subgoal_tac "ba \ 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: "\a b. Q a \ 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 \ F) = (b \ 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) \ bijR P ==> uniqP P ==> symP P - ==> \F. bijP P F \ F \ A \ F \ B --> F \ bijER P" - apply (erule bijR.induct) - apply simp - apply (case_tac "a = b") - apply clarify - apply (case_tac "b \ 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 \ F") - apply (case_tac [!] "b \ 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 \ 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 \ 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) \ bijR P ==> - bijP P A ==> uniqP P ==> symP P ==> A \ bijER P" - apply (cut_tac A = A and B = A and P = P in aux_bijRER) - apply auto - done - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Chinese.thy --- a/src/HOL/NumberTheory/Chinese.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,259 +0,0 @@ -(* Title: HOL/NumberTheory/Chinese.thy - ID: $Id$ - Author: Thomas M. Rasmussen - Copyright 2000 University of Cambridge -*) - -header {* The Chinese Remainder Theorem *} - -theory Chinese -imports IntPrimes -begin - -text {* - The Chinese Remainder Theorem for an arbitrary finite number of - equations. (The one-equation case is included in theory @{text - IntPrimes}. Uses functions for indexing.\footnote{Maybe @{term - funprod} and @{term funsum} should be based on general @{term fold} - on indices?} -*} - - -subsection {* Definitions *} - -consts - funprod :: "(nat => int) => nat => nat => int" - funsum :: "(nat => int) => nat => nat => int" - -primrec - "funprod f i 0 = f i" - "funprod f i (Suc n) = f (Suc (i + n)) * funprod f i n" - -primrec - "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 = - ((\i. i \ n --> 0 < mf i) \ - (\i j. i \ n \ j \ n \ i \ j --> zgcd (mf i) (mf j) = 1))" - -definition - km_cond :: "nat => (nat => int) => (nat => int) => bool" where - "km_cond n kf mf = (\i. i \ 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 = (\i. i \ 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 \ i \ n \ m_cond n mf \ km_cond n kf mf then - (SOME x. 0 \ x \ x < mf i \ 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 (\i. xilin_sol i n kf bf mf * mhf mf n i) 0 n" - - -text {* \medskip @{term funprod} and @{term funsum} *} - -lemma funprod_pos: "(\i. i \ n --> 0 < mf i) ==> 0 < funprod mf 0 n" - apply (induct n) - apply auto - apply (simp add: zero_less_mult_iff) - done - -lemma funprod_zgcd [rule_format (no_asm)]: - "(\i. k \ i \ i \ 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 \ i --> i \ 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 (\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)]: - "(\i. k \ i \ i \ k + l --> f i = 0) --> (funsum f k l) = 0" - apply (induct l) - apply auto - done - -lemma funsum_oneelem [rule_format (no_asm)]: - "k \ j --> j \ k + l --> - (\i. k \ i \ i \ k + l \ i \ 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 \ k + l") - prefer 4 - apply arith - apply auto - done - - -subsection {* Chinese: uniqueness *} - -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 {* Chinese: existence *} - -lemma unique_xi_sol: - "0 < n ==> i \ n ==> m_cond n mf ==> km_cond n kf mf - ==> \!x. 0 \ x \ x < mf i \ [kf i * mhf mf n i * x = bf i] (mod mf i)" - apply (rule zcong_lineq_unique) - apply (tactic {* stac (thm "zgcd_zmult_cancel") 2 *}) - apply (unfold m_cond_def km_cond_def mhf_def) - apply (simp_all (no_asm_simp)) - apply safe - apply (tactic {* stac (thm "zgcd_zmult_cancel") 3 *}) - apply (rule_tac [!] funprod_zgcd) - apply safe - apply simp_all - apply (subgoal_tac "i i \ n ==> j \ n ==> j \ 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 \ 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 {* Chinese *} - -lemma chinese_remainder: - "0 < n ==> m_cond n mf ==> km_cond n kf mf - ==> \!x. 0 \ x \ x < funprod mf 0 n \ 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 {* stac (thm "zcong_zmod") 3 *}) - apply (tactic {* stac (thm "mod_mult_eq") 3 *}) - apply (tactic {* stac (thm "mod_mod_cancel") 3 *}) - apply (tactic {* stac (thm "x_sol_lin") 4 *}) - apply (tactic {* stac (thm "mod_mult_eq" RS sym) 6 *}) - apply (tactic {* stac (thm "zcong_zmod" RS sym) 6 *}) - apply (subgoal_tac [6] - "0 \ xilin_sol i n kf bf mf \ xilin_sol i n kf bf mf < mf i - \ [kf i * mhf mf n i * xilin_sol i n kf bf mf = bf i] (mod mf i)") - prefer 6 - apply (simp add: zmult_ac) - apply (unfold xilin_sol_def) - apply (tactic {* asm_simp_tac @{simpset} 6 *}) - 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Euler.thy --- a/src/HOL/NumberTheory/Euler.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,304 +0,0 @@ -(* Title: HOL/Quadratic_Reciprocity/Euler.thy - ID: $Id$ - Authors: Jeremy Avigad, David Gray, and Adam Kramer -*) - -header {* Euler's criterion *} - -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 {* Property for MultInvPair *} - -lemma MultInvPair_prop1a: - "[| zprime p; 2 < p; ~([a = 0](mod p)); - X \ (SetS a p); Y \ (SetS a p); - ~((X \ 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 \ (SetS a p); Y \ (SetS a p); - X \ Y |] ==> X \ Y = {}" - apply (rule notnotD) - apply (rule notI) - apply (drule MultInvPair_prop1a, auto) - done - -lemma MultInvPair_prop1c: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==> - \X \ SetS a p. \Y \ SetS a p. X \ Y --> X\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: "[| zprime p; 2 < p; ~([a = 0] (mod p)); - ~([j = 0] (mod p)); - ~(QuadRes p a) |] ==> - ~([j = a * MultInv p j] (mod p))" -proof - assume "zprime p" and "2 < p" and "~([a = 0] (mod p))" and - "~([j = 0] (mod p))" and "~(QuadRes p a)" - 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: zmult_ac) - have "[j * j = a] (mod p)" - proof - - from prems have b: "[MultInv p j * j = 1] (mod p)" - by (simp add: MultInv_prop2a) - from b a show ?thesis - by (auto simp add: zcong_zmult_prop2) - qed - then have "[j^2 = a] (mod p)" - by (metis number_of_is_id power2_eq_square succ_bin_simps) - with prems 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 Pls_def StandardRes_def aux number_of_is_id one_is_num_one) - done - - -subsection {* Properties of SetS *} - -lemma SetS_finite: "2 < p ==> finite (SetS a p)" - by (auto simp add: SetS_def SRStar_finite [of p] finite_imageI) - -lemma SetS_elems_finite: "\X \ 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) |] ==> - \X \ 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 finite_Union) - -lemma card_setsum_aux: "[| finite S; \X \ S. finite (X::int set); - \X \ S. card X = n |] ==> setsum card S = setsum (%x. n) S" - by (induct set: finite) auto - -lemma SetS_card: "[| zprime p; 2 < p; ~([a = 0] (mod p)); ~(QuadRes p a) |] ==> - int(card(SetS a p)) = (p - 1) div 2" -proof - - assume "zprime p" and "2 < p" and "~([a = 0] (mod p))" and "~(QuadRes p a)" - then have "(p - 1) = 2 * int(card(SetS a p))" - proof - - have "p - 1 = int(card(Union (SetS a p)))" - by (auto simp add: prems MultInvPair_prop2 SRStar_card) - also have "... = int (setsum card (SetS a p))" - by (auto simp add: prems SetS_finite SetS_elems_finite - MultInvPair_prop1c [of p a] card_Union_disjoint) - also have "... = int(setsum (%x.2) (SetS a p))" - using prems - by (auto simp add: SetS_elems_card SetS_finite SetS_elems_finite - card_setsum_aux simp del: setsum_constant) - also have "... = 2 * int(card( SetS a p))" - by (auto simp add: prems SetS_finite setsum_const2) - finally show ?thesis . - qed - from this show ?thesis - by auto -qed - -lemma SetS_setprod_prop: "[| zprime p; 2 < p; ~([a = 0] (mod p)); - ~(QuadRes p a); x \ (SetS a p) |] ==> - [\x = a] (mod p)" - apply (auto simp add: SetS_def MultInvPair_def) - apply (frule StandardRes_SRStar_prop1a) - apply (subgoal_tac "StandardRes p x \ 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: zmult_ac) - done - -lemma aux1: "[| 0 < x; (x::int) < a; x \ (a - 1) |] ==> x < a - 1" - by arith - -lemma aux2: "[| (a::int) < c; b < c |] ==> (a \ b | b \ a)" - by auto - -lemma SRStar_d22set_prop: "2 < p \ (SRStar p) = {1} \ (d22set (p - 1))" - apply (induct p rule: d22set.induct) - 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_setprod_prop1: "[| zprime p; 2 < p; ~([a = 0] (mod p)); ~(QuadRes p a) |] ==> - [\(Union (SetS a p)) = a ^ nat ((p - 1) div 2)] (mod p)" -proof - - assume "zprime p" and "2 < p" and "~([a = 0] (mod p))" and "~(QuadRes p a)" - then have "[\(Union (SetS a p)) = - setprod (setprod (%x. x)) (SetS a p)] (mod p)" - by (auto simp add: SetS_finite SetS_elems_finite - MultInvPair_prop1c setprod_Union_disjoint) - also have "[setprod (setprod (%x. x)) (SetS a p) = - setprod (%x. a) (SetS a p)] (mod p)" - by (rule setprod_same_function_zcong) - (auto simp add: prems SetS_setprod_prop SetS_finite) - also (zcong_trans) have "[setprod (%x. a) (SetS a p) = - a^(card (SetS a p))] (mod p)" - by (auto simp add: prems SetS_finite setprod_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: prems SetS_card) - done -qed - -lemma Union_SetS_setprod_prop2: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==> - \(Union (SetS a p)) = zfact (p - 1)" -proof - - assume "zprime p" and "2 < p" and "~([a = 0](mod p))" - then have "\(Union (SetS a p)) = \(SRStar p)" - by (auto simp add: MultInvPair_prop2) - also have "... = \({1} \ (d22set (p - 1)))" - by (auto simp add: prems SRStar_d22set_prop) - also have "... = zfact(p - 1)" - proof - - have "~(1 \ d22set (p - 1)) & finite( d22set (p - 1))" - by (metis d22set_fin d22set_g_1 linorder_neq_iff) - then have "\({1} \ (d22set (p - 1))) = \(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_setprod_prop1) - apply (auto simp add: Union_SetS_setprod_prop2) - done - -text {* \medskip Prove the first part of Euler's Criterion: *} - -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 number_of_is_id zcong_sym zcong_trans zfact_prop) - -text {* \medskip Prove another part of Euler Criterion: *} - -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: zpower_zadd_distrib) - also have "... = a * a ^ (nat(p) - 1)" - by auto - finally show ?thesis . -qed - -lemma aux_2: "[| (2::int) < p; p \ zOdd |] ==> 0 < ((p - 1) div 2)" -proof - - assume "2 < p" and "p \ 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 `2 < p` 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 {* \medskip Prove the final part of Euler's Criterion: *} - -lemma aux__1: "[| ~([x = 0] (mod p)); [y ^ 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 \ zOdd") - apply (auto simp add: QuadRes_def) - prefer 2 - apply (metis number_of_is_id numeral_1_eq_1 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: zpower_zpower) - 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 mult_Bit0 number_of_is_id odd_minus_one_even one_is_num_one zmult_1 aux__2) - done - - -text {* \medskip Finally show Euler's Criterion: *} - -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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/EulerFermat.thy --- a/src/HOL/NumberTheory/EulerFermat.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,348 +0,0 @@ -(* Title: HOL/NumberTheory/EulerFermat.thy - ID: $Id$ - Author: Thomas M. Rasmussen - Copyright 2000 University of Cambridge -*) - -header {* Fermat's Little Theorem extended to Euler's Totient function *} - -theory EulerFermat -imports BijectionRel IntFact -begin - -text {* - Fermat's Little Theorem extended to Euler's Totient function. More - abstract approach than Boyer-Moore (which seems necessary to achieve - the extended version). -*} - - -subsection {* Definitions and lemmas *} - -inductive_set - RsetR :: "int => int set set" - for m :: int - where - empty [simp]: "{} \ RsetR m" - | insert: "A \ RsetR m ==> zgcd a m = 1 ==> - \a'. a' \ A --> \ zcong a a' m ==> insert a A \ RsetR m" - -consts - BnorRset :: "int * int => int set" - -recdef BnorRset - "measure ((\(a, m). nat a) :: int * int => nat)" - "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 = (\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 \ RsetR m \ card A = phi m)" - -definition - RRset2norRR :: "int set => int => int => int" where - "RRset2norRR A m a = - (if 1 < m \ is_RRset A m \ a \ A then - SOME b. zcong a b m \ b \ norRRset m - else 0)" - -definition - zcongm :: "int => int => int => bool" where - "zcongm m = (\a b. zcong a b m)" - -lemma abs_eq_1_iff [iff]: "(abs z = (1::int)) = (z = 1 \ z = -1)" - -- {* LCP: not sure why this lemma is needed now *} - by (auto simp add: abs_if) - - -text {* \medskip @{text norRRset} *} - -declare BnorRset.simps [simp del] - -lemma BnorRset_induct: - assumes "!!a m. P {} a m" - and "!!a m. 0 < (a::int) ==> P (BnorRset (a - 1, m::int)) (a - 1) m - ==> P (BnorRset(a,m)) a m" - shows "P (BnorRset(u,v)) u v" - apply (rule BnorRset.induct) - apply safe - apply (case_tac [2] "0 < a") - apply (rule_tac [2] prems) - apply simp_all - apply (simp_all add: BnorRset.simps prems) - done - -lemma Bnor_mem_zle [rule_format]: "b \ BnorRset (a, m) \ b \ 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 \ BnorRset (a, m)" - by (auto dest: Bnor_mem_zle) - -lemma Bnor_mem_zg [rule_format]: "b \ 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 \ a --> b \ 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) \ 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' \ 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 \ b - 1 ==> a < (b::int)" - apply auto - done - -lemma norR_mem_unique: - "1 < m ==> - zgcd a m = 1 ==> \!b. [a = b] (mod m) \ b \ 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 add: zcong_sym) - done - - -text {* \medskip @{term noXRRset} *} - -lemma RRset_gcd [rule_format]: - "is_RRset A m ==> a \ A --> zgcd a m = 1" - apply (unfold is_RRset_def) - apply (rule RsetR.induct [where P="%A. a \ A --> zgcd a m = 1"], auto) - done - -lemma RsetR_zmult_mono: - "A \ RsetR m ==> - 0 < m ==> zgcd x m = 1 ==> (\a. a * x) ` A \ 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 \ A - ==> zcong a (SOME b. [a = b] (mod m) \ b \ norRRset m) m \ - (SOME b. [a = b] (mod m) \ b \ norRRset m) \ 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 \ A ==> - [a = RRset2norRR A m a] (mod m) \ RRset2norRR A m a \ norRRset m" - apply (unfold RRset2norRR_def, simp) - apply (rule aux_some, simp_all) - done - -lemmas RRset2norRR_correct1 = - RRset2norRR_correct [THEN conjunct1, standard] -lemmas RRset2norRR_correct2 = - RRset2norRR_correct [THEN conjunct2, standard] - -lemma RsetR_fin: "A \ 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 \ A --> b \ A --> a = b" - apply (unfold is_RRset_def) - apply (rule RsetR.induct [where P="%A. a \ A --> b \ A --> a = b"]) - 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) ==> \a. P a \ 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 "\b. ([x = b] (mod m) \ b \ norRRset m) \ - ([y = b] (mod m) \ b \ 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 \ A ==> inj f ==> f a \ f ` A" -by (unfold inj_on_def, auto) - -lemma Bnor_prod_power [rule_format]: - "x \ 0 ==> a < m --> \((\a. a * x) ` BnorRset (a, m)) = - \(BnorRset(a, m)) * x^card (BnorRset (a, m))" - apply (induct a m rule: BnorRset_induct) - prefer 2 - apply (simplesubst BnorRset.simps) --{*multiple redexes*} - apply (unfold Let_def, auto) - apply (simp add: Bnor_fin Bnor_mem_zle_swap) - apply (subst setprod_insert) - apply (rule_tac [2] Bnor_prod_power_aux) - apply (unfold inj_on_def) - apply (simp_all add: zmult_ac Bnor_fin finite_imageI - Bnor_mem_zle_swap) - done - - -subsection {* Fermat *} - -lemma bijzcong_zcong_prod: - "(A, B) \ bijR (zcongm m) ==> [\A = \B] (mod m)" - apply (unfold zcongm_def) - apply (erule bijR.induct) - apply (subgoal_tac [2] "a \ A \ b \ B \ finite A \ finite B") - apply (auto intro: fin_bijRl fin_bijRr zcong_zmult) - done - -lemma Bnor_prod_zgcd [rule_format]: - "a < m --> zgcd (\(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 = "\(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 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: - "\ zprime p; a < p \ \ 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 ==> \ 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/EvenOdd.thy --- a/src/HOL/NumberTheory/EvenOdd.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,256 +0,0 @@ -(* Title: HOL/Quadratic_Reciprocity/EvenOdd.thy - Authors: Jeremy Avigad, David Gray, and Adam Kramer -*) - -header {*Parity: Even and Odd Integers*} - -theory EvenOdd -imports Int2 -begin - -definition - zOdd :: "int set" where - "zOdd = {x. \k. x = 2 * k + 1}" - -definition - zEven :: "int set" where - "zEven = {x. \k. x = 2 * k}" - -subsection {* Some useful properties about even and odd *} - -lemma zOddI [intro?]: "x = 2 * k + 1 \ x \ zOdd" - and zOddE [elim?]: "x \ zOdd \ (!!k. x = 2 * k + 1 \ C) \ C" - by (auto simp add: zOdd_def) - -lemma zEvenI [intro?]: "x = 2 * k \ x \ zEven" - and zEvenE [elim?]: "x \ zEven \ (!!k. x = 2 * k \ C) \ C" - by (auto simp add: zEven_def) - -lemma one_not_even: "~(1 \ zEven)" -proof - assume "1 \ zEven" - then obtain k :: int where "1 = 2 * k" .. - then show False by arith -qed - -lemma even_odd_conj: "~(x \ zOdd & x \ 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: zdiff_zmult_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 \ zOdd | x \ zEven)" - by (simp add: zOdd_def zEven_def) arith - -lemma not_odd_impl_even: "~(x \ zOdd) ==> x \ zEven" - using even_odd_disj by auto - -lemma odd_mult_odd_prop: "(x*y):zOdd ==> x \ zOdd" -proof (rule classical) - assume "\ ?thesis" - then have "x \ 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: zdiff_zmult_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 \ zOdd ==> (x - 1):zEven" - by (auto simp add: zOdd_def zEven_def) - -lemma even_div_2_prop1: "x \ zEven ==> (x mod 2) = 0" - by (auto simp add: zEven_def) - -lemma even_div_2_prop2: "x \ zEven ==> (2 * (x div 2)) = x" - by (auto simp add: zEven_def) - -lemma even_plus_even: "[| x \ zEven; y \ zEven |] ==> x + y \ zEven" - apply (auto simp add: zEven_def) - apply (auto simp only: zadd_zmult_distrib2 [symmetric]) - done - -lemma even_times_either: "x \ zEven ==> x * y \ zEven" - by (auto simp add: zEven_def) - -lemma even_minus_even: "[| x \ zEven; y \ zEven |] ==> x - y \ zEven" - apply (auto simp add: zEven_def) - apply (auto simp only: zdiff_zmult_distrib2 [symmetric]) - done - -lemma odd_minus_odd: "[| x \ zOdd; y \ zOdd |] ==> x - y \ zEven" - apply (auto simp add: zOdd_def zEven_def) - apply (auto simp only: zdiff_zmult_distrib2 [symmetric]) - done - -lemma even_minus_odd: "[| x \ zEven; y \ zOdd |] ==> x - y \ 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 \ zOdd; y \ zEven |] ==> x - y \ zOdd" - apply (auto simp add: zOdd_def zEven_def) - apply (auto simp only: zdiff_zmult_distrib2 [symmetric]) - done - -lemma odd_times_odd: "[| x \ zOdd; y \ zOdd |] ==> x * y \ zOdd" - apply (auto simp add: zOdd_def zadd_zmult_distrib zadd_zmult_distrib2) - apply (rule_tac x = "2 * ka * k + ka + k" in exI) - apply (auto simp add: zadd_zmult_distrib) - done - -lemma odd_iff_not_even: "(x \ zOdd) = (~ (x \ zEven))" - using even_odd_conj even_odd_disj by auto - -lemma even_product: "x * y \ zEven ==> x \ zEven | y \ zEven" - using odd_iff_not_even odd_times_odd by auto - -lemma even_diff: "x - y \ zEven = ((x \ zEven) = (y \ zEven))" -proof - assume xy: "x - y \ zEven" - { - assume x: "x \ zEven" - have "y \ zEven" - proof (rule classical) - assume "\ ?thesis" - then have "y \ zOdd" - by (simp add: odd_iff_not_even) - with x have "x - y \ 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 \ zEven" - have "x \ zEven" - proof (rule classical) - assume "\ ?thesis" - then have "x \ zOdd" - by (auto simp add: odd_iff_not_even) - with y have "x - y \ 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 \ zEven) = (y \ zEven)" - by (auto simp add: odd_iff_not_even even_minus_even odd_minus_odd - even_minus_odd odd_minus_even) -next - assume "(x \ zEven) = (y \ zEven)" - then show "x - y \ 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 \ zEven; 0 \ x |] ==> (-1::int)^(nat x) = 1" -proof - - assume "x \ zEven" and "0 \ x" - from `x \ zEven` obtain a where "x = 2 * a" .. - with `0 \ x` have "0 \ a" by simp - from `0 \ x` and `x = 2 * a` have "nat x = nat (2 * a)" - by simp - also from `x = 2 * a` 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)^2)^ (nat a)" - by (simp add: zpower_zpower [symmetric]) - also have "(-1::int)^2 = 1" - by simp - finally show ?thesis - by simp -qed - -lemma neg_one_odd_power: "[| x \ zOdd; 0 \ x |] ==> (-1::int)^(nat x) = -1" -proof - - assume "x \ zOdd" and "0 \ x" - from `x \ zOdd` obtain a where "x = 2 * a + 1" .. - with `0 \ x` have a: "0 \ a" by simp - with `0 \ x` and `x = 2 * a + 1` 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)^2)^ (nat a) * (-1)^1" - by (auto simp add: zpower_zpower [symmetric] zpower_zadd_distrib) - also have "(-1::int)^2 = 1" - by simp - finally show ?thesis - by simp -qed - -lemma neg_one_power_parity: "[| 0 \ x; 0 \ y; (x \ zEven) = (y \ 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 \ zEven; x < y |] ==> x div 2 < y div 2" -proof - - assume "y \ zEven" and "x < y" - from `y \ zEven` obtain k where k: "y = 2 * k" .. - with `x < y` 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 \ zEven; y \ zEven |] ==> (x + y) div 2 = x div 2 + y div 2" - by (auto simp add: zEven_def) - -lemma even_prod_div_2: "[| x \ 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 \ 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 :: int) ^ card A) * (-1 ^ card A) = 1" - by (induct set: finite) auto - -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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Factorization.thy --- a/src/HOL/NumberTheory/Factorization.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,341 +0,0 @@ -(* Title: HOL/NumberTheory/Factorization.thy - ID: $Id$ - Author: Thomas Marthedal Rasmussen - Copyright 2000 University of Cambridge -*) - -header {* Fundamental Theorem of Arithmetic (unique factorization into primes) *} - -theory Factorization -imports Main Primes Permutation -begin - - -subsection {* Definitions *} - -definition - primel :: "nat list => bool" where - "primel xs = (\p \ set xs. prime p)" - -consts - nondec :: "nat list => bool " - prod :: "nat list => nat" - oinsert :: "nat => nat list => nat list" - sort :: "nat list => nat list" - -primrec - "nondec [] = True" - "nondec (x # xs) = (case xs of [] => True | y # ys => x \ y \ nondec xs)" - -primrec - "prod [] = Suc 0" - "prod (x # xs) = x * prod xs" - -primrec - "oinsert x [] = [x]" - "oinsert x (y # ys) = (if x \ y then x # y # ys else y # oinsert x ys)" - -primrec - "sort [] = []" - "sort (x # xs) = oinsert x (sort xs)" - - -subsection {* Arithmetic *} - -lemma one_less_m: "(m::nat) \ m * k ==> m \ Suc 0 ==> Suc 0 < m" - apply (cases m) - apply auto - done - -lemma one_less_k: "(m::nat) \ 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 {* Prime list and product *} - -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 \ primel ys)" - apply (unfold primel_def) - apply auto - done - -lemma prime_primel: "prime n ==> primel [n] \ prod [n] = n" - apply (unfold primel_def) - apply auto - done - -lemma prime_nd_one: "prime p ==> \ 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 \ 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 \ xs \ [] \ Suc 0 < prod xs" - apply (induct xs) - apply simp - apply (fastsimp 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 {* Sorting *} - -lemma nondec_oinsert: "nondec xs \ nondec (oinsert x xs)" - apply (induct xs) - apply simp - apply (case_tac xs) - apply (simp_all cong del: list.weak_case_cong) - done - -lemma nondec_sort: "nondec (sort xs)" - apply (induct xs) - apply simp_all - apply (erule nondec_oinsert) - done - -lemma x_less_y_oinsert: "x \ y ==> l = y # ys ==> x # l = oinsert x l" - apply simp_all - done - -lemma nondec_sort_eq [rule_format]: "nondec xs \ 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 {* Permutation *} - -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: mult_ac) - 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 {* Existence *} - -lemma ex_nondec_lemma: - "primel xs ==> \ys. primel ys \ nondec ys \ 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 \ \ prime n ==> - \m k. Suc 0 < m \ Suc 0 < k \ m < n \ k < n \ 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) - done - -lemma split_primel: - "primel xs \ primel ys \ \l. primel l \ 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 --> (\l. primel l \ 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 ==> \l. primel l \ nondec l \ prod l = n" - apply (erule factor_exists [THEN exE]) - apply (blast intro!: ex_nondec_lemma) - done - - -subsection {* Uniqueness *} - -lemma prime_dvd_mult_list [rule_format]: - "prime p ==> p dvd (prod xs) --> (\m. m:set xs \ 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 - ==> \m. m \ set ys \ 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 \ 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 \ 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 ==> \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: - "\m. m < prod ys --> (\xs ys. primel xs \ primel ys \ - prod xs = prod ys \ 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]: - "\xs ys. primel xs \ primel ys \ prod xs = prod ys \ 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]: - "\n. Suc 0 < n --> (\!l. primel l \ nondec l \ prod l = n)" - by (metis factor_unique nondec_factor_exists perm_nondec_unique) - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Fib.thy --- a/src/HOL/NumberTheory/Fib.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,150 +0,0 @@ -(* ID: $Id$ - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Copyright 1997 University of Cambridge -*) - -header {* The Fibonacci function *} - -theory Fib -imports Primes -begin - -text {* - Fibonacci numbers: proofs of laws taken from: - R. L. Graham, D. E. Knuth, O. Patashnik. Concrete Mathematics. - (Addison-Wesley, 1989) - - \bigskip -*} - -fun fib :: "nat \ nat" -where - "fib 0 = 0" -| "fib (Suc 0) = 1" -| fib_2: "fib (Suc (Suc n)) = fib n + fib (Suc n)" - -text {* - \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. -*} - -text{*We disable @{text fib.fib_2fib_2} for simplification ...*} -declare fib_2 [simp del] - -text{*...then prove a version that has a more restrictive pattern.*} -lemma fib_Suc3: "fib (Suc (Suc (Suc n))) = fib (Suc n) + fib (Suc (Suc n))" - by (rule fib_2) - -text {* \medskip Concrete Mathematics, page 280 *} - -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) \ 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 {* - \medskip Concrete Mathematics, page 278: Cassini's identity. The proof is - much easier using integers, not natural numbers! -*} - -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 \ x mod 2 \ x mod 2 = 0" by presburger - with "3.hyps" show ?case by (simp add: fib.simps add_mult_distrib add_mult_distrib2) -qed - -text{*We now obtain a version for the natural numbers via the coercion - function @{term int}.*} -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 int_int_eq [THEN iffD1]) - apply (simp add: fib_Cassini_int) - apply (subst zdiff_int [symmetric]) - apply (insert fib_Suc_gr_0 [of n], simp_all) - done - - -text {* \medskip Toward Law 6.111 of Concrete Mathematics *} - -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 \ 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 \ 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 "\ = gcd (fib m) (fib (n - m))" by (simp add: less.hyps diff pos_m) - also have "\ = 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)" -- {* Law 6.111 *} - apply (induct m n rule: gcd_induct) - apply (simp_all add: gcd_non_0 gcd_commute gcd_fib_mod) - done - -theorem fib_mult_eq_setsum: - "fib (Suc n) * fib n = (\k \ {..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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Finite2.thy --- a/src/HOL/NumberTheory/Finite2.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,223 +0,0 @@ -(* Title: HOL/Quadratic_Reciprocity/Finite2.thy - ID: $Id$ - Authors: Jeremy Avigad, David Gray, and Adam Kramer -*) - -header {*Finite Sets and Finite Sums*} - -theory Finite2 -imports Main IntFact Infinite_Set -begin - -text{* - These are useful for combinatorial and number-theoretic counting - arguments. -*} - - -subsection {* Useful properties of sums and products *} - -lemma setsum_same_function_zcong: - assumes a: "\x \ S. [f x = g x](mod m)" - shows "[setsum f S = setsum 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 add:setsum_def) -qed - -lemma setprod_same_function_zcong: - assumes a: "\x \ S. [f x = g x](mod m)" - shows "[setprod f S = setprod 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 add:setprod_def) -qed - -lemma setsum_const: "finite X ==> setsum (%x. (c :: int)) X = c * int(card X)" - apply (induct set: finite) - apply (auto simp add: left_distrib right_distrib int_eq_of_nat) - done - -lemma setsum_const2: "finite X ==> int (setsum (%x. (c :: nat)) X) = - int(c) * int(card X)" - apply (induct set: finite) - apply (auto simp add: zadd_zmult_distrib2) - done - -lemma setsum_const_mult: "finite A ==> setsum (%x. c * ((f x)::int)) A = - c * setsum f A" - by (induct set: finite) (auto simp add: zadd_zmult_distrib2) - - -subsection {* Cardinality of explicit finite sets *} - -lemma finite_surjI: "[| B \ f ` A; finite A |] ==> finite B" - by (simp add: finite_subset finite_imageI) - -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 \ x}" -proof - - have "{y::nat . y \ 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 \ x & x < n}" - apply (subgoal_tac " {(x :: int). 0 \ x & x < n} \ - 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 \ x & x \ n}" - apply (subgoal_tac "{x. 0 \ x & x \ n} = {x. 0 \ 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} \ {x::int. 0 \ 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 \ n}" -proof - - have "{x::int. 0 < x & x \ n} \ {x::int. 0 \ x & x \ 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 `card {y. y < n} = n` by simp -qed - -lemma card_bdd_nat_set_le: "card { y::nat. y \ x} = Suc x" -proof - - have "{y::nat. y \ 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 \ (n::int) ==> card {y. 0 \ y & y < n} = nat n" -proof - - assume "0 \ 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 `0 \ n` have "int ` {y. y < nat n} = {y. 0 \ 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 \ y & y < n} = nat n" . -qed - -lemma card_bdd_int_set_le: "0 \ (n::int) ==> card {y. 0 \ y & y \ n} = - nat n + 1" -proof - - assume "0 \ n" - moreover have "{y. 0 \ y & y \ n} = {y. 0 \ 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 \ (n::int) ==> - card {x. 0 < x & x \ n} = nat n" -proof - - assume "0 \ n" - have "inj_on (%x. x+1) {x. 0 \ x & x < n}" - by (auto simp add: inj_on_def) - hence "card ((%x. x+1) ` {x. 0 \ x & x < n}) = - card {x. 0 \ x & x < n}" - by (rule card_image) - also from `0 \ n` have "... = nat n" - by (rule card_bdd_int_set_l) - also have "(%x. x + 1) ` {x. 0 \ 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 \ 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 \ 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 \ n ==> - int(card {x. 0 < x & x \ n}) = n" - by (auto simp add: card_bdd_int_set_l_le) - - -subsection {* Cardinality of finite cartesian products *} - -(* FIXME could be useful in general but not needed here -lemma insert_Sigma [simp]: "(insert x A) <*> B = ({ x } <*> B) \ (A <*> B)" - by blast - *) - -text {* Lemmas for counting arguments. *} - -lemma setsum_bij_eq: "[| finite A; finite B; f ` A \ B; inj_on f A; - g ` B \ A; inj_on g B |] ==> setsum g B = setsum (g \ f) A" - apply (frule_tac h = g and f = f in setsum_reindex) - apply (subgoal_tac "setsum g B = setsum g (f ` A)") - apply (simp add: inj_on_def) - apply (subgoal_tac "card A = card B") - apply (drule_tac A = "f ` A" and B = B in card_seteq) - apply (auto simp add: card_image) - apply (frule_tac A = A and B = B and f = f in card_inj_on_le, auto) - apply (frule_tac A = B and B = A and f = g in card_inj_on_le) - apply auto - done - -lemma setprod_bij_eq: "[| finite A; finite B; f ` A \ B; inj_on f A; - g ` B \ A; inj_on g B |] ==> setprod g B = setprod (g \ f) A" - apply (frule_tac h = g and f = f in setprod_reindex) - apply (subgoal_tac "setprod g B = setprod g (f ` A)") - apply (simp add: inj_on_def) - apply (subgoal_tac "card A = card B") - apply (drule_tac A = "f ` A" and B = B in card_seteq) - apply (auto simp add: card_image) - apply (frule_tac A = A and B = B and f = f in card_inj_on_le, auto) - apply (frule_tac A = B and B = A and f = g in card_inj_on_le, auto) - done - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Gauss.thy --- a/src/HOL/NumberTheory/Gauss.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,535 +0,0 @@ -(* Title: HOL/Quadratic_Reciprocity/Gauss.thy - ID: $Id$ - Authors: Jeremy Avigad, David Gray, and Adam Kramer) -*) - -header {* Gauss' Lemma *} - -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 :: "int set" where - "A = {(x::int). 0 < x & x \ ((p - 1) div 2)}" - -definition - B :: "int set" where - "B = (%x. x * a) ` A" - -definition - C :: "int set" where - "C = StandardRes p ` B" - -definition - D :: "int set" where - "D = C \ {x. x \ ((p - 1) div 2)}" - -definition - E :: "int set" where - "E = C \ {x. ((p - 1) div 2) < x}" - -definition - F :: "int set" where - "F = (%x. (p - x)) ` E" - - -subsection {* Basic properties of p *} - -lemma p_odd: "p \ 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 \ (p - 1) div 1" - by (rule zdiv_mono2) (auto simp add: p_g_0) - also have "\ = p - 1" by simp - finally show ?thesis by simp -qed - -lemma p_eq: "p = (2 * (p - 1) div 2) + 1" - using div_mult_self1_is_id [of 2 "p - 1"] by auto - - -lemma (in -) zodd_imp_zdiv_eq: "x \ zOdd ==> 2 * (x - 1) div 2 = 2 * ((x - 1) div 2)" - apply (frule odd_minus_one_even) - apply (simp add: zEven_def) - apply (subgoal_tac "2 \ 0") - apply (frule_tac b = "2 :: int" and a = "x - 1" in div_mult_self1_is_id) - apply (auto simp add: even_div_2_prop2) - done - - -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 {* Basic Properties of the Gauss Sets *} - -lemma finite_A: "finite (A)" - apply (auto simp add: A_def) - apply (subgoal_tac "{x. 0 < x & x \ (p - 1) div 2} \ {x. 0 \ x & x < 1 + (p - 1) div 2}") - apply (auto simp add: bdd_int_set_l_finite finite_subset) - done - -lemma finite_B: "finite (B)" - by (auto simp add: B_def finite_A finite_imageI) - -lemma finite_C: "finite (C)" - by (auto simp add: C_def finite_B finite_imageI) - -lemma finite_D: "finite (D)" - by (auto simp add: D_def finite_Int finite_C) - -lemma finite_E: "finite (E)" - by (auto simp add: E_def finite_Int finite_C) - -lemma finite_F: "finite (F)" - by (auto simp add: F_def finite_E finite_imageI) - -lemma C_eq: "C = D \ 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 \ (p - 1) div 2" - assume d: "0 < y" - assume e: "y \ (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: prems 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 prems) -proof - - fix x fix y - assume a: "x * a mod p = y * a mod p" - assume b: "0 < x" - assume c: "x \ (p - 1) div 2" - assume d: "0 < y" - assume e: "y \ (p - 1) div 2" - assume f: "x \ 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: prems 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 \ 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 \ A ==> 0 < x" - by (auto simp add: A_def) - -lemma B_ncong_p: "x \ 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 = x and b = a in zcong_zprime_prod_zero_contra) - apply (auto simp add: A_greater_zero) - done - -lemma B_greater_zero: "x \ B ==> 0 < x" - using a_nonzero by (auto simp add: B_def mult_pos_pos A_greater_zero) - -lemma C_ncong_p: "x \ C ==> ~[x = 0](mod p)" - apply (auto simp add: C_def) - apply (frule B_ncong_p) - apply (subgoal_tac "[x = StandardRes p x](mod p)") - defer apply (simp add: StandardRes_prop1) - apply (frule_tac a = x and b = "StandardRes p x" and c = 0 in zcong_trans) - apply auto - done - -lemma C_greater_zero: "y \ C ==> 0 < y" - apply (auto simp add: C_def) -proof - - fix x - assume a: "x \ B" - from p_g_0 have "0 \ 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 \ 0" - by (simp add: StandardRes_prop3) - ultimately show "0 < StandardRes p x" - by (simp add: order_le_less) -qed - -lemma D_ncong_p: "x \ D ==> ~[x = 0](mod p)" - by (auto simp add: D_def C_ncong_p) - -lemma E_ncong_p: "x \ E ==> ~[x = 0](mod p)" - by (auto simp add: E_def C_ncong_p) - -lemma F_ncong_p: "x \ F ==> ~[x = 0](mod p)" - apply (auto simp add: F_def) -proof - - fix x assume a: "x \ 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 \ {x. 0 < x & x \ ((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 \ B |] - ==> p - StandardRes p x \ (p - 1) div 2" - by simp -qed - -lemma D_subset: "D \ {x. 0 < x & x \ ((p - 1) div 2)}" - by (auto simp add: D_def C_greater_zero) - -lemma F_eq: "F = {x. \y \ 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. \y \ A. ( x = StandardRes p (y*a) & StandardRes p (y*a) \ (p - 1) div 2)}" - by (auto simp add: D_def C_def B_def A_def) - -lemma D_leq: "x \ D ==> x \ (p - 1) div 2" - by (auto simp add: D_eq) - -lemma F_ge: "x \ F ==> x \ (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) \ (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: "\x \ 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 (setprod id A) p = 1" -by(rule all_relprime_prod_relprime[OF finite_A all_A_relprime]) - - -subsection {* Relationships Between Gauss Sets *} - -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 \ 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: "setprod id E * setprod id D = setprod id C" - apply (insert D_E_disj finite_D finite_E C_eq) - apply (frule setprod_Un_disjoint [of D E id]) - apply auto - done - -lemma C_B_zcong_prod: "[setprod id C = setprod id B] (mod p)" - apply (auto simp add: C_def) - apply (insert finite_B SR_B_inj) - apply (frule_tac f = "StandardRes p" in setprod_reindex_id [symmetric], auto) - apply (rule setprod_same_function_zcong) - apply (auto simp add: StandardRes_prop1 zcong_sym p_g_0) - done - -lemma F_Un_D_subset: "(F \ D) \ A" - apply (rule Un_least) - apply (auto simp add: A_def F_subset D_subset) - done - -lemma F_D_disj: "(F \ 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: zadd_zmult_distrib2 zmult_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 \ A" and c: "ya: A" - with A_def have "0 < y + ya" - by auto - moreover from b c A_def have "y + ya \ (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 \ D) = nat ((p - 1) div 2)" -proof - - have "card (F \ 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 \ D) = card C" - by (simp add: C_card_eq_D_plus_E) - from this show "card (F \ D) = nat ((p - 1) div 2)" - by (simp add: C_card_eq_B B_card_eq) -qed - -lemma F_Un_D_eq_A: "F \ 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: - "(setprod id D) * (setprod id F) = setprod id A" - apply (insert F_D_disj finite_D finite_F) - apply (frule setprod_Un_disjoint [of F D id]) - apply (auto simp add: F_Un_D_eq_A) - done - -lemma prod_F_zcong: - "[setprod id F = ((-1) ^ (card E)) * (setprod id E)] (mod p)" -proof - - have "setprod id F = setprod id (op - p ` E)" - by (auto simp add: F_def) - then have "setprod id F = setprod (op - p) E" - apply simp - apply (insert finite_E inj_on_pminusx_E) - apply (frule_tac f = "op - p" in setprod_reindex_id, auto) - done - then have one: - "[setprod id F = setprod (StandardRes p o (op - p)) E] (mod p)" - apply simp - apply (insert p_g_0 finite_E StandardRes_prod) - by (auto) - moreover have a: "\x \ 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: "\x \ E. [StandardRes p (p - x) = p - x](mod p)" - apply clarify - apply (simp add: StandardRes_prop1 zcong_sym) - done - moreover have "\x \ 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: - "[setprod (StandardRes p o (op - p)) E = setprod (uminus) E](mod p)" - apply simp - using finite_E p_g_0 - setprod_same_function_zcong [of E "StandardRes p o (op - p)" uminus p] - by auto - then have two: "[setprod id F = setprod (uminus) E](mod p)" - apply (insert one c) - apply (rule zcong_trans [of "setprod id F" - "setprod (StandardRes p o op - p) E" p - "setprod uminus E"], auto) - done - also have "setprod uminus E = (setprod id E) * (-1)^(card E)" - using finite_E by (induct set: finite) auto - then have "setprod uminus E = (-1) ^ (card E) * (setprod id E)" - by (simp add: zmult_commute) - with two show ?thesis - by simp -qed - - -subsection {* Gauss' Lemma *} - -lemma aux: "setprod id A * -1 ^ card E * a ^ card A * -1 ^ card E = setprod 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 "[setprod id A = setprod id F * setprod id D](mod p)" - by (auto simp add: prod_D_F_eq_prod_A zmult_commute cong del:setprod_cong) - then have "[setprod id A = ((-1)^(card E) * setprod id E) * - setprod id D] (mod p)" - apply (rule zcong_trans) - apply (auto simp add: prod_F_zcong zcong_scalar cong del: setprod_cong) - done - then have "[setprod id A = ((-1)^(card E) * setprod id C)] (mod p)" - apply (rule zcong_trans) - apply (insert C_prod_eq_D_times_E, erule subst) - apply (subst zmult_assoc, auto) - done - then have "[setprod id A = ((-1)^(card E) * setprod id B)] (mod p)" - apply (rule zcong_trans) - apply (simp add: C_B_zcong_prod zcong_scalar2 cong del:setprod_cong) - done - then have "[setprod id A = ((-1)^(card E) * - (setprod id ((%x. x * a) ` A)))] (mod p)" - by (simp add: B_def) - then have "[setprod id A = ((-1)^(card E) * (setprod (%x. x * a) A))] - (mod p)" - by (simp add:finite_A inj_on_xa_A setprod_reindex_id[symmetric] cong del:setprod_cong) - moreover have "setprod (%x. x * a) A = - setprod (%x. a) A * setprod id A" - using finite_A by (induct set: finite) auto - ultimately have "[setprod id A = ((-1)^(card E) * (setprod (%x. a) A * - setprod id A))] (mod p)" - by simp - then have "[setprod id A = ((-1)^(card E) * a^(card A) * - setprod id A)](mod p)" - apply (rule zcong_trans) - apply (simp add: zcong_scalar2 zcong_scalar finite_A setprod_constant zmult_assoc) - done - then have a: "[setprod id A * (-1)^(card E) = - ((-1)^(card E) * a^(card A) * setprod id A * (-1)^(card E))](mod p)" - by (rule zcong_scalar) - then have "[setprod id A * (-1)^(card E) = setprod id A * - (-1)^(card E) * a^(card A) * (-1)^(card E)](mod p)" - apply (rule zcong_trans) - apply (simp add: a mult_commute mult_left_commute) - done - then have "[setprod id A * (-1)^(card E) = setprod id A * - a^(card A)](mod p)" - apply (rule zcong_trans) - apply (simp add: aux cong del:setprod_cong) - done - with this zcong_cancel2 [of p "setprod 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Int2.thy --- a/src/HOL/NumberTheory/Int2.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,299 +0,0 @@ -(* Title: HOL/Quadratic_Reciprocity/Gauss.thy - ID: $Id$ - Authors: Jeremy Avigad, David Gray, and Adam Kramer -*) - -header {*Integers: Divisibility and Congruences*} - -theory Int2 -imports Finite2 WilsonRuss -begin - -definition - MultInv :: "int => int => int" where - "MultInv p x = x ^ nat (p - 2)" - - -subsection {* Useful lemmas about dvd and powers *} - -lemma zpower_zdvd_prop1: - "0 < n \ p dvd y \ p dvd ((y::int) ^ n)" - by (induct n) (auto simp add: dvd_mult2 [of p y]) - -lemma zdvd_bounds: "n dvd m ==> m \ (0::int) | n \ 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 \ 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 \ p dvd ((y::int) ^ n) \ 0 < n \ 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: "[| 0 < z; (x::int) < y * z |] ==> x div z < y" -proof - - assume "0 < z" then have modth: "x mod z \ 0" by simp - have "(x div z) * z \ (x div z) * z" by simp - then have "(x div z) * z \ (x div z) * z + x mod z" using modth by arith - also have "\ = x" - by (auto simp add: zmod_zdiv_equality [symmetric] zmult_ac) - also assume "x < y * z" - finally show ?thesis - by (auto simp add: prems mult_less_cancel_right, insert prems, arith) -qed - -lemma div_prop2: "[| 0 < z; (x::int) < (y * z) + z |] ==> x div z \ y" -proof - - assume "0 < z" and "x < (y * z) + z" - then have "x < (y + 1) * z" by (auto simp add: int_distrib) - then have "x div z < y + 1" - apply - - apply (rule_tac y = "y + 1" in div_prop1) - apply (auto simp add: prems) - done - then show ?thesis by auto -qed - -lemma zdiv_leq_prop: "[| 0 < y |] ==> y * (x div y) \ (x::int)" -proof- - assume "0 < y" - from zmod_zdiv_equality have "x = y * (x div y) + x mod y" by auto - moreover have "0 \ x mod y" - by (auto simp add: prems pos_mod_sign) - ultimately show ?thesis - by arith -qed - - -subsection {* Useful properties of congruences *} - -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_refl 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: zmult_ac 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 zless_linear) - -lemma zcong_neg_1_impl_ne_1: "[| 2 < p; [x = -1] (mod p) |] ==> - ~([x = 1] (mod p))" -proof - assume "2 < p" and "[x = 1] (mod p)" and "[x = -1] (mod p)" - then 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 prems 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 \ 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; \x \ A. zgcd x y = 1 |] - ==> zgcd (setprod id A) y = 1" - by (induct set: finite) (auto simp add: zgcd_zgcd_zmult) - - -subsection {* Some properties of MultInv *} - -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 "2 < p" and "zprime p" and "~ p dvd x" - have "x * x ^ nat (p - 2) = x ^ (nat (p - 2) + 1)" - by auto - also from prems 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 prems 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 zmult_ac) - -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: zmult_ac) - 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: zmult_ac) - 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: zmult_ac) - 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: zmult_ac) - done - -lemma aux___3: "[j * k = a] (mod p) ==> [(MultInv p j) * j * k = - (MultInv p j) * a] (mod p)" - by (auto simp add: zmult_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: zmult_ac 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/IntFact.thy --- a/src/HOL/NumberTheory/IntFact.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -(* Title: HOL/NumberTheory/IntFact.thy - ID: $Id$ - Author: Thomas M. Rasmussen - Copyright 2000 University of Cambridge -*) - -header {* Factorial on integers *} - -theory IntFact imports IntPrimes begin - -text {* - Factorial on integers and recursively defined set including all - Integers from @{text 2} up to @{text a}. Plus definition of product - of finite set. - - \bigskip -*} - -consts - zfact :: "int => int" - d22set :: "int => int set" - -recdef zfact "measure ((\n. nat n) :: int => nat)" - "zfact n = (if n \ 0 then 1 else n * zfact (n - 1))" - -recdef d22set "measure ((\a. nat a) :: int => nat)" - "d22set a = (if 1 < a then insert a (d22set (a - 1)) else {})" - - -text {* - \medskip @{term d22set} --- recursively defined set including all - integers from @{text 2} up to @{text a} -*} - -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 safe - prefer 2 - apply (case_tac "1 < a") - apply (rule_tac prems) - apply (simp_all (no_asm_simp)) - apply (simp_all (no_asm_simp) add: d22set.simps prems) - done - -lemma d22set_g_1 [rule_format]: "b \ 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 \ d22set a --> b \ a" - apply (induct a rule: d22set_induct) - apply simp - apply (subst d22set.simps) - apply auto - done - -lemma d22set_le_swap: "a < b ==> b \ d22set a" - by (auto dest: d22set_le) - -lemma d22set_mem: "1 < b \ b \ a \ b \ d22set a" - apply (induct a rule: d22set.induct) - apply auto - apply (simp_all add: d22set.simps) - 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: "\(d22set a) = zfact a" - apply (induct a rule: d22set.induct) - apply safe - apply (simp add: d22set.simps zfact.simps) - 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/IntPrimes.thy --- a/src/HOL/NumberTheory/IntPrimes.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,423 +0,0 @@ -(* Title: HOL/NumberTheory/IntPrimes.thy - ID: $Id$ - Author: Thomas M. Rasmussen - Copyright 2000 University of Cambridge -*) - -header {* Divisibility and prime numbers (on integers) *} - -theory IntPrimes -imports Main Primes -begin - -text {* - The @{text dvd} relation, GCD, Euclid's extended algorithm, primes, - congruences (all on the Integers). Comparable to theory @{text - Primes}, but @{text dvd} is included here as it is not present in - main HOL. Also includes extended GCD and congruences not present in - @{text Primes}. -*} - - -subsection {* Definitions *} - -consts - xzgcda :: "int * int * int * int * int * int * int * int => int * int * int" - -recdef xzgcda - "measure ((\(m, n, r', r, s', s, t', t). nat r) - :: int * int * int * int *int * int * int * int => nat)" - "xzgcda (m, n, r', r, s', s, t', t) = - (if r \ 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 \ bool" where - "zprime p = (1 < p \ (\m. 0 <= m & m dvd p --> m = 1 \ 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 {* Euclid's Algorithm and GCD *} - - -lemma zrelprime_zdvd_zmult_aux: - "zgcd n k = 1 ==> k dvd m * n ==> 0 \ m ==> k dvd m" - by (metis abs_of_nonneg dvd_triv_right zgcd_greatest_iff zgcd_zmult_distrib2_abs zmult_1_right) - -lemma zrelprime_zdvd_zmult: "zgcd n k = 1 ==> k dvd m * n ==> k dvd m" - apply (case_tac "0 \ 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{*This is merely a sanity check on zprime, since the previous version - denoted the empty set.*} -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 ==> \ 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 \ (m::int) ==> zprime p ==> p dvd m * n ==> p dvd m \ 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: zmult_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 \ zgcd n m = m" - by (metis abs_of_pos zdvd_mult_div_cancel zgcd_0 zgcd_commute zgcd_geq_zero zgcd_zdvd2 zgcd_zmult_eq_self) - - - -subsection {* Congruences *} - -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 zdiff_zmult_distrib2 dvd_mult zmult_commute) - apply (metis zdiff_zmult_distrib2 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) \ [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: zdiff_zmult_distrib zmult_commute zdiff_zmult_distrib2) - done - -lemma zcong_cancel: - "0 \ 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: zdiff_zmult_distrib) - apply (subgoal_tac "m dvd (-(a * k - b * k))") - apply simp - apply (subst dvd_minus_iff, assumption) - done - -lemma zcong_cancel2: - "0 \ m ==> - zgcd k m = 1 ==> [k * a = k * b] (mod m) = [a = b] (mod m)" - by (simp add: zmult_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 \ ka") - apply (metis zdvd_mult_div_cancel dvd_refl dvd_mult_left zmult_commute zrelprime_zdvd_zmult) - apply (metis abs_dvd_iff abs_of_nonneg zadd_0 zgcd_0_left zgcd_commute zgcd_zadd_zmult zgcd_zdvd_zgcd_zmult zgcd_zmult_distrib2_abs zmult_1_right zmult_commute) - apply (metis mult_le_0_iff zdvd_mono zdvd_mult_cancel dvd_triv_left zero_le_mult_iff zle_anti_sym zle_linear zle_refl zmult_commute zrelprime_zdvd_zmult) - apply (metis dvd_triv_left) - done - -lemma zcong_zless_imp_eq: - "0 \ a ==> - a < m ==> 0 \ b ==> b < m ==> [a = b] (mod m) ==> a = b" - apply (unfold zcong_def dvd_def, auto) - apply (drule_tac f = "\z. z mod m" in arg_cong) - apply (metis diff_add_cancel mod_pos_pos_trivial zadd_0 zadd_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 \ 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 ==> \ [a = b] (mod m)" - apply (unfold zcong_def) - apply (rule zdvd_not_zless, auto) - done - -lemma zcong_zless_0: - "0 \ 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 div_mult_self1_is_id) - done - -lemma zcong_zless_unique: - "0 < m ==> (\!b. 0 \ b \ b < m \ [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 zmult_div_cancel) - done - -lemma zcong_iff_lin: "([a = b] (mod m)) = (\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: zdiff_zmult_distrib2 add_diff_eq eq_diff_eq add_ac) - -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: zadd_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 (case_tac "m = 0", simp add: DIVISION_BY_ZERO) - apply (simp add: linorder_neq_iff) - apply (erule disjE) - prefer 2 apply (simp add: zcong_zmod_eq) - txt{*Remainding case: @{term "m<0"}*} - apply (rule_tac t = m in zminus_zminus [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 {* Modulo *} - -lemma zmod_zdvd_zmod: - "0 < (m::int) ==> m dvd b ==> (a mod b mod m) = (a mod m)" - by (rule mod_mod_cancel) - - -subsection {* Extended GCD *} - -declare xzgcda.simps [simp del] - -lemma xzgcd_correct_aux1: - "zgcd r' r = k --> 0 < r --> - (\sn tn. xzgcda (m, n, r', r, s', s, t', t) = (k, sn, tn))" - apply (rule_tac u = m and v = n and w = r' and x = r and y = s' and - z = s and aa = t' and ab = t in 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: - "(\sn tn. xzgcda (m, n, r', r, s', s, t', t) = (k, sn, tn)) --> 0 < r --> - zgcd r' r = k" - apply (rule_tac u = m and v = n and w = r' and x = r and y = s' and - z = s and aa = t' and ab = t in 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 Pair_eq simps zle_refl) - done - -lemma xzgcd_correct: - "0 < n ==> (zgcd m n = k) = (\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 {* \medskip @{term xzgcd} linear *} - -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: zdiff_zmult_distrib zadd_zmult_distrib2 zmult_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) \ y ==> x \ 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 (rule_tac u = m and v = n and w = r' and x = r and y = s' and - z = s and aa = t' and ab = t in 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 ==> (\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 ==> \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: zmult_commute) - done - -lemma zcong_lineq_unique: - "0 < n ==> - zgcd a n = 1 ==> \!x. 0 \ x \ x < n \ [a * x = b] (mod n)" - apply auto - apply (rule_tac [2] zcong_zless_imp_eq) - apply (tactic {* stac (thm "zcong_cancel2" RS sym) 6 *}) - 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 zmod_zmult1_eq zmult_1 zmult_assoc) - done - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Quadratic_Reciprocity.thy --- a/src/HOL/NumberTheory/Quadratic_Reciprocity.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,644 +0,0 @@ -(* Title: HOL/NumberTheory/Quadratic_Reciprocity.thy - ID: $Id$ - Authors: Jeremy Avigad, David Gray, and Adam Kramer -*) - -header {* The law of Quadratic reciprocity *} - -theory Quadratic_Reciprocity -imports Gauss -begin - -text {* - Lemmas leading up to the proof of theorem 3.3 in Niven and - Zuckerman's presentation. -*} - -context GAUSS -begin - -lemma QRLemma1: "a * setsum id A = - p * setsum (%x. ((x * a) div p)) A + setsum id D + setsum id E" -proof - - from finite_A have "a * setsum id A = setsum (%x. a * x) A" - by (auto simp add: setsum_const_mult id_def) - also have "setsum (%x. a * x) = setsum (%x. x * a)" - by (auto simp add: zmult_commute) - also have "setsum (%x. x * a) A = setsum id B" - by (simp add: B_def setsum_reindex_id[OF inj_on_xa_A]) - also have "... = setsum (%x. p * (x div p) + StandardRes p x) B" - by (auto simp add: StandardRes_def zmod_zdiv_equality) - also have "... = setsum (%x. p * (x div p)) B + setsum (StandardRes p) B" - by (rule setsum_addf) - also have "setsum (StandardRes p) B = setsum id C" - by (auto simp add: C_def setsum_reindex_id[OF SR_B_inj]) - also from C_eq have "... = setsum id (D \ E)" - by auto - also from finite_D finite_E have "... = setsum id D + setsum id E" - by (rule setsum_Un_disjoint) (auto simp add: D_def E_def) - also have "setsum (%x. p * (x div p)) B = - setsum ((%x. p * (x div p)) o (%x. (x * a))) A" - by (auto simp add: B_def setsum_reindex inj_on_xa_A) - also have "... = setsum (%x. p * ((x * a) div p)) A" - by (auto simp add: o_def) - also from finite_A have "setsum (%x. p * ((x * a) div p)) A = - p * setsum (%x. ((x * a) div p)) A" - by (auto simp add: setsum_const_mult) - finally show ?thesis by arith -qed - -lemma QRLemma2: "setsum id A = p * int (card E) - setsum id E + - setsum id D" -proof - - from F_Un_D_eq_A have "setsum id A = setsum id (D \ F)" - by (simp add: Un_commute) - also from F_D_disj finite_D finite_F - have "... = setsum id D + setsum id F" - by (auto simp add: Int_commute intro: setsum_Un_disjoint) - also from F_def have "F = (%x. (p - x)) ` E" - by auto - also from finite_E inj_on_pminusx_E have "setsum id ((%x. (p - x)) ` E) = - setsum (%x. (p - x)) E" - by (auto simp add: setsum_reindex) - also from finite_E have "setsum (op - p) E = setsum (%x. p) E - setsum id E" - by (auto simp add: setsum_subtractf id_def) - also from finite_E have "setsum (%x. p) E = p * int(card E)" - by (intro setsum_const) - finally show ?thesis - by arith -qed - -lemma QRLemma3: "(a - 1) * setsum id A = - p * (setsum (%x. ((x * a) div p)) A - int(card E)) + 2 * setsum id E" -proof - - have "(a - 1) * setsum id A = a * setsum id A - setsum id A" - by (auto simp add: zdiff_zmult_distrib) - also note QRLemma1 - also from QRLemma2 have "p * (\x \ A. x * a div p) + setsum id D + - setsum id E - setsum id A = - p * (\x \ A. x * a div p) + setsum id D + - setsum id E - (p * int (card E) - setsum id E + setsum id D)" - by auto - also have "... = p * (\x \ A. x * a div p) - - p * int (card E) + 2 * setsum id E" - by arith - finally show ?thesis - by (auto simp only: zdiff_zmult_distrib2) -qed - -lemma QRLemma4: "a \ zOdd ==> - (setsum (%x. ((x * a) div p)) A \ zEven) = (int(card E): zEven)" -proof - - assume a_odd: "a \ zOdd" - from QRLemma3 have a: "p * (setsum (%x. ((x * a) div p)) A - int(card E)) = - (a - 1) * setsum id A - 2 * setsum id E" - by arith - from a_odd have "a - 1 \ zEven" - by (rule odd_minus_one_even) - hence "(a - 1) * setsum id A \ zEven" - by (rule even_times_either) - moreover have "2 * setsum id E \ zEven" - by (auto simp add: zEven_def) - ultimately have "(a - 1) * setsum id A - 2 * setsum id E \ zEven" - by (rule even_minus_even) - with a have "p * (setsum (%x. ((x * a) div p)) A - int(card E)): zEven" - by simp - hence "p \ zEven | (setsum (%x. ((x * a) div p)) A - int(card E)): zEven" - by (rule EvenOdd.even_product) - with p_odd have "(setsum (%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 \ zOdd ==> - (-1::int)^(card E) = (-1::int)^(nat(setsum (%x. ((x * a) div p)) A))" -proof - - assume "a \ zOdd" - from QRLemma4 [OF this] have - "(int(card E): zEven) = (setsum (%x. ((x * a) div p)) A \ zEven)" .. - moreover have "0 \ int(card E)" - by auto - moreover have "0 \ setsum (%x. ((x * a) div p)) A" - proof (intro setsum_nonneg) - show "\x \ A. 0 \ x * a div p" - proof - fix x - assume "x \ A" - then have "0 \ x" - by (auto simp add: A_def) - with a_nonzero have "0 \ x * a" - by (auto simp add: zero_le_mult_iff) - with p_g_2 show "0 \ 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(((\x \ 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 \ zOdd; 0 < a; ~([a = 0] (mod p)); zprime p; 2 < p; - A = {x. 0 < x & x \ (p - 1) div 2} |] ==> - (Legendre a p) = (-1::int)^(nat(setsum (%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 {* Stuff about S, S1 and S2 *} - -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 \ q" -begin - -definition - P_set :: "int set" where - "P_set = {x. 0 < x & x \ ((p - 1) div 2) }" - -definition - Q_set :: "int set" where - "Q_set = {x. 0 < x & x \ ((q - 1) div 2) }" - -definition - S :: "(int * int) set" where - "S = P_set <*> 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 \ (q * j) div p) }" - -definition - f2 :: "int => (int * int) set" where - "f2 j = { (x, j1). (x, j1):S & j1 = j & (x \ (p * j) div q) }" - -lemma p_fact: "0 < (p - 1) div 2" -proof - - from p_g_2 have "2 \ p - 1" by arith - then have "2 div 2 \ (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 \ q - 1" by arith - then have "2 div 2 \ (q - 1) div 2" by (rule zdiv_mono1, auto) - then show ?thesis by auto -qed - -lemma pb_neq_qa: "[|1 \ b; b \ (q - 1) div 2 |] ==> - (p * b \ q * a)" -proof - assume "p * b = q * a" and "1 \ b" and "b \ (q - 1) div 2" - 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 \ q", simp add: QRTEMP_def) - apply (insert prems) - 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 \ b" - proof - - assume "q dvd b" - moreover from prems have "0 < b" by auto - ultimately show ?thesis using zdvd_bounds [of q b] by auto - qed - with prems have "q \ (q - 1) div 2" by auto - then have "2 * q \ 2 * ((q - 1) div 2)" by arith - then have "2 * q \ q - 1" - proof - - assume "2 * q \ 2 * ((q - 1) div 2)" - with prems have "q \ 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 prems show ?thesis by auto - qed - then have p1: "q \ -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 \ 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 \ 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 (auto simp add: S_def zmult_int setsum_constant) - -lemma S1_Int_S2_prop: "S1 \ S2 = {}" - by (auto simp add: S1_def S2_def) - -lemma S1_Union_S2_prop: "S = S1 \ 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 \ (q - 1) div 2" - with zless_linear have "(p * b < q * a) | (p * b = q * a)" by auto - moreover from pb_neq_qa b1 b2 have "(p * b \ 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: "[| 0 < a; a \ (p - 1) div 2; - 0 < b; b \ (q - 1) div 2 |] ==> - (p * b < q * a) = (b \ q * a div p)" -proof - - assume "0 < a" and "a \ (p - 1) div 2" and "0 < b" and "b \ (q - 1) div 2" - have "p * b < q * a ==> b \ q * a div p" - proof - - assume "p * b < q * a" - then have "p * b \ q * a" by auto - then have "(p * b) div p \ (q * a) div p" - by (rule zdiv_mono1) (insert p_g_2, auto) - then show "b \ (q * a) div p" - apply (subgoal_tac "p \ 0") - apply (frule div_mult_self1_is_id, force) - apply (insert p_g_2, auto) - done - qed - moreover have "b \ q * a div p ==> p * b < q * a" - proof - - assume "b \ q * a div p" - then have "p * b \ p * ((q * a) div p)" - using p_g_2 by (auto simp add: mult_le_cancel_left) - also have "... \ q * a" - by (rule zdiv_leq_prop) (insert p_g_2, auto) - finally have "p * b \ 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 \ q * a" - by (rule pb_neq_qa) (insert prems, auto) - ultimately show ?thesis by auto - qed - ultimately show ?thesis .. -qed - -lemma aux1b: "[| 0 < a; a \ (p - 1) div 2; - 0 < b; b \ (q - 1) div 2 |] ==> - (q * a < p * b) = (a \ p * b div q)" -proof - - assume "0 < a" and "a \ (p - 1) div 2" and "0 < b" and "b \ (q - 1) div 2" - have "q * a < p * b ==> a \ p * b div q" - proof - - assume "q * a < p * b" - then have "q * a \ p * b" by auto - then have "(q * a) div q \ (p * b) div q" - by (rule zdiv_mono1) (insert q_g_2, auto) - then show "a \ (p * b) div q" - apply (subgoal_tac "q \ 0") - apply (frule div_mult_self1_is_id, force) - apply (insert q_g_2, auto) - done - qed - moreover have "a \ p * b div q ==> q * a < p * b" - proof - - assume "a \ p * b div q" - then have "q * a \ q * ((p * b) div q)" - using q_g_2 by (auto simp add: mult_le_cancel_left) - also have "... \ p * b" - by (rule zdiv_leq_prop) (insert q_g_2, auto) - finally have "q * a \ 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 \ q * a" - by (rule pb_neq_qa) (insert prems, auto) - ultimately show ?thesis by auto - qed - ultimately show ?thesis .. -qed - -lemma (in -) aux2: "[| zprime p; zprime q; 2 < p; 2 < q |] ==> - (q * ((p - 1) div 2)) div p \ (q - 1) div 2" -proof- - assume "zprime p" and "zprime q" and "2 < p" and "2 < q" - (* Set up what's even and odd *) - then have "p \ zOdd & q \ 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 prems 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: zmult_ac) - 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 prems by auto -qed - -lemma aux3a: "\j \ P_set. int (card (f1 j)) = (q * j) div p" -proof - fix j - assume j_fact: "j \ P_set" - have "int (card (f1 j)) = int (card {y. y \ Q_set & y \ (q * j) div p})" - proof - - have "finite (f1 j)" - proof - - have "(f1 j) \ 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 \ Q_set & y \ (q * j) div p}" - using prems 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 \ (q * j) div p})" - proof - - have "{y. y \ Q_set & y \ (q * j) div p} = - {y. 0 < y & y \ (q * j) div p}" - apply (auto simp add: Q_set_def) - proof - - fix x - assume "0 < x" and "x \ q * j div p" - with j_fact P_set_def have "j \ (p - 1) div 2" by auto - with q_g_2 have "q * j \ q * ((p - 1) div 2)" - by (auto simp add: mult_le_cancel_left) - with p_g_2 have "q * j div p \ q * ((p - 1) div 2) div p" - by (auto simp add: zdiv_mono1) - also from prems P_set_def have "... \ (q - 1) div 2" - apply simp - apply (insert aux2) - apply (simp add: QRTEMP_def) - done - finally show "x \ (q - 1) div 2" using prems by auto - qed - then show ?thesis by auto - qed - also have "... = (q * j) div p" - proof - - from j_fact P_set_def have "0 \ j" by auto - with q_g_2 have "q * 0 \ q * j" by (auto simp only: mult_left_mono) - then have "0 \ q * j" by auto - then have "0 div p \ (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: "\j \ Q_set. int (card (f2 j)) = (p * j) div q" -proof - fix j - assume j_fact: "j \ Q_set" - have "int (card (f2 j)) = int (card {y. y \ P_set & y \ (p * j) div q})" - proof - - have "finite (f2 j)" - proof - - have "(f2 j) \ 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 \ P_set & y \ (p * j) div q}" - using prems 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 \ (p * j) div q})" - proof - - have "{y. y \ P_set & y \ (p * j) div q} = - {y. 0 < y & y \ (p * j) div q}" - apply (auto simp add: P_set_def) - proof - - fix x - assume "0 < x" and "x \ p * j div q" - with j_fact Q_set_def have "j \ (q - 1) div 2" by auto - with p_g_2 have "p * j \ p * ((q - 1) div 2)" - by (auto simp add: mult_le_cancel_left) - with q_g_2 have "p * j div q \ p * ((q - 1) div 2) div q" - by (auto simp add: zdiv_mono1) - also from prems have "... \ (p - 1) div 2" - by (auto simp add: aux2 QRTEMP_def) - finally show "x \ (p - 1) div 2" using prems by auto - qed - then show ?thesis by auto - qed - also have "... = (p * j) div q" - proof - - from j_fact Q_set_def have "0 \ j" by auto - with p_g_2 have "p * 0 \ p * j" by (auto simp only: mult_left_mono) - then have "0 \ p * j" by auto - then have "0 div q \ (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)) = setsum (%j. (q * j) div p) P_set" -proof - - have "\x \ P_set. finite (f1 x)" - proof - fix x - have "f1 x \ S" by (auto simp add: f1_def) - with S_finite show "finite (f1 x)" by (auto simp add: finite_subset) - qed - moreover have "(\x \ P_set. \y \ P_set. x \ y --> (f1 x) \ (f1 y) = {})" - by (auto simp add: f1_def) - moreover note P_set_finite - ultimately have "int(card (UNION P_set f1)) = - setsum (%x. int(card (f1 x))) P_set" - by(simp add:card_UN_disjoint int_setsum 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)) = setsum (%j. int(card (f1 j))) P_set" - by auto - also have "... = setsum (%j. q * j div p) P_set" - using aux3a by(fastsimp intro: setsum_cong) - finally show ?thesis . -qed - -lemma S2_card: "int (card(S2)) = setsum (%j. (p * j) div q) Q_set" -proof - - have "\x \ Q_set. finite (f2 x)" - proof - fix x - have "f2 x \ S" by (auto simp add: f2_def) - with S_finite show "finite (f2 x)" by (auto simp add: finite_subset) - qed - moreover have "(\x \ Q_set. \y \ Q_set. x \ y --> - (f2 x) \ (f2 y) = {})" - by (auto simp add: f2_def) - moreover note Q_set_finite - ultimately have "int(card (UNION Q_set f2)) = - setsum (%x. int(card (f2 x))) Q_set" - by(simp add:card_UN_disjoint int_setsum 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)) = setsum (%j. int(card (f2 j))) Q_set" - by auto - also have "... = setsum (%j. p * j div q) Q_set" - using aux3b by(fastsimp intro: setsum_cong) - finally show ?thesis . -qed - -lemma S1_carda: "int (card(S1)) = - setsum (%j. (j * q) div p) P_set" - by (auto simp add: S1_card zmult_ac) - -lemma S2_carda: "int (card(S2)) = - setsum (%j. (j * p) div q) Q_set" - by (auto simp add: S2_card zmult_ac) - -lemma pq_sum_prop: "(setsum (%j. (j * p) div q) Q_set) + - (setsum (%j. (j * q) div p) P_set) = ((p - 1) div 2) * ((q - 1) div 2)" -proof - - have "(setsum (%j. (j * p) div q) Q_set) + - (setsum (%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 \ 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 prems have "~([p = 0] (mod q))" - by (auto simp add: pq_prime_neq QRTEMP_def) - with prems Q_set_def have a1: "(Legendre p q) = (-1::int) ^ - nat(setsum (%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 prems have "~([q = 0] (mod p))" - apply (rule_tac p = q and q = p in pq_prime_neq) - apply (simp add: QRTEMP_def)+ - done - with prems P_set_def have a2: "(Legendre q p) = - (-1::int) ^ nat(setsum (%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(setsum (%x. ((x * p) div q)) Q_set) * - (-1::int) ^ nat(setsum (%x. ((x * q) div p)) P_set)" - by auto - also have "... = (-1::int) ^ (nat(setsum (%x. ((x * p) div q)) Q_set) + - nat(setsum (%x. ((x * q) div p)) P_set))" - by (auto simp add: zpower_zadd_distrib) - also have "nat(setsum (%x. ((x * p) div q)) Q_set) + - nat(setsum (%x. ((x * q) div p)) P_set) = - nat((setsum (%x. ((x * p) div q)) Q_set) + - (setsum (%x. ((x * q) div p)) P_set))" - apply (rule_tac z = "setsum (%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 \ zOdd; zprime p; q \ zOdd; zprime q; - p \ 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/ROOT.ML --- a/src/HOL/NumberTheory/ROOT.ML Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -(* $Id$ *) - -no_document use_thys ["Infinite_Set", "Permutation", "Primes"]; -use_thys ["Fib", "Factorization", "Chinese", "WilsonRuss", - "WilsonBij", "Quadratic_Reciprocity"]; diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/Residues.thy --- a/src/HOL/NumberTheory/Residues.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,172 +0,0 @@ -(* Title: HOL/Quadratic_Reciprocity/Residues.thy - ID: $Id$ - Authors: Jeremy Avigad, David Gray, and Adam Kramer -*) - -header {* Residue Sets *} - -theory Residues imports Int2 begin - -text {* - \medskip Define the residue of a set, the standard residue, - quadratic residues, and prove some basic properties. *} - -definition - ResSet :: "int => int set => bool" where - "ResSet m X = (\y1 y2. (y1 \ X & y2 \ 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 = (\y. ([(y ^ 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 \ x) & (x < p)}" - -definition - SRStar :: "int => int set" where - "SRStar p = {x. (0 < x) & (x < p)}" - - -subsection {* Some useful properties of StandardRes *} - -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 \ StandardRes p x" - by (auto simp add: StandardRes_def pos_mod_sign) - -lemma StandardRes_ubound: "0 < p ==> StandardRes p x < p" - by (auto simp add: StandardRes_def pos_mod_bound) - -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 {* Relations between StandardRes, SRStar, and SR *} - -lemma SRStar_SR_prop: "x \ SRStar p ==> x \ SR p" - by (auto simp add: SRStar_def SR_def) - -lemma StandardRes_SR_prop: "x \ 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 \ SRStar p) - = (~[x = 0] (mod p))" - apply (auto simp add: StandardRes_prop3 StandardRes_def - SRStar_def pos_mod_bound) - apply (subgoal_tac "0 < p") - apply (drule_tac a = x in pos_mod_sign, arith, simp) - done - -lemma StandardRes_SRStar_prop1a: "x \ 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 \ SRStar p |] - ==> StandardRes p (MultInv p x) \ 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 \ 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 \ SRStar p |] - ==> StandardRes p x \ SRStar p" - by (frule StandardRes_SRStar_prop3, auto) - -lemma SRStar_mult_prop1: "[| zprime p; 2 < p; x \ SRStar p; y \ 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 \ SRStar p |] - ==> StandardRes p (a * MultInv p x) \ 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 {* Properties relating ResSets with StandardRes *} - -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 |] - ==> [setsum f X = setsum (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) \ {x. 0 \ 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) \ 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 |] - ==> [setprod f X = setprod (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; \x \ A. \y \ A. ([f x = f y](mod m) --> x = y) |] ==> - ResSet m (f ` A)" - by (auto simp add: ResSet_def) - - -subsection {* Property for SRStar *} - -lemma ResSet_SRStar_prop: "ResSet p (SRStar p)" - by (auto simp add: SRStar_def ResSet_def zcong_zless_imp_eq) - -end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/WilsonBij.thy --- a/src/HOL/NumberTheory/WilsonBij.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,263 +0,0 @@ -(* Title: HOL/NumberTheory/WilsonBij.thy - ID: $Id$ - Author: Thomas M. Rasmussen - Copyright 2000 University of Cambridge -*) - -header {* Wilson's Theorem using a more abstract approach *} - -theory WilsonBij imports BijectionRel IntFact begin - -text {* - Wilson's Theorem using a more ``abstract'' approach based on - bijections between sets. Does not use Fermat's Little Theorem - (unlike Russinoff). -*} - - -subsection {* Definitions and lemmas *} - -definition - reciR :: "int => int => int => bool" where - "reciR p = (\a b. zcong (a * b) 1 p \ 1 < a \ a < p - 1 \ 1 < b \ b < p - 1)" - -definition - inv :: "int => int => int" where - "inv p a = - (if zprime p \ 0 < a \ a < p then - (SOME x. 0 \ x \ x < p \ zcong (a * x) 1 p) - else 0)" - - -text {* \medskip Inverse *} - -lemma inv_correct: - "zprime p ==> 0 < a ==> a < p - ==> 0 \ inv p a \ inv p a < p \ [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, standard] -lemmas inv_less = inv_correct [THEN conjunct2, THEN conjunct1, standard] -lemmas inv_is_inv = inv_correct [THEN conjunct2, THEN conjunct2, standard] - -lemma inv_not_0: - "zprime p ==> 1 < a ==> a < p - 1 ==> inv p a \ 0" - -- {* same as @{text WilsonRuss} *} - apply safe - apply (cut_tac a = a and p = p in inv_is_inv) - apply (unfold zcong_def) - apply auto - apply (subgoal_tac "\ p dvd 1") - apply (rule_tac [2] zdvd_not_zless) - apply (subgoal_tac "p dvd 1") - prefer 2 - apply (subst dvd_minus_iff [symmetric]) - apply auto - done - -lemma inv_not_1: - "zprime p ==> 1 < a ==> a < p - 1 ==> inv p a \ 1" - -- {* same as @{text WilsonRuss} *} - 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)" - -- {* same as @{text WilsonRuss} *} - apply (unfold zcong_def) - apply (simp add: OrderedGroup.diff_diff_eq diff_diff_eq2 zdiff_zmult_distrib2) - apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans) - apply (simp add: mult_commute) - 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 \ p - 1" - -- {* same as @{text WilsonRuss} *} - 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 {* - Below is slightly different as we don't expand @{term [source] inv} - but use ``@{text correct}'' theorems. -*} - -lemma inv_g_1: "zprime p ==> 1 < a ==> a < p - 1 ==> 1 < inv p a" - apply (subgoal_tac "inv p a \ 1") - apply (subgoal_tac "inv p a \ 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" - -- {* ditto *} - apply (subst order_less_le) - apply (simp add: inv_not_p_minus_1 inv_less) - done - - -text {* \medskip Bijection *} - -lemma aux1: "1 < x ==> 0 \ (x::int)" - apply auto - done - -lemma aux2: "1 < x ==> 0 < (x::int)" - apply auto - done - -lemma aux3: "x \ p - 2 ==> x < (p::int)" - apply auto - done - -lemma aux4: "x \ 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 {* stac (thm "zcong_cancel" RS sym) 5 *}) - apply (rule_tac [7] zcong_trans) - apply (tactic {* stac (thm "zcong_sym") 8 *}) - apply (erule_tac [7] inv_is_inv) - apply (tactic "asm_simp_tac @{simpset} 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)) \ 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 {* stac (thm "zcong_cancel2" RS sym) 5 *}) - apply (rule_tac [7] zcong_trans) - apply (tactic {* stac (thm "zcong_sym") 8 *}) - apply (rule_tac [6] zless_zprime_imp_zrelprime) - apply auto - apply (rule zcong_zless_imp_eq) - apply (tactic {* stac (thm "zcong_cancel" RS sym) 5 *}) - apply (rule_tac [7] zcong_trans) - apply (tactic {* stac (thm "zcong_sym") 8 *}) - 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: zmult_commute) - apply auto - done - -lemma bijER_d22set: "zprime p ==> d22set (p - 2) \ 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 {* Wilson *} - -lemma bijER_zcong_prod_1: - "zprime p ==> A \ bijER (reciR p) ==> [\A = 1] (mod p)" - apply (unfold reciR_def) - apply (erule bijER.induct) - apply (subgoal_tac [2] "a = 1 \ a = p - 1") - apply (rule_tac [3] zcong_square_zless) - apply auto - apply (subst setprod_insert) - prefer 3 - apply (subst setprod_insert) - apply (auto simp add: fin_bijER) - apply (subgoal_tac "zcong ((a * b) * \A) (1 * 1) p") - apply (simp add: zmult_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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/WilsonRuss.thy --- a/src/HOL/NumberTheory/WilsonRuss.thy Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,329 +0,0 @@ -(* Title: HOL/NumberTheory/WilsonRuss.thy - ID: $Id$ - Author: Thomas M. Rasmussen - Copyright 2000 University of Cambridge -*) - -header {* Wilson's Theorem according to Russinoff *} - -theory WilsonRuss imports EulerFermat begin - -text {* - Wilson's Theorem following quite closely Russinoff's approach - using Boyer-Moore (using finite sets instead of lists, though). -*} - -subsection {* Definitions and lemmas *} - -definition - inv :: "int => int => int" where - "inv p a = (a^(nat (p - 2))) mod p" - -consts - wset :: "int * int => int set" - -recdef wset - "measure ((\(a, p). nat a) :: int * int => nat)" - "wset (a, p) = - (if 1 < a then - let ws = wset (a - 1, p) - in (if a \ ws then ws else insert a (insert (inv p a) ws)) else {})" - - -text {* \medskip @{term [source] inv} *} - -lemma inv_is_inv_aux: "1 < m ==> Suc (nat (m - 2)) = nat (m - 1)" -by (subst int_int_eq [symmetric], auto) - -lemma inv_is_inv: - "zprime p \ 0 < a \ a < p ==> [a * inv p a = 1] (mod p)" - apply (unfold inv_def) - apply (subst zcong_zmod) - apply (subst zmod_zmult1_eq [symmetric]) - apply (subst zcong_zmod [symmetric]) - apply (subst power_Suc [symmetric]) - apply (subst inv_is_inv_aux) - apply (erule_tac [2] Little_Fermat) - apply (erule_tac [2] zdvd_not_zless) - apply (unfold zprime_def, auto) - done - -lemma inv_distinct: - "zprime p \ 1 < a \ a < p - 1 ==> a \ 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 \ 1 < a \ a < p - 1 ==> inv p a \ 0" - apply safe - apply (cut_tac a = a and p = p in inv_is_inv) - apply (unfold zcong_def, auto) - apply (subgoal_tac "\ p dvd 1") - apply (rule_tac [2] zdvd_not_zless) - apply (subgoal_tac "p dvd 1") - prefer 2 - apply (subst dvd_minus_iff [symmetric], auto) - done - -lemma inv_not_1: - "zprime p \ 1 < a \ a < p - 1 ==> inv p a \ 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: OrderedGroup.diff_diff_eq diff_diff_eq2 zdiff_zmult_distrib2) - apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans) - apply (simp add: mult_commute) - 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 \ 1 < a \ a < p - 1 ==> inv p a \ 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 \ 1 < a \ a < p - 1 ==> 1 < inv p a" - apply (case_tac "0\ inv p a") - apply (subgoal_tac "inv p a \ 1") - apply (subgoal_tac "inv p a \ 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 \ 1 < a \ 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 \ p ==> - nat (p - 2) * nat (p - 2) = Suc (nat (p - 1) * nat (p - 3))" - apply (subst int_int_eq [symmetric]) - apply (simp add: zmult_int [symmetric]) - apply (simp add: zdiff_zmult_distrib zdiff_zmult_distrib2) - done - -lemma zcong_zpower_zmult: - "[x^y = 1] (mod p) \ [x^(y * z) = 1] (mod p)" - apply (induct z) - apply (auto simp add: zpower_zadd_distrib) - 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 \ - 5 \ p \ 0 < a \ a < p ==> inv p (inv p a) = a" - apply (unfold inv_def) - apply (subst zpower_zmod) - apply (subst zpower_zpower) - 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 {* \medskip @{term wset} *} - -declare wset.simps [simp del] - -lemma wset_induct: - assumes "!!a p. P {} a p" - and "!!a p. 1 < (a::int) \ - 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, safe) - prefer 2 - apply (case_tac "1 < a") - apply (rule prems) - apply simp_all - apply (simp_all add: wset.simps prems) - done - -lemma wset_mem_imp_or [rule_format]: - "1 < a \ b \ wset (a - 1, p) - ==> b \ wset (a, p) --> b = a \ b = inv p a" - apply (subst wset.simps) - apply (unfold Let_def, simp) - done - -lemma wset_mem_mem [simp]: "1 < a ==> a \ wset (a, p)" - apply (subst wset.simps) - apply (unfold Let_def, simp) - done - -lemma wset_subset: "1 < a \ b \ wset (a - 1, p) ==> b \ 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 \ 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 \ 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 \ 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 \ 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 \ a --> b \ 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 \ p --> a < p - 1 --> b \ wset (a, p) - --> inv p b \ 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 \ b = inv p a") - apply (rule_tac [7] wset_mem_imp_or, auto) - done - -lemma wset_inv_mem_mem: - "zprime p \ 5 \ p \ a < p - 1 \ 1 < b \ b < p - 1 - \ inv p b \ wset (a, p) \ b \ 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 \ p --> a < p - 1 --> [(\x\wset(a, p). x) = 1] (mod p)" - apply (induct a p rule: wset_induct) - prefer 2 - apply (subst wset.simps) - apply (unfold Let_def, auto) - apply (subst setprod_insert) - apply (tactic {* stac (thm "setprod_insert") 3 *}) - apply (subgoal_tac [5] - "zcong (a * inv p a * (\x\ wset(a - 1, p). x)) (1 * 1) p") - prefer 5 - apply (simp add: zmult_assoc) - apply (rule_tac [5] zcong_zmult) - apply (rule_tac [5] inv_is_inv) - apply (tactic "clarify_tac @{claset} 4") - apply (subgoal_tac [4] "a \ 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 {* Wilson *} - -lemma prime_g_5: "zprime p \ p \ 2 \ p \ 3 ==> 5 \ 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 \ 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/NumberTheory/document/root.tex --- a/src/HOL/NumberTheory/document/root.tex Tue Sep 01 19:48:11 2009 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,56 +0,0 @@ - -\documentclass[11pt,a4paper]{article} -\usepackage{graphicx} -\usepackage{isabelle,isabellesym,pdfsetup} - -\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} - -\end{document} diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/Binomial.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/Binomial.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,373 @@ +(* Title: Binomial.thy + Authors: Lawrence C. Paulson, Jeremy Avigad, Tobias Nipkow + + +Defines the "choose" function, and establishes basic properties. + +The original theory "Binomial" was by Lawrence C. Paulson, based on +the work of Andy Gordon and Florian Kammueller. The approach here, +which derives the definition of binomial coefficients in terms of the +factorial function, is due to Jeremy Avigad. The binomial theorem was +formalized by Tobias Nipkow. + +*) + + +header {* Binomial *} + +theory Binomial +imports Cong Fact +begin + + +subsection {* Main definitions *} + +class binomial = + +fixes + binomial :: "'a \ 'a \ 'a" (infixl "choose" 65) + +(* definitions for the natural numbers *) + +instantiation nat :: binomial + +begin + +fun + binomial_nat :: "nat \ nat \ nat" +where + "binomial_nat n k = + (if k = 0 then 1 else + if n = 0 then 0 else + (binomial (n - 1) k) + (binomial (n - 1) (k - 1)))" + +instance proof qed + +end + +(* definitions for the integers *) + +instantiation int :: binomial + +begin + +definition + binomial_int :: "int => int \ int" +where + "binomial_int n k = (if n \ 0 \ k \ 0 then int (binomial (nat n) (nat k)) + else 0)" +instance proof qed + +end + + +subsection {* Set up Transfer *} + +lemma transfer_nat_int_binomial: + "(n::int) >= 0 \ k >= 0 \ binomial (nat n) (nat k) = + nat (binomial n k)" + unfolding binomial_int_def + by auto + +lemma transfer_nat_int_binomial_closure: + "n >= (0::int) \ k >= 0 \ binomial n k >= 0" + by (auto simp add: binomial_int_def) + +declare TransferMorphism_nat_int[transfer add return: + transfer_nat_int_binomial transfer_nat_int_binomial_closure] + +lemma transfer_int_nat_binomial: + "binomial (int n) (int k) = int (binomial n k)" + unfolding fact_int_def binomial_int_def by auto + +lemma transfer_int_nat_binomial_closure: + "is_nat n \ is_nat k \ binomial n k >= 0" + by (auto simp add: binomial_int_def) + +declare TransferMorphism_int_nat[transfer add return: + transfer_int_nat_binomial transfer_int_nat_binomial_closure] + + +subsection {* Binomial coefficients *} + +lemma choose_zero_nat [simp]: "(n::nat) choose 0 = 1" + by simp + +lemma choose_zero_int [simp]: "n \ 0 \ (n::int) choose 0 = 1" + by (simp add: binomial_int_def) + +lemma zero_choose_nat [rule_format,simp]: "ALL (k::nat) > n. n choose k = 0" + by (induct n rule: induct'_nat, auto) + +lemma zero_choose_int [rule_format,simp]: "(k::int) > n \ n choose k = 0" + unfolding binomial_int_def apply (case_tac "n < 0") + apply force + apply (simp del: binomial_nat.simps) +done + +lemma choose_reduce_nat: "(n::nat) > 0 \ 0 < k \ + (n choose k) = ((n - 1) choose k) + ((n - 1) choose (k - 1))" + by simp + +lemma choose_reduce_int: "(n::int) > 0 \ 0 < k \ + (n choose k) = ((n - 1) choose k) + ((n - 1) choose (k - 1))" + unfolding binomial_int_def apply (subst choose_reduce_nat) + apply (auto simp del: binomial_nat.simps + simp add: nat_diff_distrib) +done + +lemma choose_plus_one_nat: "((n::nat) + 1) choose (k + 1) = + (n choose (k + 1)) + (n choose k)" + by (simp add: choose_reduce_nat) + +lemma choose_Suc_nat: "(Suc n) choose (Suc k) = + (n choose (Suc k)) + (n choose k)" + by (simp add: choose_reduce_nat One_nat_def) + +lemma choose_plus_one_int: "n \ 0 \ k \ 0 \ ((n::int) + 1) choose (k + 1) = + (n choose (k + 1)) + (n choose k)" + by (simp add: binomial_int_def choose_plus_one_nat nat_add_distrib del: binomial_nat.simps) + +declare binomial_nat.simps [simp del] + +lemma choose_self_nat [simp]: "((n::nat) choose n) = 1" + by (induct n rule: induct'_nat, auto simp add: choose_plus_one_nat) + +lemma choose_self_int [simp]: "n \ 0 \ ((n::int) choose n) = 1" + by (auto simp add: binomial_int_def) + +lemma choose_one_nat [simp]: "(n::nat) choose 1 = n" + by (induct n rule: induct'_nat, auto simp add: choose_reduce_nat) + +lemma choose_one_int [simp]: "n \ 0 \ (n::int) choose 1 = n" + by (auto simp add: binomial_int_def) + +lemma plus_one_choose_self_nat [simp]: "(n::nat) + 1 choose n = n + 1" + apply (induct n rule: induct'_nat, force) + apply (case_tac "n = 0") + apply auto + apply (subst choose_reduce_nat) + apply (auto simp add: One_nat_def) + (* natdiff_cancel_numerals introduces Suc *) +done + +lemma Suc_choose_self_nat [simp]: "(Suc n) choose n = Suc n" + using plus_one_choose_self_nat by (simp add: One_nat_def) + +lemma plus_one_choose_self_int [rule_format, simp]: + "(n::int) \ 0 \ n + 1 choose n = n + 1" + by (auto simp add: binomial_int_def nat_add_distrib) + +(* bounded quantification doesn't work with the unicode characters? *) +lemma choose_pos_nat [rule_format]: "ALL k <= (n::nat). + ((n::nat) choose k) > 0" + apply (induct n rule: induct'_nat) + apply force + apply clarify + apply (case_tac "k = 0") + apply force + apply (subst choose_reduce_nat) + apply auto +done + +lemma choose_pos_int: "n \ 0 \ k >= 0 \ k \ n \ + ((n::int) choose k) > 0" + by (auto simp add: binomial_int_def choose_pos_nat) + +lemma binomial_induct [rule_format]: "(ALL (n::nat). P n n) \ + (ALL n. P (n + 1) 0) \ (ALL n. (ALL k < n. P n k \ P n (k + 1) \ + P (n + 1) (k + 1))) \ (ALL k <= n. P n k)" + apply (induct n rule: induct'_nat) + apply auto + apply (case_tac "k = 0") + apply auto + apply (case_tac "k = n + 1") + apply auto + apply (drule_tac x = n in spec) back back + apply (drule_tac x = "k - 1" in spec) back back back + apply auto +done + +lemma choose_altdef_aux_nat: "(k::nat) \ n \ + fact k * fact (n - k) * (n choose k) = fact n" + apply (rule binomial_induct [of _ k n]) + apply auto +proof - + fix k :: nat and n + assume less: "k < n" + assume ih1: "fact k * fact (n - k) * (n choose k) = fact n" + hence one: "fact (k + 1) * fact (n - k) * (n choose k) = (k + 1) * fact n" + by (subst fact_plus_one_nat, auto) + assume ih2: "fact (k + 1) * fact (n - (k + 1)) * (n choose (k + 1)) = + fact n" + with less have "fact (k + 1) * fact ((n - (k + 1)) + 1) * + (n choose (k + 1)) = (n - k) * fact n" + by (subst (2) fact_plus_one_nat, auto) + with less have two: "fact (k + 1) * fact (n - k) * (n choose (k + 1)) = + (n - k) * fact n" by simp + have "fact (k + 1) * fact (n - k) * (n + 1 choose (k + 1)) = + fact (k + 1) * fact (n - k) * (n choose (k + 1)) + + fact (k + 1) * fact (n - k) * (n choose k)" + by (subst choose_reduce_nat, auto simp add: ring_simps) + also note one + also note two + also with less have "(n - k) * fact n + (k + 1) * fact n= fact (n + 1)" + apply (subst fact_plus_one_nat) + apply (subst left_distrib [symmetric]) + apply simp + done + finally show "fact (k + 1) * fact (n - k) * (n + 1 choose (k + 1)) = + fact (n + 1)" . +qed + +lemma choose_altdef_nat: "(k::nat) \ n \ + n choose k = fact n div (fact k * fact (n - k))" + apply (frule choose_altdef_aux_nat) + apply (erule subst) + apply (simp add: mult_ac) +done + + +lemma choose_altdef_int: + assumes "(0::int) <= k" and "k <= n" + shows "n choose k = fact n div (fact k * fact (n - k))" + + apply (subst tsub_eq [symmetric], rule prems) + apply (rule choose_altdef_nat [transferred]) + using prems apply auto +done + +lemma choose_dvd_nat: "(k::nat) \ n \ fact k * fact (n - k) dvd fact n" + unfolding dvd_def apply (frule choose_altdef_aux_nat) + (* why don't blast and auto get this??? *) + apply (rule exI) + apply (erule sym) +done + +lemma choose_dvd_int: + assumes "(0::int) <= k" and "k <= n" + shows "fact k * fact (n - k) dvd fact n" + + apply (subst tsub_eq [symmetric], rule prems) + apply (rule choose_dvd_nat [transferred]) + using prems apply auto +done + +(* generalizes Tobias Nipkow's proof to any commutative semiring *) +theorem binomial: "(a+b::'a::{comm_ring_1,power})^n = + (SUM k=0..n. (of_nat (n choose k)) * a^k * b^(n-k))" (is "?P n") +proof (induct n rule: induct'_nat) + show "?P 0" by simp +next + fix n + assume ih: "?P n" + have decomp: "{0..n+1} = {0} Un {n+1} Un {1..n}" + by auto + have decomp2: "{0..n} = {0} Un {1..n}" + by auto + have decomp3: "{1..n+1} = {n+1} Un {1..n}" + by auto + have "(a+b)^(n+1) = + (a+b) * (SUM k=0..n. of_nat (n choose k) * a^k * b^(n-k))" + using ih by (simp add: power_plus_one) + also have "... = a*(SUM k=0..n. of_nat (n choose k) * a^k * b^(n-k)) + + b*(SUM k=0..n. of_nat (n choose k) * a^k * b^(n-k))" + by (rule distrib) + also have "... = (SUM k=0..n. of_nat (n choose k) * a^(k+1) * b^(n-k)) + + (SUM k=0..n. of_nat (n choose k) * a^k * b^(n-k+1))" + by (subst (1 2) power_plus_one, simp add: setsum_right_distrib mult_ac) + also have "... = (SUM k=0..n. of_nat (n choose k) * a^k * b^(n+1-k)) + + (SUM k=1..n+1. of_nat (n choose (k - 1)) * a^k * b^(n+1-k))" + by (simp add:setsum_shift_bounds_cl_Suc_ivl Suc_diff_le + power_Suc ring_simps One_nat_def del:setsum_cl_ivl_Suc) + also have "... = a^(n+1) + b^(n+1) + + (SUM k=1..n. of_nat (n choose (k - 1)) * a^k * b^(n+1-k)) + + (SUM k=1..n. of_nat (n choose k) * a^k * b^(n+1-k))" + by (simp add: decomp2 decomp3) + also have + "... = a^(n+1) + b^(n+1) + + (SUM k=1..n. of_nat(n+1 choose k) * a^k * b^(n+1-k))" + by (auto simp add: ring_simps setsum_addf [symmetric] + choose_reduce_nat) + also have "... = (SUM k=0..n+1. of_nat (n+1 choose k) * a^k * b^(n+1-k))" + using decomp by (simp add: ring_simps) + finally show "?P (n + 1)" by simp +qed + +lemma set_explicit: "{S. S = T \ P S} = (if P T then {T} else {})" + by auto + +lemma card_subsets_nat [rule_format]: + fixes S :: "'a set" + assumes "finite S" + shows "ALL k. card {T. T \ S \ card T = k} = card S choose k" + (is "?P S") +using `finite S` +proof (induct set: finite) + show "?P {}" by (auto simp add: set_explicit) + next fix x :: "'a" and F + assume iassms: "finite F" "x ~: F" + assume ih: "?P F" + show "?P (insert x F)" (is "ALL k. ?Q k") + proof + fix k + show "card {T. T \ (insert x F) \ card T = k} = + card (insert x F) choose k" (is "?Q k") + proof (induct k rule: induct'_nat) + from iassms have "{T. T \ (insert x F) \ card T = 0} = {{}}" + apply auto + apply (subst (asm) card_0_eq) + apply (auto elim: finite_subset) + done + thus "?Q 0" + by auto + next fix k + show "?Q (k + 1)" + proof - + from iassms have fin: "finite (insert x F)" by auto + hence "{ T. T \ insert x F \ card T = k + 1} = + {T. T \ F & card T = k + 1} Un + {T. T \ insert x F & x : T & card T = k + 1}" + by (auto intro!: subsetI) + with iassms fin have "card ({T. T \ insert x F \ card T = k + 1}) = + card ({T. T \ F \ card T = k + 1}) + + card ({T. T \ insert x F \ x : T \ card T = k + 1})" + apply (subst card_Un_disjoint [symmetric]) + apply auto + (* note: nice! Didn't have to say anything here *) + done + also from ih have "card ({T. T \ F \ card T = k + 1}) = + card F choose (k+1)" by auto + also have "card ({T. T \ insert x F \ x : T \ card T = k + 1}) = + card ({T. T <= F & card T = k})" + proof - + let ?f = "%T. T Un {x}" + from iassms have "inj_on ?f {T. T <= F & card T = k}" + unfolding inj_on_def by (auto intro!: subsetI) + hence "card ({T. T <= F & card T = k}) = + card(?f ` {T. T <= F & card T = k})" + by (rule card_image [symmetric]) + also from iassms fin have "?f ` {T. T <= F & card T = k} = + {T. T \ insert x F \ x : T \ card T = k + 1}" + unfolding image_def + (* I can't figure out why this next line takes so long *) + apply auto + apply (frule (1) finite_subset, force) + apply (rule_tac x = "xa - {x}" in exI) + apply (subst card_Diff_singleton) + apply (auto elim: finite_subset) + done + finally show ?thesis by (rule sym) + qed + also from ih have "card ({T. T <= F & card T = k}) = card F choose k" + by auto + finally have "card ({T. T \ insert x F \ card T = k + 1}) = + card F choose (k + 1) + (card F choose k)". + with iassms choose_plus_one_nat show ?thesis + by auto + qed + qed + qed +qed + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/Cong.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/Cong.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,1091 @@ +(* Title: HOL/Library/Cong.thy + ID: + Authors: Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb, + Thomas M. Rasmussen, Jeremy Avigad + + +Defines congruence (notation: [x = y] (mod z)) for natural numbers and +integers. + +This file combines and revises a number of prior developments. + +The original theories "GCD" and "Primes" were by Christophe Tabacznyj +and Lawrence C. Paulson, based on \cite{davenport92}. They introduced +gcd, lcm, and prime for the natural numbers. + +The original theory "IntPrimes" was by Thomas M. Rasmussen, and +extended gcd, lcm, primes to the integers. Amine Chaieb provided +another extension of the notions to the integers, and added a number +of results to "Primes" and "GCD". + +The original theory, "IntPrimes", by Thomas M. Rasmussen, defined and +developed the congruence relations on the integers. The notion was +extended to the natural numbers by Chiaeb. Jeremy Avigad combined +these, revised and tidied them, made the development uniform for the +natural numbers and the integers, and added a number of new theorems. + +*) + + +header {* Congruence *} + +theory Cong +imports GCD Primes +begin + +subsection {* Turn off One_nat_def *} + +lemma induct'_nat [case_names zero plus1, induct type: nat]: + "\ P (0::nat); !!n. P n \ P (n + 1)\ \ P n" +by (erule nat_induct) (simp add:One_nat_def) + +lemma cases_nat [case_names zero plus1, cases type: nat]: + "P (0::nat) \ (!!n. P (n + 1)) \ P n" +by(metis induct'_nat) + +lemma power_plus_one [simp]: "(x::'a::power)^(n + 1) = x * x^n" +by (simp add: One_nat_def) + +lemma power_eq_one_eq_nat [simp]: + "((x::nat)^m = 1) = (m = 0 | x = 1)" +by (induct m, auto) + +lemma card_insert_if' [simp]: "finite A \ + card (insert x A) = (if x \ A then (card A) else (card A) + 1)" +by (auto simp add: insert_absorb) + +(* why wasn't card_insert_if a simp rule? *) +declare card_insert_disjoint [simp del] + +lemma nat_1' [simp]: "nat 1 = 1" +by simp + +(* For those annoying moments where Suc reappears, use Suc_eq_plus1 *) + +declare nat_1 [simp del] +declare add_2_eq_Suc [simp del] +declare add_2_eq_Suc' [simp del] + + +declare mod_pos_pos_trivial [simp] + + +subsection {* Main definitions *} + +class cong = + +fixes + cong :: "'a \ 'a \ 'a \ bool" ("(1[_ = _] '(mod _'))") + +begin + +abbreviation + notcong :: "'a \ 'a \ 'a \ bool" ("(1[_ \ _] '(mod _'))") +where + "notcong x y m == (~cong x y m)" + +end + +(* definitions for the natural numbers *) + +instantiation nat :: cong + +begin + +definition + cong_nat :: "nat \ nat \ nat \ bool" +where + "cong_nat x y m = ((x mod m) = (y mod m))" + +instance proof qed + +end + + +(* definitions for the integers *) + +instantiation int :: cong + +begin + +definition + cong_int :: "int \ int \ int \ bool" +where + "cong_int x y m = ((x mod m) = (y mod m))" + +instance proof qed + +end + + +subsection {* Set up Transfer *} + + +lemma transfer_nat_int_cong: + "(x::int) >= 0 \ y >= 0 \ m >= 0 \ + ([(nat x) = (nat y)] (mod (nat m))) = ([x = y] (mod m))" + unfolding cong_int_def cong_nat_def + apply (auto simp add: nat_mod_distrib [symmetric]) + apply (subst (asm) eq_nat_nat_iff) + apply (case_tac "m = 0", force, rule pos_mod_sign, force)+ + apply assumption +done + +declare TransferMorphism_nat_int[transfer add return: + transfer_nat_int_cong] + +lemma transfer_int_nat_cong: + "[(int x) = (int y)] (mod (int m)) = [x = y] (mod m)" + apply (auto simp add: cong_int_def cong_nat_def) + apply (auto simp add: zmod_int [symmetric]) +done + +declare TransferMorphism_int_nat[transfer add return: + transfer_int_nat_cong] + + +subsection {* Congruence *} + +(* was zcong_0, etc. *) +lemma cong_0_nat [simp, presburger]: "([(a::nat) = b] (mod 0)) = (a = b)" + by (unfold cong_nat_def, auto) + +lemma cong_0_int [simp, presburger]: "([(a::int) = b] (mod 0)) = (a = b)" + by (unfold cong_int_def, auto) + +lemma cong_1_nat [simp, presburger]: "[(a::nat) = b] (mod 1)" + by (unfold cong_nat_def, auto) + +lemma cong_Suc_0_nat [simp, presburger]: "[(a::nat) = b] (mod Suc 0)" + by (unfold cong_nat_def, auto simp add: One_nat_def) + +lemma cong_1_int [simp, presburger]: "[(a::int) = b] (mod 1)" + by (unfold cong_int_def, auto) + +lemma cong_refl_nat [simp]: "[(k::nat) = k] (mod m)" + by (unfold cong_nat_def, auto) + +lemma cong_refl_int [simp]: "[(k::int) = k] (mod m)" + by (unfold cong_int_def, auto) + +lemma cong_sym_nat: "[(a::nat) = b] (mod m) \ [b = a] (mod m)" + by (unfold cong_nat_def, auto) + +lemma cong_sym_int: "[(a::int) = b] (mod m) \ [b = a] (mod m)" + by (unfold cong_int_def, auto) + +lemma cong_sym_eq_nat: "[(a::nat) = b] (mod m) = [b = a] (mod m)" + by (unfold cong_nat_def, auto) + +lemma cong_sym_eq_int: "[(a::int) = b] (mod m) = [b = a] (mod m)" + by (unfold cong_int_def, auto) + +lemma cong_trans_nat [trans]: + "[(a::nat) = b] (mod m) \ [b = c] (mod m) \ [a = c] (mod m)" + by (unfold cong_nat_def, auto) + +lemma cong_trans_int [trans]: + "[(a::int) = b] (mod m) \ [b = c] (mod m) \ [a = c] (mod m)" + by (unfold cong_int_def, auto) + +lemma cong_add_nat: + "[(a::nat) = b] (mod m) \ [c = d] (mod m) \ [a + c = b + d] (mod m)" + apply (unfold cong_nat_def) + apply (subst (1 2) mod_add_eq) + apply simp +done + +lemma cong_add_int: + "[(a::int) = b] (mod m) \ [c = d] (mod m) \ [a + c = b + d] (mod m)" + apply (unfold cong_int_def) + apply (subst (1 2) mod_add_left_eq) + apply (subst (1 2) mod_add_right_eq) + apply simp +done + +lemma cong_diff_int: + "[(a::int) = b] (mod m) \ [c = d] (mod m) \ [a - c = b - d] (mod m)" + apply (unfold cong_int_def) + apply (subst (1 2) mod_diff_eq) + apply simp +done + +lemma cong_diff_aux_int: + "(a::int) >= c \ b >= d \ [(a::int) = b] (mod m) \ + [c = d] (mod m) \ [tsub a c = tsub b d] (mod m)" + apply (subst (1 2) tsub_eq) + apply (auto intro: cong_diff_int) +done; + +lemma cong_diff_nat: + assumes "(a::nat) >= c" and "b >= d" and "[a = b] (mod m)" and + "[c = d] (mod m)" + shows "[a - c = b - d] (mod m)" + + using prems by (rule cong_diff_aux_int [transferred]); + +lemma cong_mult_nat: + "[(a::nat) = b] (mod m) \ [c = d] (mod m) \ [a * c = b * d] (mod m)" + apply (unfold cong_nat_def) + apply (subst (1 2) mod_mult_eq) + apply simp +done + +lemma cong_mult_int: + "[(a::int) = b] (mod m) \ [c = d] (mod m) \ [a * c = b * d] (mod m)" + apply (unfold cong_int_def) + apply (subst (1 2) zmod_zmult1_eq) + apply (subst (1 2) mult_commute) + apply (subst (1 2) zmod_zmult1_eq) + apply simp +done + +lemma cong_exp_nat: "[(x::nat) = y] (mod n) \ [x^k = y^k] (mod n)" + apply (induct k) + apply (auto simp add: cong_refl_nat cong_mult_nat) +done + +lemma cong_exp_int: "[(x::int) = y] (mod n) \ [x^k = y^k] (mod n)" + apply (induct k) + apply (auto simp add: cong_refl_int cong_mult_int) +done + +lemma cong_setsum_nat [rule_format]: + "(ALL x: A. [((f x)::nat) = g x] (mod m)) \ + [(SUM x:A. f x) = (SUM x:A. g x)] (mod m)" + apply (case_tac "finite A") + apply (induct set: finite) + apply (auto intro: cong_add_nat) +done + +lemma cong_setsum_int [rule_format]: + "(ALL x: A. [((f x)::int) = g x] (mod m)) \ + [(SUM x:A. f x) = (SUM x:A. g x)] (mod m)" + apply (case_tac "finite A") + apply (induct set: finite) + apply (auto intro: cong_add_int) +done + +lemma cong_setprod_nat [rule_format]: + "(ALL x: A. [((f x)::nat) = g x] (mod m)) \ + [(PROD x:A. f x) = (PROD x:A. g x)] (mod m)" + apply (case_tac "finite A") + apply (induct set: finite) + apply (auto intro: cong_mult_nat) +done + +lemma cong_setprod_int [rule_format]: + "(ALL x: A. [((f x)::int) = g x] (mod m)) \ + [(PROD x:A. f x) = (PROD x:A. g x)] (mod m)" + apply (case_tac "finite A") + apply (induct set: finite) + apply (auto intro: cong_mult_int) +done + +lemma cong_scalar_nat: "[(a::nat)= b] (mod m) \ [a * k = b * k] (mod m)" + by (rule cong_mult_nat, simp_all) + +lemma cong_scalar_int: "[(a::int)= b] (mod m) \ [a * k = b * k] (mod m)" + by (rule cong_mult_int, simp_all) + +lemma cong_scalar2_nat: "[(a::nat)= b] (mod m) \ [k * a = k * b] (mod m)" + by (rule cong_mult_nat, simp_all) + +lemma cong_scalar2_int: "[(a::int)= b] (mod m) \ [k * a = k * b] (mod m)" + by (rule cong_mult_int, simp_all) + +lemma cong_mult_self_nat: "[(a::nat) * m = 0] (mod m)" + by (unfold cong_nat_def, auto) + +lemma cong_mult_self_int: "[(a::int) * m = 0] (mod m)" + by (unfold cong_int_def, auto) + +lemma cong_eq_diff_cong_0_int: "[(a::int) = b] (mod m) = [a - b = 0] (mod m)" + apply (rule iffI) + apply (erule cong_diff_int [of a b m b b, simplified]) + apply (erule cong_add_int [of "a - b" 0 m b b, simplified]) +done + +lemma cong_eq_diff_cong_0_aux_int: "a >= b \ + [(a::int) = b] (mod m) = [tsub a b = 0] (mod m)" + by (subst tsub_eq, assumption, rule cong_eq_diff_cong_0_int) + +lemma cong_eq_diff_cong_0_nat: + assumes "(a::nat) >= b" + shows "[a = b] (mod m) = [a - b = 0] (mod m)" + + using prems by (rule cong_eq_diff_cong_0_aux_int [transferred]) + +lemma cong_diff_cong_0'_nat: + "[(x::nat) = y] (mod n) \ + (if x <= y then [y - x = 0] (mod n) else [x - y = 0] (mod n))" + apply (case_tac "y <= x") + apply (frule cong_eq_diff_cong_0_nat [where m = n]) + apply auto [1] + apply (subgoal_tac "x <= y") + apply (frule cong_eq_diff_cong_0_nat [where m = n]) + apply (subst cong_sym_eq_nat) + apply auto +done + +lemma cong_altdef_nat: "(a::nat) >= b \ [a = b] (mod m) = (m dvd (a - b))" + apply (subst cong_eq_diff_cong_0_nat, assumption) + apply (unfold cong_nat_def) + apply (simp add: dvd_eq_mod_eq_0 [symmetric]) +done + +lemma cong_altdef_int: "[(a::int) = b] (mod m) = (m dvd (a - b))" + apply (subst cong_eq_diff_cong_0_int) + apply (unfold cong_int_def) + apply (simp add: dvd_eq_mod_eq_0 [symmetric]) +done + +lemma cong_abs_int: "[(x::int) = y] (mod abs m) = [x = y] (mod m)" + by (simp add: cong_altdef_int) + +lemma cong_square_int: + "\ prime (p::int); 0 < a; [a * a = 1] (mod p) \ + \ [a = 1] (mod p) \ [a = - 1] (mod p)" + apply (simp only: cong_altdef_int) + apply (subst prime_dvd_mult_eq_int [symmetric], assumption) + (* any way around this? *) + apply (subgoal_tac "a * a - 1 = (a - 1) * (a - -1)") + apply (auto simp add: ring_simps) +done + +lemma cong_mult_rcancel_int: + "coprime k (m::int) \ [a * k = b * k] (mod m) = [a = b] (mod m)" + apply (subst (1 2) cong_altdef_int) + apply (subst left_diff_distrib [symmetric]) + apply (rule coprime_dvd_mult_iff_int) + apply (subst gcd_commute_int, assumption) +done + +lemma cong_mult_rcancel_nat: + assumes "coprime k (m::nat)" + shows "[a * k = b * k] (mod m) = [a = b] (mod m)" + + apply (rule cong_mult_rcancel_int [transferred]) + using prems apply auto +done + +lemma cong_mult_lcancel_nat: + "coprime k (m::nat) \ [k * a = k * b ] (mod m) = [a = b] (mod m)" + by (simp add: mult_commute cong_mult_rcancel_nat) + +lemma cong_mult_lcancel_int: + "coprime k (m::int) \ [k * a = k * b] (mod m) = [a = b] (mod m)" + by (simp add: mult_commute cong_mult_rcancel_int) + +(* was zcong_zgcd_zmult_zmod *) +lemma coprime_cong_mult_int: + "[(a::int) = b] (mod m) \ [a = b] (mod n) \ coprime m n + \ [a = b] (mod m * n)" + apply (simp only: cong_altdef_int) + apply (erule (2) divides_mult_int) +done + +lemma coprime_cong_mult_nat: + assumes "[(a::nat) = b] (mod m)" and "[a = b] (mod n)" and "coprime m n" + shows "[a = b] (mod m * n)" + + apply (rule coprime_cong_mult_int [transferred]) + using prems apply auto +done + +lemma cong_less_imp_eq_nat: "0 \ (a::nat) \ + a < m \ 0 \ b \ b < m \ [a = b] (mod m) \ a = b" + by (auto simp add: cong_nat_def mod_pos_pos_trivial) + +lemma cong_less_imp_eq_int: "0 \ (a::int) \ + a < m \ 0 \ b \ b < m \ [a = b] (mod m) \ a = b" + by (auto simp add: cong_int_def mod_pos_pos_trivial) + +lemma cong_less_unique_nat: + "0 < (m::nat) \ (\!b. 0 \ b \ b < m \ [a = b] (mod m))" + apply auto + apply (rule_tac x = "a mod m" in exI) + apply (unfold cong_nat_def, auto) +done + +lemma cong_less_unique_int: + "0 < (m::int) \ (\!b. 0 \ b \ b < m \ [a = b] (mod m))" + apply auto + apply (rule_tac x = "a mod m" in exI) + apply (unfold cong_int_def, auto simp add: mod_pos_pos_trivial) +done + +lemma cong_iff_lin_int: "([(a::int) = b] (mod m)) = (\k. b = a + m * k)" + apply (auto simp add: cong_altdef_int dvd_def ring_simps) + apply (rule_tac [!] x = "-k" in exI, auto) +done + +lemma cong_iff_lin_nat: "([(a::nat) = b] (mod m)) = + (\k1 k2. b + k1 * m = a + k2 * m)" + apply (rule iffI) + apply (case_tac "b <= a") + apply (subst (asm) cong_altdef_nat, assumption) + apply (unfold dvd_def, auto) + apply (rule_tac x = k in exI) + apply (rule_tac x = 0 in exI) + apply (auto simp add: ring_simps) + apply (subst (asm) cong_sym_eq_nat) + apply (subst (asm) cong_altdef_nat) + apply force + apply (unfold dvd_def, auto) + apply (rule_tac x = 0 in exI) + apply (rule_tac x = k in exI) + apply (auto simp add: ring_simps) + apply (unfold cong_nat_def) + apply (subgoal_tac "a mod m = (a + k2 * m) mod m") + apply (erule ssubst)back + apply (erule subst) + apply auto +done + +lemma cong_gcd_eq_int: "[(a::int) = b] (mod m) \ gcd a m = gcd b m" + apply (subst (asm) cong_iff_lin_int, auto) + apply (subst add_commute) + apply (subst (2) gcd_commute_int) + apply (subst mult_commute) + apply (subst gcd_add_mult_int) + apply (rule gcd_commute_int) +done + +lemma cong_gcd_eq_nat: + assumes "[(a::nat) = b] (mod m)" + shows "gcd a m = gcd b m" + + apply (rule cong_gcd_eq_int [transferred]) + using prems apply auto +done + +lemma cong_imp_coprime_nat: "[(a::nat) = b] (mod m) \ coprime a m \ + coprime b m" + by (auto simp add: cong_gcd_eq_nat) + +lemma cong_imp_coprime_int: "[(a::int) = b] (mod m) \ coprime a m \ + coprime b m" + by (auto simp add: cong_gcd_eq_int) + +lemma cong_cong_mod_nat: "[(a::nat) = b] (mod m) = + [a mod m = b mod m] (mod m)" + by (auto simp add: cong_nat_def) + +lemma cong_cong_mod_int: "[(a::int) = b] (mod m) = + [a mod m = b mod m] (mod m)" + by (auto simp add: cong_int_def) + +lemma cong_minus_int [iff]: "[(a::int) = b] (mod -m) = [a = b] (mod m)" + by (subst (1 2) cong_altdef_int, auto) + +lemma cong_zero_nat [iff]: "[(a::nat) = b] (mod 0) = (a = b)" + by (auto simp add: cong_nat_def) + +lemma cong_zero_int [iff]: "[(a::int) = b] (mod 0) = (a = b)" + by (auto simp add: cong_int_def) + +(* +lemma mod_dvd_mod_int: + "0 < (m::int) \ m dvd b \ (a mod b mod m) = (a mod m)" + apply (unfold dvd_def, auto) + apply (rule mod_mod_cancel) + apply auto +done + +lemma mod_dvd_mod: + assumes "0 < (m::nat)" and "m dvd b" + shows "(a mod b mod m) = (a mod m)" + + apply (rule mod_dvd_mod_int [transferred]) + using prems apply auto +done +*) + +lemma cong_add_lcancel_nat: + "[(a::nat) + x = a + y] (mod n) \ [x = y] (mod n)" + by (simp add: cong_iff_lin_nat) + +lemma cong_add_lcancel_int: + "[(a::int) + x = a + y] (mod n) \ [x = y] (mod n)" + by (simp add: cong_iff_lin_int) + +lemma cong_add_rcancel_nat: "[(x::nat) + a = y + a] (mod n) \ [x = y] (mod n)" + by (simp add: cong_iff_lin_nat) + +lemma cong_add_rcancel_int: "[(x::int) + a = y + a] (mod n) \ [x = y] (mod n)" + by (simp add: cong_iff_lin_int) + +lemma cong_add_lcancel_0_nat: "[(a::nat) + x = a] (mod n) \ [x = 0] (mod n)" + by (simp add: cong_iff_lin_nat) + +lemma cong_add_lcancel_0_int: "[(a::int) + x = a] (mod n) \ [x = 0] (mod n)" + by (simp add: cong_iff_lin_int) + +lemma cong_add_rcancel_0_nat: "[x + (a::nat) = a] (mod n) \ [x = 0] (mod n)" + by (simp add: cong_iff_lin_nat) + +lemma cong_add_rcancel_0_int: "[x + (a::int) = a] (mod n) \ [x = 0] (mod n)" + by (simp add: cong_iff_lin_int) + +lemma cong_dvd_modulus_nat: "[(x::nat) = y] (mod m) \ n dvd m \ + [x = y] (mod n)" + apply (auto simp add: cong_iff_lin_nat dvd_def) + apply (rule_tac x="k1 * k" in exI) + apply (rule_tac x="k2 * k" in exI) + apply (simp add: ring_simps) +done + +lemma cong_dvd_modulus_int: "[(x::int) = y] (mod m) \ n dvd m \ + [x = y] (mod n)" + by (auto simp add: cong_altdef_int dvd_def) + +lemma cong_dvd_eq_nat: "[(x::nat) = y] (mod n) \ n dvd x \ n dvd y" + by (unfold cong_nat_def, auto simp add: dvd_eq_mod_eq_0) + +lemma cong_dvd_eq_int: "[(x::int) = y] (mod n) \ n dvd x \ n dvd y" + by (unfold cong_int_def, auto simp add: dvd_eq_mod_eq_0) + +lemma cong_mod_nat: "(n::nat) ~= 0 \ [a mod n = a] (mod n)" + by (simp add: cong_nat_def) + +lemma cong_mod_int: "(n::int) ~= 0 \ [a mod n = a] (mod n)" + by (simp add: cong_int_def) + +lemma mod_mult_cong_nat: "(a::nat) ~= 0 \ b ~= 0 + \ [x mod (a * b) = y] (mod a) \ [x = y] (mod a)" + by (simp add: cong_nat_def mod_mult2_eq mod_add_left_eq) + +lemma neg_cong_int: "([(a::int) = b] (mod m)) = ([-a = -b] (mod m))" + apply (simp add: cong_altdef_int) + apply (subst dvd_minus_iff [symmetric]) + apply (simp add: ring_simps) +done + +lemma cong_modulus_neg_int: "([(a::int) = b] (mod m)) = ([a = b] (mod -m))" + by (auto simp add: cong_altdef_int) + +lemma mod_mult_cong_int: "(a::int) ~= 0 \ b ~= 0 + \ [x mod (a * b) = y] (mod a) \ [x = y] (mod a)" + apply (case_tac "b > 0") + apply (simp add: cong_int_def mod_mod_cancel mod_add_left_eq) + apply (subst (1 2) cong_modulus_neg_int) + apply (unfold cong_int_def) + apply (subgoal_tac "a * b = (-a * -b)") + apply (erule ssubst) + apply (subst zmod_zmult2_eq) + apply (auto simp add: mod_add_left_eq) +done + +lemma cong_to_1_nat: "([(a::nat) = 1] (mod n)) \ (n dvd (a - 1))" + apply (case_tac "a = 0") + apply force + apply (subst (asm) cong_altdef_nat) + apply auto +done + +lemma cong_0_1_nat: "[(0::nat) = 1] (mod n) = (n = 1)" + by (unfold cong_nat_def, auto) + +lemma cong_0_1_int: "[(0::int) = 1] (mod n) = ((n = 1) | (n = -1))" + by (unfold cong_int_def, auto simp add: zmult_eq_1_iff) + +lemma cong_to_1'_nat: "[(a::nat) = 1] (mod n) \ + a = 0 \ n = 1 \ (\m. a = 1 + m * n)" + apply (case_tac "n = 1") + apply auto [1] + apply (drule_tac x = "a - 1" in spec) + apply force + apply (case_tac "a = 0") + apply (auto simp add: cong_0_1_nat) [1] + apply (rule iffI) + apply (drule cong_to_1_nat) + apply (unfold dvd_def) + apply auto [1] + apply (rule_tac x = k in exI) + apply (auto simp add: ring_simps) [1] + apply (subst cong_altdef_nat) + apply (auto simp add: dvd_def) +done + +lemma cong_le_nat: "(y::nat) <= x \ [x = y] (mod n) \ (\q. x = q * n + y)" + apply (subst cong_altdef_nat) + apply assumption + apply (unfold dvd_def, auto simp add: ring_simps) + apply (rule_tac x = k in exI) + apply auto +done + +lemma cong_solve_nat: "(a::nat) \ 0 \ EX x. [a * x = gcd a n] (mod n)" + apply (case_tac "n = 0") + apply force + apply (frule bezout_nat [of a n], auto) + apply (rule exI, erule ssubst) + apply (rule cong_trans_nat) + apply (rule cong_add_nat) + apply (subst mult_commute) + apply (rule cong_mult_self_nat) + prefer 2 + apply simp + apply (rule cong_refl_nat) + apply (rule cong_refl_nat) +done + +lemma cong_solve_int: "(a::int) \ 0 \ EX x. [a * x = gcd a n] (mod n)" + apply (case_tac "n = 0") + apply (case_tac "a \ 0") + apply auto + apply (rule_tac x = "-1" in exI) + apply auto + apply (insert bezout_int [of a n], auto) + apply (rule exI) + apply (erule subst) + apply (rule cong_trans_int) + prefer 2 + apply (rule cong_add_int) + apply (rule cong_refl_int) + apply (rule cong_sym_int) + apply (rule cong_mult_self_int) + apply simp + apply (subst mult_commute) + apply (rule cong_refl_int) +done + +lemma cong_solve_dvd_nat: + assumes a: "(a::nat) \ 0" and b: "gcd a n dvd d" + shows "EX x. [a * x = d] (mod n)" +proof - + from cong_solve_nat [OF a] obtain x where + "[a * x = gcd a n](mod n)" + by auto + hence "[(d div gcd a n) * (a * x) = (d div gcd a n) * gcd a n] (mod n)" + by (elim cong_scalar2_nat) + also from b have "(d div gcd a n) * gcd a n = d" + by (rule dvd_div_mult_self) + also have "(d div gcd a n) * (a * x) = a * (d div gcd a n * x)" + by auto + finally show ?thesis + by auto +qed + +lemma cong_solve_dvd_int: + assumes a: "(a::int) \ 0" and b: "gcd a n dvd d" + shows "EX x. [a * x = d] (mod n)" +proof - + from cong_solve_int [OF a] obtain x where + "[a * x = gcd a n](mod n)" + by auto + hence "[(d div gcd a n) * (a * x) = (d div gcd a n) * gcd a n] (mod n)" + by (elim cong_scalar2_int) + also from b have "(d div gcd a n) * gcd a n = d" + by (rule dvd_div_mult_self) + also have "(d div gcd a n) * (a * x) = a * (d div gcd a n * x)" + by auto + finally show ?thesis + by auto +qed + +lemma cong_solve_coprime_nat: "coprime (a::nat) n \ + EX x. [a * x = 1] (mod n)" + apply (case_tac "a = 0") + apply force + apply (frule cong_solve_nat [of a n]) + apply auto +done + +lemma cong_solve_coprime_int: "coprime (a::int) n \ + EX x. [a * x = 1] (mod n)" + apply (case_tac "a = 0") + apply auto + apply (case_tac "n \ 0") + apply auto + apply (subst cong_int_def, auto) + apply (frule cong_solve_int [of a n]) + apply auto +done + +lemma coprime_iff_invertible_nat: "m > (1::nat) \ coprime a m = + (EX x. [a * x = 1] (mod m))" + apply (auto intro: cong_solve_coprime_nat) + apply (unfold cong_nat_def, auto intro: invertible_coprime_nat) +done + +lemma coprime_iff_invertible_int: "m > (1::int) \ coprime a m = + (EX x. [a * x = 1] (mod m))" + apply (auto intro: cong_solve_coprime_int) + apply (unfold cong_int_def) + apply (auto intro: invertible_coprime_int) +done + +lemma coprime_iff_invertible'_int: "m > (1::int) \ coprime a m = + (EX x. 0 <= x & x < m & [a * x = 1] (mod m))" + apply (subst coprime_iff_invertible_int) + apply auto + apply (auto simp add: cong_int_def) + apply (rule_tac x = "x mod m" in exI) + apply (auto simp add: mod_mult_right_eq [symmetric]) +done + + +lemma cong_cong_lcm_nat: "[(x::nat) = y] (mod a) \ + [x = y] (mod b) \ [x = y] (mod lcm a b)" + apply (case_tac "y \ x") + apply (auto simp add: cong_altdef_nat lcm_least_nat) [1] + apply (rule cong_sym_nat) + apply (subst (asm) (1 2) cong_sym_eq_nat) + apply (auto simp add: cong_altdef_nat lcm_least_nat) +done + +lemma cong_cong_lcm_int: "[(x::int) = y] (mod a) \ + [x = y] (mod b) \ [x = y] (mod lcm a b)" + by (auto simp add: cong_altdef_int lcm_least_int) [1] + +lemma cong_cong_coprime_nat: "coprime a b \ [(x::nat) = y] (mod a) \ + [x = y] (mod b) \ [x = y] (mod a * b)" + apply (frule (1) cong_cong_lcm_nat)back + apply (simp add: lcm_nat_def) +done + +lemma cong_cong_coprime_int: "coprime a b \ [(x::int) = y] (mod a) \ + [x = y] (mod b) \ [x = y] (mod a * b)" + apply (frule (1) cong_cong_lcm_int)back + apply (simp add: lcm_altdef_int cong_abs_int abs_mult [symmetric]) +done + +lemma cong_cong_setprod_coprime_nat [rule_format]: "finite A \ + (ALL i:A. (ALL j:A. i \ j \ coprime (m i) (m j))) \ + (ALL i:A. [(x::nat) = y] (mod m i)) \ + [x = y] (mod (PROD i:A. m i))" + apply (induct set: finite) + apply auto + apply (rule cong_cong_coprime_nat) + apply (subst gcd_commute_nat) + apply (rule setprod_coprime_nat) + apply auto +done + +lemma cong_cong_setprod_coprime_int [rule_format]: "finite A \ + (ALL i:A. (ALL j:A. i \ j \ coprime (m i) (m j))) \ + (ALL i:A. [(x::int) = y] (mod m i)) \ + [x = y] (mod (PROD i:A. m i))" + apply (induct set: finite) + apply auto + apply (rule cong_cong_coprime_int) + apply (subst gcd_commute_int) + apply (rule setprod_coprime_int) + apply auto +done + +lemma binary_chinese_remainder_aux_nat: + assumes a: "coprime (m1::nat) m2" + shows "EX b1 b2. [b1 = 1] (mod m1) \ [b1 = 0] (mod m2) \ + [b2 = 0] (mod m1) \ [b2 = 1] (mod m2)" +proof - + from cong_solve_coprime_nat [OF a] + obtain x1 where one: "[m1 * x1 = 1] (mod m2)" + by auto + from a have b: "coprime m2 m1" + by (subst gcd_commute_nat) + from cong_solve_coprime_nat [OF b] + obtain x2 where two: "[m2 * x2 = 1] (mod m1)" + by auto + have "[m1 * x1 = 0] (mod m1)" + by (subst mult_commute, rule cong_mult_self_nat) + moreover have "[m2 * x2 = 0] (mod m2)" + by (subst mult_commute, rule cong_mult_self_nat) + moreover note one two + ultimately show ?thesis by blast +qed + +lemma binary_chinese_remainder_aux_int: + assumes a: "coprime (m1::int) m2" + shows "EX b1 b2. [b1 = 1] (mod m1) \ [b1 = 0] (mod m2) \ + [b2 = 0] (mod m1) \ [b2 = 1] (mod m2)" +proof - + from cong_solve_coprime_int [OF a] + obtain x1 where one: "[m1 * x1 = 1] (mod m2)" + by auto + from a have b: "coprime m2 m1" + by (subst gcd_commute_int) + from cong_solve_coprime_int [OF b] + obtain x2 where two: "[m2 * x2 = 1] (mod m1)" + by auto + have "[m1 * x1 = 0] (mod m1)" + by (subst mult_commute, rule cong_mult_self_int) + moreover have "[m2 * x2 = 0] (mod m2)" + by (subst mult_commute, rule cong_mult_self_int) + moreover note one two + ultimately show ?thesis by blast +qed + +lemma binary_chinese_remainder_nat: + assumes a: "coprime (m1::nat) m2" + shows "EX x. [x = u1] (mod m1) \ [x = u2] (mod m2)" +proof - + from binary_chinese_remainder_aux_nat [OF a] obtain b1 b2 + where "[b1 = 1] (mod m1)" and "[b1 = 0] (mod m2)" and + "[b2 = 0] (mod m1)" and "[b2 = 1] (mod m2)" + by blast + let ?x = "u1 * b1 + u2 * b2" + have "[?x = u1 * 1 + u2 * 0] (mod m1)" + apply (rule cong_add_nat) + apply (rule cong_scalar2_nat) + apply (rule `[b1 = 1] (mod m1)`) + apply (rule cong_scalar2_nat) + apply (rule `[b2 = 0] (mod m1)`) + done + hence "[?x = u1] (mod m1)" by simp + have "[?x = u1 * 0 + u2 * 1] (mod m2)" + apply (rule cong_add_nat) + apply (rule cong_scalar2_nat) + apply (rule `[b1 = 0] (mod m2)`) + apply (rule cong_scalar2_nat) + apply (rule `[b2 = 1] (mod m2)`) + done + hence "[?x = u2] (mod m2)" by simp + with `[?x = u1] (mod m1)` show ?thesis by blast +qed + +lemma binary_chinese_remainder_int: + assumes a: "coprime (m1::int) m2" + shows "EX x. [x = u1] (mod m1) \ [x = u2] (mod m2)" +proof - + from binary_chinese_remainder_aux_int [OF a] obtain b1 b2 + where "[b1 = 1] (mod m1)" and "[b1 = 0] (mod m2)" and + "[b2 = 0] (mod m1)" and "[b2 = 1] (mod m2)" + by blast + let ?x = "u1 * b1 + u2 * b2" + have "[?x = u1 * 1 + u2 * 0] (mod m1)" + apply (rule cong_add_int) + apply (rule cong_scalar2_int) + apply (rule `[b1 = 1] (mod m1)`) + apply (rule cong_scalar2_int) + apply (rule `[b2 = 0] (mod m1)`) + done + hence "[?x = u1] (mod m1)" by simp + have "[?x = u1 * 0 + u2 * 1] (mod m2)" + apply (rule cong_add_int) + apply (rule cong_scalar2_int) + apply (rule `[b1 = 0] (mod m2)`) + apply (rule cong_scalar2_int) + apply (rule `[b2 = 1] (mod m2)`) + done + hence "[?x = u2] (mod m2)" by simp + with `[?x = u1] (mod m1)` show ?thesis by blast +qed + +lemma cong_modulus_mult_nat: "[(x::nat) = y] (mod m * n) \ + [x = y] (mod m)" + apply (case_tac "y \ x") + apply (simp add: cong_altdef_nat) + apply (erule dvd_mult_left) + apply (rule cong_sym_nat) + apply (subst (asm) cong_sym_eq_nat) + apply (simp add: cong_altdef_nat) + apply (erule dvd_mult_left) +done + +lemma cong_modulus_mult_int: "[(x::int) = y] (mod m * n) \ + [x = y] (mod m)" + apply (simp add: cong_altdef_int) + apply (erule dvd_mult_left) +done + +lemma cong_less_modulus_unique_nat: + "[(x::nat) = y] (mod m) \ x < m \ y < m \ x = y" + by (simp add: cong_nat_def) + +lemma binary_chinese_remainder_unique_nat: + assumes a: "coprime (m1::nat) m2" and + nz: "m1 \ 0" "m2 \ 0" + shows "EX! x. x < m1 * m2 \ [x = u1] (mod m1) \ [x = u2] (mod m2)" +proof - + from binary_chinese_remainder_nat [OF a] obtain y where + "[y = u1] (mod m1)" and "[y = u2] (mod m2)" + by blast + let ?x = "y mod (m1 * m2)" + from nz have less: "?x < m1 * m2" + by auto + have one: "[?x = u1] (mod m1)" + apply (rule cong_trans_nat) + prefer 2 + apply (rule `[y = u1] (mod m1)`) + apply (rule cong_modulus_mult_nat) + apply (rule cong_mod_nat) + using nz apply auto + done + have two: "[?x = u2] (mod m2)" + apply (rule cong_trans_nat) + prefer 2 + apply (rule `[y = u2] (mod m2)`) + apply (subst mult_commute) + apply (rule cong_modulus_mult_nat) + apply (rule cong_mod_nat) + using nz apply auto + done + have "ALL z. z < m1 * m2 \ [z = u1] (mod m1) \ [z = u2] (mod m2) \ + z = ?x" + proof (clarify) + fix z + assume "z < m1 * m2" + assume "[z = u1] (mod m1)" and "[z = u2] (mod m2)" + have "[?x = z] (mod m1)" + apply (rule cong_trans_nat) + apply (rule `[?x = u1] (mod m1)`) + apply (rule cong_sym_nat) + apply (rule `[z = u1] (mod m1)`) + done + moreover have "[?x = z] (mod m2)" + apply (rule cong_trans_nat) + apply (rule `[?x = u2] (mod m2)`) + apply (rule cong_sym_nat) + apply (rule `[z = u2] (mod m2)`) + done + ultimately have "[?x = z] (mod m1 * m2)" + by (auto intro: coprime_cong_mult_nat a) + with `z < m1 * m2` `?x < m1 * m2` show "z = ?x" + apply (intro cong_less_modulus_unique_nat) + apply (auto, erule cong_sym_nat) + done + qed + with less one two show ?thesis + by auto + qed + +lemma chinese_remainder_aux_nat: + fixes A :: "'a set" and + m :: "'a \ nat" + assumes fin: "finite A" and + cop: "ALL i : A. (ALL j : A. i \ j \ coprime (m i) (m j))" + shows "EX b. (ALL i : A. + [b i = 1] (mod m i) \ [b i = 0] (mod (PROD j : A - {i}. m j)))" +proof (rule finite_set_choice, rule fin, rule ballI) + fix i + assume "i : A" + with cop have "coprime (PROD j : A - {i}. m j) (m i)" + by (intro setprod_coprime_nat, auto) + hence "EX x. [(PROD j : A - {i}. m j) * x = 1] (mod m i)" + by (elim cong_solve_coprime_nat) + then obtain x where "[(PROD j : A - {i}. m j) * x = 1] (mod m i)" + by auto + moreover have "[(PROD j : A - {i}. m j) * x = 0] + (mod (PROD j : A - {i}. m j))" + by (subst mult_commute, rule cong_mult_self_nat) + ultimately show "\a. [a = 1] (mod m i) \ [a = 0] + (mod setprod m (A - {i}))" + by blast +qed + +lemma chinese_remainder_nat: + fixes A :: "'a set" and + m :: "'a \ nat" and + u :: "'a \ nat" + assumes + fin: "finite A" and + cop: "ALL i:A. (ALL j : A. i \ j \ coprime (m i) (m j))" + shows "EX x. (ALL i:A. [x = u i] (mod m i))" +proof - + from chinese_remainder_aux_nat [OF fin cop] obtain b where + bprop: "ALL i:A. [b i = 1] (mod m i) \ + [b i = 0] (mod (PROD j : A - {i}. m j))" + by blast + let ?x = "SUM i:A. (u i) * (b i)" + show "?thesis" + proof (rule exI, clarify) + fix i + assume a: "i : A" + show "[?x = u i] (mod m i)" + proof - + from fin a have "?x = (SUM j:{i}. u j * b j) + + (SUM j:A-{i}. u j * b j)" + by (subst setsum_Un_disjoint [symmetric], auto intro: setsum_cong) + hence "[?x = u i * b i + (SUM j:A-{i}. u j * b j)] (mod m i)" + by auto + also have "[u i * b i + (SUM j:A-{i}. u j * b j) = + u i * 1 + (SUM j:A-{i}. u j * 0)] (mod m i)" + apply (rule cong_add_nat) + apply (rule cong_scalar2_nat) + using bprop a apply blast + apply (rule cong_setsum_nat) + apply (rule cong_scalar2_nat) + using bprop apply auto + apply (rule cong_dvd_modulus_nat) + apply (drule (1) bspec) + apply (erule conjE) + apply assumption + apply (rule dvd_setprod) + using fin a apply auto + done + finally show ?thesis + by simp + qed + qed +qed + +lemma coprime_cong_prod_nat [rule_format]: "finite A \ + (ALL i: A. (ALL j: A. i \ j \ coprime (m i) (m j))) \ + (ALL i: A. [(x::nat) = y] (mod m i)) \ + [x = y] (mod (PROD i:A. m i))" + apply (induct set: finite) + apply auto + apply (erule (1) coprime_cong_mult_nat) + apply (subst gcd_commute_nat) + apply (rule setprod_coprime_nat) + apply auto +done + +lemma chinese_remainder_unique_nat: + fixes A :: "'a set" and + m :: "'a \ nat" and + u :: "'a \ nat" + assumes + fin: "finite A" and + nz: "ALL i:A. m i \ 0" and + cop: "ALL i:A. (ALL j : A. i \ j \ coprime (m i) (m j))" + shows "EX! x. x < (PROD i:A. m i) \ (ALL i:A. [x = u i] (mod m i))" +proof - + from chinese_remainder_nat [OF fin cop] obtain y where + one: "(ALL i:A. [y = u i] (mod m i))" + by blast + let ?x = "y mod (PROD i:A. m i)" + from fin nz have prodnz: "(PROD i:A. m i) \ 0" + by auto + hence less: "?x < (PROD i:A. m i)" + by auto + have cong: "ALL i:A. [?x = u i] (mod m i)" + apply auto + apply (rule cong_trans_nat) + prefer 2 + using one apply auto + apply (rule cong_dvd_modulus_nat) + apply (rule cong_mod_nat) + using prodnz apply auto + apply (rule dvd_setprod) + apply (rule fin) + apply assumption + done + have unique: "ALL z. z < (PROD i:A. m i) \ + (ALL i:A. [z = u i] (mod m i)) \ z = ?x" + proof (clarify) + fix z + assume zless: "z < (PROD i:A. m i)" + assume zcong: "(ALL i:A. [z = u i] (mod m i))" + have "ALL i:A. [?x = z] (mod m i)" + apply clarify + apply (rule cong_trans_nat) + using cong apply (erule bspec) + apply (rule cong_sym_nat) + using zcong apply auto + done + with fin cop have "[?x = z] (mod (PROD i:A. m i))" + by (intro coprime_cong_prod_nat, auto) + with zless less show "z = ?x" + apply (intro cong_less_modulus_unique_nat) + apply (auto, erule cong_sym_nat) + done + qed + from less cong unique show ?thesis + by blast +qed + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/Fib.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/Fib.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,319 @@ +(* Title: Fib.thy + Authors: Lawrence C. Paulson, Jeremy Avigad + + +Defines the fibonacci function. + +The original "Fib" is due to Lawrence C. Paulson, and was adapted by +Jeremy Avigad. +*) + + +header {* Fib *} + +theory Fib +imports Binomial +begin + + +subsection {* Main definitions *} + +class fib = + +fixes + fib :: "'a \ 'a" + + +(* definition for the natural numbers *) + +instantiation nat :: fib + +begin + +fun + fib_nat :: "nat \ nat" +where + "fib_nat n = + (if n = 0 then 0 else + (if n = 1 then 1 else + fib (n - 1) + fib (n - 2)))" + +instance proof qed + +end + +(* definition for the integers *) + +instantiation int :: fib + +begin + +definition + fib_int :: "int \ int" +where + "fib_int n = (if n >= 0 then int (fib (nat n)) else 0)" + +instance proof qed + +end + + +subsection {* Set up Transfer *} + + +lemma transfer_nat_int_fib: + "(x::int) >= 0 \ fib (nat x) = nat (fib x)" + unfolding fib_int_def by auto + +lemma transfer_nat_int_fib_closure: + "n >= (0::int) \ fib n >= 0" + by (auto simp add: fib_int_def) + +declare TransferMorphism_nat_int[transfer add return: + transfer_nat_int_fib transfer_nat_int_fib_closure] + +lemma transfer_int_nat_fib: + "fib (int n) = int (fib n)" + unfolding fib_int_def by auto + +lemma transfer_int_nat_fib_closure: + "is_nat n \ fib n >= 0" + unfolding fib_int_def by auto + +declare TransferMorphism_int_nat[transfer add return: + transfer_int_nat_fib transfer_int_nat_fib_closure] + + +subsection {* Fibonacci numbers *} + +lemma fib_0_nat [simp]: "fib (0::nat) = 0" + by simp + +lemma fib_0_int [simp]: "fib (0::int) = 0" + unfolding fib_int_def by simp + +lemma fib_1_nat [simp]: "fib (1::nat) = 1" + by simp + +lemma fib_Suc_0_nat [simp]: "fib (Suc 0) = Suc 0" + by simp + +lemma fib_1_int [simp]: "fib (1::int) = 1" + unfolding fib_int_def by simp + +lemma fib_reduce_nat: "(n::nat) >= 2 \ fib n = fib (n - 1) + fib (n - 2)" + by simp + +declare fib_nat.simps [simp del] + +lemma fib_reduce_int: "(n::int) >= 2 \ fib n = fib (n - 1) + fib (n - 2)" + unfolding fib_int_def + by (auto simp add: fib_reduce_nat nat_diff_distrib) + +lemma fib_neg_int [simp]: "(n::int) < 0 \ fib n = 0" + unfolding fib_int_def by auto + +lemma fib_2_nat [simp]: "fib (2::nat) = 1" + by (subst fib_reduce_nat, auto) + +lemma fib_2_int [simp]: "fib (2::int) = 1" + by (subst fib_reduce_int, auto) + +lemma fib_plus_2_nat: "fib ((n::nat) + 2) = fib (n + 1) + fib n" + by (subst fib_reduce_nat, auto simp add: One_nat_def) +(* the need for One_nat_def is due to the natdiff_cancel_numerals + procedure *) + +lemma fib_induct_nat: "P (0::nat) \ P (1::nat) \ + (!!n. P n \ P (n + 1) \ P (n + 2)) \ P n" + apply (atomize, induct n rule: nat_less_induct) + apply auto + apply (case_tac "n = 0", force) + apply (case_tac "n = 1", force) + apply (subgoal_tac "n >= 2") + apply (frule_tac x = "n - 1" in spec) + apply (drule_tac x = "n - 2" in spec) + apply (drule_tac x = "n - 2" in spec) + apply auto + apply (auto simp add: One_nat_def) (* again, natdiff_cancel *) +done + +lemma fib_add_nat: "fib ((n::nat) + k + 1) = fib (k + 1) * fib (n + 1) + + fib k * fib n" + apply (induct n rule: fib_induct_nat) + apply auto + apply (subst fib_reduce_nat) + apply (auto simp add: ring_simps) + apply (subst (1 3 5) fib_reduce_nat) + apply (auto simp add: ring_simps Suc_eq_plus1) +(* hmmm. Why doesn't "n + (1 + (1 + k))" simplify to "n + k + 2"? *) + apply (subgoal_tac "n + (k + 2) = n + (1 + (1 + k))") + apply (erule ssubst) back back + apply (erule ssubst) back + apply auto +done + +lemma fib_add'_nat: "fib (n + Suc k) = fib (Suc k) * fib (Suc n) + + fib k * fib n" + using fib_add_nat by (auto simp add: One_nat_def) + + +(* transfer from nats to ints *) +lemma fib_add_int [rule_format]: "(n::int) >= 0 \ k >= 0 \ + fib (n + k + 1) = fib (k + 1) * fib (n + 1) + + fib k * fib n " + + by (rule fib_add_nat [transferred]) + +lemma fib_neq_0_nat: "(n::nat) > 0 \ fib n ~= 0" + apply (induct n rule: fib_induct_nat) + apply (auto simp add: fib_plus_2_nat) +done + +lemma fib_gr_0_nat: "(n::nat) > 0 \ fib n > 0" + by (frule fib_neq_0_nat, simp) + +lemma fib_gr_0_int: "(n::int) > 0 \ fib n > 0" + unfolding fib_int_def by (simp add: fib_gr_0_nat) + +text {* + \medskip Concrete Mathematics, page 278: Cassini's identity. The proof is + much easier using integers, not natural numbers! +*} + +lemma fib_Cassini_aux_int: "fib (int n + 2) * fib (int n) - + (fib (int n + 1))^2 = (-1)^(n + 1)" + apply (induct n) + apply (auto simp add: ring_simps power2_eq_square fib_reduce_int + power_add) +done + +lemma fib_Cassini_int: "n >= 0 \ fib (n + 2) * fib n - + (fib (n + 1))^2 = (-1)^(nat n + 1)" + by (insert fib_Cassini_aux_int [of "nat n"], auto) + +(* +lemma fib_Cassini'_int: "n >= 0 \ fib (n + 2) * fib n = + (fib (n + 1))^2 + (-1)^(nat n + 1)" + by (frule fib_Cassini_int, simp) +*) + +lemma fib_Cassini'_int: "n >= 0 \ fib ((n::int) + 2) * fib n = + (if even n then tsub ((fib (n + 1))^2) 1 + else (fib (n + 1))^2 + 1)" + apply (frule fib_Cassini_int, auto simp add: pos_int_even_equiv_nat_even) + apply (subst tsub_eq) + apply (insert fib_gr_0_int [of "n + 1"], force) + apply auto +done + +lemma fib_Cassini_nat: "fib ((n::nat) + 2) * fib n = + (if even n then (fib (n + 1))^2 - 1 + else (fib (n + 1))^2 + 1)" + + by (rule fib_Cassini'_int [transferred, of n], auto) + + +text {* \medskip Toward Law 6.111 of Concrete Mathematics *} + +lemma coprime_fib_plus_1_nat: "coprime (fib (n::nat)) (fib (n + 1))" + apply (induct n rule: fib_induct_nat) + apply auto + apply (subst (2) fib_reduce_nat) + apply (auto simp add: Suc_eq_plus1) (* again, natdiff_cancel *) + apply (subst add_commute, auto) + apply (subst gcd_commute_nat, auto simp add: ring_simps) +done + +lemma coprime_fib_Suc_nat: "coprime (fib n) (fib (Suc n))" + using coprime_fib_plus_1_nat by (simp add: One_nat_def) + +lemma coprime_fib_plus_1_int: + "n >= 0 \ coprime (fib (n::int)) (fib (n + 1))" + by (erule coprime_fib_plus_1_nat [transferred]) + +lemma gcd_fib_add_nat: "gcd (fib (m::nat)) (fib (n + m)) = gcd (fib m) (fib n)" + apply (simp add: gcd_commute_nat [of "fib m"]) + apply (rule cases_nat [of _ m]) + apply simp + apply (subst add_assoc [symmetric]) + apply (simp add: fib_add_nat) + apply (subst gcd_commute_nat) + apply (subst mult_commute) + apply (subst gcd_add_mult_nat) + apply (subst gcd_commute_nat) + apply (rule gcd_mult_cancel_nat) + apply (rule coprime_fib_plus_1_nat) +done + +lemma gcd_fib_add_int [rule_format]: "m >= 0 \ n >= 0 \ + gcd (fib (m::int)) (fib (n + m)) = gcd (fib m) (fib n)" + by (erule gcd_fib_add_nat [transferred]) + +lemma gcd_fib_diff_nat: "(m::nat) \ n \ + gcd (fib m) (fib (n - m)) = gcd (fib m) (fib n)" + by (simp add: gcd_fib_add_nat [symmetric, of _ "n-m"]) + +lemma gcd_fib_diff_int: "0 <= (m::int) \ m \ n \ + gcd (fib m) (fib (n - m)) = gcd (fib m) (fib n)" + by (simp add: gcd_fib_add_int [symmetric, of _ "n-m"]) + +lemma gcd_fib_mod_nat: "0 < (m::nat) \ + 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 \ 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 "\ = gcd (fib m) (fib (n - m))" + by (simp add: less.hyps diff pos_m) + also have "\ = gcd (fib m) (fib n)" by (simp add: gcd_fib_diff_nat 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 gcd_fib_mod_int: + assumes "0 < (m::int)" and "0 <= n" + shows "gcd (fib m) (fib (n mod m)) = gcd (fib m) (fib n)" + + apply (rule gcd_fib_mod_nat [transferred]) + using prems apply auto +done + +lemma fib_gcd_nat: "fib (gcd (m::nat) n) = gcd (fib m) (fib n)" + -- {* Law 6.111 *} + apply (induct m n rule: gcd_nat_induct) + apply (simp_all add: gcd_non_0_nat gcd_commute_nat gcd_fib_mod_nat) +done + +lemma fib_gcd_int: "m >= 0 \ n >= 0 \ + fib (gcd (m::int) n) = gcd (fib m) (fib n)" + by (erule fib_gcd_nat [transferred]) + +lemma atMost_plus_one_nat: "{..(k::nat) + 1} = insert (k + 1) {..k}" + by auto + +theorem fib_mult_eq_setsum_nat: + "fib ((n::nat) + 1) * fib n = (\k \ {..n}. fib k * fib k)" + apply (induct n) + apply (auto simp add: atMost_plus_one_nat fib_plus_2_nat ring_simps) +done + +theorem fib_mult_eq_setsum'_nat: + "fib (Suc n) * fib n = (\k \ {..n}. fib k * fib k)" + using fib_mult_eq_setsum_nat by (simp add: One_nat_def) + +theorem fib_mult_eq_setsum_int [rule_format]: + "n >= 0 \ fib ((n::int) + 1) * fib n = (\k \ {0..n}. fib k * fib k)" + by (erule fib_mult_eq_setsum_nat [transferred]) + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/MiscAlgebra.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/MiscAlgebra.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,355 @@ +(* Title: MiscAlgebra.thy + Author: Jeremy Avigad + +These are things that can be added to the Algebra library. +*) + +theory MiscAlgebra +imports + "~~/src/HOL/Algebra/Ring" + "~~/src/HOL/Algebra/FiniteProduct" +begin; + +(* finiteness stuff *) + +lemma bounded_set1_int [intro]: "finite {(x::int). a < x & x < b & P x}" + apply (subgoal_tac "{x. a < x & x < b & P x} <= {a<.. 'a monoid" + "units_of G == (| carrier = Units G, + Group.monoid.mult = Group.monoid.mult G, + one = one G |)"; + +(* + +lemma (in monoid) Units_mult_closed [intro]: + "x : Units G ==> y : Units G ==> x \ y : Units G" + apply (unfold Units_def) + apply (clarsimp) + apply (rule_tac x = "xaa \ xa" in bexI) + apply auto + apply (subst m_assoc) + apply auto + apply (subst (2) m_assoc [symmetric]) + apply auto + apply (subst m_assoc) + apply auto + apply (subst (2) m_assoc [symmetric]) + apply auto +done + +*) + +lemma (in monoid) units_group: "group(units_of G)" + apply (unfold units_of_def) + apply (rule groupI) + apply auto + apply (subst m_assoc) + apply auto + apply (rule_tac x = "inv x" in bexI) + apply auto +done + +lemma (in comm_monoid) units_comm_group: "comm_group(units_of G)" + apply (rule group.group_comm_groupI) + apply (rule units_group) + apply (insert prems) + apply (unfold units_of_def Units_def comm_monoid_def comm_monoid_axioms_def) + apply auto; +done; + +lemma units_of_carrier: "carrier (units_of G) = Units G" + by (unfold units_of_def, auto) + +lemma units_of_mult: "mult(units_of G) = mult G" + by (unfold units_of_def, auto) + +lemma units_of_one: "one(units_of G) = one G" + by (unfold units_of_def, auto) + +lemma (in monoid) units_of_inv: "x : Units G ==> + m_inv (units_of G) x = m_inv G x" + apply (rule sym) + apply (subst m_inv_def) + apply (rule the1_equality) + apply (rule ex_ex1I) + apply (subst (asm) Units_def) + apply auto + apply (erule inv_unique) + apply auto + apply (rule Units_closed) + apply (simp_all only: units_of_carrier [symmetric]) + apply (insert units_group) + apply auto + apply (subst units_of_mult [symmetric]) + apply (subst units_of_one [symmetric]) + apply (erule group.r_inv, assumption) + apply (subst units_of_mult [symmetric]) + apply (subst units_of_one [symmetric]) + apply (erule group.l_inv, assumption) +done + +lemma (in group) inj_on_const_mult: "a: (carrier G) ==> + inj_on (%x. a \ x) (carrier G)" + by (unfold inj_on_def, auto) + +lemma (in group) surj_const_mult: "a : (carrier G) ==> + (%x. a \ x) ` (carrier G) = (carrier G)" + apply (auto simp add: image_def) + apply (rule_tac x = "(m_inv G a) \ x" in bexI) + apply auto +(* auto should get this. I suppose we need "comm_monoid_simprules" + for mult_ac rewriting. *) + apply (subst m_assoc [symmetric]) + apply auto +done + +lemma (in group) l_cancel_one [simp]: "x : carrier G \ a : carrier G \ + (x \ a = x) = (a = one G)" + apply auto + apply (subst l_cancel [symmetric]) + prefer 4 + apply (erule ssubst) + apply auto +done + +lemma (in group) r_cancel_one [simp]: "x : carrier G \ a : carrier G \ + (a \ x = x) = (a = one G)" + apply auto + apply (subst r_cancel [symmetric]) + prefer 4 + apply (erule ssubst) + apply auto +done + +(* Is there a better way to do this? *) + +lemma (in group) l_cancel_one' [simp]: "x : carrier G \ a : carrier G \ + (x = x \ a) = (a = one G)" + by (subst eq_commute, simp) + +lemma (in group) r_cancel_one' [simp]: "x : carrier G \ a : carrier G \ + (x = a \ x) = (a = one G)" + by (subst eq_commute, simp) + +(* This should be generalized to arbitrary groups, not just commutative + ones, using Lagrange's theorem. *) + +lemma (in comm_group) power_order_eq_one: + assumes fin [simp]: "finite (carrier G)" + and a [simp]: "a : carrier G" + shows "a (^) card(carrier G) = one G" +proof - + have "(\x:carrier G. x) = (\x:carrier G. a \ x)" + by (subst (2) finprod_reindex [symmetric], + auto simp add: Pi_def inj_on_const_mult surj_const_mult) + also have "\ = (\x:carrier G. a) \ (\x:carrier G. x)" + by (auto simp add: finprod_multf Pi_def) + also have "(\x:carrier G. a) = a (^) card(carrier G)" + by (auto simp add: finprod_const) + finally show ?thesis +(* uses the preceeding lemma *) + by auto +qed + + +(* Miscellaneous *) + +lemma (in cring) field_intro2: "\\<^bsub>R\<^esub> ~= \\<^bsub>R\<^esub> \ ALL x : carrier R - {\\<^bsub>R\<^esub>}. + x : Units R \ field R" + apply (unfold_locales) + apply (insert prems, auto) + apply (rule trans) + apply (subgoal_tac "a = (a \ b) \ inv b") + apply assumption + apply (subst m_assoc) + apply (auto simp add: Units_r_inv) + apply (unfold Units_def) + apply auto +done + +lemma (in monoid) inv_char: "x : carrier G \ y : carrier G \ + x \ y = \ \ y \ x = \ \ inv x = y" + apply (subgoal_tac "x : Units G") + apply (subgoal_tac "y = inv x \ \") + apply simp + apply (erule subst) + apply (subst m_assoc [symmetric]) + apply auto + apply (unfold Units_def) + apply auto +done + +lemma (in comm_monoid) comm_inv_char: "x : carrier G \ y : carrier G \ + x \ y = \ \ inv x = y" + apply (rule inv_char) + apply auto + apply (subst m_comm, auto) +done + +lemma (in ring) inv_neg_one [simp]: "inv (\ \) = \ \" + apply (rule inv_char) + apply (auto simp add: l_minus r_minus) +done + +lemma (in monoid) inv_eq_imp_eq: "x : Units G \ y : Units G \ + inv x = inv y \ x = y" + apply (subgoal_tac "inv(inv x) = inv(inv y)") + apply (subst (asm) Units_inv_inv)+ + apply auto +done + +lemma (in ring) Units_minus_one_closed [intro]: "\ \ : Units R" + apply (unfold Units_def) + apply auto + apply (rule_tac x = "\ \" in bexI) + apply auto + apply (simp add: l_minus r_minus) +done + +lemma (in monoid) inv_one [simp]: "inv \ = \" + apply (rule inv_char) + apply auto +done + +lemma (in ring) inv_eq_neg_one_eq: "x : Units R \ (inv x = \ \) = (x = \ \)" + apply auto + apply (subst Units_inv_inv [symmetric]) + apply auto +done + +lemma (in monoid) inv_eq_one_eq: "x : Units G \ (inv x = \) = (x = \)" + apply auto + apply (subst Units_inv_inv [symmetric]) + apply auto +done + + +(* This goes in FiniteProduct *) + +lemma (in comm_monoid) finprod_UN_disjoint: + "finite I \ (ALL i:I. finite (A i)) \ (ALL i:I. ALL j:I. i ~= j \ + (A i) Int (A j) = {}) \ + (ALL i:I. ALL x: (A i). g x : carrier G) \ + finprod G g (UNION I A) = finprod G (%i. finprod G g (A i)) I" + apply (induct set: finite) + apply force + apply clarsimp + apply (subst finprod_Un_disjoint) + apply blast + apply (erule finite_UN_I) + apply blast + apply (fastsimp) + apply (auto intro!: funcsetI finprod_closed) +done + +lemma (in comm_monoid) finprod_Union_disjoint: + "[| finite C; (ALL A:C. finite A & (ALL x:A. f x : carrier G)); + (ALL A:C. ALL B:C. A ~= B --> A Int B = {}) |] + ==> finprod G f (Union C) = finprod G (finprod G f) C" + apply (frule finprod_UN_disjoint [of C id f]) + apply (unfold Union_def id_def, auto) +done + +lemma (in comm_monoid) finprod_one [rule_format]: + "finite A \ (ALL x:A. f x = \) \ + finprod G f A = \" +by (induct set: finite) auto + + +(* need better simplification rules for rings *) +(* the next one holds more generally for abelian groups *) + +lemma (in cring) sum_zero_eq_neg: + "x : carrier R \ y : carrier R \ x \ y = \ \ x = \ y" + apply (subgoal_tac "\ y = \ \ \ y") + apply (erule ssubst)back + apply (erule subst) + apply (simp add: ring_simprules)+ +done + +(* there's a name conflict -- maybe "domain" should be + "integral_domain" *) + +lemma (in Ring.domain) square_eq_one: + fixes x + assumes [simp]: "x : carrier R" and + "x \ x = \" + shows "x = \ | x = \\" +proof - + have "(x \ \) \ (x \ \ \) = x \ x \ \ \" + by (simp add: ring_simprules) + also with `x \ x = \` have "\ = \" + by (simp add: ring_simprules) + finally have "(x \ \) \ (x \ \ \) = \" . + hence "(x \ \) = \ | (x \ \ \) = \" + by (intro integral, auto) + thus ?thesis + apply auto + apply (erule notE) + apply (rule sum_zero_eq_neg) + apply auto + apply (subgoal_tac "x = \ (\ \)") + apply (simp add: ring_simprules) + apply (rule sum_zero_eq_neg) + apply auto + done +qed + +lemma (in Ring.domain) inv_eq_self: "x : Units R \ + x = inv x \ x = \ | x = \ \" + apply (rule square_eq_one) + apply auto + apply (erule ssubst)back + apply (erule Units_r_inv) +done + + +(* + The following translates theorems about groups to the facts about + the units of a ring. (The list should be expanded as more things are + needed.) +*) + +lemma (in ring) finite_ring_finite_units [intro]: "finite (carrier R) \ + finite (Units R)" + by (rule finite_subset, auto) + +(* this belongs with MiscAlgebra.thy *) +lemma (in monoid) units_of_pow: + "x : Units G \ x (^)\<^bsub>units_of G\<^esub> (n::nat) = x (^)\<^bsub>G\<^esub> n" + apply (induct n) + apply (auto simp add: units_group group.is_monoid + monoid.nat_pow_0 monoid.nat_pow_Suc units_of_one units_of_mult + One_nat_def) +done + +lemma (in cring) units_power_order_eq_one: "finite (Units R) \ a : Units R + \ a (^) card(Units R) = \" + apply (subst units_of_carrier [symmetric]) + apply (subst units_of_one [symmetric]) + apply (subst units_of_pow [symmetric]) + apply assumption + apply (rule comm_group.power_order_eq_one) + apply (rule units_comm_group) + apply (unfold units_of_def, auto) +done + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/Number_Theory.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/Number_Theory.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,8 @@ + +header {* Comprehensive number theory *} + +theory Number_Theory +imports Fib Residues +begin + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/Primes.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/Primes.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,423 @@ +(* Authors: Christophe Tabacznyj, Lawrence C. Paulson, Amine Chaieb, + Thomas M. Rasmussen, Jeremy Avigad, Tobias Nipkow + + +This file deals with properties of primes. Definitions and lemmas are +proved uniformly for the natural numbers and integers. + +This file combines and revises a number of prior developments. + +The original theories "GCD" and "Primes" were by Christophe Tabacznyj +and Lawrence C. Paulson, based on \cite{davenport92}. They introduced +gcd, lcm, and prime for the natural numbers. + +The original theory "IntPrimes" was by Thomas M. Rasmussen, and +extended gcd, lcm, primes to the integers. Amine Chaieb provided +another extension of the notions to the integers, and added a number +of results to "Primes" and "GCD". IntPrimes also defined and developed +the congruence relations on the integers. The notion was extended to +the natural numbers by Chiaeb. + +Jeremy Avigad combined all of these, made everything uniform for the +natural numbers and the integers, and added a number of new theorems. + +Tobias Nipkow cleaned up a lot. +*) + + +header {* Primes *} + +theory Primes +imports GCD +begin + +declare One_nat_def [simp del] + +class prime = one + + +fixes + prime :: "'a \ bool" + +instantiation nat :: prime + +begin + +definition + prime_nat :: "nat \ bool" +where + [code del]: "prime_nat p = (1 < p \ (\m. m dvd p --> m = 1 \ m = p))" + +instance proof qed + +end + +instantiation int :: prime + +begin + +definition + prime_int :: "int \ bool" +where + [code del]: "prime_int p = prime (nat p)" + +instance proof qed + +end + + +subsection {* Set up Transfer *} + + +lemma transfer_nat_int_prime: + "(x::int) >= 0 \ prime (nat x) = prime x" + unfolding gcd_int_def lcm_int_def prime_int_def + by auto + +declare TransferMorphism_nat_int[transfer add return: + transfer_nat_int_prime] + +lemma transfer_int_nat_prime: + "prime (int x) = prime x" + by (unfold gcd_int_def lcm_int_def prime_int_def, auto) + +declare TransferMorphism_int_nat[transfer add return: + transfer_int_nat_prime] + + +subsection {* Primes *} + +lemma prime_odd_nat: "prime (p::nat) \ p > 2 \ odd p" + unfolding prime_nat_def + apply (subst even_mult_two_ex) + apply clarify + apply (drule_tac x = 2 in spec) + apply auto +done + +lemma prime_odd_int: "prime (p::int) \ p > 2 \ odd p" + unfolding prime_int_def + apply (frule prime_odd_nat) + apply (auto simp add: even_nat_def) +done + +(* FIXME Is there a better way to handle these, rather than making them elim rules? *) + +lemma prime_ge_0_nat [elim]: "prime (p::nat) \ p >= 0" + by (unfold prime_nat_def, auto) + +lemma prime_gt_0_nat [elim]: "prime (p::nat) \ p > 0" + by (unfold prime_nat_def, auto) + +lemma prime_ge_1_nat [elim]: "prime (p::nat) \ p >= 1" + by (unfold prime_nat_def, auto) + +lemma prime_gt_1_nat [elim]: "prime (p::nat) \ p > 1" + by (unfold prime_nat_def, auto) + +lemma prime_ge_Suc_0_nat [elim]: "prime (p::nat) \ p >= Suc 0" + by (unfold prime_nat_def, auto) + +lemma prime_gt_Suc_0_nat [elim]: "prime (p::nat) \ p > Suc 0" + by (unfold prime_nat_def, auto) + +lemma prime_ge_2_nat [elim]: "prime (p::nat) \ p >= 2" + by (unfold prime_nat_def, auto) + +lemma prime_ge_0_int [elim]: "prime (p::int) \ p >= 0" + by (unfold prime_int_def prime_nat_def) auto + +lemma prime_gt_0_int [elim]: "prime (p::int) \ p > 0" + by (unfold prime_int_def prime_nat_def, auto) + +lemma prime_ge_1_int [elim]: "prime (p::int) \ p >= 1" + by (unfold prime_int_def prime_nat_def, auto) + +lemma prime_gt_1_int [elim]: "prime (p::int) \ p > 1" + by (unfold prime_int_def prime_nat_def, auto) + +lemma prime_ge_2_int [elim]: "prime (p::int) \ p >= 2" + by (unfold prime_int_def prime_nat_def, auto) + + +lemma prime_int_altdef: "prime (p::int) = (1 < p \ (\m \ 0. m dvd p \ + m = 1 \ m = p))" + using prime_nat_def [transferred] + apply (case_tac "p >= 0") + by (blast, auto simp add: prime_ge_0_int) + +lemma prime_imp_coprime_nat: "prime (p::nat) \ \ p dvd n \ coprime p n" + apply (unfold prime_nat_def) + apply (metis gcd_dvd1_nat gcd_dvd2_nat) + done + +lemma prime_imp_coprime_int: "prime (p::int) \ \ p dvd n \ coprime p n" + apply (unfold prime_int_altdef) + apply (metis gcd_dvd1_int gcd_dvd2_int gcd_ge_0_int) + done + +lemma prime_dvd_mult_nat: "prime (p::nat) \ p dvd m * n \ p dvd m \ p dvd n" + by (blast intro: coprime_dvd_mult_nat prime_imp_coprime_nat) + +lemma prime_dvd_mult_int: "prime (p::int) \ p dvd m * n \ p dvd m \ p dvd n" + by (blast intro: coprime_dvd_mult_int prime_imp_coprime_int) + +lemma prime_dvd_mult_eq_nat [simp]: "prime (p::nat) \ + p dvd m * n = (p dvd m \ p dvd n)" + by (rule iffI, rule prime_dvd_mult_nat, auto) + +lemma prime_dvd_mult_eq_int [simp]: "prime (p::int) \ + p dvd m * n = (p dvd m \ p dvd n)" + by (rule iffI, rule prime_dvd_mult_int, auto) + +lemma not_prime_eq_prod_nat: "(n::nat) > 1 \ ~ prime n \ + EX m k. n = m * k & 1 < m & m < n & 1 < k & k < n" + unfolding prime_nat_def dvd_def apply auto + by(metis mult_commute linorder_neq_iff linorder_not_le mult_1 n_less_n_mult_m one_le_mult_iff less_imp_le_nat) + +lemma not_prime_eq_prod_int: "(n::int) > 1 \ ~ prime n \ + EX m k. n = m * k & 1 < m & m < n & 1 < k & k < n" + unfolding prime_int_altdef dvd_def + apply auto + by(metis div_mult_self1_is_id div_mult_self2_is_id int_div_less_self int_one_le_iff_zero_less zero_less_mult_pos zless_le) + +lemma prime_dvd_power_nat [rule_format]: "prime (p::nat) --> + n > 0 --> (p dvd x^n --> p dvd x)" + by (induct n rule: nat_induct, auto) + +lemma prime_dvd_power_int [rule_format]: "prime (p::int) --> + n > 0 --> (p dvd x^n --> p dvd x)" + apply (induct n rule: nat_induct, auto) + apply (frule prime_ge_0_int) + apply auto +done + +subsubsection{* Make prime naively executable *} + +lemma zero_not_prime_nat [simp]: "~prime (0::nat)" + by (simp add: prime_nat_def) + +lemma zero_not_prime_int [simp]: "~prime (0::int)" + by (simp add: prime_int_def) + +lemma one_not_prime_nat [simp]: "~prime (1::nat)" + by (simp add: prime_nat_def) + +lemma Suc_0_not_prime_nat [simp]: "~prime (Suc 0)" + by (simp add: prime_nat_def One_nat_def) + +lemma one_not_prime_int [simp]: "~prime (1::int)" + by (simp add: prime_int_def) + +lemma prime_nat_code[code]: + "prime(p::nat) = (p > 1 & (ALL n : {1<.. 1 & (list_all (%n. ~ n dvd p) [2.. 1 & (ALL n : {1<.. 1 & (list_all (%n. ~ n dvd p) [2..p - 1]))" +apply(simp only:prime_int_code list_ball_code greaterThanLessThan_upto) +apply simp +done + +lemmas prime_int_simp_number_of[simp] = prime_int_simp[of "number_of m", standard] + +lemma two_is_prime_nat [simp]: "prime (2::nat)" +by simp + +lemma two_is_prime_int [simp]: "prime (2::int)" +by simp + +text{* A bit of regression testing: *} + +lemma "prime(97::nat)" +by simp + +lemma "prime(97::int)" +by simp + +lemma "prime(997::nat)" +by eval + +lemma "prime(997::int)" +by eval + + +lemma prime_imp_power_coprime_nat: "prime (p::nat) \ ~ p dvd a \ coprime a (p^m)" + apply (rule coprime_exp_nat) + apply (subst gcd_commute_nat) + apply (erule (1) prime_imp_coprime_nat) +done + +lemma prime_imp_power_coprime_int: "prime (p::int) \ ~ p dvd a \ coprime a (p^m)" + apply (rule coprime_exp_int) + apply (subst gcd_commute_int) + apply (erule (1) prime_imp_coprime_int) +done + +lemma primes_coprime_nat: "prime (p::nat) \ prime q \ p \ q \ coprime p q" + apply (rule prime_imp_coprime_nat, assumption) + apply (unfold prime_nat_def, auto) +done + +lemma primes_coprime_int: "prime (p::int) \ prime q \ p \ q \ coprime p q" + apply (rule prime_imp_coprime_int, assumption) + apply (unfold prime_int_altdef, clarify) + apply (drule_tac x = q in spec) + apply (drule_tac x = p in spec) + apply auto +done + +lemma primes_imp_powers_coprime_nat: "prime (p::nat) \ prime q \ p ~= q \ coprime (p^m) (q^n)" + by (rule coprime_exp2_nat, rule primes_coprime_nat) + +lemma primes_imp_powers_coprime_int: "prime (p::int) \ prime q \ p ~= q \ coprime (p^m) (q^n)" + by (rule coprime_exp2_int, rule primes_coprime_int) + +lemma prime_factor_nat: "n \ (1::nat) \ \ p. prime p \ p dvd n" + apply (induct n rule: nat_less_induct) + apply (case_tac "n = 0") + using two_is_prime_nat apply blast + apply (case_tac "prime n") + apply blast + apply (subgoal_tac "n > 1") + apply (frule (1) not_prime_eq_prod_nat) + apply (auto intro: dvd_mult dvd_mult2) +done + +(* An Isar version: + +lemma prime_factor_b_nat: + fixes n :: nat + assumes "n \ 1" + shows "\p. prime p \ p dvd n" + +using `n ~= 1` +proof (induct n rule: less_induct_nat) + fix n :: nat + assume "n ~= 1" and + ih: "\m 1 \ (\p. prime p \ p dvd m)" + thus "\p. prime p \ p dvd n" + proof - + { + assume "n = 0" + moreover note two_is_prime_nat + ultimately have ?thesis + by (auto simp del: two_is_prime_nat) + } + moreover + { + assume "prime n" + hence ?thesis by auto + } + moreover + { + assume "n ~= 0" and "~ prime n" + with `n ~= 1` have "n > 1" by auto + with `~ prime n` and not_prime_eq_prod_nat obtain m k where + "n = m * k" and "1 < m" and "m < n" by blast + with ih obtain p where "prime p" and "p dvd m" by blast + with `n = m * k` have ?thesis by auto + } + ultimately show ?thesis by blast + qed +qed + +*) + +text {* One property of coprimality is easier to prove via prime factors. *} + +lemma prime_divprod_pow_nat: + assumes p: "prime (p::nat)" and ab: "coprime a b" and pab: "p^n dvd a * b" + shows "p^n dvd a \ p^n dvd b" +proof- + {assume "n = 0 \ a = 1 \ b = 1" with pab have ?thesis + apply (cases "n=0", simp_all) + apply (cases "a=1", simp_all) done} + moreover + {assume n: "n \ 0" and a: "a\1" and b: "b\1" + then obtain m where m: "n = Suc m" by (cases n, auto) + from n have "p dvd p^n" by (intro dvd_power, auto) + also note pab + finally have pab': "p dvd a * b". + from prime_dvd_mult_nat[OF p pab'] + have "p dvd a \ 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_common_divisor_nat [OF ab, OF pa] p have "\ p dvd b" by auto + with p have "coprime b p" + by (subst gcd_commute_nat, intro prime_imp_coprime_nat) + hence pnb: "coprime (p^n) b" + by (subst gcd_commute_nat, rule coprime_exp_nat) + from coprime_divprod_nat[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_common_divisor_nat [OF ab, of p] pb p have "\ p dvd a" + by auto + with p have "coprime a p" + by (subst gcd_commute_nat, intro prime_imp_coprime_nat) + hence pna: "coprime (p^n) a" + by (subst gcd_commute_nat, rule coprime_exp_nat) + from coprime_divprod_nat[OF pab pna] have ?thesis by blast } + ultimately have ?thesis by blast} + ultimately show ?thesis by blast +qed + +subsection {* Infinitely many primes *} + +lemma next_prime_bound: "\(p::nat). prime p \ n < p \ p <= fact n + 1" +proof- + have f1: "fact n + 1 \ 1" using fact_ge_one_nat [of n] by arith + from prime_factor_nat [OF f1] + obtain p where "prime p" and "p dvd fact n + 1" by auto + hence "p \ fact n + 1" + by (intro dvd_imp_le, auto) + {assume "p \ n" + from `prime p` have "p \ 1" + by (cases p, simp_all) + with `p <= n` have "p dvd fact n" + by (intro dvd_fact_nat) + with `p dvd fact n + 1` have "p dvd fact n + 1 - fact n" + by (rule dvd_diff_nat) + hence "p dvd 1" by simp + hence "p <= 1" by auto + moreover from `prime p` have "p > 1" by auto + ultimately have False by auto} + hence "n < p" by arith + with `prime p` and `p <= fact n + 1` show ?thesis by auto +qed + +lemma bigger_prime: "\p. prime p \ p > (n::nat)" +using next_prime_bound by auto + +lemma primes_infinite: "\ (finite {(p::nat). prime p})" +proof + assume "finite {(p::nat). prime p}" + with Max_ge have "(EX b. (ALL x : {(p::nat). prime p}. x <= b))" + by auto + then obtain b where "ALL (x::nat). prime x \ x <= b" + by auto + with bigger_prime [of b] show False by auto +qed + + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/ROOT.ML --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/ROOT.ML Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,2 @@ + +use_thy "Number_Theory"; diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/Residues.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/Residues.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,466 @@ +(* Title: HOL/Library/Residues.thy + ID: + Author: Jeremy Avigad + + An algebraic treatment of residue rings, and resulting proofs of + Euler's theorem and Wilson's theorem. +*) + +header {* Residue rings *} + +theory Residues +imports + UniqueFactorization + Binomial + MiscAlgebra +begin + + +(* + + A locale for residue rings + +*) + +constdefs + residue_ring :: "int => int ring" + "residue_ring m == (| + carrier = {0..m - 1}, + mult = (%x y. (x * y) mod m), + one = 1, + zero = 0, + add = (%x y. (x + y) mod m) |)" + +locale residues = + fixes m :: int and R (structure) + assumes m_gt_one: "m > 1" + defines "R == residue_ring m" + +context residues begin + +lemma abelian_group: "abelian_group R" + apply (insert m_gt_one) + apply (rule abelian_groupI) + apply (unfold R_def residue_ring_def) + apply (auto simp add: mod_pos_pos_trivial mod_add_right_eq [symmetric] + add_ac) + apply (case_tac "x = 0") + apply force + apply (subgoal_tac "(x + (m - x)) mod m = 0") + apply (erule bexI) + apply auto +done + +lemma comm_monoid: "comm_monoid R" + apply (insert m_gt_one) + apply (unfold R_def residue_ring_def) + apply (rule comm_monoidI) + apply auto + apply (subgoal_tac "x * y mod m * z mod m = z * (x * y mod m) mod m") + apply (erule ssubst) + apply (subst zmod_zmult1_eq [symmetric])+ + apply (simp_all only: mult_ac) +done + +lemma cring: "cring R" + apply (rule cringI) + apply (rule abelian_group) + apply (rule comm_monoid) + apply (unfold R_def residue_ring_def, auto) + apply (subst mod_add_eq [symmetric]) + apply (subst mult_commute) + apply (subst zmod_zmult1_eq [symmetric]) + apply (simp add: ring_simps) +done + +end + +sublocale residues < cring + by (rule cring) + + +context residues begin + +(* These lemmas translate back and forth between internal and + external concepts *) + +lemma res_carrier_eq: "carrier R = {0..m - 1}" + by (unfold R_def residue_ring_def, auto) + +lemma res_add_eq: "x \ y = (x + y) mod m" + by (unfold R_def residue_ring_def, auto) + +lemma res_mult_eq: "x \ y = (x * y) mod m" + by (unfold R_def residue_ring_def, auto) + +lemma res_zero_eq: "\ = 0" + by (unfold R_def residue_ring_def, auto) + +lemma res_one_eq: "\ = 1" + by (unfold R_def residue_ring_def units_of_def residue_ring_def, auto) + +lemma res_units_eq: "Units R = { x. 0 < x & x < m & coprime x m}" + apply (insert m_gt_one) + apply (unfold Units_def R_def residue_ring_def) + apply auto + apply (subgoal_tac "x ~= 0") + apply auto + apply (rule invertible_coprime_int) + apply (subgoal_tac "x ~= 0") + apply auto + apply (subst (asm) coprime_iff_invertible'_int) + apply (rule m_gt_one) + apply (auto simp add: cong_int_def mult_commute) +done + +lemma res_neg_eq: "\ x = (- x) mod m" + apply (insert m_gt_one) + apply (unfold R_def a_inv_def m_inv_def residue_ring_def) + apply auto + apply (rule the_equality) + apply auto + apply (subst mod_add_right_eq [symmetric]) + apply auto + apply (subst mod_add_left_eq [symmetric]) + apply auto + apply (subgoal_tac "y mod m = - x mod m") + apply simp + apply (subst zmod_eq_dvd_iff) + apply auto +done + +lemma finite [iff]: "finite(carrier R)" + by (subst res_carrier_eq, auto) + +lemma finite_Units [iff]: "finite(Units R)" + by (subst res_units_eq, auto) + +(* The function a -> a mod m maps the integers to the + residue classes. The following lemmas show that this mapping + respects addition and multiplication on the integers. *) + +lemma mod_in_carrier [iff]: "a mod m : carrier R" + apply (unfold res_carrier_eq) + apply (insert m_gt_one, auto) +done + +lemma add_cong: "(x mod m) \ (y mod m) = (x + y) mod m" + by (unfold R_def residue_ring_def, auto, arith) + +lemma mult_cong: "(x mod m) \ (y mod m) = (x * y) mod m" + apply (unfold R_def residue_ring_def, auto) + apply (subst zmod_zmult1_eq [symmetric]) + apply (subst mult_commute) + apply (subst zmod_zmult1_eq [symmetric]) + apply (subst mult_commute) + apply auto +done + +lemma zero_cong: "\ = 0" + apply (unfold R_def residue_ring_def, auto) +done + +lemma one_cong: "\ = 1 mod m" + apply (insert m_gt_one) + apply (unfold R_def residue_ring_def, auto) +done + +(* revise algebra library to use 1? *) +lemma pow_cong: "(x mod m) (^) n = x^n mod m" + apply (insert m_gt_one) + apply (induct n) + apply (auto simp add: nat_pow_def one_cong One_nat_def) + apply (subst mult_commute) + apply (rule mult_cong) +done + +lemma neg_cong: "\ (x mod m) = (- x) mod m" + apply (rule sym) + apply (rule sum_zero_eq_neg) + apply auto + apply (subst add_cong) + apply (subst zero_cong) + apply auto +done + +lemma (in residues) prod_cong: + "finite A \ (\ i:A. (f i) mod m) = (PROD i:A. f i) mod m" + apply (induct set: finite) + apply (auto simp: one_cong mult_cong) +done + +lemma (in residues) sum_cong: + "finite A \ (\ i:A. (f i) mod m) = (SUM i: A. f i) mod m" + apply (induct set: finite) + apply (auto simp: zero_cong add_cong) +done + +lemma mod_in_res_units [simp]: "1 < m \ coprime a m \ + a mod m : Units R" + apply (subst res_units_eq, auto) + apply (insert pos_mod_sign [of m a]) + apply (subgoal_tac "a mod m ~= 0") + apply arith + apply auto + apply (subst (asm) gcd_red_int) + apply (subst gcd_commute_int, assumption) +done + +lemma res_eq_to_cong: "((a mod m) = (b mod m)) = [a = b] (mod (m::int))" + unfolding cong_int_def by auto + +(* Simplifying with these will translate a ring equation in R to a + congruence. *) + +lemmas res_to_cong_simps = add_cong mult_cong pow_cong one_cong + prod_cong sum_cong neg_cong res_eq_to_cong + +(* Other useful facts about the residue ring *) + +lemma one_eq_neg_one: "\ = \ \ \ m = 2" + apply (simp add: res_one_eq res_neg_eq) + apply (insert m_gt_one) + apply (subgoal_tac "~(m > 2)") + apply arith + apply (rule notI) + apply (subgoal_tac "-1 mod m = m - 1") + apply force + apply (subst mod_add_self2 [symmetric]) + apply (subst mod_pos_pos_trivial) + apply auto +done + +end + + +(* prime residues *) + +locale residues_prime = + fixes p :: int and R (structure) + assumes p_prime [intro]: "prime p" + defines "R == residue_ring p" + +sublocale residues_prime < residues p + apply (unfold R_def residues_def) + using p_prime apply auto +done + +context residues_prime begin + +lemma is_field: "field R" + apply (rule cring.field_intro2) + apply (rule cring) + apply (auto simp add: res_carrier_eq res_one_eq res_zero_eq + res_units_eq) + apply (rule classical) + apply (erule notE) + apply (subst gcd_commute_int) + apply (rule prime_imp_coprime_int) + apply (rule p_prime) + apply (rule notI) + apply (frule zdvd_imp_le) + apply auto +done + +lemma res_prime_units_eq: "Units R = {1..p - 1}" + apply (subst res_units_eq) + apply auto + apply (subst gcd_commute_int) + apply (rule prime_imp_coprime_int) + apply (rule p_prime) + apply (rule zdvd_not_zless) + apply auto +done + +end + +sublocale residues_prime < field + by (rule is_field) + + +(* + Test cases: Euler's theorem and Wilson's theorem. +*) + + +subsection{* Euler's theorem *} + +(* the definition of the phi function *) + +constdefs + phi :: "int => nat" + "phi m == card({ x. 0 < x & x < m & gcd x m = 1})" + +lemma phi_zero [simp]: "phi 0 = 0" + apply (subst phi_def) +(* Auto hangs here. Once again, where is the simplification rule + 1 == Suc 0 coming from? *) + apply (auto simp add: card_eq_0_iff) +(* Add card_eq_0_iff as a simp rule? delete card_empty_imp? *) +done + +lemma phi_one [simp]: "phi 1 = 0" + apply (auto simp add: phi_def card_eq_0_iff) +done + +lemma (in residues) phi_eq: "phi m = card(Units R)" + by (simp add: phi_def res_units_eq) + +lemma (in residues) euler_theorem1: + assumes a: "gcd a m = 1" + shows "[a^phi m = 1] (mod m)" +proof - + from a m_gt_one have [simp]: "a mod m : Units R" + by (intro mod_in_res_units) + from phi_eq have "(a mod m) (^) (phi m) = (a mod m) (^) (card (Units R))" + by simp + also have "\ = \" + by (intro units_power_order_eq_one, auto) + finally show ?thesis + by (simp add: res_to_cong_simps) +qed + +(* In fact, there is a two line proof! + +lemma (in residues) euler_theorem1: + assumes a: "gcd a m = 1" + shows "[a^phi m = 1] (mod m)" +proof - + have "(a mod m) (^) (phi m) = \" + by (simp add: phi_eq units_power_order_eq_one a m_gt_one) + thus ?thesis + by (simp add: res_to_cong_simps) +qed + +*) + +(* outside the locale, we can relax the restriction m > 1 *) + +lemma euler_theorem: + assumes "m >= 0" and "gcd a m = 1" + shows "[a^phi m = 1] (mod m)" +proof (cases) + assume "m = 0 | m = 1" + thus ?thesis by auto +next + assume "~(m = 0 | m = 1)" + with prems show ?thesis + by (intro residues.euler_theorem1, unfold residues_def, auto) +qed + +lemma (in residues_prime) phi_prime: "phi p = (nat p - 1)" + apply (subst phi_eq) + apply (subst res_prime_units_eq) + apply auto +done + +lemma phi_prime: "prime p \ phi p = (nat p - 1)" + apply (rule residues_prime.phi_prime) + apply (erule residues_prime.intro) +done + +lemma fermat_theorem: + assumes "prime p" and "~ (p dvd a)" + shows "[a^(nat p - 1) = 1] (mod p)" +proof - + from prems have "[a^phi p = 1] (mod p)" + apply (intro euler_theorem) + (* auto should get this next part. matching across + substitutions is needed. *) + apply (frule prime_gt_1_int, arith) + apply (subst gcd_commute_int, erule prime_imp_coprime_int, assumption) + done + also have "phi p = nat p - 1" + by (rule phi_prime, rule prems) + finally show ?thesis . +qed + + +subsection {* Wilson's theorem *} + +lemma (in field) inv_pair_lemma: "x : Units R \ y : Units R \ + {x, inv x} ~= {y, inv y} \ {x, inv x} Int {y, inv y} = {}" + apply auto + apply (erule notE) + apply (erule inv_eq_imp_eq) + apply auto + apply (erule notE) + apply (erule inv_eq_imp_eq) + apply auto +done + +lemma (in residues_prime) wilson_theorem1: + assumes a: "p > 2" + shows "[fact (p - 1) = - 1] (mod p)" +proof - + let ?InversePairs = "{ {x, inv x} | x. x : Units R - {\, \ \}}" + have UR: "Units R = {\, \ \} Un (Union ?InversePairs)" + by auto + have "(\i: Units R. i) = + (\i: {\, \ \}. i) \ (\i: Union ?InversePairs. i)" + apply (subst UR) + apply (subst finprod_Un_disjoint) + apply (auto intro:funcsetI) + apply (drule sym, subst (asm) inv_eq_one_eq) + apply auto + apply (drule sym, subst (asm) inv_eq_neg_one_eq) + apply auto + done + also have "(\i: {\, \ \}. i) = \ \" + apply (subst finprod_insert) + apply auto + apply (frule one_eq_neg_one) + apply (insert a, force) + done + also have "(\i:(Union ?InversePairs). i) = + (\ A: ?InversePairs. (\ y:A. y))" + apply (subst finprod_Union_disjoint) + apply force + apply force + apply clarify + apply (rule inv_pair_lemma) + apply auto + done + also have "\ = \" + apply (rule finprod_one) + apply auto + apply (subst finprod_insert) + apply auto + apply (frule inv_eq_self) + apply (auto) + done + finally have "(\i: Units R. i) = \ \" + by simp + also have "(\i: Units R. i) = (\i: Units R. i mod p)" + apply (rule finprod_cong') + apply (auto) + apply (subst (asm) res_prime_units_eq) + apply auto + done + also have "\ = (PROD i: Units R. i) mod p" + apply (rule prod_cong) + apply auto + done + also have "\ = fact (p - 1) mod p" + apply (subst fact_altdef_int) + apply (insert prems, force) + apply (subst res_prime_units_eq, rule refl) + done + finally have "fact (p - 1) mod p = \ \". + thus ?thesis + by (simp add: res_to_cong_simps) +qed + +lemma wilson_theorem: "prime (p::int) \ [fact (p - 1) = - 1] (mod p)" + apply (frule prime_gt_1_int) + apply (case_tac "p = 2") + apply (subst fact_altdef_int, simp) + apply (subst cong_int_def) + apply simp + apply (rule residues_prime.wilson_theorem1) + apply (rule residues_prime.intro) + apply auto +done + + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Number_Theory/UniqueFactorization.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Number_Theory/UniqueFactorization.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,967 @@ +(* Title: UniqueFactorization.thy + ID: + Author: Jeremy Avigad + + + Unique factorization for the natural numbers and the integers. + + Note: there were previous Isabelle formalizations of unique + factorization due to Thomas Marthedal Rasmussen, and, building on + that, by Jeremy Avigad and David Gray. +*) + +header {* UniqueFactorization *} + +theory UniqueFactorization +imports Cong Multiset +begin + +(* inherited from Multiset *) +declare One_nat_def [simp del] + +(* As a simp or intro rule, + + prime p \ p > 0 + + wreaks havoc here. When the premise includes ALL x :# M. prime x, it + leads to the backchaining + + x > 0 + prime x + x :# M which is, unfortunately, + count M x > 0 +*) + + +(* useful facts *) + +lemma setsum_Un2: "finite (A Un B) \ + setsum f (A Un B) = setsum f (A - B) + setsum f (B - A) + + setsum f (A Int B)" + apply (subgoal_tac "A Un B = (A - B) Un (B - A) Un (A Int B)") + apply (erule ssubst) + apply (subst setsum_Un_disjoint) + apply auto + apply (subst setsum_Un_disjoint) + apply auto +done + +lemma setprod_Un2: "finite (A Un B) \ + setprod f (A Un B) = setprod f (A - B) * setprod f (B - A) * + setprod f (A Int B)" + apply (subgoal_tac "A Un B = (A - B) Un (B - A) Un (A Int B)") + apply (erule ssubst) + apply (subst setprod_Un_disjoint) + apply auto + apply (subst setprod_Un_disjoint) + apply auto +done + +(* Should this go in Multiset.thy? *) +(* TN: No longer an intro-rule; needed only once and might get in the way *) +lemma multiset_eqI: "[| !!x. count M x = count N x |] ==> M = N" + by (subst multiset_eq_conv_count_eq, blast) + +(* Here is a version of set product for multisets. Is it worth moving + to multiset.thy? If so, one should similarly define msetsum for abelian + semirings, using of_nat. Also, is it worth developing bounded quantifiers + "ALL i :# M. P i"? +*) + +constdefs + msetprod :: "('a => ('b::{power,comm_monoid_mult})) => 'a multiset => 'b" + "msetprod f M == setprod (%x. (f x)^(count M x)) (set_of M)" + +syntax + "_msetprod" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult" + ("(3PROD _:#_. _)" [0, 51, 10] 10) + +translations + "PROD i :# A. b" == "msetprod (%i. b) A" + +lemma msetprod_Un: "msetprod f (A+B) = msetprod f A * msetprod f B" + apply (simp add: msetprod_def power_add) + apply (subst setprod_Un2) + apply auto + apply (subgoal_tac + "(PROD x:set_of A - set_of B. f x ^ count A x * f x ^ count B x) = + (PROD x:set_of A - set_of B. f x ^ count A x)") + apply (erule ssubst) + apply (subgoal_tac + "(PROD x:set_of B - set_of A. f x ^ count A x * f x ^ count B x) = + (PROD x:set_of B - set_of A. f x ^ count B x)") + apply (erule ssubst) + apply (subgoal_tac "(PROD x:set_of A. f x ^ count A x) = + (PROD x:set_of A - set_of B. f x ^ count A x) * + (PROD x:set_of A Int set_of B. f x ^ count A x)") + apply (erule ssubst) + apply (subgoal_tac "(PROD x:set_of B. f x ^ count B x) = + (PROD x:set_of B - set_of A. f x ^ count B x) * + (PROD x:set_of A Int set_of B. f x ^ count B x)") + apply (erule ssubst) + apply (subst setprod_timesf) + apply (force simp add: mult_ac) + apply (subst setprod_Un_disjoint [symmetric]) + apply (auto intro: setprod_cong) + apply (subst setprod_Un_disjoint [symmetric]) + apply (auto intro: setprod_cong) +done + + +subsection {* unique factorization: multiset version *} + +lemma multiset_prime_factorization_exists [rule_format]: "n > 0 --> + (EX M. (ALL (p::nat) : set_of M. prime p) & n = (PROD i :# M. i))" +proof (rule nat_less_induct, clarify) + fix n :: nat + assume ih: "ALL m < n. 0 < m --> (EX M. (ALL p : set_of M. prime p) & m = + (PROD i :# M. i))" + assume "(n::nat) > 0" + then have "n = 1 | (n > 1 & prime n) | (n > 1 & ~ prime n)" + by arith + moreover + { + assume "n = 1" + then have "(ALL p : set_of {#}. prime p) & n = (PROD i :# {#}. i)" + by (auto simp add: msetprod_def) + } + moreover + { + assume "n > 1" and "prime n" + then have "(ALL p : set_of {# n #}. prime p) & n = (PROD i :# {# n #}. i)" + by (auto simp add: msetprod_def) + } + moreover + { + assume "n > 1" and "~ prime n" + from prems not_prime_eq_prod_nat + obtain m k where "n = m * k & 1 < m & m < n & 1 < k & k < n" + by blast + with ih obtain Q R where "(ALL p : set_of Q. prime p) & m = (PROD i:#Q. i)" + and "(ALL p: set_of R. prime p) & k = (PROD i:#R. i)" + by blast + hence "(ALL p: set_of (Q + R). prime p) & n = (PROD i :# Q + R. i)" + by (auto simp add: prems msetprod_Un set_of_union) + then have "EX M. (ALL p : set_of M. prime p) & n = (PROD i :# M. i)".. + } + ultimately show "EX M. (ALL p : set_of M. prime p) & n = (PROD i::nat:#M. i)" + by blast +qed + +lemma multiset_prime_factorization_unique_aux: + fixes a :: nat + assumes "(ALL p : set_of M. prime p)" and + "(ALL p : set_of N. prime p)" and + "(PROD i :# M. i) dvd (PROD i:# N. i)" + shows + "count M a <= count N a" +proof cases + assume "a : set_of M" + with prems have a: "prime a" + by auto + with prems have "a ^ count M a dvd (PROD i :# M. i)" + by (auto intro: dvd_setprod simp add: msetprod_def) + also have "... dvd (PROD i :# N. i)" + by (rule prems) + also have "... = (PROD i : (set_of N). i ^ (count N i))" + by (simp add: msetprod_def) + also have "... = + a^(count N a) * (PROD i : (set_of N - {a}). i ^ (count N i))" + proof (cases) + assume "a : set_of N" + hence b: "set_of N = {a} Un (set_of N - {a})" + by auto + thus ?thesis + by (subst (1) b, subst setprod_Un_disjoint, auto) + next + assume "a ~: set_of N" + thus ?thesis + by auto + qed + finally have "a ^ count M a dvd + a^(count N a) * (PROD i : (set_of N - {a}). i ^ (count N i))". + moreover have "coprime (a ^ count M a) + (PROD i : (set_of N - {a}). i ^ (count N i))" + apply (subst gcd_commute_nat) + apply (rule setprod_coprime_nat) + apply (rule primes_imp_powers_coprime_nat) + apply (insert prems, auto) + done + ultimately have "a ^ count M a dvd a^(count N a)" + by (elim coprime_dvd_mult_nat) + with a show ?thesis + by (intro power_dvd_imp_le, auto) +next + assume "a ~: set_of M" + thus ?thesis by auto +qed + +lemma multiset_prime_factorization_unique: + assumes "(ALL (p::nat) : set_of M. prime p)" and + "(ALL p : set_of N. prime p)" and + "(PROD i :# M. i) = (PROD i:# N. i)" + shows + "M = N" +proof - + { + fix a + from prems have "count M a <= count N a" + by (intro multiset_prime_factorization_unique_aux, auto) + moreover from prems have "count N a <= count M a" + by (intro multiset_prime_factorization_unique_aux, auto) + ultimately have "count M a = count N a" + by auto + } + thus ?thesis by (simp add:multiset_eq_conv_count_eq) +qed + +constdefs + multiset_prime_factorization :: "nat => nat multiset" + "multiset_prime_factorization n == + if n > 0 then (THE M. ((ALL p : set_of M. prime p) & + n = (PROD i :# M. i))) + else {#}" + +lemma multiset_prime_factorization: "n > 0 ==> + (ALL p : set_of (multiset_prime_factorization n). prime p) & + n = (PROD i :# (multiset_prime_factorization n). i)" + apply (unfold multiset_prime_factorization_def) + apply clarsimp + apply (frule multiset_prime_factorization_exists) + apply clarify + apply (rule theI) + apply (insert multiset_prime_factorization_unique, blast)+ +done + + +subsection {* Prime factors and multiplicity for nats and ints *} + +class unique_factorization = + +fixes + multiplicity :: "'a \ 'a \ nat" and + prime_factors :: "'a \ 'a set" + +(* definitions for the natural numbers *) + +instantiation nat :: unique_factorization + +begin + +definition + multiplicity_nat :: "nat \ nat \ nat" +where + "multiplicity_nat p n = count (multiset_prime_factorization n) p" + +definition + prime_factors_nat :: "nat \ nat set" +where + "prime_factors_nat n = set_of (multiset_prime_factorization n)" + +instance proof qed + +end + +(* definitions for the integers *) + +instantiation int :: unique_factorization + +begin + +definition + multiplicity_int :: "int \ int \ nat" +where + "multiplicity_int p n = multiplicity (nat p) (nat n)" + +definition + prime_factors_int :: "int \ int set" +where + "prime_factors_int n = int ` (prime_factors (nat n))" + +instance proof qed + +end + + +subsection {* Set up transfer *} + +lemma transfer_nat_int_prime_factors: + "prime_factors (nat n) = nat ` prime_factors n" + unfolding prime_factors_int_def apply auto + by (subst transfer_int_nat_set_return_embed, assumption) + +lemma transfer_nat_int_prime_factors_closure: "n >= 0 \ + nat_set (prime_factors n)" + by (auto simp add: nat_set_def prime_factors_int_def) + +lemma transfer_nat_int_multiplicity: "p >= 0 \ n >= 0 \ + multiplicity (nat p) (nat n) = multiplicity p n" + by (auto simp add: multiplicity_int_def) + +declare TransferMorphism_nat_int[transfer add return: + transfer_nat_int_prime_factors transfer_nat_int_prime_factors_closure + transfer_nat_int_multiplicity] + + +lemma transfer_int_nat_prime_factors: + "prime_factors (int n) = int ` prime_factors n" + unfolding prime_factors_int_def by auto + +lemma transfer_int_nat_prime_factors_closure: "is_nat n \ + nat_set (prime_factors n)" + by (simp only: transfer_nat_int_prime_factors_closure is_nat_def) + +lemma transfer_int_nat_multiplicity: + "multiplicity (int p) (int n) = multiplicity p n" + by (auto simp add: multiplicity_int_def) + +declare TransferMorphism_int_nat[transfer add return: + transfer_int_nat_prime_factors transfer_int_nat_prime_factors_closure + transfer_int_nat_multiplicity] + + +subsection {* Properties of prime factors and multiplicity for nats and ints *} + +lemma prime_factors_ge_0_int [elim]: "p : prime_factors (n::int) \ p >= 0" + by (unfold prime_factors_int_def, auto) + +lemma prime_factors_prime_nat [intro]: "p : prime_factors (n::nat) \ prime p" + apply (case_tac "n = 0") + apply (simp add: prime_factors_nat_def multiset_prime_factorization_def) + apply (auto simp add: prime_factors_nat_def multiset_prime_factorization) +done + +lemma prime_factors_prime_int [intro]: + assumes "n >= 0" and "p : prime_factors (n::int)" + shows "prime p" + + apply (rule prime_factors_prime_nat [transferred, of n p]) + using prems apply auto +done + +lemma prime_factors_gt_0_nat [elim]: "p : prime_factors x \ p > (0::nat)" + by (frule prime_factors_prime_nat, auto) + +lemma prime_factors_gt_0_int [elim]: "x >= 0 \ p : prime_factors x \ + p > (0::int)" + by (frule (1) prime_factors_prime_int, auto) + +lemma prime_factors_finite_nat [iff]: "finite (prime_factors (n::nat))" + by (unfold prime_factors_nat_def, auto) + +lemma prime_factors_finite_int [iff]: "finite (prime_factors (n::int))" + by (unfold prime_factors_int_def, auto) + +lemma prime_factors_altdef_nat: "prime_factors (n::nat) = + {p. multiplicity p n > 0}" + by (force simp add: prime_factors_nat_def multiplicity_nat_def) + +lemma prime_factors_altdef_int: "prime_factors (n::int) = + {p. p >= 0 & multiplicity p n > 0}" + apply (unfold prime_factors_int_def multiplicity_int_def) + apply (subst prime_factors_altdef_nat) + apply (auto simp add: image_def) +done + +lemma prime_factorization_nat: "(n::nat) > 0 \ + n = (PROD p : prime_factors n. p^(multiplicity p n))" + by (frule multiset_prime_factorization, + simp add: prime_factors_nat_def multiplicity_nat_def msetprod_def) + +thm prime_factorization_nat [transferred] + +lemma prime_factorization_int: + assumes "(n::int) > 0" + shows "n = (PROD p : prime_factors n. p^(multiplicity p n))" + + apply (rule prime_factorization_nat [transferred, of n]) + using prems apply auto +done + +lemma neq_zero_eq_gt_zero_nat: "((x::nat) ~= 0) = (x > 0)" + by auto + +lemma prime_factorization_unique_nat: + "S = { (p::nat) . f p > 0} \ finite S \ (ALL p : S. prime p) \ + n = (PROD p : S. p^(f p)) \ + S = prime_factors n & (ALL p. f p = multiplicity p n)" + apply (subgoal_tac "multiset_prime_factorization n = Abs_multiset + f") + apply (unfold prime_factors_nat_def multiplicity_nat_def) + apply (simp add: set_of_def count_def Abs_multiset_inverse multiset_def) + apply (unfold multiset_prime_factorization_def) + apply (subgoal_tac "n > 0") + prefer 2 + apply force + apply (subst if_P, assumption) + apply (rule the1_equality) + apply (rule ex_ex1I) + apply (rule multiset_prime_factorization_exists, assumption) + apply (rule multiset_prime_factorization_unique) + apply force + apply force + apply force + unfolding set_of_def count_def msetprod_def + apply (subgoal_tac "f : multiset") + apply (auto simp only: Abs_multiset_inverse) + unfolding multiset_def apply force +done + +lemma prime_factors_characterization_nat: "S = {p. 0 < f (p::nat)} \ + finite S \ (ALL p:S. prime p) \ n = (PROD p:S. p ^ f p) \ + prime_factors n = S" + by (rule prime_factorization_unique_nat [THEN conjunct1, symmetric], + assumption+) + +lemma prime_factors_characterization'_nat: + "finite {p. 0 < f (p::nat)} \ + (ALL p. 0 < f p \ prime p) \ + prime_factors (PROD p | 0 < f p . p ^ f p) = {p. 0 < f p}" + apply (rule prime_factors_characterization_nat) + apply auto +done + +(* A minor glitch:*) + +thm prime_factors_characterization'_nat + [where f = "%x. f (int (x::nat))", + transferred direction: nat "op <= (0::int)", rule_format] + +(* + Transfer isn't smart enough to know that the "0 < f p" should + remain a comparison between nats. But the transfer still works. +*) + +lemma primes_characterization'_int [rule_format]: + "finite {p. p >= 0 & 0 < f (p::int)} \ + (ALL p. 0 < f p \ prime p) \ + prime_factors (PROD p | p >=0 & 0 < f p . p ^ f p) = + {p. p >= 0 & 0 < f p}" + + apply (insert prime_factors_characterization'_nat + [where f = "%x. f (int (x::nat))", + transferred direction: nat "op <= (0::int)"]) + apply auto +done + +lemma prime_factors_characterization_int: "S = {p. 0 < f (p::int)} \ + finite S \ (ALL p:S. prime p) \ n = (PROD p:S. p ^ f p) \ + prime_factors n = S" + apply simp + apply (subgoal_tac "{p. 0 < f p} = {p. 0 <= p & 0 < f p}") + apply (simp only:) + apply (subst primes_characterization'_int) + apply auto + apply (auto simp add: prime_ge_0_int) +done + +lemma multiplicity_characterization_nat: "S = {p. 0 < f (p::nat)} \ + finite S \ (ALL p:S. prime p) \ n = (PROD p:S. p ^ f p) \ + multiplicity p n = f p" + by (frule prime_factorization_unique_nat [THEN conjunct2, rule_format, + symmetric], auto) + +lemma multiplicity_characterization'_nat: "finite {p. 0 < f (p::nat)} \ + (ALL p. 0 < f p \ prime p) \ + multiplicity p (PROD p | 0 < f p . p ^ f p) = f p" + apply (rule impI)+ + apply (rule multiplicity_characterization_nat) + apply auto +done + +lemma multiplicity_characterization'_int [rule_format]: + "finite {p. p >= 0 & 0 < f (p::int)} \ + (ALL p. 0 < f p \ prime p) \ p >= 0 \ + multiplicity p (PROD p | p >= 0 & 0 < f p . p ^ f p) = f p" + + apply (insert multiplicity_characterization'_nat + [where f = "%x. f (int (x::nat))", + transferred direction: nat "op <= (0::int)", rule_format]) + apply auto +done + +lemma multiplicity_characterization_int: "S = {p. 0 < f (p::int)} \ + finite S \ (ALL p:S. prime p) \ n = (PROD p:S. p ^ f p) \ + p >= 0 \ multiplicity p n = f p" + apply simp + apply (subgoal_tac "{p. 0 < f p} = {p. 0 <= p & 0 < f p}") + apply (simp only:) + apply (subst multiplicity_characterization'_int) + apply auto + apply (auto simp add: prime_ge_0_int) +done + +lemma multiplicity_zero_nat [simp]: "multiplicity (p::nat) 0 = 0" + by (simp add: multiplicity_nat_def multiset_prime_factorization_def) + +lemma multiplicity_zero_int [simp]: "multiplicity (p::int) 0 = 0" + by (simp add: multiplicity_int_def) + +lemma multiplicity_one_nat [simp]: "multiplicity p (1::nat) = 0" + by (subst multiplicity_characterization_nat [where f = "%x. 0"], auto) + +lemma multiplicity_one_int [simp]: "multiplicity p (1::int) = 0" + by (simp add: multiplicity_int_def) + +lemma multiplicity_prime_nat [simp]: "prime (p::nat) \ multiplicity p p = 1" + apply (subst multiplicity_characterization_nat + [where f = "(%q. if q = p then 1 else 0)"]) + apply auto + apply (case_tac "x = p") + apply auto +done + +lemma multiplicity_prime_int [simp]: "prime (p::int) \ multiplicity p p = 1" + unfolding prime_int_def multiplicity_int_def by auto + +lemma multiplicity_prime_power_nat [simp]: "prime (p::nat) \ + multiplicity p (p^n) = n" + apply (case_tac "n = 0") + apply auto + apply (subst multiplicity_characterization_nat + [where f = "(%q. if q = p then n else 0)"]) + apply auto + apply (case_tac "x = p") + apply auto +done + +lemma multiplicity_prime_power_int [simp]: "prime (p::int) \ + multiplicity p (p^n) = n" + apply (frule prime_ge_0_int) + apply (auto simp add: prime_int_def multiplicity_int_def nat_power_eq) +done + +lemma multiplicity_nonprime_nat [simp]: "~ prime (p::nat) \ + multiplicity p n = 0" + apply (case_tac "n = 0") + apply auto + apply (frule multiset_prime_factorization) + apply (auto simp add: set_of_def multiplicity_nat_def) +done + +lemma multiplicity_nonprime_int [simp]: "~ prime (p::int) \ multiplicity p n = 0" + by (unfold multiplicity_int_def prime_int_def, auto) + +lemma multiplicity_not_factor_nat [simp]: + "p ~: prime_factors (n::nat) \ multiplicity p n = 0" + by (subst (asm) prime_factors_altdef_nat, auto) + +lemma multiplicity_not_factor_int [simp]: + "p >= 0 \ p ~: prime_factors (n::int) \ multiplicity p n = 0" + by (subst (asm) prime_factors_altdef_int, auto) + +lemma multiplicity_product_aux_nat: "(k::nat) > 0 \ l > 0 \ + (prime_factors k) Un (prime_factors l) = prime_factors (k * l) & + (ALL p. multiplicity p k + multiplicity p l = multiplicity p (k * l))" + apply (rule prime_factorization_unique_nat) + apply (simp only: prime_factors_altdef_nat) + apply auto + apply (subst power_add) + apply (subst setprod_timesf) + apply (rule arg_cong2)back back + apply (subgoal_tac "prime_factors k Un prime_factors l = prime_factors k Un + (prime_factors l - prime_factors k)") + apply (erule ssubst) + apply (subst setprod_Un_disjoint) + apply auto + apply (subgoal_tac "(\p\prime_factors l - prime_factors k. p ^ multiplicity p k) = + (\p\prime_factors l - prime_factors k. 1)") + apply (erule ssubst) + apply (simp add: setprod_1) + apply (erule prime_factorization_nat) + apply (rule setprod_cong, auto) + apply (subgoal_tac "prime_factors k Un prime_factors l = prime_factors l Un + (prime_factors k - prime_factors l)") + apply (erule ssubst) + apply (subst setprod_Un_disjoint) + apply auto + apply (subgoal_tac "(\p\prime_factors k - prime_factors l. p ^ multiplicity p l) = + (\p\prime_factors k - prime_factors l. 1)") + apply (erule ssubst) + apply (simp add: setprod_1) + apply (erule prime_factorization_nat) + apply (rule setprod_cong, auto) +done + +(* transfer doesn't have the same problem here with the right + choice of rules. *) + +lemma multiplicity_product_aux_int: + assumes "(k::int) > 0" and "l > 0" + shows + "(prime_factors k) Un (prime_factors l) = prime_factors (k * l) & + (ALL p >= 0. multiplicity p k + multiplicity p l = multiplicity p (k * l))" + + apply (rule multiplicity_product_aux_nat [transferred, of l k]) + using prems apply auto +done + +lemma prime_factors_product_nat: "(k::nat) > 0 \ l > 0 \ prime_factors (k * l) = + prime_factors k Un prime_factors l" + by (rule multiplicity_product_aux_nat [THEN conjunct1, symmetric]) + +lemma prime_factors_product_int: "(k::int) > 0 \ l > 0 \ prime_factors (k * l) = + prime_factors k Un prime_factors l" + by (rule multiplicity_product_aux_int [THEN conjunct1, symmetric]) + +lemma multiplicity_product_nat: "(k::nat) > 0 \ l > 0 \ multiplicity p (k * l) = + multiplicity p k + multiplicity p l" + by (rule multiplicity_product_aux_nat [THEN conjunct2, rule_format, + symmetric]) + +lemma multiplicity_product_int: "(k::int) > 0 \ l > 0 \ p >= 0 \ + multiplicity p (k * l) = multiplicity p k + multiplicity p l" + by (rule multiplicity_product_aux_int [THEN conjunct2, rule_format, + symmetric]) + +lemma multiplicity_setprod_nat: "finite S \ (ALL x : S. f x > 0) \ + multiplicity (p::nat) (PROD x : S. f x) = + (SUM x : S. multiplicity p (f x))" + apply (induct set: finite) + apply auto + apply (subst multiplicity_product_nat) + apply auto +done + +(* Transfer is delicate here for two reasons: first, because there is + an implicit quantifier over functions (f), and, second, because the + product over the multiplicity should not be translated to an integer + product. + + The way to handle the first is to use quantifier rules for functions. + The way to handle the second is to turn off the offending rule. +*) + +lemma transfer_nat_int_sum_prod_closure3: + "(SUM x : A. int (f x)) >= 0" + "(PROD x : A. int (f x)) >= 0" + apply (rule setsum_nonneg, auto) + apply (rule setprod_nonneg, auto) +done + +declare TransferMorphism_nat_int[transfer + add return: transfer_nat_int_sum_prod_closure3 + del: transfer_nat_int_sum_prod2 (1)] + +lemma multiplicity_setprod_int: "p >= 0 \ finite S \ + (ALL x : S. f x > 0) \ + multiplicity (p::int) (PROD x : S. f x) = + (SUM x : S. multiplicity p (f x))" + + apply (frule multiplicity_setprod_nat + [where f = "%x. nat(int(nat(f x)))", + transferred direction: nat "op <= (0::int)"]) + apply auto + apply (subst (asm) setprod_cong) + apply (rule refl) + apply (rule if_P) + apply auto + apply (rule setsum_cong) + apply auto +done + +declare TransferMorphism_nat_int[transfer + add return: transfer_nat_int_sum_prod2 (1)] + +lemma multiplicity_prod_prime_powers_nat: + "finite S \ (ALL p : S. prime (p::nat)) \ + multiplicity p (PROD p : S. p ^ f p) = (if p : S then f p else 0)" + apply (subgoal_tac "(PROD p : S. p ^ f p) = + (PROD p : S. p ^ (%x. if x : S then f x else 0) p)") + apply (erule ssubst) + apply (subst multiplicity_characterization_nat) + prefer 5 apply (rule refl) + apply (rule refl) + apply auto + apply (subst setprod_mono_one_right) + apply assumption + prefer 3 + apply (rule setprod_cong) + apply (rule refl) + apply auto +done + +(* Here the issue with transfer is the implicit quantifier over S *) + +lemma multiplicity_prod_prime_powers_int: + "(p::int) >= 0 \ finite S \ (ALL p : S. prime p) \ + multiplicity p (PROD p : S. p ^ f p) = (if p : S then f p else 0)" + + apply (subgoal_tac "int ` nat ` S = S") + apply (frule multiplicity_prod_prime_powers_nat [where f = "%x. f(int x)" + and S = "nat ` S", transferred]) + apply auto + apply (subst prime_int_def [symmetric]) + apply auto + apply (subgoal_tac "xb >= 0") + apply force + apply (rule prime_ge_0_int) + apply force + apply (subst transfer_nat_int_set_return_embed) + apply (unfold nat_set_def, auto) +done + +lemma multiplicity_distinct_prime_power_nat: "prime (p::nat) \ prime q \ + p ~= q \ multiplicity p (q^n) = 0" + apply (subgoal_tac "q^n = setprod (%x. x^n) {q}") + apply (erule ssubst) + apply (subst multiplicity_prod_prime_powers_nat) + apply auto +done + +lemma multiplicity_distinct_prime_power_int: "prime (p::int) \ prime q \ + p ~= q \ multiplicity p (q^n) = 0" + apply (frule prime_ge_0_int [of q]) + apply (frule multiplicity_distinct_prime_power_nat [transferred leaving: n]) + prefer 4 + apply assumption + apply auto +done + +lemma dvd_multiplicity_nat: + "(0::nat) < y \ x dvd y \ multiplicity p x <= multiplicity p y" + apply (case_tac "x = 0") + apply (auto simp add: dvd_def multiplicity_product_nat) +done + +lemma dvd_multiplicity_int: + "(0::int) < y \ 0 <= x \ x dvd y \ p >= 0 \ + multiplicity p x <= multiplicity p y" + apply (case_tac "x = 0") + apply (auto simp add: dvd_def) + apply (subgoal_tac "0 < k") + apply (auto simp add: multiplicity_product_int) + apply (erule zero_less_mult_pos) + apply arith +done + +lemma dvd_prime_factors_nat [intro]: + "0 < (y::nat) \ x dvd y \ prime_factors x <= prime_factors y" + apply (simp only: prime_factors_altdef_nat) + apply auto + apply (frule dvd_multiplicity_nat) + apply auto +(* It is a shame that auto and arith don't get this. *) + apply (erule order_less_le_trans)back + apply assumption +done + +lemma dvd_prime_factors_int [intro]: + "0 < (y::int) \ 0 <= x \ x dvd y \ prime_factors x <= prime_factors y" + apply (auto simp add: prime_factors_altdef_int) + apply (erule order_less_le_trans) + apply (rule dvd_multiplicity_int) + apply auto +done + +lemma multiplicity_dvd_nat: "0 < (x::nat) \ 0 < y \ + ALL p. multiplicity p x <= multiplicity p y \ + x dvd y" + apply (subst prime_factorization_nat [of x], assumption) + apply (subst prime_factorization_nat [of y], assumption) + apply (rule setprod_dvd_setprod_subset2) + apply force + apply (subst prime_factors_altdef_nat)+ + apply auto +(* Again, a shame that auto and arith don't get this. *) + apply (drule_tac x = xa in spec, auto) + apply (rule le_imp_power_dvd) + apply blast +done + +lemma multiplicity_dvd_int: "0 < (x::int) \ 0 < y \ + ALL p >= 0. multiplicity p x <= multiplicity p y \ + x dvd y" + apply (subst prime_factorization_int [of x], assumption) + apply (subst prime_factorization_int [of y], assumption) + apply (rule setprod_dvd_setprod_subset2) + apply force + apply (subst prime_factors_altdef_int)+ + apply auto + apply (rule dvd_power_le) + apply auto + apply (drule_tac x = xa in spec) + apply (erule impE) + apply auto +done + +lemma multiplicity_dvd'_nat: "(0::nat) < x \ + \p. prime p \ multiplicity p x \ multiplicity p y \ x dvd y" + apply (cases "y = 0") + apply auto + apply (rule multiplicity_dvd_nat, auto) + apply (case_tac "prime p") + apply auto +done + +lemma multiplicity_dvd'_int: "(0::int) < x \ 0 <= y \ + \p. prime p \ multiplicity p x \ multiplicity p y \ x dvd y" + apply (cases "y = 0") + apply auto + apply (rule multiplicity_dvd_int, auto) + apply (case_tac "prime p") + apply auto +done + +lemma dvd_multiplicity_eq_nat: "0 < (x::nat) \ 0 < y \ + (x dvd y) = (ALL p. multiplicity p x <= multiplicity p y)" + by (auto intro: dvd_multiplicity_nat multiplicity_dvd_nat) + +lemma dvd_multiplicity_eq_int: "0 < (x::int) \ 0 < y \ + (x dvd y) = (ALL p >= 0. multiplicity p x <= multiplicity p y)" + by (auto intro: dvd_multiplicity_int multiplicity_dvd_int) + +lemma prime_factors_altdef2_nat: "(n::nat) > 0 \ + (p : prime_factors n) = (prime p & p dvd n)" + apply (case_tac "prime p") + apply auto + apply (subst prime_factorization_nat [where n = n], assumption) + apply (rule dvd_trans) + apply (rule dvd_power [where x = p and n = "multiplicity p n"]) + apply (subst (asm) prime_factors_altdef_nat, force) + apply (rule dvd_setprod) + apply auto + apply (subst prime_factors_altdef_nat) + apply (subst (asm) dvd_multiplicity_eq_nat) + apply auto + apply (drule spec [where x = p]) + apply auto +done + +lemma prime_factors_altdef2_int: + assumes "(n::int) > 0" + shows "(p : prime_factors n) = (prime p & p dvd n)" + + apply (case_tac "p >= 0") + apply (rule prime_factors_altdef2_nat [transferred]) + using prems apply auto + apply (auto simp add: prime_ge_0_int prime_factors_ge_0_int) +done + +lemma multiplicity_eq_nat: + fixes x and y::nat + assumes [arith]: "x > 0" "y > 0" and + mult_eq [simp]: "!!p. prime p \ multiplicity p x = multiplicity p y" + shows "x = y" + + apply (rule dvd_anti_sym) + apply (auto intro: multiplicity_dvd'_nat) +done + +lemma multiplicity_eq_int: + fixes x and y::int + assumes [arith]: "x > 0" "y > 0" and + mult_eq [simp]: "!!p. prime p \ multiplicity p x = multiplicity p y" + shows "x = y" + + apply (rule dvd_anti_sym [transferred]) + apply (auto intro: multiplicity_dvd'_int) +done + + +subsection {* An application *} + +lemma gcd_eq_nat: + assumes pos [arith]: "x > 0" "y > 0" + shows "gcd (x::nat) y = + (PROD p: prime_factors x Un prime_factors y. + p ^ (min (multiplicity p x) (multiplicity p y)))" +proof - + def z == "(PROD p: prime_factors (x::nat) Un prime_factors y. + p ^ (min (multiplicity p x) (multiplicity p y)))" + have [arith]: "z > 0" + unfolding z_def by (rule setprod_pos_nat, auto) + have aux: "!!p. prime p \ multiplicity p z = + min (multiplicity p x) (multiplicity p y)" + unfolding z_def + apply (subst multiplicity_prod_prime_powers_nat) + apply (auto simp add: multiplicity_not_factor_nat) + done + have "z dvd x" + by (intro multiplicity_dvd'_nat, auto simp add: aux) + moreover have "z dvd y" + by (intro multiplicity_dvd'_nat, auto simp add: aux) + moreover have "ALL w. w dvd x & w dvd y \ w dvd z" + apply auto + apply (case_tac "w = 0", auto) + apply (erule multiplicity_dvd'_nat) + apply (auto intro: dvd_multiplicity_nat simp add: aux) + done + ultimately have "z = gcd x y" + by (subst gcd_unique_nat [symmetric], blast) + thus ?thesis + unfolding z_def by auto +qed + +lemma lcm_eq_nat: + assumes pos [arith]: "x > 0" "y > 0" + shows "lcm (x::nat) y = + (PROD p: prime_factors x Un prime_factors y. + p ^ (max (multiplicity p x) (multiplicity p y)))" +proof - + def z == "(PROD p: prime_factors (x::nat) Un prime_factors y. + p ^ (max (multiplicity p x) (multiplicity p y)))" + have [arith]: "z > 0" + unfolding z_def by (rule setprod_pos_nat, auto) + have aux: "!!p. prime p \ multiplicity p z = + max (multiplicity p x) (multiplicity p y)" + unfolding z_def + apply (subst multiplicity_prod_prime_powers_nat) + apply (auto simp add: multiplicity_not_factor_nat) + done + have "x dvd z" + by (intro multiplicity_dvd'_nat, auto simp add: aux) + moreover have "y dvd z" + by (intro multiplicity_dvd'_nat, auto simp add: aux) + moreover have "ALL w. x dvd w & y dvd w \ z dvd w" + apply auto + apply (case_tac "w = 0", auto) + apply (rule multiplicity_dvd'_nat) + apply (auto intro: dvd_multiplicity_nat simp add: aux) + done + ultimately have "z = lcm x y" + by (subst lcm_unique_nat [symmetric], blast) + thus ?thesis + unfolding z_def by auto +qed + +lemma multiplicity_gcd_nat: + assumes [arith]: "x > 0" "y > 0" + shows "multiplicity (p::nat) (gcd x y) = + min (multiplicity p x) (multiplicity p y)" + + apply (subst gcd_eq_nat) + apply auto + apply (subst multiplicity_prod_prime_powers_nat) + apply auto +done + +lemma multiplicity_lcm_nat: + assumes [arith]: "x > 0" "y > 0" + shows "multiplicity (p::nat) (lcm x y) = + max (multiplicity p x) (multiplicity p y)" + + apply (subst lcm_eq_nat) + apply auto + apply (subst multiplicity_prod_prime_powers_nat) + apply auto +done + +lemma gcd_lcm_distrib_nat: "gcd (x::nat) (lcm y z) = lcm (gcd x y) (gcd x z)" + apply (case_tac "x = 0 | y = 0 | z = 0") + apply auto + apply (rule multiplicity_eq_nat) + apply (auto simp add: multiplicity_gcd_nat multiplicity_lcm_nat + lcm_pos_nat) +done + +lemma gcd_lcm_distrib_int: "gcd (x::int) (lcm y z) = lcm (gcd x y) (gcd x z)" + apply (subst (1 2 3) gcd_abs_int) + apply (subst lcm_abs_int) + apply (subst (2) abs_of_nonneg) + apply force + apply (rule gcd_lcm_distrib_nat [transferred]) + apply auto +done + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/BijectionRel.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/BijectionRel.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,229 @@ +(* Author: Thomas M. Rasmussen + Copyright 2000 University of Cambridge +*) + +header {* Bijections between sets *} + +theory BijectionRel imports Main begin + +text {* + Inductive definitions of bijections between two different sets and + between the same set. Theorem for relating the two definitions. + + \bigskip +*} + +inductive_set + bijR :: "('a => 'b => bool) => ('a set * 'b set) set" + for P :: "'a => 'b => bool" +where + empty [simp]: "({}, {}) \ bijR P" +| insert: "P a b ==> a \ A ==> b \ B ==> (A, B) \ bijR P + ==> (insert a A, insert b B) \ bijR P" + +text {* + Add extra condition to @{term insert}: @{term "\b \ B. \ P a b"} + (and similar for @{term A}). +*} + +definition + bijP :: "('a => 'a => bool) => 'a set => bool" where + "bijP P F = (\a b. a \ F \ P a b --> b \ F)" + +definition + uniqP :: "('a => 'a => bool) => bool" where + "uniqP P = (\a b c d. P a b \ P c d --> (a = c) = (b = d))" + +definition + symP :: "('a => 'a => bool) => bool" where + "symP P = (\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]: "{} \ bijER P" +| insert1: "P a a ==> a \ A ==> A \ bijER P ==> insert a A \ bijER P" +| insert2: "P a b ==> a \ b ==> a \ A ==> b \ A ==> A \ bijER P + ==> insert a (insert b A) \ bijER P" + + +text {* \medskip @{term bijR} *} + +lemma fin_bijRl: "(A, B) \ bijR P ==> finite A" + apply (erule bijR.induct) + apply auto + done + +lemma fin_bijRr: "(A, B) \ bijR P ==> finite B" + apply (erule bijR.induct) + apply auto + done + +lemma aux_induct: + assumes major: "finite F" + and subs: "F \ A" + and cases: "P {}" + "!!F a. F \ A ==> a \ A ==> a \ 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 \ B ==> a \ A ==> a \ B ==> inj_on f B ==> f a \ f ` A" + apply (unfold inj_on_def) + apply auto + done + +lemma inj_func_bijR_aux2: + "\a. a \ A --> P a (f a) ==> inj_on f A ==> finite A ==> F <= A + ==> (F, f ` F) \ 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: + "\a. a \ A --> P a (f a) ==> inj_on f A ==> finite A + ==> (A, f ` A) \ bijR P" + apply (rule inj_func_bijR_aux2) + apply auto + done + + +text {* \medskip @{term bijER} *} + +lemma fin_bijER: "A \ bijER P ==> finite A" + apply (erule bijER.induct) + apply auto + done + +lemma aux1: + "a \ A ==> a \ B ==> F \ insert a A ==> F \ insert a B ==> a \ F + ==> \C. F = insert a C \ a \ C \ C <= A \ C <= B" + apply (rule_tac x = "F - {a}" in exI) + apply auto + done + +lemma aux2: "a \ b ==> a \ A ==> b \ B ==> a \ F ==> b \ F + ==> F \ insert a A ==> F \ insert b B + ==> \C. F = insert a (insert b C) \ a \ C \ b \ C \ C \ A \ C \ 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 \ C ==> P b b ==> bijP P (insert b C) ==> bijP P C" + apply (unfold bijP_def) + apply auto + apply (subgoal_tac "b \ a") + prefer 2 + apply clarify + apply (simp add: aux_uniq) + apply auto + done + +lemma aux_in2: + "symP P ==> uniqP P ==> a \ C ==> b \ C ==> a \ b ==> P a b + ==> bijP P (insert a (insert b C)) ==> bijP P C" + apply (unfold bijP_def) + apply auto + apply (subgoal_tac "aa \ a") + prefer 2 + apply clarify + apply (subgoal_tac "aa \ b") + prefer 2 + apply clarify + apply (simp add: aux_uniq) + apply (subgoal_tac "ba \ 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: "\a b. Q a \ 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 \ F) = (b \ 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) \ bijR P ==> uniqP P ==> symP P + ==> \F. bijP P F \ F \ A \ F \ B --> F \ bijER P" + apply (erule bijR.induct) + apply simp + apply (case_tac "a = b") + apply clarify + apply (case_tac "b \ 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 \ F") + apply (case_tac [!] "b \ 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 \ 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 \ 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) \ bijR P ==> + bijP P A ==> uniqP P ==> symP P ==> A \ bijER P" + apply (cut_tac A = A and B = A and P = P in aux_bijRER) + apply auto + done + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Chinese.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Chinese.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,257 @@ +(* Author: Thomas M. Rasmussen + Copyright 2000 University of Cambridge +*) + +header {* The Chinese Remainder Theorem *} + +theory Chinese +imports IntPrimes +begin + +text {* + The Chinese Remainder Theorem for an arbitrary finite number of + equations. (The one-equation case is included in theory @{text + IntPrimes}. Uses functions for indexing.\footnote{Maybe @{term + funprod} and @{term funsum} should be based on general @{term fold} + on indices?} +*} + + +subsection {* Definitions *} + +consts + funprod :: "(nat => int) => nat => nat => int" + funsum :: "(nat => int) => nat => nat => int" + +primrec + "funprod f i 0 = f i" + "funprod f i (Suc n) = f (Suc (i + n)) * funprod f i n" + +primrec + "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 = + ((\i. i \ n --> 0 < mf i) \ + (\i j. i \ n \ j \ n \ i \ j --> zgcd (mf i) (mf j) = 1))" + +definition + km_cond :: "nat => (nat => int) => (nat => int) => bool" where + "km_cond n kf mf = (\i. i \ 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 = (\i. i \ 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 \ i \ n \ m_cond n mf \ km_cond n kf mf then + (SOME x. 0 \ x \ x < mf i \ 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 (\i. xilin_sol i n kf bf mf * mhf mf n i) 0 n" + + +text {* \medskip @{term funprod} and @{term funsum} *} + +lemma funprod_pos: "(\i. i \ n --> 0 < mf i) ==> 0 < funprod mf 0 n" + apply (induct n) + apply auto + apply (simp add: zero_less_mult_iff) + done + +lemma funprod_zgcd [rule_format (no_asm)]: + "(\i. k \ i \ i \ 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 \ i --> i \ 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 (\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)]: + "(\i. k \ i \ i \ k + l --> f i = 0) --> (funsum f k l) = 0" + apply (induct l) + apply auto + done + +lemma funsum_oneelem [rule_format (no_asm)]: + "k \ j --> j \ k + l --> + (\i. k \ i \ i \ k + l \ i \ 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 \ k + l") + prefer 4 + apply arith + apply auto + done + + +subsection {* Chinese: uniqueness *} + +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 {* Chinese: existence *} + +lemma unique_xi_sol: + "0 < n ==> i \ n ==> m_cond n mf ==> km_cond n kf mf + ==> \!x. 0 \ x \ x < mf i \ [kf i * mhf mf n i * x = bf i] (mod mf i)" + apply (rule zcong_lineq_unique) + apply (tactic {* stac (thm "zgcd_zmult_cancel") 2 *}) + apply (unfold m_cond_def km_cond_def mhf_def) + apply (simp_all (no_asm_simp)) + apply safe + apply (tactic {* stac (thm "zgcd_zmult_cancel") 3 *}) + apply (rule_tac [!] funprod_zgcd) + apply safe + apply simp_all + apply (subgoal_tac "i i \ n ==> j \ n ==> j \ 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 \ 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 {* Chinese *} + +lemma chinese_remainder: + "0 < n ==> m_cond n mf ==> km_cond n kf mf + ==> \!x. 0 \ x \ x < funprod mf 0 n \ 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 {* stac (thm "zcong_zmod") 3 *}) + apply (tactic {* stac (thm "mod_mult_eq") 3 *}) + apply (tactic {* stac (thm "mod_mod_cancel") 3 *}) + apply (tactic {* stac (thm "x_sol_lin") 4 *}) + apply (tactic {* stac (thm "mod_mult_eq" RS sym) 6 *}) + apply (tactic {* stac (thm "zcong_zmod" RS sym) 6 *}) + apply (subgoal_tac [6] + "0 \ xilin_sol i n kf bf mf \ xilin_sol i n kf bf mf < mf i + \ [kf i * mhf mf n i * xilin_sol i n kf bf mf = bf i] (mod mf i)") + prefer 6 + apply (simp add: zmult_ac) + apply (unfold xilin_sol_def) + apply (tactic {* asm_simp_tac @{simpset} 6 *}) + 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Euler.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Euler.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,304 @@ +(* Title: HOL/Quadratic_Reciprocity/Euler.thy + ID: $Id$ + Authors: Jeremy Avigad, David Gray, and Adam Kramer +*) + +header {* Euler's criterion *} + +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 {* Property for MultInvPair *} + +lemma MultInvPair_prop1a: + "[| zprime p; 2 < p; ~([a = 0](mod p)); + X \ (SetS a p); Y \ (SetS a p); + ~((X \ 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 \ (SetS a p); Y \ (SetS a p); + X \ Y |] ==> X \ Y = {}" + apply (rule notnotD) + apply (rule notI) + apply (drule MultInvPair_prop1a, auto) + done + +lemma MultInvPair_prop1c: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==> + \X \ SetS a p. \Y \ SetS a p. X \ Y --> X\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: "[| zprime p; 2 < p; ~([a = 0] (mod p)); + ~([j = 0] (mod p)); + ~(QuadRes p a) |] ==> + ~([j = a * MultInv p j] (mod p))" +proof + assume "zprime p" and "2 < p" and "~([a = 0] (mod p))" and + "~([j = 0] (mod p))" and "~(QuadRes p a)" + 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: zmult_ac) + have "[j * j = a] (mod p)" + proof - + from prems have b: "[MultInv p j * j = 1] (mod p)" + by (simp add: MultInv_prop2a) + from b a show ?thesis + by (auto simp add: zcong_zmult_prop2) + qed + then have "[j^2 = a] (mod p)" + by (metis number_of_is_id power2_eq_square succ_bin_simps) + with prems 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 Pls_def StandardRes_def aux number_of_is_id one_is_num_one) + done + + +subsection {* Properties of SetS *} + +lemma SetS_finite: "2 < p ==> finite (SetS a p)" + by (auto simp add: SetS_def SRStar_finite [of p] finite_imageI) + +lemma SetS_elems_finite: "\X \ 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) |] ==> + \X \ 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 finite_Union) + +lemma card_setsum_aux: "[| finite S; \X \ S. finite (X::int set); + \X \ S. card X = n |] ==> setsum card S = setsum (%x. n) S" + by (induct set: finite) auto + +lemma SetS_card: "[| zprime p; 2 < p; ~([a = 0] (mod p)); ~(QuadRes p a) |] ==> + int(card(SetS a p)) = (p - 1) div 2" +proof - + assume "zprime p" and "2 < p" and "~([a = 0] (mod p))" and "~(QuadRes p a)" + then have "(p - 1) = 2 * int(card(SetS a p))" + proof - + have "p - 1 = int(card(Union (SetS a p)))" + by (auto simp add: prems MultInvPair_prop2 SRStar_card) + also have "... = int (setsum card (SetS a p))" + by (auto simp add: prems SetS_finite SetS_elems_finite + MultInvPair_prop1c [of p a] card_Union_disjoint) + also have "... = int(setsum (%x.2) (SetS a p))" + using prems + by (auto simp add: SetS_elems_card SetS_finite SetS_elems_finite + card_setsum_aux simp del: setsum_constant) + also have "... = 2 * int(card( SetS a p))" + by (auto simp add: prems SetS_finite setsum_const2) + finally show ?thesis . + qed + from this show ?thesis + by auto +qed + +lemma SetS_setprod_prop: "[| zprime p; 2 < p; ~([a = 0] (mod p)); + ~(QuadRes p a); x \ (SetS a p) |] ==> + [\x = a] (mod p)" + apply (auto simp add: SetS_def MultInvPair_def) + apply (frule StandardRes_SRStar_prop1a) + apply (subgoal_tac "StandardRes p x \ 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: zmult_ac) + done + +lemma aux1: "[| 0 < x; (x::int) < a; x \ (a - 1) |] ==> x < a - 1" + by arith + +lemma aux2: "[| (a::int) < c; b < c |] ==> (a \ b | b \ a)" + by auto + +lemma SRStar_d22set_prop: "2 < p \ (SRStar p) = {1} \ (d22set (p - 1))" + apply (induct p rule: d22set.induct) + 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_setprod_prop1: "[| zprime p; 2 < p; ~([a = 0] (mod p)); ~(QuadRes p a) |] ==> + [\(Union (SetS a p)) = a ^ nat ((p - 1) div 2)] (mod p)" +proof - + assume "zprime p" and "2 < p" and "~([a = 0] (mod p))" and "~(QuadRes p a)" + then have "[\(Union (SetS a p)) = + setprod (setprod (%x. x)) (SetS a p)] (mod p)" + by (auto simp add: SetS_finite SetS_elems_finite + MultInvPair_prop1c setprod_Union_disjoint) + also have "[setprod (setprod (%x. x)) (SetS a p) = + setprod (%x. a) (SetS a p)] (mod p)" + by (rule setprod_same_function_zcong) + (auto simp add: prems SetS_setprod_prop SetS_finite) + also (zcong_trans) have "[setprod (%x. a) (SetS a p) = + a^(card (SetS a p))] (mod p)" + by (auto simp add: prems SetS_finite setprod_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: prems SetS_card) + done +qed + +lemma Union_SetS_setprod_prop2: "[| zprime p; 2 < p; ~([a = 0](mod p)) |] ==> + \(Union (SetS a p)) = zfact (p - 1)" +proof - + assume "zprime p" and "2 < p" and "~([a = 0](mod p))" + then have "\(Union (SetS a p)) = \(SRStar p)" + by (auto simp add: MultInvPair_prop2) + also have "... = \({1} \ (d22set (p - 1)))" + by (auto simp add: prems SRStar_d22set_prop) + also have "... = zfact(p - 1)" + proof - + have "~(1 \ d22set (p - 1)) & finite( d22set (p - 1))" + by (metis d22set_fin d22set_g_1 linorder_neq_iff) + then have "\({1} \ (d22set (p - 1))) = \(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_setprod_prop1) + apply (auto simp add: Union_SetS_setprod_prop2) + done + +text {* \medskip Prove the first part of Euler's Criterion: *} + +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 number_of_is_id zcong_sym zcong_trans zfact_prop) + +text {* \medskip Prove another part of Euler Criterion: *} + +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: zpower_zadd_distrib) + also have "... = a * a ^ (nat(p) - 1)" + by auto + finally show ?thesis . +qed + +lemma aux_2: "[| (2::int) < p; p \ zOdd |] ==> 0 < ((p - 1) div 2)" +proof - + assume "2 < p" and "p \ 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 `2 < p` 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 {* \medskip Prove the final part of Euler's Criterion: *} + +lemma aux__1: "[| ~([x = 0] (mod p)); [y ^ 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 \ zOdd") + apply (auto simp add: QuadRes_def) + prefer 2 + apply (metis number_of_is_id numeral_1_eq_1 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: zpower_zpower) + 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 mult_Bit0 number_of_is_id odd_minus_one_even one_is_num_one zmult_1 aux__2) + done + + +text {* \medskip Finally show Euler's Criterion: *} + +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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/EulerFermat.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/EulerFermat.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,346 @@ +(* Author: Thomas M. Rasmussen + Copyright 2000 University of Cambridge +*) + +header {* Fermat's Little Theorem extended to Euler's Totient function *} + +theory EulerFermat +imports BijectionRel IntFact +begin + +text {* + Fermat's Little Theorem extended to Euler's Totient function. More + abstract approach than Boyer-Moore (which seems necessary to achieve + the extended version). +*} + + +subsection {* Definitions and lemmas *} + +inductive_set + RsetR :: "int => int set set" + for m :: int + where + empty [simp]: "{} \ RsetR m" + | insert: "A \ RsetR m ==> zgcd a m = 1 ==> + \a'. a' \ A --> \ zcong a a' m ==> insert a A \ RsetR m" + +consts + BnorRset :: "int * int => int set" + +recdef BnorRset + "measure ((\(a, m). nat a) :: int * int => nat)" + "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 = (\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 \ RsetR m \ card A = phi m)" + +definition + RRset2norRR :: "int set => int => int => int" where + "RRset2norRR A m a = + (if 1 < m \ is_RRset A m \ a \ A then + SOME b. zcong a b m \ b \ norRRset m + else 0)" + +definition + zcongm :: "int => int => int => bool" where + "zcongm m = (\a b. zcong a b m)" + +lemma abs_eq_1_iff [iff]: "(abs z = (1::int)) = (z = 1 \ z = -1)" + -- {* LCP: not sure why this lemma is needed now *} + by (auto simp add: abs_if) + + +text {* \medskip @{text norRRset} *} + +declare BnorRset.simps [simp del] + +lemma BnorRset_induct: + assumes "!!a m. P {} a m" + and "!!a m. 0 < (a::int) ==> P (BnorRset (a - 1, m::int)) (a - 1) m + ==> P (BnorRset(a,m)) a m" + shows "P (BnorRset(u,v)) u v" + apply (rule BnorRset.induct) + apply safe + apply (case_tac [2] "0 < a") + apply (rule_tac [2] prems) + apply simp_all + apply (simp_all add: BnorRset.simps prems) + done + +lemma Bnor_mem_zle [rule_format]: "b \ BnorRset (a, m) \ b \ 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 \ BnorRset (a, m)" + by (auto dest: Bnor_mem_zle) + +lemma Bnor_mem_zg [rule_format]: "b \ 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 \ a --> b \ 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) \ 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' \ 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 \ b - 1 ==> a < (b::int)" + apply auto + done + +lemma norR_mem_unique: + "1 < m ==> + zgcd a m = 1 ==> \!b. [a = b] (mod m) \ b \ 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 add: zcong_sym) + done + + +text {* \medskip @{term noXRRset} *} + +lemma RRset_gcd [rule_format]: + "is_RRset A m ==> a \ A --> zgcd a m = 1" + apply (unfold is_RRset_def) + apply (rule RsetR.induct [where P="%A. a \ A --> zgcd a m = 1"], auto) + done + +lemma RsetR_zmult_mono: + "A \ RsetR m ==> + 0 < m ==> zgcd x m = 1 ==> (\a. a * x) ` A \ 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 \ A + ==> zcong a (SOME b. [a = b] (mod m) \ b \ norRRset m) m \ + (SOME b. [a = b] (mod m) \ b \ norRRset m) \ 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 \ A ==> + [a = RRset2norRR A m a] (mod m) \ RRset2norRR A m a \ norRRset m" + apply (unfold RRset2norRR_def, simp) + apply (rule aux_some, simp_all) + done + +lemmas RRset2norRR_correct1 = + RRset2norRR_correct [THEN conjunct1, standard] +lemmas RRset2norRR_correct2 = + RRset2norRR_correct [THEN conjunct2, standard] + +lemma RsetR_fin: "A \ 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 \ A --> b \ A --> a = b" + apply (unfold is_RRset_def) + apply (rule RsetR.induct [where P="%A. a \ A --> b \ A --> a = b"]) + 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) ==> \a. P a \ 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 "\b. ([x = b] (mod m) \ b \ norRRset m) \ + ([y = b] (mod m) \ b \ 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 \ A ==> inj f ==> f a \ f ` A" +by (unfold inj_on_def, auto) + +lemma Bnor_prod_power [rule_format]: + "x \ 0 ==> a < m --> \((\a. a * x) ` BnorRset (a, m)) = + \(BnorRset(a, m)) * x^card (BnorRset (a, m))" + apply (induct a m rule: BnorRset_induct) + prefer 2 + apply (simplesubst BnorRset.simps) --{*multiple redexes*} + apply (unfold Let_def, auto) + apply (simp add: Bnor_fin Bnor_mem_zle_swap) + apply (subst setprod_insert) + apply (rule_tac [2] Bnor_prod_power_aux) + apply (unfold inj_on_def) + apply (simp_all add: zmult_ac Bnor_fin finite_imageI + Bnor_mem_zle_swap) + done + + +subsection {* Fermat *} + +lemma bijzcong_zcong_prod: + "(A, B) \ bijR (zcongm m) ==> [\A = \B] (mod m)" + apply (unfold zcongm_def) + apply (erule bijR.induct) + apply (subgoal_tac [2] "a \ A \ b \ B \ finite A \ finite B") + apply (auto intro: fin_bijRl fin_bijRr zcong_zmult) + done + +lemma Bnor_prod_zgcd [rule_format]: + "a < m --> zgcd (\(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 = "\(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 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: + "\ zprime p; a < p \ \ 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 ==> \ 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/EvenOdd.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/EvenOdd.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,256 @@ +(* Title: HOL/Quadratic_Reciprocity/EvenOdd.thy + Authors: Jeremy Avigad, David Gray, and Adam Kramer +*) + +header {*Parity: Even and Odd Integers*} + +theory EvenOdd +imports Int2 +begin + +definition + zOdd :: "int set" where + "zOdd = {x. \k. x = 2 * k + 1}" + +definition + zEven :: "int set" where + "zEven = {x. \k. x = 2 * k}" + +subsection {* Some useful properties about even and odd *} + +lemma zOddI [intro?]: "x = 2 * k + 1 \ x \ zOdd" + and zOddE [elim?]: "x \ zOdd \ (!!k. x = 2 * k + 1 \ C) \ C" + by (auto simp add: zOdd_def) + +lemma zEvenI [intro?]: "x = 2 * k \ x \ zEven" + and zEvenE [elim?]: "x \ zEven \ (!!k. x = 2 * k \ C) \ C" + by (auto simp add: zEven_def) + +lemma one_not_even: "~(1 \ zEven)" +proof + assume "1 \ zEven" + then obtain k :: int where "1 = 2 * k" .. + then show False by arith +qed + +lemma even_odd_conj: "~(x \ zOdd & x \ 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: zdiff_zmult_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 \ zOdd | x \ zEven)" + by (simp add: zOdd_def zEven_def) arith + +lemma not_odd_impl_even: "~(x \ zOdd) ==> x \ zEven" + using even_odd_disj by auto + +lemma odd_mult_odd_prop: "(x*y):zOdd ==> x \ zOdd" +proof (rule classical) + assume "\ ?thesis" + then have "x \ 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: zdiff_zmult_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 \ zOdd ==> (x - 1):zEven" + by (auto simp add: zOdd_def zEven_def) + +lemma even_div_2_prop1: "x \ zEven ==> (x mod 2) = 0" + by (auto simp add: zEven_def) + +lemma even_div_2_prop2: "x \ zEven ==> (2 * (x div 2)) = x" + by (auto simp add: zEven_def) + +lemma even_plus_even: "[| x \ zEven; y \ zEven |] ==> x + y \ zEven" + apply (auto simp add: zEven_def) + apply (auto simp only: zadd_zmult_distrib2 [symmetric]) + done + +lemma even_times_either: "x \ zEven ==> x * y \ zEven" + by (auto simp add: zEven_def) + +lemma even_minus_even: "[| x \ zEven; y \ zEven |] ==> x - y \ zEven" + apply (auto simp add: zEven_def) + apply (auto simp only: zdiff_zmult_distrib2 [symmetric]) + done + +lemma odd_minus_odd: "[| x \ zOdd; y \ zOdd |] ==> x - y \ zEven" + apply (auto simp add: zOdd_def zEven_def) + apply (auto simp only: zdiff_zmult_distrib2 [symmetric]) + done + +lemma even_minus_odd: "[| x \ zEven; y \ zOdd |] ==> x - y \ 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 \ zOdd; y \ zEven |] ==> x - y \ zOdd" + apply (auto simp add: zOdd_def zEven_def) + apply (auto simp only: zdiff_zmult_distrib2 [symmetric]) + done + +lemma odd_times_odd: "[| x \ zOdd; y \ zOdd |] ==> x * y \ zOdd" + apply (auto simp add: zOdd_def zadd_zmult_distrib zadd_zmult_distrib2) + apply (rule_tac x = "2 * ka * k + ka + k" in exI) + apply (auto simp add: zadd_zmult_distrib) + done + +lemma odd_iff_not_even: "(x \ zOdd) = (~ (x \ zEven))" + using even_odd_conj even_odd_disj by auto + +lemma even_product: "x * y \ zEven ==> x \ zEven | y \ zEven" + using odd_iff_not_even odd_times_odd by auto + +lemma even_diff: "x - y \ zEven = ((x \ zEven) = (y \ zEven))" +proof + assume xy: "x - y \ zEven" + { + assume x: "x \ zEven" + have "y \ zEven" + proof (rule classical) + assume "\ ?thesis" + then have "y \ zOdd" + by (simp add: odd_iff_not_even) + with x have "x - y \ 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 \ zEven" + have "x \ zEven" + proof (rule classical) + assume "\ ?thesis" + then have "x \ zOdd" + by (auto simp add: odd_iff_not_even) + with y have "x - y \ 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 \ zEven) = (y \ zEven)" + by (auto simp add: odd_iff_not_even even_minus_even odd_minus_odd + even_minus_odd odd_minus_even) +next + assume "(x \ zEven) = (y \ zEven)" + then show "x - y \ 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 \ zEven; 0 \ x |] ==> (-1::int)^(nat x) = 1" +proof - + assume "x \ zEven" and "0 \ x" + from `x \ zEven` obtain a where "x = 2 * a" .. + with `0 \ x` have "0 \ a" by simp + from `0 \ x` and `x = 2 * a` have "nat x = nat (2 * a)" + by simp + also from `x = 2 * a` 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)^2)^ (nat a)" + by (simp add: zpower_zpower [symmetric]) + also have "(-1::int)^2 = 1" + by simp + finally show ?thesis + by simp +qed + +lemma neg_one_odd_power: "[| x \ zOdd; 0 \ x |] ==> (-1::int)^(nat x) = -1" +proof - + assume "x \ zOdd" and "0 \ x" + from `x \ zOdd` obtain a where "x = 2 * a + 1" .. + with `0 \ x` have a: "0 \ a" by simp + with `0 \ x` and `x = 2 * a + 1` 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)^2)^ (nat a) * (-1)^1" + by (auto simp add: zpower_zpower [symmetric] zpower_zadd_distrib) + also have "(-1::int)^2 = 1" + by simp + finally show ?thesis + by simp +qed + +lemma neg_one_power_parity: "[| 0 \ x; 0 \ y; (x \ zEven) = (y \ 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 \ zEven; x < y |] ==> x div 2 < y div 2" +proof - + assume "y \ zEven" and "x < y" + from `y \ zEven` obtain k where k: "y = 2 * k" .. + with `x < y` 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 \ zEven; y \ zEven |] ==> (x + y) div 2 = x div 2 + y div 2" + by (auto simp add: zEven_def) + +lemma even_prod_div_2: "[| x \ 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 \ 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 :: int) ^ card A) * (-1 ^ card A) = 1" + by (induct set: finite) auto + +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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Factorization.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Factorization.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,339 @@ +(* Author: Thomas Marthedal Rasmussen + Copyright 2000 University of Cambridge +*) + +header {* Fundamental Theorem of Arithmetic (unique factorization into primes) *} + +theory Factorization +imports Main "~~/src/HOL/Old_Number_Theory/Primes" Permutation +begin + + +subsection {* Definitions *} + +definition + primel :: "nat list => bool" where + "primel xs = (\p \ set xs. prime p)" + +consts + nondec :: "nat list => bool " + prod :: "nat list => nat" + oinsert :: "nat => nat list => nat list" + sort :: "nat list => nat list" + +primrec + "nondec [] = True" + "nondec (x # xs) = (case xs of [] => True | y # ys => x \ y \ nondec xs)" + +primrec + "prod [] = Suc 0" + "prod (x # xs) = x * prod xs" + +primrec + "oinsert x [] = [x]" + "oinsert x (y # ys) = (if x \ y then x # y # ys else y # oinsert x ys)" + +primrec + "sort [] = []" + "sort (x # xs) = oinsert x (sort xs)" + + +subsection {* Arithmetic *} + +lemma one_less_m: "(m::nat) \ m * k ==> m \ Suc 0 ==> Suc 0 < m" + apply (cases m) + apply auto + done + +lemma one_less_k: "(m::nat) \ 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 {* Prime list and product *} + +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 \ primel ys)" + apply (unfold primel_def) + apply auto + done + +lemma prime_primel: "prime n ==> primel [n] \ prod [n] = n" + apply (unfold primel_def) + apply auto + done + +lemma prime_nd_one: "prime p ==> \ 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 \ 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 \ xs \ [] \ Suc 0 < prod xs" + apply (induct xs) + apply simp + apply (fastsimp 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 {* Sorting *} + +lemma nondec_oinsert: "nondec xs \ nondec (oinsert x xs)" + apply (induct xs) + apply simp + apply (case_tac xs) + apply (simp_all cong del: list.weak_case_cong) + done + +lemma nondec_sort: "nondec (sort xs)" + apply (induct xs) + apply simp_all + apply (erule nondec_oinsert) + done + +lemma x_less_y_oinsert: "x \ y ==> l = y # ys ==> x # l = oinsert x l" + apply simp_all + done + +lemma nondec_sort_eq [rule_format]: "nondec xs \ 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 {* Permutation *} + +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: mult_ac) + 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 {* Existence *} + +lemma ex_nondec_lemma: + "primel xs ==> \ys. primel ys \ nondec ys \ 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 \ \ prime n ==> + \m k. Suc 0 < m \ Suc 0 < k \ m < n \ k < n \ 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) + done + +lemma split_primel: + "primel xs \ primel ys \ \l. primel l \ 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 --> (\l. primel l \ 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 ==> \l. primel l \ nondec l \ prod l = n" + apply (erule factor_exists [THEN exE]) + apply (blast intro!: ex_nondec_lemma) + done + + +subsection {* Uniqueness *} + +lemma prime_dvd_mult_list [rule_format]: + "prime p ==> p dvd (prod xs) --> (\m. m:set xs \ 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 + ==> \m. m \ set ys \ 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 \ 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 \ 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 ==> \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: + "\m. m < prod ys --> (\xs ys. primel xs \ primel ys \ + prod xs = prod ys \ 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]: + "\xs ys. primel xs \ primel ys \ prod xs = prod ys \ 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]: + "\n. Suc 0 < n --> (\!l. primel l \ nondec l \ prod l = n)" + by (metis factor_unique nondec_factor_exists perm_nondec_unique) + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Fib.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Fib.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,150 @@ +(* ID: $Id$ + Author: Lawrence C Paulson, Cambridge University Computer Laboratory + Copyright 1997 University of Cambridge +*) + +header {* The Fibonacci function *} + +theory Fib +imports Primes +begin + +text {* + Fibonacci numbers: proofs of laws taken from: + R. L. Graham, D. E. Knuth, O. Patashnik. Concrete Mathematics. + (Addison-Wesley, 1989) + + \bigskip +*} + +fun fib :: "nat \ nat" +where + "fib 0 = 0" +| "fib (Suc 0) = 1" +| fib_2: "fib (Suc (Suc n)) = fib n + fib (Suc n)" + +text {* + \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. +*} + +text{*We disable @{text fib.fib_2fib_2} for simplification ...*} +declare fib_2 [simp del] + +text{*...then prove a version that has a more restrictive pattern.*} +lemma fib_Suc3: "fib (Suc (Suc (Suc n))) = fib (Suc n) + fib (Suc (Suc n))" + by (rule fib_2) + +text {* \medskip Concrete Mathematics, page 280 *} + +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) \ 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 {* + \medskip Concrete Mathematics, page 278: Cassini's identity. The proof is + much easier using integers, not natural numbers! +*} + +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 \ x mod 2 \ x mod 2 = 0" by presburger + with "3.hyps" show ?case by (simp add: fib.simps add_mult_distrib add_mult_distrib2) +qed + +text{*We now obtain a version for the natural numbers via the coercion + function @{term int}.*} +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 int_int_eq [THEN iffD1]) + apply (simp add: fib_Cassini_int) + apply (subst zdiff_int [symmetric]) + apply (insert fib_Suc_gr_0 [of n], simp_all) + done + + +text {* \medskip Toward Law 6.111 of Concrete Mathematics *} + +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 \ 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 \ 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 "\ = gcd (fib m) (fib (n - m))" by (simp add: less.hyps diff pos_m) + also have "\ = 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)" -- {* Law 6.111 *} + apply (induct m n rule: gcd_induct) + apply (simp_all add: gcd_non_0 gcd_commute gcd_fib_mod) + done + +theorem fib_mult_eq_setsum: + "fib (Suc n) * fib n = (\k \ {..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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Finite2.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Finite2.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,223 @@ +(* Title: HOL/Quadratic_Reciprocity/Finite2.thy + ID: $Id$ + Authors: Jeremy Avigad, David Gray, and Adam Kramer +*) + +header {*Finite Sets and Finite Sums*} + +theory Finite2 +imports Main IntFact Infinite_Set +begin + +text{* + These are useful for combinatorial and number-theoretic counting + arguments. +*} + + +subsection {* Useful properties of sums and products *} + +lemma setsum_same_function_zcong: + assumes a: "\x \ S. [f x = g x](mod m)" + shows "[setsum f S = setsum 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 add:setsum_def) +qed + +lemma setprod_same_function_zcong: + assumes a: "\x \ S. [f x = g x](mod m)" + shows "[setprod f S = setprod 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 add:setprod_def) +qed + +lemma setsum_const: "finite X ==> setsum (%x. (c :: int)) X = c * int(card X)" + apply (induct set: finite) + apply (auto simp add: left_distrib right_distrib int_eq_of_nat) + done + +lemma setsum_const2: "finite X ==> int (setsum (%x. (c :: nat)) X) = + int(c) * int(card X)" + apply (induct set: finite) + apply (auto simp add: zadd_zmult_distrib2) + done + +lemma setsum_const_mult: "finite A ==> setsum (%x. c * ((f x)::int)) A = + c * setsum f A" + by (induct set: finite) (auto simp add: zadd_zmult_distrib2) + + +subsection {* Cardinality of explicit finite sets *} + +lemma finite_surjI: "[| B \ f ` A; finite A |] ==> finite B" + by (simp add: finite_subset finite_imageI) + +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 \ x}" +proof - + have "{y::nat . y \ 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 \ x & x < n}" + apply (subgoal_tac " {(x :: int). 0 \ x & x < n} \ + 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 \ x & x \ n}" + apply (subgoal_tac "{x. 0 \ x & x \ n} = {x. 0 \ 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} \ {x::int. 0 \ 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 \ n}" +proof - + have "{x::int. 0 < x & x \ n} \ {x::int. 0 \ x & x \ 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 `card {y. y < n} = n` by simp +qed + +lemma card_bdd_nat_set_le: "card { y::nat. y \ x} = Suc x" +proof - + have "{y::nat. y \ 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 \ (n::int) ==> card {y. 0 \ y & y < n} = nat n" +proof - + assume "0 \ 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 `0 \ n` have "int ` {y. y < nat n} = {y. 0 \ 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 \ y & y < n} = nat n" . +qed + +lemma card_bdd_int_set_le: "0 \ (n::int) ==> card {y. 0 \ y & y \ n} = + nat n + 1" +proof - + assume "0 \ n" + moreover have "{y. 0 \ y & y \ n} = {y. 0 \ 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 \ (n::int) ==> + card {x. 0 < x & x \ n} = nat n" +proof - + assume "0 \ n" + have "inj_on (%x. x+1) {x. 0 \ x & x < n}" + by (auto simp add: inj_on_def) + hence "card ((%x. x+1) ` {x. 0 \ x & x < n}) = + card {x. 0 \ x & x < n}" + by (rule card_image) + also from `0 \ n` have "... = nat n" + by (rule card_bdd_int_set_l) + also have "(%x. x + 1) ` {x. 0 \ 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 \ 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 \ 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 \ n ==> + int(card {x. 0 < x & x \ n}) = n" + by (auto simp add: card_bdd_int_set_l_le) + + +subsection {* Cardinality of finite cartesian products *} + +(* FIXME could be useful in general but not needed here +lemma insert_Sigma [simp]: "(insert x A) <*> B = ({ x } <*> B) \ (A <*> B)" + by blast + *) + +text {* Lemmas for counting arguments. *} + +lemma setsum_bij_eq: "[| finite A; finite B; f ` A \ B; inj_on f A; + g ` B \ A; inj_on g B |] ==> setsum g B = setsum (g \ f) A" + apply (frule_tac h = g and f = f in setsum_reindex) + apply (subgoal_tac "setsum g B = setsum g (f ` A)") + apply (simp add: inj_on_def) + apply (subgoal_tac "card A = card B") + apply (drule_tac A = "f ` A" and B = B in card_seteq) + apply (auto simp add: card_image) + apply (frule_tac A = A and B = B and f = f in card_inj_on_le, auto) + apply (frule_tac A = B and B = A and f = g in card_inj_on_le) + apply auto + done + +lemma setprod_bij_eq: "[| finite A; finite B; f ` A \ B; inj_on f A; + g ` B \ A; inj_on g B |] ==> setprod g B = setprod (g \ f) A" + apply (frule_tac h = g and f = f in setprod_reindex) + apply (subgoal_tac "setprod g B = setprod g (f ` A)") + apply (simp add: inj_on_def) + apply (subgoal_tac "card A = card B") + apply (drule_tac A = "f ` A" and B = B in card_seteq) + apply (auto simp add: card_image) + apply (frule_tac A = A and B = B and f = f in card_inj_on_le, auto) + apply (frule_tac A = B and B = A and f = g in card_inj_on_le, auto) + done + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Gauss.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Gauss.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,535 @@ +(* Title: HOL/Quadratic_Reciprocity/Gauss.thy + ID: $Id$ + Authors: Jeremy Avigad, David Gray, and Adam Kramer) +*) + +header {* Gauss' Lemma *} + +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 :: "int set" where + "A = {(x::int). 0 < x & x \ ((p - 1) div 2)}" + +definition + B :: "int set" where + "B = (%x. x * a) ` A" + +definition + C :: "int set" where + "C = StandardRes p ` B" + +definition + D :: "int set" where + "D = C \ {x. x \ ((p - 1) div 2)}" + +definition + E :: "int set" where + "E = C \ {x. ((p - 1) div 2) < x}" + +definition + F :: "int set" where + "F = (%x. (p - x)) ` E" + + +subsection {* Basic properties of p *} + +lemma p_odd: "p \ 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 \ (p - 1) div 1" + by (rule zdiv_mono2) (auto simp add: p_g_0) + also have "\ = p - 1" by simp + finally show ?thesis by simp +qed + +lemma p_eq: "p = (2 * (p - 1) div 2) + 1" + using div_mult_self1_is_id [of 2 "p - 1"] by auto + + +lemma (in -) zodd_imp_zdiv_eq: "x \ zOdd ==> 2 * (x - 1) div 2 = 2 * ((x - 1) div 2)" + apply (frule odd_minus_one_even) + apply (simp add: zEven_def) + apply (subgoal_tac "2 \ 0") + apply (frule_tac b = "2 :: int" and a = "x - 1" in div_mult_self1_is_id) + apply (auto simp add: even_div_2_prop2) + done + + +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 {* Basic Properties of the Gauss Sets *} + +lemma finite_A: "finite (A)" + apply (auto simp add: A_def) + apply (subgoal_tac "{x. 0 < x & x \ (p - 1) div 2} \ {x. 0 \ x & x < 1 + (p - 1) div 2}") + apply (auto simp add: bdd_int_set_l_finite finite_subset) + done + +lemma finite_B: "finite (B)" + by (auto simp add: B_def finite_A finite_imageI) + +lemma finite_C: "finite (C)" + by (auto simp add: C_def finite_B finite_imageI) + +lemma finite_D: "finite (D)" + by (auto simp add: D_def finite_Int finite_C) + +lemma finite_E: "finite (E)" + by (auto simp add: E_def finite_Int finite_C) + +lemma finite_F: "finite (F)" + by (auto simp add: F_def finite_E finite_imageI) + +lemma C_eq: "C = D \ 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 \ (p - 1) div 2" + assume d: "0 < y" + assume e: "y \ (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: prems 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 prems) +proof - + fix x fix y + assume a: "x * a mod p = y * a mod p" + assume b: "0 < x" + assume c: "x \ (p - 1) div 2" + assume d: "0 < y" + assume e: "y \ (p - 1) div 2" + assume f: "x \ 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: prems 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 \ 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 \ A ==> 0 < x" + by (auto simp add: A_def) + +lemma B_ncong_p: "x \ 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 = x and b = a in zcong_zprime_prod_zero_contra) + apply (auto simp add: A_greater_zero) + done + +lemma B_greater_zero: "x \ B ==> 0 < x" + using a_nonzero by (auto simp add: B_def mult_pos_pos A_greater_zero) + +lemma C_ncong_p: "x \ C ==> ~[x = 0](mod p)" + apply (auto simp add: C_def) + apply (frule B_ncong_p) + apply (subgoal_tac "[x = StandardRes p x](mod p)") + defer apply (simp add: StandardRes_prop1) + apply (frule_tac a = x and b = "StandardRes p x" and c = 0 in zcong_trans) + apply auto + done + +lemma C_greater_zero: "y \ C ==> 0 < y" + apply (auto simp add: C_def) +proof - + fix x + assume a: "x \ B" + from p_g_0 have "0 \ 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 \ 0" + by (simp add: StandardRes_prop3) + ultimately show "0 < StandardRes p x" + by (simp add: order_le_less) +qed + +lemma D_ncong_p: "x \ D ==> ~[x = 0](mod p)" + by (auto simp add: D_def C_ncong_p) + +lemma E_ncong_p: "x \ E ==> ~[x = 0](mod p)" + by (auto simp add: E_def C_ncong_p) + +lemma F_ncong_p: "x \ F ==> ~[x = 0](mod p)" + apply (auto simp add: F_def) +proof - + fix x assume a: "x \ 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 \ {x. 0 < x & x \ ((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 \ B |] + ==> p - StandardRes p x \ (p - 1) div 2" + by simp +qed + +lemma D_subset: "D \ {x. 0 < x & x \ ((p - 1) div 2)}" + by (auto simp add: D_def C_greater_zero) + +lemma F_eq: "F = {x. \y \ 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. \y \ A. ( x = StandardRes p (y*a) & StandardRes p (y*a) \ (p - 1) div 2)}" + by (auto simp add: D_def C_def B_def A_def) + +lemma D_leq: "x \ D ==> x \ (p - 1) div 2" + by (auto simp add: D_eq) + +lemma F_ge: "x \ F ==> x \ (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) \ (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: "\x \ 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 (setprod id A) p = 1" +by(rule all_relprime_prod_relprime[OF finite_A all_A_relprime]) + + +subsection {* Relationships Between Gauss Sets *} + +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 \ 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: "setprod id E * setprod id D = setprod id C" + apply (insert D_E_disj finite_D finite_E C_eq) + apply (frule setprod_Un_disjoint [of D E id]) + apply auto + done + +lemma C_B_zcong_prod: "[setprod id C = setprod id B] (mod p)" + apply (auto simp add: C_def) + apply (insert finite_B SR_B_inj) + apply (frule_tac f = "StandardRes p" in setprod_reindex_id [symmetric], auto) + apply (rule setprod_same_function_zcong) + apply (auto simp add: StandardRes_prop1 zcong_sym p_g_0) + done + +lemma F_Un_D_subset: "(F \ D) \ A" + apply (rule Un_least) + apply (auto simp add: A_def F_subset D_subset) + done + +lemma F_D_disj: "(F \ 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: zadd_zmult_distrib2 zmult_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 \ A" and c: "ya: A" + with A_def have "0 < y + ya" + by auto + moreover from b c A_def have "y + ya \ (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 \ D) = nat ((p - 1) div 2)" +proof - + have "card (F \ 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 \ D) = card C" + by (simp add: C_card_eq_D_plus_E) + from this show "card (F \ D) = nat ((p - 1) div 2)" + by (simp add: C_card_eq_B B_card_eq) +qed + +lemma F_Un_D_eq_A: "F \ 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: + "(setprod id D) * (setprod id F) = setprod id A" + apply (insert F_D_disj finite_D finite_F) + apply (frule setprod_Un_disjoint [of F D id]) + apply (auto simp add: F_Un_D_eq_A) + done + +lemma prod_F_zcong: + "[setprod id F = ((-1) ^ (card E)) * (setprod id E)] (mod p)" +proof - + have "setprod id F = setprod id (op - p ` E)" + by (auto simp add: F_def) + then have "setprod id F = setprod (op - p) E" + apply simp + apply (insert finite_E inj_on_pminusx_E) + apply (frule_tac f = "op - p" in setprod_reindex_id, auto) + done + then have one: + "[setprod id F = setprod (StandardRes p o (op - p)) E] (mod p)" + apply simp + apply (insert p_g_0 finite_E StandardRes_prod) + by (auto) + moreover have a: "\x \ 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: "\x \ E. [StandardRes p (p - x) = p - x](mod p)" + apply clarify + apply (simp add: StandardRes_prop1 zcong_sym) + done + moreover have "\x \ 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: + "[setprod (StandardRes p o (op - p)) E = setprod (uminus) E](mod p)" + apply simp + using finite_E p_g_0 + setprod_same_function_zcong [of E "StandardRes p o (op - p)" uminus p] + by auto + then have two: "[setprod id F = setprod (uminus) E](mod p)" + apply (insert one c) + apply (rule zcong_trans [of "setprod id F" + "setprod (StandardRes p o op - p) E" p + "setprod uminus E"], auto) + done + also have "setprod uminus E = (setprod id E) * (-1)^(card E)" + using finite_E by (induct set: finite) auto + then have "setprod uminus E = (-1) ^ (card E) * (setprod id E)" + by (simp add: zmult_commute) + with two show ?thesis + by simp +qed + + +subsection {* Gauss' Lemma *} + +lemma aux: "setprod id A * -1 ^ card E * a ^ card A * -1 ^ card E = setprod 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 "[setprod id A = setprod id F * setprod id D](mod p)" + by (auto simp add: prod_D_F_eq_prod_A zmult_commute cong del:setprod_cong) + then have "[setprod id A = ((-1)^(card E) * setprod id E) * + setprod id D] (mod p)" + apply (rule zcong_trans) + apply (auto simp add: prod_F_zcong zcong_scalar cong del: setprod_cong) + done + then have "[setprod id A = ((-1)^(card E) * setprod id C)] (mod p)" + apply (rule zcong_trans) + apply (insert C_prod_eq_D_times_E, erule subst) + apply (subst zmult_assoc, auto) + done + then have "[setprod id A = ((-1)^(card E) * setprod id B)] (mod p)" + apply (rule zcong_trans) + apply (simp add: C_B_zcong_prod zcong_scalar2 cong del:setprod_cong) + done + then have "[setprod id A = ((-1)^(card E) * + (setprod id ((%x. x * a) ` A)))] (mod p)" + by (simp add: B_def) + then have "[setprod id A = ((-1)^(card E) * (setprod (%x. x * a) A))] + (mod p)" + by (simp add:finite_A inj_on_xa_A setprod_reindex_id[symmetric] cong del:setprod_cong) + moreover have "setprod (%x. x * a) A = + setprod (%x. a) A * setprod id A" + using finite_A by (induct set: finite) auto + ultimately have "[setprod id A = ((-1)^(card E) * (setprod (%x. a) A * + setprod id A))] (mod p)" + by simp + then have "[setprod id A = ((-1)^(card E) * a^(card A) * + setprod id A)](mod p)" + apply (rule zcong_trans) + apply (simp add: zcong_scalar2 zcong_scalar finite_A setprod_constant zmult_assoc) + done + then have a: "[setprod id A * (-1)^(card E) = + ((-1)^(card E) * a^(card A) * setprod id A * (-1)^(card E))](mod p)" + by (rule zcong_scalar) + then have "[setprod id A * (-1)^(card E) = setprod id A * + (-1)^(card E) * a^(card A) * (-1)^(card E)](mod p)" + apply (rule zcong_trans) + apply (simp add: a mult_commute mult_left_commute) + done + then have "[setprod id A * (-1)^(card E) = setprod id A * + a^(card A)](mod p)" + apply (rule zcong_trans) + apply (simp add: aux cong del:setprod_cong) + done + with this zcong_cancel2 [of p "setprod 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Int2.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Int2.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,299 @@ +(* Title: HOL/Quadratic_Reciprocity/Gauss.thy + ID: $Id$ + Authors: Jeremy Avigad, David Gray, and Adam Kramer +*) + +header {*Integers: Divisibility and Congruences*} + +theory Int2 +imports Finite2 WilsonRuss +begin + +definition + MultInv :: "int => int => int" where + "MultInv p x = x ^ nat (p - 2)" + + +subsection {* Useful lemmas about dvd and powers *} + +lemma zpower_zdvd_prop1: + "0 < n \ p dvd y \ p dvd ((y::int) ^ n)" + by (induct n) (auto simp add: dvd_mult2 [of p y]) + +lemma zdvd_bounds: "n dvd m ==> m \ (0::int) | n \ 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 \ 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 \ p dvd ((y::int) ^ n) \ 0 < n \ 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: "[| 0 < z; (x::int) < y * z |] ==> x div z < y" +proof - + assume "0 < z" then have modth: "x mod z \ 0" by simp + have "(x div z) * z \ (x div z) * z" by simp + then have "(x div z) * z \ (x div z) * z + x mod z" using modth by arith + also have "\ = x" + by (auto simp add: zmod_zdiv_equality [symmetric] zmult_ac) + also assume "x < y * z" + finally show ?thesis + by (auto simp add: prems mult_less_cancel_right, insert prems, arith) +qed + +lemma div_prop2: "[| 0 < z; (x::int) < (y * z) + z |] ==> x div z \ y" +proof - + assume "0 < z" and "x < (y * z) + z" + then have "x < (y + 1) * z" by (auto simp add: int_distrib) + then have "x div z < y + 1" + apply - + apply (rule_tac y = "y + 1" in div_prop1) + apply (auto simp add: prems) + done + then show ?thesis by auto +qed + +lemma zdiv_leq_prop: "[| 0 < y |] ==> y * (x div y) \ (x::int)" +proof- + assume "0 < y" + from zmod_zdiv_equality have "x = y * (x div y) + x mod y" by auto + moreover have "0 \ x mod y" + by (auto simp add: prems pos_mod_sign) + ultimately show ?thesis + by arith +qed + + +subsection {* Useful properties of congruences *} + +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_refl 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: zmult_ac 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 zless_linear) + +lemma zcong_neg_1_impl_ne_1: "[| 2 < p; [x = -1] (mod p) |] ==> + ~([x = 1] (mod p))" +proof + assume "2 < p" and "[x = 1] (mod p)" and "[x = -1] (mod p)" + then 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 prems 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 \ 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; \x \ A. zgcd x y = 1 |] + ==> zgcd (setprod id A) y = 1" + by (induct set: finite) (auto simp add: zgcd_zgcd_zmult) + + +subsection {* Some properties of MultInv *} + +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 "2 < p" and "zprime p" and "~ p dvd x" + have "x * x ^ nat (p - 2) = x ^ (nat (p - 2) + 1)" + by auto + also from prems 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 prems 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 zmult_ac) + +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: zmult_ac) + 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: zmult_ac) + 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: zmult_ac) + 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: zmult_ac) + done + +lemma aux___3: "[j * k = a] (mod p) ==> [(MultInv p j) * j * k = + (MultInv p j) * a] (mod p)" + by (auto simp add: zmult_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: zmult_ac 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/IntFact.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/IntFact.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,94 @@ +(* Author: Thomas M. Rasmussen + Copyright 2000 University of Cambridge +*) + +header {* Factorial on integers *} + +theory IntFact imports IntPrimes begin + +text {* + Factorial on integers and recursively defined set including all + Integers from @{text 2} up to @{text a}. Plus definition of product + of finite set. + + \bigskip +*} + +consts + zfact :: "int => int" + d22set :: "int => int set" + +recdef zfact "measure ((\n. nat n) :: int => nat)" + "zfact n = (if n \ 0 then 1 else n * zfact (n - 1))" + +recdef d22set "measure ((\a. nat a) :: int => nat)" + "d22set a = (if 1 < a then insert a (d22set (a - 1)) else {})" + + +text {* + \medskip @{term d22set} --- recursively defined set including all + integers from @{text 2} up to @{text a} +*} + +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 safe + prefer 2 + apply (case_tac "1 < a") + apply (rule_tac prems) + apply (simp_all (no_asm_simp)) + apply (simp_all (no_asm_simp) add: d22set.simps prems) + done + +lemma d22set_g_1 [rule_format]: "b \ 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 \ d22set a --> b \ a" + apply (induct a rule: d22set_induct) + apply simp + apply (subst d22set.simps) + apply auto + done + +lemma d22set_le_swap: "a < b ==> b \ d22set a" + by (auto dest: d22set_le) + +lemma d22set_mem: "1 < b \ b \ a \ b \ d22set a" + apply (induct a rule: d22set.induct) + apply auto + apply (simp_all add: d22set.simps) + 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: "\(d22set a) = zfact a" + apply (induct a rule: d22set.induct) + apply safe + apply (simp add: d22set.simps zfact.simps) + 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/IntPrimes.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/IntPrimes.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,421 @@ +(* Author: Thomas M. Rasmussen + Copyright 2000 University of Cambridge +*) + +header {* Divisibility and prime numbers (on integers) *} + +theory IntPrimes +imports Main Primes +begin + +text {* + The @{text dvd} relation, GCD, Euclid's extended algorithm, primes, + congruences (all on the Integers). Comparable to theory @{text + Primes}, but @{text dvd} is included here as it is not present in + main HOL. Also includes extended GCD and congruences not present in + @{text Primes}. +*} + + +subsection {* Definitions *} + +consts + xzgcda :: "int * int * int * int * int * int * int * int => int * int * int" + +recdef xzgcda + "measure ((\(m, n, r', r, s', s, t', t). nat r) + :: int * int * int * int *int * int * int * int => nat)" + "xzgcda (m, n, r', r, s', s, t', t) = + (if r \ 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 \ bool" where + "zprime p = (1 < p \ (\m. 0 <= m & m dvd p --> m = 1 \ 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 {* Euclid's Algorithm and GCD *} + + +lemma zrelprime_zdvd_zmult_aux: + "zgcd n k = 1 ==> k dvd m * n ==> 0 \ m ==> k dvd m" + by (metis abs_of_nonneg dvd_triv_right zgcd_greatest_iff zgcd_zmult_distrib2_abs zmult_1_right) + +lemma zrelprime_zdvd_zmult: "zgcd n k = 1 ==> k dvd m * n ==> k dvd m" + apply (case_tac "0 \ 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{*This is merely a sanity check on zprime, since the previous version + denoted the empty set.*} +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 ==> \ 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 \ (m::int) ==> zprime p ==> p dvd m * n ==> p dvd m \ 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: zmult_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 \ zgcd n m = m" + by (metis abs_of_pos zdvd_mult_div_cancel zgcd_0 zgcd_commute zgcd_geq_zero zgcd_zdvd2 zgcd_zmult_eq_self) + + + +subsection {* Congruences *} + +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 zdiff_zmult_distrib2 dvd_mult zmult_commute) + apply (metis zdiff_zmult_distrib2 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) \ [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: zdiff_zmult_distrib zmult_commute zdiff_zmult_distrib2) + done + +lemma zcong_cancel: + "0 \ 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: zdiff_zmult_distrib) + apply (subgoal_tac "m dvd (-(a * k - b * k))") + apply simp + apply (subst dvd_minus_iff, assumption) + done + +lemma zcong_cancel2: + "0 \ m ==> + zgcd k m = 1 ==> [k * a = k * b] (mod m) = [a = b] (mod m)" + by (simp add: zmult_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 \ ka") + apply (metis zdvd_mult_div_cancel dvd_refl dvd_mult_left zmult_commute zrelprime_zdvd_zmult) + apply (metis abs_dvd_iff abs_of_nonneg zadd_0 zgcd_0_left zgcd_commute zgcd_zadd_zmult zgcd_zdvd_zgcd_zmult zgcd_zmult_distrib2_abs zmult_1_right zmult_commute) + apply (metis mult_le_0_iff zdvd_mono zdvd_mult_cancel dvd_triv_left zero_le_mult_iff zle_anti_sym zle_linear zle_refl zmult_commute zrelprime_zdvd_zmult) + apply (metis dvd_triv_left) + done + +lemma zcong_zless_imp_eq: + "0 \ a ==> + a < m ==> 0 \ b ==> b < m ==> [a = b] (mod m) ==> a = b" + apply (unfold zcong_def dvd_def, auto) + apply (drule_tac f = "\z. z mod m" in arg_cong) + apply (metis diff_add_cancel mod_pos_pos_trivial zadd_0 zadd_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 \ 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 ==> \ [a = b] (mod m)" + apply (unfold zcong_def) + apply (rule zdvd_not_zless, auto) + done + +lemma zcong_zless_0: + "0 \ 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 div_mult_self1_is_id) + done + +lemma zcong_zless_unique: + "0 < m ==> (\!b. 0 \ b \ b < m \ [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 zmult_div_cancel) + done + +lemma zcong_iff_lin: "([a = b] (mod m)) = (\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: zdiff_zmult_distrib2 add_diff_eq eq_diff_eq add_ac) + +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: zadd_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 (case_tac "m = 0", simp add: DIVISION_BY_ZERO) + apply (simp add: linorder_neq_iff) + apply (erule disjE) + prefer 2 apply (simp add: zcong_zmod_eq) + txt{*Remainding case: @{term "m<0"}*} + apply (rule_tac t = m in zminus_zminus [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 {* Modulo *} + +lemma zmod_zdvd_zmod: + "0 < (m::int) ==> m dvd b ==> (a mod b mod m) = (a mod m)" + by (rule mod_mod_cancel) + + +subsection {* Extended GCD *} + +declare xzgcda.simps [simp del] + +lemma xzgcd_correct_aux1: + "zgcd r' r = k --> 0 < r --> + (\sn tn. xzgcda (m, n, r', r, s', s, t', t) = (k, sn, tn))" + apply (rule_tac u = m and v = n and w = r' and x = r and y = s' and + z = s and aa = t' and ab = t in 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: + "(\sn tn. xzgcda (m, n, r', r, s', s, t', t) = (k, sn, tn)) --> 0 < r --> + zgcd r' r = k" + apply (rule_tac u = m and v = n and w = r' and x = r and y = s' and + z = s and aa = t' and ab = t in 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 Pair_eq simps zle_refl) + done + +lemma xzgcd_correct: + "0 < n ==> (zgcd m n = k) = (\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 {* \medskip @{term xzgcd} linear *} + +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: zdiff_zmult_distrib zadd_zmult_distrib2 zmult_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) \ y ==> x \ 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 (rule_tac u = m and v = n and w = r' and x = r and y = s' and + z = s and aa = t' and ab = t in 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 ==> (\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 ==> \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: zmult_commute) + done + +lemma zcong_lineq_unique: + "0 < n ==> + zgcd a n = 1 ==> \!x. 0 \ x \ x < n \ [a * x = b] (mod n)" + apply auto + apply (rule_tac [2] zcong_zless_imp_eq) + apply (tactic {* stac (thm "zcong_cancel2" RS sym) 6 *}) + 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 zmod_zmult1_eq zmult_1 zmult_assoc) + done + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Legacy_GCD.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Legacy_GCD.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,787 @@ +(* Title: HOL/GCD.thy + Author: Christophe Tabacznyj and Lawrence C Paulson + Copyright 1996 University of Cambridge +*) + +header {* The Greatest Common Divisor *} + +theory Legacy_GCD +imports Main +begin + +text {* + See \cite{davenport92}. \bigskip +*} + +subsection {* Specification of GCD on nats *} + +definition + is_gcd :: "nat \ nat \ nat \ bool" where -- {* @{term gcd} as a relation *} + [code del]: "is_gcd m n p \ p dvd m \ p dvd n \ + (\d. d dvd m \ d dvd n \ d dvd p)" + +text {* Uniqueness *} + +lemma is_gcd_unique: "is_gcd a b m \ is_gcd a b n \ m = n" + by (simp add: is_gcd_def) (blast intro: dvd_anti_sym) + +text {* Connection to divides relation *} + +lemma is_gcd_dvd: "is_gcd a b m \ k dvd a \ k dvd b \ k dvd m" + by (auto simp add: is_gcd_def) + +text {* Commutativity *} + +lemma is_gcd_commute: "is_gcd m n k = is_gcd n m k" + by (auto simp add: is_gcd_def) + + +subsection {* GCD on nat by Euclid's algorithm *} + +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 "\m. P m 0" + and "\m n. 0 < n \ P n (m mod n) \ 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 \ 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 {* + \medskip @{term "gcd m n"} divides @{text m} and @{text n}. The + conjunctions don't seem provable separately. +*} + +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 {* + \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"}. +*} + +lemma gcd_greatest: "k dvd m \ k dvd n \ k dvd gcd m n" + by (induct m n rule: gcd_induct) (simp_all add: gcd_non_0 dvd_mod) + +text {* + \medskip Function gcd yields the Greatest Common Divisor. +*} + +lemma is_gcd: "is_gcd m n (gcd m n) " + by (simp add: is_gcd_def gcd_greatest) + + +subsection {* Derived laws for GCD *} + +lemma gcd_greatest_iff [iff, algebra]: "k dvd gcd m n \ k dvd m \ k dvd n" + by (blast intro!: gcd_greatest intro: dvd_trans) + +lemma gcd_zero[algebra]: "gcd m n = 0 \ m = 0 \ 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 {* + \medskip Multiplication laws +*} + +lemma gcd_mult_distrib2: "k * gcd m n = gcd (k * m) (k * n)" + -- {* \cite[page 27]{davenport92} *} + apply (induct m n rule: gcd_induct) + apply simp + apply (case_tac "k = 0") + apply (simp_all add: mod_geq gcd_non_0 mod_mult_distrib2) + 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_anti_sym) + 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 {* \medskip Addition laws *} + +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 {* + \medskip Division by gcd yields rrelatively primes. +*} + +lemma div_gcd_relprime: + assumes nz: "a \ 0 \ b \ 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 + then have "?g * ?a' = (?g * ?g') * ka'" "?g * ?b' = (?g * ?g') * kb'" by simp_all + 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 \ 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\d dvd b \ (\e. e dvd a \ e dvd b \ e dvd d) \ d = gcd a b" +proof(auto) + assume H: "d dvd a" "d dvd b" "\e. e dvd a \ e dvd b \ 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_anti_sym[OF th gcd_greatest[OF H(1,2)]] show "d = gcd a b" by blast +qed + +lemma gcd_eq: assumes H: "\d. d dvd x \ d dvd y \ d dvd u \ d dvd v" + shows "gcd x y = gcd u v" +proof- + from H have "\d. d dvd x \ d dvd y \ 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: " \a b. P (a::nat) b \ P b a" and z: "\a. P a 0" + and add: "\a b. P a b \ P a (a + b)" + shows "P a b" +proof(induct n\"a+b" arbitrary: a b rule: nat_less_induct) + fix n a b + assume H: "\m < n. \a b. m = a + b \ P a b" "n = a + b" + have "a = b \ a < b \ 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 < n \ a = 0" using H(2) by arith + moreover + {assume "a =0" with z c have "P a b" by blast } + moreover + {assume ab: "a + b - a < n" + have th0: "a + b - a = a + (b - a)" using lt by arith + from add[rule_format, OF H(1)[rule_format, OF ab th0]] + 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 < n \ b = 0" using H(2) by arith + moreover + {assume "b =0" with z c have "P a b" by blast } + moreover + {assume ab: "b + a - b < n" + have th0: "b + a - b = b + (a - b)" using lt by arith + from add[rule_format, OF H(1)[rule_format, OF ab th0]] + 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: "\(d::nat) x y. d dvd a \ d dvd b \ (a * x = b * y + d \ b * x = a * y + d)" + shows "\d x y. d dvd a \ d dvd a + b \ (a * x = (a + b) * y + d \ (a + b) * x = a * y + d)" +using ex +apply clarsimp +apply (rule_tac x="d" in exI, simp add: dvd_add) +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: "\(d::nat) x y. d dvd a \ d dvd b \ (a * x = b * y + d \ b * x = a * y + d)" +apply(induct a b rule: ind_euclid) +apply blast +apply clarify +apply (rule_tac x="a" in exI, simp add: dvd_add) +apply clarsimp +apply (rule_tac x="d" in exI) +apply (case_tac "a * x = b * y + d", simp_all add: dvd_add) +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: "\(d::nat) x y. d dvd a \ d dvd b \ (a * x - b * y = d \ 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 {* We can get a stronger version with a nonzeroness assumption. *} +lemma divides_le: "m dvd n ==> m <= n \ n = (0::nat)" by (auto simp add: dvd_def) + +lemma bezout_add_strong: assumes nz: "a \ (0::nat)" + shows "\d x y. d dvd a \ d dvd b \ a * x = b * y + d" +proof- + from nz have ap: "a > 0" by simp + from bezout_add[of a b] + have "(\d x y. d dvd a \ d dvd b \ a * x = b * y + d) \ (\d x y. d dvd a \ d dvd b \ 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 \ 0" hence bp: "b > 0" by simp + from divides_le[OF H(2)] b have "d < b \ d = b" using le_less by blast + moreover + {assume db: "d=b" + from prems 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 prems by simp } + moreover + {assume x0: "x \ 0" hence xp: "x > 0" by simp + + from db have "d \ b - 1" by simp + hence "d*b \ b*(b - 1)" by simp + with xp mult_mono[of "1" "x" "d*b" "b*(b - 1)"] + have dble: "d*b \ 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 add_commute mult_ac) + 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: "\x y. a * x - b * y = gcd a b \ 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 \ 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 \ (b * x - a * y)*k = d*k" by blast + hence "a * x * k - b * y*k = d*k \ b * x * k - a * y*k = d*k" + by (algebra add: diff_mult_distrib) + hence "a * (x * k) - b * (y*k) = ?g \ 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 \ 0" + shows "\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: "(\x y. a * x - b * y = d \ b * x - a * y = d) \ gcd a b dvd d" + (is "?lhs \ ?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 \ b * x - a * y = ?g" + by blast + hence "(a * x - b * y)*k = ?g*k \ (b * x - a * y)*k = ?g*k" by auto + hence "a * x*k - b * y*k = ?g*k \ b * x * k - a * y*k = ?g*k" + by (simp only: diff_mult_distrib) + hence "a * (x*k) - b * (y*k) = d \ 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 \ 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: gcd_mult 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" +apply (simp_all add: gcd_add1) +by (simp add: gcd_commute gcd_add1) + +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 \ (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 \ a" + from th[OF ab] show "gcd (a - b) b = gcd a b" by blast +next + assume ab: "a \ b" + from th[OF ab] show "gcd a (b - a) = gcd a b" + by (simp add: gcd_commute)} +qed + + +subsection {* LCM defined by GCD *} + + +definition + lcm :: "nat \ nat \ 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: mult_ac gcd_mult_distrib2) + also have "\ = k * gcd (m * p * q) (n * q * p)" + by (simp add: k_m [symmetric] k_n [symmetric]) + also have "\ = k * p * q * gcd m n" + by (simp add: mult_ac 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: mult_ac) + 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: mult_ac) + 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: mult_ac) + also have "\ = 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: mult_ac) + also have "\ = 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 \ 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 {* GCD and LCM on integers *} + +definition + zgcd :: "int \ int \ int" where + "zgcd i j = int (gcd (nat (abs i)) (nat (abs j)))" + +lemma zgcd_zdvd1 [iff,simp, algebra]: "zgcd i j dvd i" +by (simp add: zgcd_def int_dvd_iff) + +lemma zgcd_zdvd2 [iff,simp, algebra]: "zgcd i j dvd j" +by (simp add: zgcd_def int_dvd_iff) + +lemma zgcd_pos: "zgcd i j \ 0" +by (simp add: zgcd_def) + +lemma zgcd0 [simp,algebra]: "(zgcd i j = 0) = (i = 0 \ 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 \ i dvd k * j \ i dvd k" + unfolding zgcd_def +proof - + assume "int (gcd (nat \i\) (nat \j\)) = 1" "i dvd k * j" + then have g: "gcd (nat \i\) (nat \j\) = 1" by simp + from `i dvd k * j` obtain h where h: "k*j = i*h" unfolding dvd_def by blast + have th: "nat \i\ dvd nat \k\ * nat \j\" + unfolding dvd_def + by (rule_tac x= "nat \h\" in exI, simp add: h nat_abs_mult_distrib [symmetric]) + from relprime_dvd_mult [OF g th] obtain h' where h': "nat \k\ = nat \i\ * h'" + unfolding dvd_def by blast + from h' have "int (nat \k\) = int (nat \i\ * h')" by simp + then have "\k\ = \i\ * int h'" by (simp add: int_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 (abs x)) = abs x" by arith + +lemma zgcd_greatest: + assumes "k dvd m" and "k dvd n" + shows "k dvd zgcd m n" +proof - + let ?k' = "nat \k\" + let ?m' = "nat \m\" + let ?n' = "nat \n\" + from `k dvd m` and `k dvd n` 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 \k\) dvd zgcd m n" + unfolding zgcd_def by (simp only: zdvd_int) + then have "\k\ 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 \ 0 \ b \ 0" + shows "zgcd (a div (zgcd a b)) (b div (zgcd a b)) = 1" +proof - + from nz have nz': "nat \a\ \ 0 \ nat \b\ \ 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 add: zgcd_zdvd1 zgcd_zdvd2) + have dvdg': "?g' dvd ?a'" "?g' dvd ?b'" by (simp_all add: zgcd_zdvd1 zgcd_zdvd2) + 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 + then have "?g* ?a' = (?g * ?g') * ka'" "?g* ?b' = (?g * ?g') * kb'" by simp_all + then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b" + by (auto simp add: zdvd_mult_div_cancel [OF dvdg(1)] + zdvd_mult_div_cancel [OF dvdg(2)] dvd_def) + have "?g \ 0" using nz by simp + then have gp: "?g \ 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 "\?g'\ = 1" by simp + with zgcd_pos show "?g' = 1" by simp +qed + +lemma zgcd_0 [simp, algebra]: "zgcd m 0 = abs m" + by (simp add: zgcd_def abs_if) + +lemma zgcd_0_left [simp, algebra]: "zgcd 0 m = abs m" + 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: nat_diff_distrib gcd_diff2 nat_le_eq_zle) + done + +lemma zgcd_eq: "zgcd m n = zgcd n (m mod n)" + apply (case_tac "n = 0", simp add: DIVISION_BY_ZERO) + 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 \ \m\ = 1" + by (simp add: zgcd_def abs_if) + +lemma zgcd_greatest_iff[algebra]: "k dvd zgcd m n = (k dvd m \ 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 gcd_1_left) + +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 + -- {* addition is an AC-operator *} + +lemma zgcd_zmult_distrib2: "0 \ 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] zmult_int [symmetric]) + +lemma zgcd_zmult_distrib2_abs: "zgcd (k * m) (k * n) = abs k * zgcd m n" + by (simp add: abs_if zgcd_zmult_distrib2) + +lemma zgcd_self [simp]: "0 \ 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 \ 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 \ 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(abs i)) (nat(abs j)))" + +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(abs k) dvd nat(abs i)" using `k dvd i` + 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(abs k) dvd nat(abs j)" using `k dvd j` + 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 (abs d)" +by (case_tac "d <0", simp_all) + +lemma zdvd_self_abs2: "(abs (d::int)) 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 \ 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 \ m" by simp + with npos have t1:"gcd m n *n \ m*n" by simp + have "gcd m n \ gcd m n*n" using npos by simp + with t1 have "gcd m n \ m*n" by arith +ultimately show "False" by simp +qed + +lemma zlcm_pos: + assumes anz: "a \ 0" + and bnz: "b \ 0" + shows "0 < zlcm a b" +proof- + let ?na = "nat (abs a)" + let ?nb = "nat (abs b)" + 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 = \if l = 0 then k else zgcd l (\k\ mod \l\)\" + by (simp add: zgcd_def gcd.simps [of "nat \k\"] nat_mod_distrib) + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Pocklington.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Pocklington.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,1263 @@ +(* Title: HOL/Library/Pocklington.thy + Author: Amine Chaieb +*) + +header {* Pocklington's Theorem for Primes *} + +theory Pocklington +imports Main 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[_ \ _] '(mod _'))") + where "[a \ b] (mod p) == ((a mod p) \ (b mod p))" + +lemma modeq_trans: + "\ [a = b] (mod p); [b = c] (mod p) \ \ [a = c] (mod p)" + by (simp add:modeq_def) + + +lemma nat_mod_lemma: assumes xyn: "[x = y] (mod n)" and xy:"y \ x" + shows "\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) \ (\q1 q2. x + n * q1 = y + n * q2)" +unfolding modeq_def nat_mod_eq_iff .. + +(* Lemmas about previously defined terms. *) + +lemma prime: "prime p \ p \ 0 \ p\1 \ (\m. 0 < m \ m < p \ coprime p m)" + (is "?lhs \ ?rhs") +proof- + {assume "p=0 \ p=1" hence ?thesis using prime_0 prime_1 by (cases "p=0", simp_all)} + moreover + {assume p0: "p\0" "p\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 \ 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: "\m. 0 < m \ m < p \ 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 \ p" by arith + {assume "q = p" hence ?lhs using q(1) by blast} + moreover + {assume "q\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 \ p=1", auto) +qed + +lemma finite_number_segment: "card { m. 0 < m \ m < n } = n - 1" +proof- + have "{ m. 0 < m \ m < n } = {1.. 0" shows "coprime (a mod n) n \ 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) \ x = y" "[x = y] (mod 1)" "[x = 0] (mod n) \ n dvd x" + by (simp_all add: modeq_def, presburger) + +lemma cong_sub_cases: + "[x = y] (mod n) \ (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\0" + {assume xy: "x \ y" hence axy': "a*x \ 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: "\x \ y" hence xy: "y \ x" by arith + from H az have axy': "\ a*x \ 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 \ [a = b] (mod n)" by (simp add: cong_refl) + +lemma cong_commute: "[x = y] (mod n) \ [y = x] (mod n)" + by (auto simp add: modeq_def) + +lemma cong_trans[trans]: "[x = y] (mod n) \ [y = z] (mod n) \ [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 "\ = (x' mod n + y' mod n) mod n" using xx' yy' modeq_def by simp + also have "\ = (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 "\ = (x' mod n) * (y' mod n) mod n" using xx'[unfolded modeq_def] yy'[unfolded modeq_def] by simp + also have "\ = (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) \ [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' \ y + b = y' + b' \ y <= x \ y' <= x' + \ (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: right_distrib) + 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) \ [x = y] (mod n)" (is "?lhs \ ?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) \ [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) \ [x = y] (mod n)" + by (simp add: nat_mod) + +lemma cong_add_rcancel_eq: "[x + a = y + a] (mod n) \ [x = y] (mod n)" + by (simp add: nat_mod) + +lemma cong_add_rcancel: "[x + a = y + a] (mod n) \ [x = y] (mod n)" + by (simp add: nat_mod) + +lemma cong_add_lcancel: "[a + x = a + y] (mod n) \ [x = y] (mod n)" + by (simp add: nat_mod) + +lemma cong_add_lcancel_eq_0: "[a + x = a] (mod n) \ [x = 0] (mod n)" + by (simp add: nat_mod) + +lemma cong_add_rcancel_eq_0: "[x + a = a] (mod n) \ [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) \ 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) \ n dvd x" by simp + +lemma cong_1_divides:"[x = 1] (mod n) ==> n dvd x - 1" + apply (cases "x\1", simp_all) + using cong_sub_cases[of x 1 n] by auto + +lemma cong_divides: "[x = y] (mod n) \ n dvd x \ 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 \ coprime n y" +proof- + {assume "n=0" hence ?thesis using xy by simp} + moreover + {assume nz: "n \ 0" + have "coprime n x \ coprime (x mod n) n" + by (simp add: coprime_mod[OF nz, of x] coprime_commute[of n x]) + also have "\ \ coprime (y mod n) n" using xy[unfolded modeq_def] by simp + also have "\ \ 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) \ [a mod n = a] (mod n)" by (simp add: modeq_def) + +lemma mod_mult_cong: "~(a = 0) \ ~(b = 0) + \ [x mod (a * b) = y] (mod a) \ [x = y] (mod a)" + by (simp add: modeq_def mod_mult2_eq mod_add_left_eq) + +lemma cong_mod_mult: "[x = y] (mod n) \ m dvd n \ [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 \ [x = y] (mod n) \ (\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) \ a = 0 \ n = 1 \ (\m. a = 1 + m * n)" +proof- + {assume "n = 0 \ n = 1\ a = 0 \ 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 + by (cases "a=1", simp_all add: modeq_def cong_commute)} + moreover + {assume n: "n\0" "n\1" and a:"a\0" "a \ 1" hence a': "a \ 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 "\x. [a * x = b] (mod n)" +proof- + {assume "a=0" hence ?thesis using an by (simp add: modeq_def)} + moreover + {assume az: "a\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 \ 0" + shows "\!x. x < n \ [a * x = b] (mod n)" +proof- + let ?P = "\x. x < n \ [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 "\!y. 0 < y \ y < p \ [x * y = a] (mod p)" +proof- + from p have p1: "p > 1" using prime_ge_2[OF p] by arith + hence p01: "p \ 0" "p \ 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)" "\z. z < p \ [x * z = a] (mod p) \ 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 "\!y. 0 < y \ y < p \ [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 \ y", simp_all add: divides_mul[of a _ b]) + +lemma chinese_remainder_unique: + assumes ab: "coprime a b" and az: "a \ 0" and bz: "b\0" + shows "\!x. x < a * b \ [x = m] (mod a) \ [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 "\ = m mod a" apply (simp add: mod_mult2_eq) + apply (subst mod_add_left_eq) + by simp + 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 "\ = ((n + q2 * b) mod (b*a)) mod b" by (simp add: mult_commute) + also have "\ = n mod b" apply (simp add: mod_mult2_eq) + apply (subst mod_add_left_eq) + by simp + 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 \ 0" and bz: "b \ 0" + and ma: "coprime m a" and nb: "coprime n b" + shows "\!x. coprime x (a * b) \ x < a * b \ [x = m] (mod a) \ [x = n] (mod b)" +proof- + let ?P = "\x. x < a * b \ [x = m] (mod a) \ [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)" + "\y. ?P y \ 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: "\ n = card { m. 0 < m \ m <= n \ coprime m n }" + +lemma phi_0[simp]: "\ 0 = 0" + unfolding phi_def by auto + +lemma phi_finite[simp]: "finite ({ m. 0 < m \ m <= n \ coprime m n })" +proof- + have "{ m. 0 < m \ m <= n \ coprime m n } \ {0..n}" by auto + thus ?thesis by (auto intro: finite_subset) +qed + +declare coprime_1[presburger] +lemma phi_1[simp]: "\ 1 = 1" +proof- + {fix m + have "0 < m \ m <= 1 \ coprime m 1 \ m = 1" by presburger } + thus ?thesis by (simp add: phi_def) +qed + +lemma [simp]: "\ (Suc 0) = Suc 0" using phi_1 by simp + +lemma phi_alt: "\(n) = card { m. coprime m n \ m < n}" +proof- + {assume "n=0 \ n=1" hence ?thesis by (cases "n=0", simp_all)} + moreover + {assume n: "n\0" "n\1" + {fix m + from n have "0 < m \ m <= n \ coprime m n \ coprime m n \ 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 \ m < n}" (is "finite ?S") + by (rule finite_subset[of "?S" "{0..n}"], auto) + +lemma phi_another: assumes n: "n\1" + shows "\ n = card {m. 0 < m \ m < n \ coprime m n }" +proof- + {fix m + from n have "0 < m \ m < n \ coprime m n \ coprime m n \ m < n" + by (cases "m=0", auto)} + thus ?thesis unfolding phi_alt by auto +qed + +lemma phi_limit: "\ n \ n" +proof- + have "{ m. coprime m n \ m < n} \ {0 .. m < n}"] + show ?thesis unfolding phi_alt by auto +qed + +lemma stupid[simp]: "{m. (0::nat) < m \ m < n} = {1..1" + shows "\(n) \ n - 1" +proof- + show ?thesis + unfolding phi_another[OF n] finite_number_segment[of n, symmetric] + by (rule card_mono[of "{m. 0 < m \ m < n}" "{m. 0 < m \ m < n \ coprime m n}"], auto) +qed + +lemma phi_lowerbound_1_strong: assumes n: "n \ 1" + shows "\(n) \ 1" +proof- + let ?S = "{ m. 0 < m \ m <= n \ coprime m n }" + from card_0_eq[of ?S] n have "\ n \ 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 <= \(n)" + using phi_lowerbound_1_strong[of n] by auto + +lemma phi_lowerbound_2: assumes n: "3 <= n" shows "2 <= \ (n)" +proof- + let ?S = "{ m. 0 < m \ m <= n \ coprime m n }" + have inS: "{1, n - 1} \ ?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: "\ n = n - 1 \ n\0 \ n\1 \ prime n" +proof- + {assume "n=0 \ n=1" hence ?thesis by (cases "n=1", simp_all)} + moreover + {assume n: "n\0" "n\1" + let ?S = "{m. 0 < m \ m < n}" + have fS: "finite ?S" by simp + let ?S' = "{m. 0 < m \ m < n \ coprime m n}" + have fS':"finite ?S'" apply (rule finite_subset[of ?S' ?S]) by auto + {assume H: "\ n = n - 1 \ n\0 \ n\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" "\ coprime m n" + hence mS': "m \ ?S'" by auto + have "insert m ?S' \ ?S" using m by auto + from m have "card (insert m ?S') \ card ?S" + by - (rule card_mono[of ?S "insert m ?S'"], auto) + hence False + unfolding card_insert_disjoint[of "?S'" m, OF fS' mS'] ceq + by simp } + hence "\m. 0 m < n \ 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 "\ 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 "\ (a * b) = \ a * \ b" +proof- + {assume "a = 0 \ b = 0 \ a = 1 \ b = 1" + hence ?thesis + by (cases "a=0", simp, cases "b=0", simp, cases"a=1", simp_all) } + moreover + {assume a: "a\0" "a\1" and b: "b\0" "b\1" + hence ab0: "a*b \ 0" by simp + let ?S = "\k. {m. coprime m k \ m < k}" + let ?f = "\x. (x mod a, x mod b)" + have eq: "?f ` (?S (a*b)) = (?S a \ ?S b)" + proof- + {fix x assume x:"x \ ?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 \ (?S a \ ?S b)" + by (simp add: coprime_mod[OF a(1)] coprime_mod[OF b(1)])} + moreover + {fix x y assume x: "x \ ?S a" and y: "y \ ?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) \ ?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 \ 0" + shows "[setprod (\m. a(m) mod n) S = setprod a S] (mod n)" +proof- + have th1:"[1 = 1] (mod n)" by (simp add: modeq_def) + from cong_mult + have th3:"\x1 y1 x2 y2. + [x1 = x2] (mod n) \ [y1 = y2] (mod n) \ [x1 * y1 = x2 * y2] (mod n)" + by blast + have th4:"\x\S. [a x mod n = a x] (mod n)" by (simp add: modeq_def) + from fold_image_related[where h="(\m. a(m) mod n)" and g=a, OF th1 th3 fS, OF th4] show ?thesis unfolding setprod_def by (simp add: fS) +qed + +lemma nproduct_cmul: + assumes fS:"finite S" + shows "setprod (\m. (c::'a::{comm_monoid_mult})* a(m)) S = c ^ (card S) * setprod a S" +unfolding setprod_timesf setprod_constant[OF fS, of c] .. + +lemma coprime_nproduct: + assumes fS: "finite S" and Sn: "\x\S. coprime n (a x)" + shows "coprime n (setprod a S)" + using fS unfolding setprod_def by (rule finite_subset_induct) + (insert Sn, auto simp add: coprime_mul) + +lemma fermat_little: assumes an: "coprime a n" + shows "[a ^ (\ 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 \ 0" and n1: "n \ 1" + let ?S = "{m. coprime m n \ m < n}" + let ?P = "\ ?S" + have fS: "finite ?S" by simp + have cardfS: "\ n = card ?S" unfolding phi_alt .. + {fix m assume m: "m \ ?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: "\m\ ?S. coprime (a*m) n " by blast + from coprime_nproduct[OF fS, of n "\m. m"] have nP:"coprime ?P n" + by (simp add: coprime_commute) + have Paphi: "[?P*a^ (\ n) = ?P*1] (mod n)" + proof- + let ?h = "\m. m mod n" + {fix m assume mS: "m\ ?S" + hence "?h m \ ?S" by simp} + hence hS: "?h ` ?S = ?S"by (auto simp add: image_iff) + have "a\0" using an n1 nz apply- apply (rule ccontr) by simp + hence inj: "inj_on (op * a) ?S" unfolding inj_on_def by simp + + have eq0: "fold_image op * (?h \ op * a) 1 {m. coprime m n \ m < n} = + fold_image op * (\m. m) 1 {m. coprime m n \ m < n}" + proof (rule fold_image_eq_general[where h="?h o (op * a)"]) + show "finite ?S" using fS . + next + {fix y assume yS: "y \ ?S" hence y: "coprime y n" "y < n" by simp_all + from cong_solve_unique[OF an nz, of y] + obtain x where x:"x < n" "[a * x = y] (mod n)" "\z. z < n \ [a * z = y] (mod n) \ z=x" by blast + from cong_coprime[OF x(2)] y(1) + have xm: "coprime x n" by (simp add: coprime_mul_eq coprime_commute) + {fix z assume "z \ ?S" "(?h \ op * a) z = y" + hence z: "coprime z n" "z < n" "(?h \ op * a) z = y" by simp_all + from x(3)[rule_format, of z] z(2,3) have "z=x" + unfolding modeq_def mod_less[OF y(2)] by simp} + with xm x(1,2) have "\!x. x \ ?S \ (?h \ op * a) x = y" + unfolding modeq_def mod_less[OF y(2)] by auto } + thus "\y\{m. coprime m n \ m < n}. + \!x. x \ {m. coprime m n \ m < n} \ ((\m. m mod n) \ op * a) x = y" by blast + next + {fix x assume xS: "x\ ?S" + hence x: "coprime x n" "x < n" by simp_all + with an have "coprime (a*x) n" + by (simp add: coprime_mul_eq[of n a x] coprime_commute) + hence "?h (a*x) \ ?S" using nz + by (simp add: coprime_mod[OF nz] mod_less_divisor)} + thus " \x\{m. coprime m n \ m < n}. + ((\m. m mod n) \ op * a) x \ {m. coprime m n \ m < n} \ + ((\m. m mod n) \ op * a) x = ((\m. m mod n) \ op * a) x" by simp + qed + from nproduct_mod[OF fS nz, of "op * a"] + have "[(setprod (op *a) ?S) = (setprod (?h o (op * a)) ?S)] (mod n)" + unfolding o_def + by (simp add: cong_commute) + also have "[setprod (?h o (op * a)) ?S = ?P ] (mod n)" + using eq0 fS an by (simp add: setprod_def modeq_def o_def) + finally show "[?P*a^ (\ 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\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\0" "n\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 \ 2" and an:"[a^(n - 1) = 1] (mod n)" + and nm: "\m. 0 m < n - 1 \ \ [a^m = 1] (mod n)" + shows "prime n" +proof- + from n have n1: "n \ 1" "n\0" "n - 1 \ 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 ^ \ n = 1] (mod n)" . + {assume "\ n \ n - 1" + with phi_limit_strong[OF n1(1)] phi_lowerbound_1[OF n] + have c:"\ n > 0 \ \ n < n - 1" by arith + from nm[rule_format, OF c] afn have False ..} + hence "\ n = n - 1" by blast + with phi_prime[of n] n1(1,2) show ?thesis by simp +qed + +lemma nat_exists_least_iff: "(\(n::nat). P n) \ (\n. P n \ (\m < n. \ P m))" + (is "?lhs \ ?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 "\ P m" .} + with LeastI_ex[OF H] show ?rhs by blast +qed + +lemma nat_exists_least_iff': "(\(n::nat). P n) \ (P (Least P) \ (\m < (Least P). \ P m))" + (is "?lhs \ ?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 "\ 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 "\ = ((x mod m) * (x^n mod m)) mod m" using Suc.hyps by simp + also have "\ = 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 \ 2" and an1: "[a^(n - 1) = 1] (mod n)" + and pn: "\p. prime p \ p dvd n - 1 \ \ [a^((n - 1) div p) = 1] (mod n)" + shows "prime n" +proof- + from n2 have n01: "n\0" "n\1" "n - 1 \ 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: "\m. 0 < m \ m < n - 1 \ [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)" "\k ?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 = mod_div_equality[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 "\ = (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 "\ = 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 + mod_div_equality[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\0" "r\1" by - (rule ccontr, simp)+ + from prime_factor[OF r01(2)] obtain p where p: "prime p" "p dvd r" by blast + hence th: "prime p \ 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 "\ = (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 "\ = ((a^m)^(r div p)) mod n" by (simp add: power_mult) + also have "\ = ((a^m mod n)^(r div p)) mod n" using power_mod[of "a^m" "n" "r div p" ] .. + also have "\ = 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: "\m. 0 < m \ m < n - 1 \ \ [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 (\d. d > 0 \ [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 \ [a ^(ord n a) = 1] (mod n) \ (\m. 0 < m \ m < ord n a \ \ [a^ m = 1] (mod n))" +proof- + let ?P = "\d. 0 < d \ [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 \ n=1" with na have "\m>0. ?P m" apply auto apply (rule exI[where x=1]) by (simp add: modeq_def)} + moreover + {assume "n\0 \ n\1" hence n2:"n \ 2" by arith + from na have na': "coprime a n" by (simp add: coprime_commute) + from phi_lowerbound_1[OF n2] fermat_little[OF na'] + have ex: "\m>0. ?P m" by - (rule exI[where x="\ n"], auto) } + ultimately have ex: "\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) \ (\m. 0 < m \ m < ord n a \ ~[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 \ m < ord n a \ ~[a^m = 1] (mod n)" + using ord_works by blast +lemma ord_eq_0: "ord n a = 0 \ ~coprime n a" +by (cases "coprime n a", simp add: neq0_conv coprime_ord, simp add: neq0_conv ord_def) + +lemma ord_divides: + "[a ^ d = 1] (mod n) \ ord n a dvd d" (is "?lhs \ ?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: "\ 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\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 \ 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 \ 0" by (simp add: ord_eq_0) + hence op: "?o > 0" by simp + from mod_div_equality[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 \ 0" + with mod_less_divisor[OF op, of d] have r0o:"?r >0 \ ?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 \ ord n a dvd \ 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) \ [d = e] (mod (ord n a))" +proof- + {fix n a d e + assume na: "coprime n a" and ed: "(e::nat) \ d" + hence "\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) \ [a^(e + c) = a^(e + 0)] (mod n)" + using c by simp + also have "\ \ [a^e* a^c = a^e *a^0] (mod n)" by (simp add: power_add) + also have "\ \ [a ^ c = 1] (mod n)" + using cong_mult_lcancel_eq[OF aen, of "a^c" "a^0"] by simp + also have "\ \ ord n a dvd c" by (simp only: ord_divides) + also have "\ \ [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) \ [d = e] (mod (ord n a))" + using c by simp } + note th = this + have "e \ d \ d \ e" by arith + moreover + {assume ed: "e \ d" from th[OF na ed] have ?thesis .} + moreover + {assume de: "d \ 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 \ n \ 1\ (\p. prime p \ p dvd n \ p = n)" +proof- + {assume n: "n=0 \ n=1" hence ?thesis using prime_0 two_is_prime by auto} + moreover + {assume n: "n\0" "n\1" + {assume pn: "prime n" + + from pn[unfolded prime_def] have "\p. prime p \ p dvd n \ p = n" + using n + apply (cases "n = 0 \ n=1",simp) + by (clarsimp, erule_tac x="p" in allE, auto)} + moreover + {assume H: "\p. prime p \ p dvd n \ p = n" + from n have n1: "n > 1" by arith + {fix m assume m: "m dvd n" "m\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_anti_sym[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 \ n \ 1 \ (\d. d dvd n \ d^2 \ n \ d = 1)" +proof- + {assume "n=0 \ n=1" hence ?thesis using prime_0 prime_1 + by (auto simp add: nat_power_eq_0_iff)} + moreover + {assume n: "n\0" "n\1" + hence np: "n > 1" by arith + {fix d assume d: "d dvd n" "d^2 \ n" and H: "\m. m dvd n \ m=1 \ m=n" + from H d have d1n: "d = 1 \ d=n" by blast + {assume dn: "d=n" + have "n^2 > n*1" using n + by (simp add: power2_eq_square mult_less_cancel1) + 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: "\d'. d' dvd n \ d'^2 \ n \ d' = 1" + from d n have "d \ 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^2 \ n \ e^2 \ n" using dp ep + by (auto simp add: e power2_eq_square mult_le_cancel_left) + moreover + {assume h: "d^2 \ n" + from H[rule_format, of d] h d have "d = 1" by blast} + moreover + {assume h: "e^2 \ 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 \ 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 \ n \ 0 \ n \ 1 \ \ (\p. prime p \ p dvd n \ p^2 \ n)" + (is "?lhs \?rhs") +proof- + {assume "n=0 \ n=1" hence ?thesis using prime_0 prime_1 by auto} + moreover + {assume n: "n\0" "n\1" + {assume H: ?lhs + from H[unfolded prime_divisor_sqrt] n + have ?rhs apply clarsimp by (erule_tac x="p" in allE, simp add: prime_1) + } + moreover + {assume H: ?rhs + {fix d assume d: "d dvd n" "d^2 \ n" "d\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 + from d(1) n have "d \ 0" by - (rule ccontr, 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^2 \ 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 \ n=1", auto) +qed +(* Pocklington theorem. *) + +lemma pocklington_lemma: + assumes n: "n \ 2" and nqr: "n - 1 = q*r" and an: "[a^ (n - 1) = 1] (mod n)" + and aq:"\p. prime p \ p dvd q \ 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 \ 0" "p \ 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\0" .. + from n nqr have aqr0: "a ^ (q * r) \ 0" using a0 by (simp add: neq0_conv) + 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: mult_ac) + 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 \ 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 \ 0" using P(1) prime_0 by - (rule ccontr, 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: " \ p = p - 1" by simp + {fix d assume d: "d dvd p" "d dvd a" "d \ 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 \ 0" by simp + from d(2) an n12[symmetric] have a0: "a \ 0" + by - (rule ccontr, simp add: modeq_def) + have th1: "a^ (n - 1) \ 0" using n d(2) dp a0 by (auto simp add: neq0_conv) + 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 + from prime_0 pp have p0:"p \ 0" by - (rule ccontr, 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 \ 2" and nqr: "n - 1 = q*r" and sqr: "n \ q^2" + and an: "[a^ (n - 1) = 1] (mod n)" + and aq:"\p. prime p \ p dvd q \ coprime (a^ ((n - 1) div p) - 1) n" + shows "prime n" +unfolding prime_prime_factor_sqrt[of n] +proof- + let ?ths = "n \ 0 \ n \ 1 \ \ (\p. prime p \ p dvd n \ p\ \ n)" + from n have n01: "n\0" "n\1" by arith+ + {fix p assume p: "prime p" "p dvd n" "p^2 \ n" + from p(3) sqr have "p^(Suc 1) \ q^(Suc 1)" by (simp add: power2_eq_square) + hence pq: "p \ 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 \ 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 \ 2" and nqr: "n - 1 = q*r" and sqr: "n \ q^2" + and an: "[a^ (n - 1) = 1] (mod n)" + and aq:"\p. prime p \ p dvd q \ (\b. [a^((n - 1) div p) = b] (mod n) \ 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\ 0" .. + hence a1: "a \ 1" by arith + from one_le_power[OF a1] have ath: "1 \ 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 mod_div_equality[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 \ 0" .. + hence b1: "b \ 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: "\p. prime p \ p dvd q \ 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 \ (\p\ set ps. prime p))" + +lemma primefact: assumes n: "n \ 0" + shows "\ps. primefact ps n" +using n +proof(induct n rule: nat_less_induct) + fix n assume H: "\m 0 \ (\ps. primefact ps m)" and n: "n\0" + let ?ths = "\ps. primefact ps n" + {assume "n = 1" + hence "primefact [] n" by (simp add: primefact_def) + hence ?ths by blast } + moreover + {assume n1: "n \ 1" + with n have n2: "n \ 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\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 \ 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" "\p \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 \ foldr op * ps 1 = n \ list_all prime ps" by (auto simp add: primefact_def list_all_iff) + +(* Variant of Lucas theorem. *) + +lemma lucas_primefact: + assumes n: "n \ 2" and an: "[a^(n - 1) = 1] (mod n)" + and psn: "foldr op * ps 1 = n - 1" + and psp: "list_all (\p. prime p \ \ [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 \ (0::nat)" shows "m mod n \ m" +proof- + from mod_div_equality[of m n] + have "\x. x + m mod n = m" by blast + then show ?thesis by auto +qed + + +lemma pocklington_primefact: + assumes n: "n \ 2" and qrn: "q*r = n - 1" and nq2: "n \ q^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 (\p. prime p \ 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 (\p. prime p \ 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 mod_div_equality[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 \ 0" "p \ 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: "\a (b::nat). a <= b \ a \ 0 ==> 1 <= a \ 1 <= b" by arith + from n0 have n00: "n \ 0" by arith + from mod_le[OF n00] + have th10: "a ^ ((n - 1) div p) mod n \ 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 + from dvd_trans[OF p(2) qn1] div_mod_equality'[of "n - 1" p] + have npp: "(n - 1) div p * p = n - 1" by (simp add: dvd_eq_mod_eq_0) + 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 "\ = 0" by (simp add: mult_assoc) + finally have False by simp } + then have th11: "a ^ ((n - 1) div p) mod n \ 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Primes.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Primes.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,826 @@ +(* Title: HOL/Library/Primes.thy + Author: Amine Chaieb, Christophe Tabacznyj and Lawrence C Paulson + Copyright 1996 University of Cambridge +*) + +header {* Primality on nat *} + +theory Primes +imports Complex_Main Legacy_GCD +begin + +definition + coprime :: "nat => nat => bool" where + "coprime m n \ gcd m n = 1" + +definition + prime :: "nat \ bool" where + [code del]: "prime p \ (1 < p \ (\m. m dvd p --> m = 1 \ 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 ==> \ p dvd n ==> gcd p n = 1" + apply (auto simp add: prime_def) + apply (metis One_nat_def gcd_dvd1 gcd_dvd2) + done + +text {* + 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. +*} + +lemma prime_dvd_mult: "prime p ==> p dvd m * n ==> p dvd m \ 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\ ==> p dvd m" + by (rule prime_dvd_square) (simp_all add: power2_eq_square) + + +lemma exp_eq_1:"(x::nat)^n = 1 \ x = 1 \ n = 0" +by (induct n, auto) + +lemma exp_mono_lt: "(x::nat) ^ (Suc n) < y ^ (Suc n) \ 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) \ y ^ (Suc n) \ x \ y" +by (simp only: linorder_not_less[symmetric] exp_mono_lt) + +lemma exp_mono_eq: "(x::nat) ^ Suc n = y ^ Suc n \ x = y" +using power_inject_base[of x n y] by auto + + +lemma even_square: assumes e: "even (n::nat)" shows "\x. n ^ 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^2 = 4* (k^2)" by (simp add: power2_eq_square) + thus ?thesis by blast +qed + +lemma odd_square: assumes e: "odd (n::nat)" shows "\x. n ^ 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" using dvd_def by auto + hence k: "n = 2*k + 1" using e by presburger + hence "n^2 = 4* (k^2 + k) + 1" by algebra + thus ?thesis by blast +qed + +lemma diff_square: "(x::nat)^2 - y^2 = (x+y)*(x - y)" +proof- + have "x \ y \ y \ x" by (rule nat_le_linear) + moreover + {assume le: "x \ y" + hence "x ^2 \ y^2" by (simp only: numeral_2_eq_2 exp_mono_le Let_def) + with le have ?thesis by simp } + moreover + {assume le: "y \ x" + hence le2: "y ^2 \ x^2" by (simp only: numeral_2_eq_2 exp_mono_le Let_def) + from le have "\z. y + z = x" by presburger + then obtain z where z: "x = y + z" by blast + from le2 have "\z. x^2 = y^2 + z" by presburger + then obtain z2 where z2: "x^2 = y^2 + z2" by blast + from z z2 have ?thesis apply simp by algebra } + ultimately show ?thesis by blast +qed + +text {* Elementary theory of divisibility *} +lemma divides_ge: "(a::nat) dvd b \ b = 0 \ a \ b" unfolding dvd_def by auto +lemma divides_antisym: "(x::nat) dvd y \ y dvd x \ x = y" + using dvd_anti_sym[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 \ k = 0 \ 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 \ m = n \ 2 * n <= m" + by (auto simp add: dvd_def) + +lemma divides_div_not: "(x::nat) = (q * n) + r \ 0 < r \ 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 \ 0" with r have "r \ 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 \ 0 \ (x::nat) ^ n dvd y \ x dvd y" + by (induct n ,auto simp add: dvd_def) + +fun fact :: "nat \ 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 \ 1" using fact_lt[of n] by simp +lemma fact_mono: assumes le: "m \ n" shows "fact m \ fact n" +proof- + from le have "\i. n = m+i" by presburger + then obtain i where i: "n = m+i" by blast + have "fact m \ 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 \ 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 \ 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 \ p \ n" by presburger + moreover + {assume "p = Suc n" hence ?case by (simp only: fact.simps dvd_triv_left)} + moreover + {assume "p \ 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 \ (x::nat) dvd (y^(Suc n))" by (simp add: dvd_mult2[of x y]) + +text {* Coprimality *} + +lemma coprime: "coprime a b \ (\d. d dvd a \ d dvd b \ d = 1)" +using gcd_unique[of 1 a b, simplified] by (auto simp add: coprime_def) +lemma coprime_commute: "coprime a b \ coprime b a" by (simp add: coprime_def gcd_commute) + +lemma coprime_bezout: "coprime a b \ (\x y. a * x - b * y = 1 \ b * x - a * y = 1)" +using coprime_def gcd_bezout by auto + +lemma coprime_divprod: "d dvd a * b \ coprime d a \ 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 \ 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\ 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 \ 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 prems 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: mult_ac) +apply (rule_tac x="a*x" in exI) +apply (rule_tac x="y" in exI) +apply (simp add: mult_ac) +done + +lemma coprime_rmul2: "coprime d (a * b) \ 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: mult_ac) +apply (rule_tac x="b*x" in exI) +apply (rule_tac x="y" in exI) +apply (simp add: mult_ac) +done +lemma coprime_mul_eq: "coprime d (a * b) \ coprime d a \ 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 \ 0" + shows "\a' b'. a = a' * gcd a b \ b = b' * gcd a b \ 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 \ 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 \ 0 ==> coprime (n - 1) n" + using coprime_plus1[of "n - 1"] coprime_commute[of "n - 1" n] by auto + +lemma bezout_gcd_pow: "\x y. a ^n * x - b ^ n * y = gcd a b ^ n \ 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]) + by simp} + moreover + {assume z: "?g \ 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: mult_ac) + 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 \ b'^n * x - a'^n * y = 1" by blast + hence "?g^n * (a'^n * x - b'^n * y) = ?g^n \ ?g^n*(b'^n * x - a'^n * y) = ?g^n" + using z by auto + then have "a^n * x - b^n * y = ?g^n \ 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 \ 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: "\e. e dvd a^n \ e dvd b^n \ 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) \ 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 "\b' c'. a = b' * c' \ b' dvd b \ 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 \ 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 \ n \ 0 \ m = 0" by (induct n, auto) + +lemma divides_rev: assumes ab: "(a::nat) ^ n dvd b ^n" and n:"n \ 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 \ 0" + hence zn: "?g ^ n \ 0" using n by (simp add: neq0_conv) + 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 {* A binary form of the Chinese Remainder Theorem. *} + +lemma chinese_remainder: assumes ab: "coprime a b" and a:"a \ 0" and b:"b \ 0" + shows "\x q1 q2. x = u + q1 * a \ 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 {* Primality *} + +text {* A few useful theorems about primes *} + +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 \ 2" by (simp add: prime_def) +lemma prime_factor: assumes n: "n \ 1" shows "\ p. prime p \ p dvd n" +using n +proof(induct n rule: nat_less_induct) + fix n + assume H: "\m 1 \ (\p. prime p \ p dvd m)" "n \ 1" + let ?ths = "\p. prime p \ p dvd n" + {assume "n=0" hence ?ths using two_is_prime by auto} + moreover + {assume nz: "n\0" + {assume "prime n" hence ?ths by - (rule exI[where x="n"], simp)} + moreover + {assume n: "\ prime n" + with nz H(2) + obtain k where k:"k dvd n" "k \ 1" "k \ n" by (auto simp add: 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) have ?ths by blast} + ultimately have ?ths by blast} + ultimately show ?ths by blast +qed + +lemma prime_factor_lt: assumes p: "prime p" and n: "n \ 0" and npm:"n = p * m" + shows "m < n" +proof- + {assume "m=0" with n have ?thesis by simp} + moreover + {assume m: "m \ 0" + from npm have mn: "m dvd n" unfolding dvd_def by auto + from npm m have "n \ m" using p by auto + with dvd_imp_le[OF mn] n have ?thesis by simp} + ultimately show ?thesis by blast +qed + +lemma euclid_bound: "\p. prime p \ n < p \ p <= Suc (fact n)" +proof- + have f1: "fact n + 1 \ 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 \ fact n + 1" by simp + {assume np: "p \ n" + from p(1) have p1: "p \ 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: "\p. prime p \ p > n" using euclid_bound by auto + +lemma primes_infinite: "\ (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 \ p dvd a \ p dvd b)" +proof + assume "prime p \ p dvd a \ 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 \ (\p. ~(prime p \ p dvd a \ p dvd b))" + (is "?lhs = ?rhs") +proof- + {assume "?lhs" with coprime_prime have ?rhs by blast} + moreover + {assume r: "?rhs" and c: "\ ?lhs" + then obtain g where g: "g\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 \ p dvd n \ coprime p n" +using p prime_imp_relprime[of p n] by (auto simp add: coprime_def) + +lemma prime_coprime_strong: "prime p \ p dvd n \ coprime p n" + using prime_coprime[of p n] by auto + +declare coprime_0[simp] + +lemma coprime_0'[simp]: "coprime 0 d \ d = 1" by (simp add: coprime_commute[of 0 d]) +lemma coprime_bezout_strong: assumes ab: "coprime a b" and b: "b \ 1" + shows "\x y. a * x = b * y + 1" +proof- + from ab b have az: "a \ 0" by - (rule ccontr, 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: "\ p dvd a" + shows "\x y. a*x = p*y + 1" +proof- + from p have p1: "p \ 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 \ 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 \ p dvd a \ 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 \ p dvd x^n \ 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: "\coprime x y" + shows "\p. prime p \ p dvd x \ p dvd y" +proof- + from xy[unfolded coprime_def] obtain g where g: "g \ 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^2 + y^2)" +proof- + {assume c: "\ coprime (x * y) (x^2 + y^2)" + from coprime_prime_dvd_ex[OF c] obtain p + where p: "prime p" "p dvd x*y" "p dvd x^2 + y^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^2 + y^2 = p * s" + by (auto elim!: dvdE) + then have "y^2 = p * (s - r)" + by (auto simp add: power2_eq_square diff_mult_distrib2) + then have "p dvd y^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^2 + y^2 = p * s" + by (auto elim!: dvdE) + then have "x^2 = p * (s - r)" + by (auto simp add: power2_eq_square diff_mult_distrib2) + then have "p dvd x^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 \ prime q \ p \ q \ 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- + {assume c: "\ coprime x p" + then obtain g where g: "g \ 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 + from g(2) x have "g \ 0" by - (rule ccontr, simp) + with g gp p[unfolded prime_def] have False by blast} +thus ?thesis by blast +qed + +lemma even_dvd[simp]: "even (n::nat) \ 2 dvd n" by presburger +lemma prime_odd: "prime p \ p = 2 \ odd p" unfolding prime_def by auto + + +text {* One property of coprimality is easier to prove via prime factors. *} + +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 \ p^n dvd b" +proof- + {assume "n = 0 \ a = 1 \ b = 1" with pab have ?thesis + apply (cases "n=0", simp_all) + apply (cases "a=1", simp_all) done} + moreover + {assume n: "n \ 0" and a: "a\1" and b: "b\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 \ 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 "\ 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 "\ 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 \ n = 1 \ m = 1" (is "?lhs \ ?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[simp]: "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 "\r s. a = r^n \ b = s ^n" + using ab abcn +proof(induct c arbitrary: a b rule: nat_less_induct) + fix c a b + assume H: "\ma b. coprime a b \ a * b = m ^ n \ (\r s. a = r ^ n \ b = s ^ n)" "coprime a b" "a * b = c ^ n" + let ?ths = "\r s. a = r^n \ b = s ^n" + {assume n: "n = 0" + with H(3) power_one have "a*b = 1" by simp + hence "a = 1 \ 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 \ 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 \ 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\1" "c \ 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 \ p^n dvd b" . + from p(2) obtain l where l: "c = p*l" unfolding dvd_def by blast + have pn0: "p^n \ 0" using n prime_ge_2 [OF p(1)] by (simp add: neq0_conv) + {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 \ 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 \ 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 {* More useful lemmas. *} +lemma prime_product: + assumes "prime (p * q)" + shows "p = 1 \ q = 1" +proof - + from assms have + "1 < p * q" and P: "\m. m dvd p * q \ m = 1 \ m = p * q" + unfolding prime_def by auto + from `1 < p * q` have "p \ 0" by (cases p) auto + then have Q: "p = p * q \ q = 1" by auto + have "p dvd p * q" by simp + then have "p = 1 \ p = p * q" by (rule P) + then show ?thesis by (simp add: Q) +qed + +lemma prime_exp: "prime (p^n) \ prime p \ 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 \ 0" "p\1" + {assume pp: "prime (p^Suc n)" + hence "p = 1 \ 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 \ Suc n = 1" by simp} + moreover + {assume n: "prime p \ 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 "\i j. x = p ^i \ 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) + from Suc.prems have pxy: "p dvd x*y" by auto + from prime_divprod[OF p pxy] have pxyc: "p dvd x \ p dvd y" . + from p have p0: "p \ 0" by - (rule ccontr, simp) + {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) have ?case by blast} + moreover + {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) have ?case by blast} + ultimately show ?case using pxyc by blast +qed + +lemma prime_power_exp: assumes p: "prime p" and n:"n \ 0" + and xn: "x^n = p^k" shows "\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 prems have ?case apply simp + by (rule exI[where x="k"],simp)} + moreover + {assume n: "n \ 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 \ (\ i. i \ k \ 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 \ k" by arith + with ij(1) show "\i\k. d = p ^ i" by blast +next + {fix i assume H: "i \ k" "d = p^i" + hence "\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 "\i\k. d = p ^ i \ d dvd p ^ k" by blast +qed + +lemma coprime_divisors: "d dvd a \ e dvd b \ coprime a b \ coprime d e" + by (auto simp add: dvd_def coprime) + +declare power_Suc0[simp del] +declare even_dvd[simp del] + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Quadratic_Reciprocity.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Quadratic_Reciprocity.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,642 @@ +(* Authors: Jeremy Avigad, David Gray, and Adam Kramer +*) + +header {* The law of Quadratic reciprocity *} + +theory Quadratic_Reciprocity +imports Gauss +begin + +text {* + Lemmas leading up to the proof of theorem 3.3 in Niven and + Zuckerman's presentation. +*} + +context GAUSS +begin + +lemma QRLemma1: "a * setsum id A = + p * setsum (%x. ((x * a) div p)) A + setsum id D + setsum id E" +proof - + from finite_A have "a * setsum id A = setsum (%x. a * x) A" + by (auto simp add: setsum_const_mult id_def) + also have "setsum (%x. a * x) = setsum (%x. x * a)" + by (auto simp add: zmult_commute) + also have "setsum (%x. x * a) A = setsum id B" + by (simp add: B_def setsum_reindex_id[OF inj_on_xa_A]) + also have "... = setsum (%x. p * (x div p) + StandardRes p x) B" + by (auto simp add: StandardRes_def zmod_zdiv_equality) + also have "... = setsum (%x. p * (x div p)) B + setsum (StandardRes p) B" + by (rule setsum_addf) + also have "setsum (StandardRes p) B = setsum id C" + by (auto simp add: C_def setsum_reindex_id[OF SR_B_inj]) + also from C_eq have "... = setsum id (D \ E)" + by auto + also from finite_D finite_E have "... = setsum id D + setsum id E" + by (rule setsum_Un_disjoint) (auto simp add: D_def E_def) + also have "setsum (%x. p * (x div p)) B = + setsum ((%x. p * (x div p)) o (%x. (x * a))) A" + by (auto simp add: B_def setsum_reindex inj_on_xa_A) + also have "... = setsum (%x. p * ((x * a) div p)) A" + by (auto simp add: o_def) + also from finite_A have "setsum (%x. p * ((x * a) div p)) A = + p * setsum (%x. ((x * a) div p)) A" + by (auto simp add: setsum_const_mult) + finally show ?thesis by arith +qed + +lemma QRLemma2: "setsum id A = p * int (card E) - setsum id E + + setsum id D" +proof - + from F_Un_D_eq_A have "setsum id A = setsum id (D \ F)" + by (simp add: Un_commute) + also from F_D_disj finite_D finite_F + have "... = setsum id D + setsum id F" + by (auto simp add: Int_commute intro: setsum_Un_disjoint) + also from F_def have "F = (%x. (p - x)) ` E" + by auto + also from finite_E inj_on_pminusx_E have "setsum id ((%x. (p - x)) ` E) = + setsum (%x. (p - x)) E" + by (auto simp add: setsum_reindex) + also from finite_E have "setsum (op - p) E = setsum (%x. p) E - setsum id E" + by (auto simp add: setsum_subtractf id_def) + also from finite_E have "setsum (%x. p) E = p * int(card E)" + by (intro setsum_const) + finally show ?thesis + by arith +qed + +lemma QRLemma3: "(a - 1) * setsum id A = + p * (setsum (%x. ((x * a) div p)) A - int(card E)) + 2 * setsum id E" +proof - + have "(a - 1) * setsum id A = a * setsum id A - setsum id A" + by (auto simp add: zdiff_zmult_distrib) + also note QRLemma1 + also from QRLemma2 have "p * (\x \ A. x * a div p) + setsum id D + + setsum id E - setsum id A = + p * (\x \ A. x * a div p) + setsum id D + + setsum id E - (p * int (card E) - setsum id E + setsum id D)" + by auto + also have "... = p * (\x \ A. x * a div p) - + p * int (card E) + 2 * setsum id E" + by arith + finally show ?thesis + by (auto simp only: zdiff_zmult_distrib2) +qed + +lemma QRLemma4: "a \ zOdd ==> + (setsum (%x. ((x * a) div p)) A \ zEven) = (int(card E): zEven)" +proof - + assume a_odd: "a \ zOdd" + from QRLemma3 have a: "p * (setsum (%x. ((x * a) div p)) A - int(card E)) = + (a - 1) * setsum id A - 2 * setsum id E" + by arith + from a_odd have "a - 1 \ zEven" + by (rule odd_minus_one_even) + hence "(a - 1) * setsum id A \ zEven" + by (rule even_times_either) + moreover have "2 * setsum id E \ zEven" + by (auto simp add: zEven_def) + ultimately have "(a - 1) * setsum id A - 2 * setsum id E \ zEven" + by (rule even_minus_even) + with a have "p * (setsum (%x. ((x * a) div p)) A - int(card E)): zEven" + by simp + hence "p \ zEven | (setsum (%x. ((x * a) div p)) A - int(card E)): zEven" + by (rule EvenOdd.even_product) + with p_odd have "(setsum (%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 \ zOdd ==> + (-1::int)^(card E) = (-1::int)^(nat(setsum (%x. ((x * a) div p)) A))" +proof - + assume "a \ zOdd" + from QRLemma4 [OF this] have + "(int(card E): zEven) = (setsum (%x. ((x * a) div p)) A \ zEven)" .. + moreover have "0 \ int(card E)" + by auto + moreover have "0 \ setsum (%x. ((x * a) div p)) A" + proof (intro setsum_nonneg) + show "\x \ A. 0 \ x * a div p" + proof + fix x + assume "x \ A" + then have "0 \ x" + by (auto simp add: A_def) + with a_nonzero have "0 \ x * a" + by (auto simp add: zero_le_mult_iff) + with p_g_2 show "0 \ 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(((\x \ 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 \ zOdd; 0 < a; ~([a = 0] (mod p)); zprime p; 2 < p; + A = {x. 0 < x & x \ (p - 1) div 2} |] ==> + (Legendre a p) = (-1::int)^(nat(setsum (%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 {* Stuff about S, S1 and S2 *} + +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 \ q" +begin + +definition + P_set :: "int set" where + "P_set = {x. 0 < x & x \ ((p - 1) div 2) }" + +definition + Q_set :: "int set" where + "Q_set = {x. 0 < x & x \ ((q - 1) div 2) }" + +definition + S :: "(int * int) set" where + "S = P_set <*> 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 \ (q * j) div p) }" + +definition + f2 :: "int => (int * int) set" where + "f2 j = { (x, j1). (x, j1):S & j1 = j & (x \ (p * j) div q) }" + +lemma p_fact: "0 < (p - 1) div 2" +proof - + from p_g_2 have "2 \ p - 1" by arith + then have "2 div 2 \ (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 \ q - 1" by arith + then have "2 div 2 \ (q - 1) div 2" by (rule zdiv_mono1, auto) + then show ?thesis by auto +qed + +lemma pb_neq_qa: "[|1 \ b; b \ (q - 1) div 2 |] ==> + (p * b \ q * a)" +proof + assume "p * b = q * a" and "1 \ b" and "b \ (q - 1) div 2" + 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 \ q", simp add: QRTEMP_def) + apply (insert prems) + 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 \ b" + proof - + assume "q dvd b" + moreover from prems have "0 < b" by auto + ultimately show ?thesis using zdvd_bounds [of q b] by auto + qed + with prems have "q \ (q - 1) div 2" by auto + then have "2 * q \ 2 * ((q - 1) div 2)" by arith + then have "2 * q \ q - 1" + proof - + assume "2 * q \ 2 * ((q - 1) div 2)" + with prems have "q \ 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 prems show ?thesis by auto + qed + then have p1: "q \ -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 \ 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 \ 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 (auto simp add: S_def zmult_int setsum_constant) + +lemma S1_Int_S2_prop: "S1 \ S2 = {}" + by (auto simp add: S1_def S2_def) + +lemma S1_Union_S2_prop: "S = S1 \ 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 \ (q - 1) div 2" + with zless_linear have "(p * b < q * a) | (p * b = q * a)" by auto + moreover from pb_neq_qa b1 b2 have "(p * b \ 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: "[| 0 < a; a \ (p - 1) div 2; + 0 < b; b \ (q - 1) div 2 |] ==> + (p * b < q * a) = (b \ q * a div p)" +proof - + assume "0 < a" and "a \ (p - 1) div 2" and "0 < b" and "b \ (q - 1) div 2" + have "p * b < q * a ==> b \ q * a div p" + proof - + assume "p * b < q * a" + then have "p * b \ q * a" by auto + then have "(p * b) div p \ (q * a) div p" + by (rule zdiv_mono1) (insert p_g_2, auto) + then show "b \ (q * a) div p" + apply (subgoal_tac "p \ 0") + apply (frule div_mult_self1_is_id, force) + apply (insert p_g_2, auto) + done + qed + moreover have "b \ q * a div p ==> p * b < q * a" + proof - + assume "b \ q * a div p" + then have "p * b \ p * ((q * a) div p)" + using p_g_2 by (auto simp add: mult_le_cancel_left) + also have "... \ q * a" + by (rule zdiv_leq_prop) (insert p_g_2, auto) + finally have "p * b \ 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 \ q * a" + by (rule pb_neq_qa) (insert prems, auto) + ultimately show ?thesis by auto + qed + ultimately show ?thesis .. +qed + +lemma aux1b: "[| 0 < a; a \ (p - 1) div 2; + 0 < b; b \ (q - 1) div 2 |] ==> + (q * a < p * b) = (a \ p * b div q)" +proof - + assume "0 < a" and "a \ (p - 1) div 2" and "0 < b" and "b \ (q - 1) div 2" + have "q * a < p * b ==> a \ p * b div q" + proof - + assume "q * a < p * b" + then have "q * a \ p * b" by auto + then have "(q * a) div q \ (p * b) div q" + by (rule zdiv_mono1) (insert q_g_2, auto) + then show "a \ (p * b) div q" + apply (subgoal_tac "q \ 0") + apply (frule div_mult_self1_is_id, force) + apply (insert q_g_2, auto) + done + qed + moreover have "a \ p * b div q ==> q * a < p * b" + proof - + assume "a \ p * b div q" + then have "q * a \ q * ((p * b) div q)" + using q_g_2 by (auto simp add: mult_le_cancel_left) + also have "... \ p * b" + by (rule zdiv_leq_prop) (insert q_g_2, auto) + finally have "q * a \ 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 \ q * a" + by (rule pb_neq_qa) (insert prems, auto) + ultimately show ?thesis by auto + qed + ultimately show ?thesis .. +qed + +lemma (in -) aux2: "[| zprime p; zprime q; 2 < p; 2 < q |] ==> + (q * ((p - 1) div 2)) div p \ (q - 1) div 2" +proof- + assume "zprime p" and "zprime q" and "2 < p" and "2 < q" + (* Set up what's even and odd *) + then have "p \ zOdd & q \ 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 prems 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: zmult_ac) + 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 prems by auto +qed + +lemma aux3a: "\j \ P_set. int (card (f1 j)) = (q * j) div p" +proof + fix j + assume j_fact: "j \ P_set" + have "int (card (f1 j)) = int (card {y. y \ Q_set & y \ (q * j) div p})" + proof - + have "finite (f1 j)" + proof - + have "(f1 j) \ 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 \ Q_set & y \ (q * j) div p}" + using prems 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 \ (q * j) div p})" + proof - + have "{y. y \ Q_set & y \ (q * j) div p} = + {y. 0 < y & y \ (q * j) div p}" + apply (auto simp add: Q_set_def) + proof - + fix x + assume "0 < x" and "x \ q * j div p" + with j_fact P_set_def have "j \ (p - 1) div 2" by auto + with q_g_2 have "q * j \ q * ((p - 1) div 2)" + by (auto simp add: mult_le_cancel_left) + with p_g_2 have "q * j div p \ q * ((p - 1) div 2) div p" + by (auto simp add: zdiv_mono1) + also from prems P_set_def have "... \ (q - 1) div 2" + apply simp + apply (insert aux2) + apply (simp add: QRTEMP_def) + done + finally show "x \ (q - 1) div 2" using prems by auto + qed + then show ?thesis by auto + qed + also have "... = (q * j) div p" + proof - + from j_fact P_set_def have "0 \ j" by auto + with q_g_2 have "q * 0 \ q * j" by (auto simp only: mult_left_mono) + then have "0 \ q * j" by auto + then have "0 div p \ (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: "\j \ Q_set. int (card (f2 j)) = (p * j) div q" +proof + fix j + assume j_fact: "j \ Q_set" + have "int (card (f2 j)) = int (card {y. y \ P_set & y \ (p * j) div q})" + proof - + have "finite (f2 j)" + proof - + have "(f2 j) \ 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 \ P_set & y \ (p * j) div q}" + using prems 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 \ (p * j) div q})" + proof - + have "{y. y \ P_set & y \ (p * j) div q} = + {y. 0 < y & y \ (p * j) div q}" + apply (auto simp add: P_set_def) + proof - + fix x + assume "0 < x" and "x \ p * j div q" + with j_fact Q_set_def have "j \ (q - 1) div 2" by auto + with p_g_2 have "p * j \ p * ((q - 1) div 2)" + by (auto simp add: mult_le_cancel_left) + with q_g_2 have "p * j div q \ p * ((q - 1) div 2) div q" + by (auto simp add: zdiv_mono1) + also from prems have "... \ (p - 1) div 2" + by (auto simp add: aux2 QRTEMP_def) + finally show "x \ (p - 1) div 2" using prems by auto + qed + then show ?thesis by auto + qed + also have "... = (p * j) div q" + proof - + from j_fact Q_set_def have "0 \ j" by auto + with p_g_2 have "p * 0 \ p * j" by (auto simp only: mult_left_mono) + then have "0 \ p * j" by auto + then have "0 div q \ (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)) = setsum (%j. (q * j) div p) P_set" +proof - + have "\x \ P_set. finite (f1 x)" + proof + fix x + have "f1 x \ S" by (auto simp add: f1_def) + with S_finite show "finite (f1 x)" by (auto simp add: finite_subset) + qed + moreover have "(\x \ P_set. \y \ P_set. x \ y --> (f1 x) \ (f1 y) = {})" + by (auto simp add: f1_def) + moreover note P_set_finite + ultimately have "int(card (UNION P_set f1)) = + setsum (%x. int(card (f1 x))) P_set" + by(simp add:card_UN_disjoint int_setsum 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)) = setsum (%j. int(card (f1 j))) P_set" + by auto + also have "... = setsum (%j. q * j div p) P_set" + using aux3a by(fastsimp intro: setsum_cong) + finally show ?thesis . +qed + +lemma S2_card: "int (card(S2)) = setsum (%j. (p * j) div q) Q_set" +proof - + have "\x \ Q_set. finite (f2 x)" + proof + fix x + have "f2 x \ S" by (auto simp add: f2_def) + with S_finite show "finite (f2 x)" by (auto simp add: finite_subset) + qed + moreover have "(\x \ Q_set. \y \ Q_set. x \ y --> + (f2 x) \ (f2 y) = {})" + by (auto simp add: f2_def) + moreover note Q_set_finite + ultimately have "int(card (UNION Q_set f2)) = + setsum (%x. int(card (f2 x))) Q_set" + by(simp add:card_UN_disjoint int_setsum 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)) = setsum (%j. int(card (f2 j))) Q_set" + by auto + also have "... = setsum (%j. p * j div q) Q_set" + using aux3b by(fastsimp intro: setsum_cong) + finally show ?thesis . +qed + +lemma S1_carda: "int (card(S1)) = + setsum (%j. (j * q) div p) P_set" + by (auto simp add: S1_card zmult_ac) + +lemma S2_carda: "int (card(S2)) = + setsum (%j. (j * p) div q) Q_set" + by (auto simp add: S2_card zmult_ac) + +lemma pq_sum_prop: "(setsum (%j. (j * p) div q) Q_set) + + (setsum (%j. (j * q) div p) P_set) = ((p - 1) div 2) * ((q - 1) div 2)" +proof - + have "(setsum (%j. (j * p) div q) Q_set) + + (setsum (%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 \ 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 prems have "~([p = 0] (mod q))" + by (auto simp add: pq_prime_neq QRTEMP_def) + with prems Q_set_def have a1: "(Legendre p q) = (-1::int) ^ + nat(setsum (%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 prems have "~([q = 0] (mod p))" + apply (rule_tac p = q and q = p in pq_prime_neq) + apply (simp add: QRTEMP_def)+ + done + with prems P_set_def have a2: "(Legendre q p) = + (-1::int) ^ nat(setsum (%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(setsum (%x. ((x * p) div q)) Q_set) * + (-1::int) ^ nat(setsum (%x. ((x * q) div p)) P_set)" + by auto + also have "... = (-1::int) ^ (nat(setsum (%x. ((x * p) div q)) Q_set) + + nat(setsum (%x. ((x * q) div p)) P_set))" + by (auto simp add: zpower_zadd_distrib) + also have "nat(setsum (%x. ((x * p) div q)) Q_set) + + nat(setsum (%x. ((x * q) div p)) P_set) = + nat((setsum (%x. ((x * p) div q)) Q_set) + + (setsum (%x. ((x * q) div p)) P_set))" + apply (rule_tac z = "setsum (%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 \ zOdd; zprime p; q \ zOdd; zprime q; + p \ 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/ROOT.ML --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/ROOT.ML Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,4 @@ + +no_document use_thys ["Infinite_Set", "Permutation"]; +use_thys ["Fib", "Factorization", "Chinese", "WilsonRuss", + "WilsonBij", "Quadratic_Reciprocity", "Primes", "Pocklington"]; diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/Residues.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/Residues.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,172 @@ +(* Title: HOL/Quadratic_Reciprocity/Residues.thy + ID: $Id$ + Authors: Jeremy Avigad, David Gray, and Adam Kramer +*) + +header {* Residue Sets *} + +theory Residues imports Int2 begin + +text {* + \medskip Define the residue of a set, the standard residue, + quadratic residues, and prove some basic properties. *} + +definition + ResSet :: "int => int set => bool" where + "ResSet m X = (\y1 y2. (y1 \ X & y2 \ 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 = (\y. ([(y ^ 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 \ x) & (x < p)}" + +definition + SRStar :: "int => int set" where + "SRStar p = {x. (0 < x) & (x < p)}" + + +subsection {* Some useful properties of StandardRes *} + +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 \ StandardRes p x" + by (auto simp add: StandardRes_def pos_mod_sign) + +lemma StandardRes_ubound: "0 < p ==> StandardRes p x < p" + by (auto simp add: StandardRes_def pos_mod_bound) + +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 {* Relations between StandardRes, SRStar, and SR *} + +lemma SRStar_SR_prop: "x \ SRStar p ==> x \ SR p" + by (auto simp add: SRStar_def SR_def) + +lemma StandardRes_SR_prop: "x \ 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 \ SRStar p) + = (~[x = 0] (mod p))" + apply (auto simp add: StandardRes_prop3 StandardRes_def + SRStar_def pos_mod_bound) + apply (subgoal_tac "0 < p") + apply (drule_tac a = x in pos_mod_sign, arith, simp) + done + +lemma StandardRes_SRStar_prop1a: "x \ 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 \ SRStar p |] + ==> StandardRes p (MultInv p x) \ 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 \ 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 \ SRStar p |] + ==> StandardRes p x \ SRStar p" + by (frule StandardRes_SRStar_prop3, auto) + +lemma SRStar_mult_prop1: "[| zprime p; 2 < p; x \ SRStar p; y \ 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 \ SRStar p |] + ==> StandardRes p (a * MultInv p x) \ 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 {* Properties relating ResSets with StandardRes *} + +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 |] + ==> [setsum f X = setsum (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) \ {x. 0 \ 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) \ 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 |] + ==> [setprod f X = setprod (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; \x \ A. \y \ A. ([f x = f y](mod m) --> x = y) |] ==> + ResSet m (f ` A)" + by (auto simp add: ResSet_def) + + +subsection {* Property for SRStar *} + +lemma ResSet_SRStar_prop: "ResSet p (SRStar p)" + by (auto simp add: SRStar_def ResSet_def zcong_zless_imp_eq) + +end diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/WilsonBij.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/WilsonBij.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,261 @@ +(* Author: Thomas M. Rasmussen + Copyright 2000 University of Cambridge +*) + +header {* Wilson's Theorem using a more abstract approach *} + +theory WilsonBij imports BijectionRel IntFact begin + +text {* + Wilson's Theorem using a more ``abstract'' approach based on + bijections between sets. Does not use Fermat's Little Theorem + (unlike Russinoff). +*} + + +subsection {* Definitions and lemmas *} + +definition + reciR :: "int => int => int => bool" where + "reciR p = (\a b. zcong (a * b) 1 p \ 1 < a \ a < p - 1 \ 1 < b \ b < p - 1)" + +definition + inv :: "int => int => int" where + "inv p a = + (if zprime p \ 0 < a \ a < p then + (SOME x. 0 \ x \ x < p \ zcong (a * x) 1 p) + else 0)" + + +text {* \medskip Inverse *} + +lemma inv_correct: + "zprime p ==> 0 < a ==> a < p + ==> 0 \ inv p a \ inv p a < p \ [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, standard] +lemmas inv_less = inv_correct [THEN conjunct2, THEN conjunct1, standard] +lemmas inv_is_inv = inv_correct [THEN conjunct2, THEN conjunct2, standard] + +lemma inv_not_0: + "zprime p ==> 1 < a ==> a < p - 1 ==> inv p a \ 0" + -- {* same as @{text WilsonRuss} *} + apply safe + apply (cut_tac a = a and p = p in inv_is_inv) + apply (unfold zcong_def) + apply auto + apply (subgoal_tac "\ p dvd 1") + apply (rule_tac [2] zdvd_not_zless) + apply (subgoal_tac "p dvd 1") + prefer 2 + apply (subst dvd_minus_iff [symmetric]) + apply auto + done + +lemma inv_not_1: + "zprime p ==> 1 < a ==> a < p - 1 ==> inv p a \ 1" + -- {* same as @{text WilsonRuss} *} + 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)" + -- {* same as @{text WilsonRuss} *} + apply (unfold zcong_def) + apply (simp add: OrderedGroup.diff_diff_eq diff_diff_eq2 zdiff_zmult_distrib2) + apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans) + apply (simp add: mult_commute) + 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 \ p - 1" + -- {* same as @{text WilsonRuss} *} + 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 {* + Below is slightly different as we don't expand @{term [source] inv} + but use ``@{text correct}'' theorems. +*} + +lemma inv_g_1: "zprime p ==> 1 < a ==> a < p - 1 ==> 1 < inv p a" + apply (subgoal_tac "inv p a \ 1") + apply (subgoal_tac "inv p a \ 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" + -- {* ditto *} + apply (subst order_less_le) + apply (simp add: inv_not_p_minus_1 inv_less) + done + + +text {* \medskip Bijection *} + +lemma aux1: "1 < x ==> 0 \ (x::int)" + apply auto + done + +lemma aux2: "1 < x ==> 0 < (x::int)" + apply auto + done + +lemma aux3: "x \ p - 2 ==> x < (p::int)" + apply auto + done + +lemma aux4: "x \ 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 {* stac (thm "zcong_cancel" RS sym) 5 *}) + apply (rule_tac [7] zcong_trans) + apply (tactic {* stac (thm "zcong_sym") 8 *}) + apply (erule_tac [7] inv_is_inv) + apply (tactic "asm_simp_tac @{simpset} 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)) \ 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 {* stac (thm "zcong_cancel2" RS sym) 5 *}) + apply (rule_tac [7] zcong_trans) + apply (tactic {* stac (thm "zcong_sym") 8 *}) + apply (rule_tac [6] zless_zprime_imp_zrelprime) + apply auto + apply (rule zcong_zless_imp_eq) + apply (tactic {* stac (thm "zcong_cancel" RS sym) 5 *}) + apply (rule_tac [7] zcong_trans) + apply (tactic {* stac (thm "zcong_sym") 8 *}) + 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: zmult_commute) + apply auto + done + +lemma bijER_d22set: "zprime p ==> d22set (p - 2) \ 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 {* Wilson *} + +lemma bijER_zcong_prod_1: + "zprime p ==> A \ bijER (reciR p) ==> [\A = 1] (mod p)" + apply (unfold reciR_def) + apply (erule bijER.induct) + apply (subgoal_tac [2] "a = 1 \ a = p - 1") + apply (rule_tac [3] zcong_square_zless) + apply auto + apply (subst setprod_insert) + prefer 3 + apply (subst setprod_insert) + apply (auto simp add: fin_bijER) + apply (subgoal_tac "zcong ((a * b) * \A) (1 * 1) p") + apply (simp add: zmult_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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/WilsonRuss.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/WilsonRuss.thy Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,327 @@ +(* Author: Thomas M. Rasmussen + Copyright 2000 University of Cambridge +*) + +header {* Wilson's Theorem according to Russinoff *} + +theory WilsonRuss imports EulerFermat begin + +text {* + Wilson's Theorem following quite closely Russinoff's approach + using Boyer-Moore (using finite sets instead of lists, though). +*} + +subsection {* Definitions and lemmas *} + +definition + inv :: "int => int => int" where + "inv p a = (a^(nat (p - 2))) mod p" + +consts + wset :: "int * int => int set" + +recdef wset + "measure ((\(a, p). nat a) :: int * int => nat)" + "wset (a, p) = + (if 1 < a then + let ws = wset (a - 1, p) + in (if a \ ws then ws else insert a (insert (inv p a) ws)) else {})" + + +text {* \medskip @{term [source] inv} *} + +lemma inv_is_inv_aux: "1 < m ==> Suc (nat (m - 2)) = nat (m - 1)" +by (subst int_int_eq [symmetric], auto) + +lemma inv_is_inv: + "zprime p \ 0 < a \ a < p ==> [a * inv p a = 1] (mod p)" + apply (unfold inv_def) + apply (subst zcong_zmod) + apply (subst zmod_zmult1_eq [symmetric]) + apply (subst zcong_zmod [symmetric]) + apply (subst power_Suc [symmetric]) + apply (subst inv_is_inv_aux) + apply (erule_tac [2] Little_Fermat) + apply (erule_tac [2] zdvd_not_zless) + apply (unfold zprime_def, auto) + done + +lemma inv_distinct: + "zprime p \ 1 < a \ a < p - 1 ==> a \ 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 \ 1 < a \ a < p - 1 ==> inv p a \ 0" + apply safe + apply (cut_tac a = a and p = p in inv_is_inv) + apply (unfold zcong_def, auto) + apply (subgoal_tac "\ p dvd 1") + apply (rule_tac [2] zdvd_not_zless) + apply (subgoal_tac "p dvd 1") + prefer 2 + apply (subst dvd_minus_iff [symmetric], auto) + done + +lemma inv_not_1: + "zprime p \ 1 < a \ a < p - 1 ==> inv p a \ 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: OrderedGroup.diff_diff_eq diff_diff_eq2 zdiff_zmult_distrib2) + apply (rule_tac s = "p dvd -((a + 1) + (p * -a))" in trans) + apply (simp add: mult_commute) + 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 \ 1 < a \ a < p - 1 ==> inv p a \ 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 \ 1 < a \ a < p - 1 ==> 1 < inv p a" + apply (case_tac "0\ inv p a") + apply (subgoal_tac "inv p a \ 1") + apply (subgoal_tac "inv p a \ 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 \ 1 < a \ 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 \ p ==> + nat (p - 2) * nat (p - 2) = Suc (nat (p - 1) * nat (p - 3))" + apply (subst int_int_eq [symmetric]) + apply (simp add: zmult_int [symmetric]) + apply (simp add: zdiff_zmult_distrib zdiff_zmult_distrib2) + done + +lemma zcong_zpower_zmult: + "[x^y = 1] (mod p) \ [x^(y * z) = 1] (mod p)" + apply (induct z) + apply (auto simp add: zpower_zadd_distrib) + 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 \ + 5 \ p \ 0 < a \ a < p ==> inv p (inv p a) = a" + apply (unfold inv_def) + apply (subst zpower_zmod) + apply (subst zpower_zpower) + 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 {* \medskip @{term wset} *} + +declare wset.simps [simp del] + +lemma wset_induct: + assumes "!!a p. P {} a p" + and "!!a p. 1 < (a::int) \ + 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, safe) + prefer 2 + apply (case_tac "1 < a") + apply (rule prems) + apply simp_all + apply (simp_all add: wset.simps prems) + done + +lemma wset_mem_imp_or [rule_format]: + "1 < a \ b \ wset (a - 1, p) + ==> b \ wset (a, p) --> b = a \ b = inv p a" + apply (subst wset.simps) + apply (unfold Let_def, simp) + done + +lemma wset_mem_mem [simp]: "1 < a ==> a \ wset (a, p)" + apply (subst wset.simps) + apply (unfold Let_def, simp) + done + +lemma wset_subset: "1 < a \ b \ wset (a - 1, p) ==> b \ 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 \ 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 \ 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 \ 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 \ 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 \ a --> b \ 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 \ p --> a < p - 1 --> b \ wset (a, p) + --> inv p b \ 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 \ b = inv p a") + apply (rule_tac [7] wset_mem_imp_or, auto) + done + +lemma wset_inv_mem_mem: + "zprime p \ 5 \ p \ a < p - 1 \ 1 < b \ b < p - 1 + \ inv p b \ wset (a, p) \ b \ 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 \ p --> a < p - 1 --> [(\x\wset(a, p). x) = 1] (mod p)" + apply (induct a p rule: wset_induct) + prefer 2 + apply (subst wset.simps) + apply (unfold Let_def, auto) + apply (subst setprod_insert) + apply (tactic {* stac (thm "setprod_insert") 3 *}) + apply (subgoal_tac [5] + "zcong (a * inv p a * (\x\ wset(a - 1, p). x)) (1 * 1) p") + prefer 5 + apply (simp add: zmult_assoc) + apply (rule_tac [5] zcong_zmult) + apply (rule_tac [5] inv_is_inv) + apply (tactic "clarify_tac @{claset} 4") + apply (subgoal_tac [4] "a \ 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 {* Wilson *} + +lemma prime_g_5: "zprime p \ p \ 2 \ p \ 3 ==> 5 \ 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 \ 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 diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Old_Number_Theory/document/root.tex --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Old_Number_Theory/document/root.tex Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,57 @@ + +\documentclass[11pt,a4paper]{article} +\usepackage{graphicx} +\usepackage{isabelle,isabellesym,pdfsetup} +\usepackage[latin1]{inputenc} + +\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} + +\end{document} diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/Tools/transfer_data.ML --- a/src/HOL/Tools/transfer_data.ML Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/Tools/transfer_data.ML Tue Sep 01 21:44:19 2009 +0200 @@ -223,7 +223,8 @@ transf_add >> (fn (((((g, inj), embed), ret), cg), hints) => add (inj, embed, ret, cg, g, hints))) -val transferred_att_syntax = (optional names -- Scan.option (keywordC directionN |-- (Args.term -- Args.term)) -- optional (keywordC leavingN |-- names) >> (fn ((hints, aD),leave) => transferred_attribute hints aD leave)); +val transferred_att_syntax = (optional names -- Scan.option (keywordC directionN |-- (Args.term -- Args.term)) + -- optional (keywordC leavingN |-- names) >> (fn ((hints, aD),leave) => transferred_attribute hints aD leave)); end; diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/ex/Codegenerator_Candidates.thy --- a/src/HOL/ex/Codegenerator_Candidates.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/ex/Codegenerator_Candidates.thy Tue Sep 01 21:44:19 2009 +0200 @@ -16,7 +16,7 @@ Nested_Environment Option_ord Permutation - Primes + "~~/src/HOL/Number_Theory/Primes" Product_ord SetsAndFunctions Tree diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/ex/ROOT.ML --- a/src/HOL/ex/ROOT.ML Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/ex/ROOT.ML Tue Sep 01 21:44:19 2009 +0200 @@ -12,7 +12,6 @@ "Codegenerator_Test", "Codegenerator_Pretty_Test", "NormalForm", - "../NumberTheory/Factorization", "Predicate_Compile", "Predicate_Compile_ex" ]; diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/ex/Sqrt.thy --- a/src/HOL/ex/Sqrt.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/ex/Sqrt.thy Tue Sep 01 21:44:19 2009 +0200 @@ -5,7 +5,7 @@ header {* Square roots of primes are irrational *} theory Sqrt -imports Complex_Main +imports Complex_Main "~~/src/HOL/Number_Theory/Primes" begin text {* diff -r d2c97fc18704 -r a4a1547a6f1e src/HOL/ex/Sqrt_Script.thy --- a/src/HOL/ex/Sqrt_Script.thy Tue Sep 01 19:48:11 2009 +0200 +++ b/src/HOL/ex/Sqrt_Script.thy Tue Sep 01 21:44:19 2009 +0200 @@ -6,7 +6,7 @@ header {* Square roots of primes are irrational (script version) *} theory Sqrt_Script -imports Complex_Main Primes +imports Complex_Main "~~/src/HOL/Number_Theory/Primes" begin text {* @@ -16,30 +16,30 @@ subsection {* Preliminaries *} -lemma prime_nonzero: "prime p \ p \ 0" - by (force simp add: prime_def) +lemma prime_nonzero: "prime (p::nat) \ p \ 0" + by (force simp add: prime_nat_def) lemma prime_dvd_other_side: - "n * n = p * (k * k) \ prime p \ p dvd n" - apply (subgoal_tac "p dvd n * n", blast dest: prime_dvd_mult) + "(n::nat) * n = p * (k * k) \ prime p \ p dvd n" + apply (subgoal_tac "p dvd n * n", blast dest: prime_dvd_mult_nat) apply auto done -lemma reduction: "prime p \ +lemma reduction: "prime (p::nat) \ 0 < k \ k * k = p * (j * j) \ k < p * j \ 0 < j" apply (rule ccontr) apply (simp add: linorder_not_less) apply (erule disjE) apply (frule mult_le_mono, assumption) apply auto - apply (force simp add: prime_def) + apply (force simp add: prime_nat_def) done lemma rearrange: "(j::nat) * (p * j) = k * k \ k * k = p * (j * j)" by (simp add: mult_ac) lemma prime_not_square: - "prime p \ (\k. 0 < k \ m * m \ p * (k * k))" + "prime (p::nat) \ (\k. 0 < k \ m * m \ p * (k * k))" apply (induct m rule: nat_less_induct) apply clarify apply (frule prime_dvd_other_side, assumption) @@ -57,7 +57,7 @@ *} theorem prime_sqrt_irrational: - "prime p \ x * x = real p \ 0 \ x \ x \ \" + "prime (p::nat) \ x * x = real p \ 0 \ x \ x \ \" apply (rule notI) apply (erule Rats_abs_nat_div_natE) apply (simp del: real_of_nat_mult @@ -65,6 +65,6 @@ done lemmas two_sqrt_irrational = - prime_sqrt_irrational [OF two_is_prime] + prime_sqrt_irrational [OF two_is_prime_nat] end diff -r d2c97fc18704 -r a4a1547a6f1e src/Pure/General/alist.ML --- a/src/Pure/General/alist.ML Tue Sep 01 19:48:11 2009 +0200 +++ b/src/Pure/General/alist.ML Tue Sep 01 21:44:19 2009 +0200 @@ -122,6 +122,6 @@ in coal end; fun group eq xs = - fold_rev (fn (k, v) => default eq (k, []) #> map_entry eq k (cons v)) xs []; + fold_rev (fn (k, v) => map_default eq (k, []) (cons v)) xs []; end; diff -r d2c97fc18704 -r a4a1547a6f1e src/Tools/Code/etc/settings --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/Tools/Code/etc/settings Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,2 @@ + +ISABELLE_TOOLS="$ISABELLE_TOOLS:$COMPONENT/lib/Tools" diff -r d2c97fc18704 -r a4a1547a6f1e src/Tools/Code/lib/Tools/codegen --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/Tools/Code/lib/Tools/codegen Tue Sep 01 21:44:19 2009 +0200 @@ -0,0 +1,65 @@ +#!/usr/bin/env bash +# +# Author: Florian Haftmann, TUM +# +# DESCRIPTION: issue code generation from shell + + +PRG="$(basename "$0")" + +function usage() +{ + echo + echo "Usage: isabelle $PRG [OPTIONS] IMAGE THY CMD" + echo + echo " Options are:" + echo " -q run in quick'n'dirty mode" + echo + echo " Issues code generation using image IMAGE," + echo " theory THY," + echo " with Isar command 'export_code CMD'" + echo + exit 1 +} + +## process command line + +QUICK_AND_DIRTY=0 + +while getopts "q" OPT +do + case "$OPT" in + q) + QUICK_AND_DIRTY=1 + ;; + \?) + usage + ;; + esac +done + +shift $(($OPTIND - 1)) + +[ "$#" -ne 3 ] && usage + +IMAGE="$1"; shift +THY="$1"; shift +CMD="$1" + + +## main + +CODE_CMD=$(echo $CMD | perl -pe 's/\\/\\\\/g; s/"/\\\"/g') + +if [ "$QUICK_AND_DIRTY" -eq 1 ] +then + QND_CMD="set" +else + QND_CMD="reset" +fi + +CTXT_CMD="ML_Context.eval_in (SOME (ProofContext.init (theory \"HOL\"))) false Position.none \"Code_Target.shell_command thyname cmd\";" + +FULL_CMD="$QND_CMD quick_and_dirty; val thyname = \"$THY\"; val cmd = \"$CODE_CMD\"; $CTXT_CMD" + +"$ISABELLE" -q -e "$FULL_CMD" "$IMAGE" || exit 1