From accc9fa1f5689d1bf57d3024c4ad293fd10f3617 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Wed, 22 Jun 2016 11:47:16 -0700 Subject: Make Coq 8.5 the default target for Fiat-Crypto Instructions for 8.4 build in the README --- .travis.yml | 8 +- Makefile | 4 +- README.md | 7 +- coqprime-8.4/Coqprime/Cyclic.v | 244 +++++++++ coqprime-8.4/Coqprime/EGroup.v | 605 ++++++++++++++++++++ coqprime-8.4/Coqprime/Euler.v | 88 +++ coqprime-8.4/Coqprime/FGroup.v | 123 +++++ coqprime-8.4/Coqprime/IGroup.v | 253 +++++++++ coqprime-8.4/Coqprime/Iterator.v | 180 ++++++ coqprime-8.4/Coqprime/Lagrange.v | 179 ++++++ coqprime-8.4/Coqprime/ListAux.v | 271 +++++++++ coqprime-8.4/Coqprime/LucasLehmer.v | 597 ++++++++++++++++++++ coqprime-8.4/Coqprime/Makefile.bak | 203 +++++++ coqprime-8.4/Coqprime/NatAux.v | 72 +++ coqprime-8.4/Coqprime/Note.pdf | Bin 0 -> 134038 bytes coqprime-8.4/Coqprime/PGroup.v | 347 ++++++++++++ coqprime-8.4/Coqprime/Permutation.v | 506 +++++++++++++++++ coqprime-8.4/Coqprime/Pmod.v | 617 +++++++++++++++++++++ coqprime-8.4/Coqprime/Pocklington.v | 261 +++++++++ coqprime-8.4/Coqprime/PocklingtonCertificat.v | 759 ++++++++++++++++++++++++++ coqprime-8.4/Coqprime/Root.v | 239 ++++++++ coqprime-8.4/Coqprime/Tactic.v | 84 +++ coqprime-8.4/Coqprime/UList.v | 284 ++++++++++ coqprime-8.4/Coqprime/ZCAux.v | 295 ++++++++++ coqprime-8.4/Coqprime/ZCmisc.v | 186 +++++++ coqprime-8.4/Coqprime/ZProgression.v | 104 ++++ coqprime-8.4/Coqprime/ZSum.v | 335 ++++++++++++ coqprime-8.4/Coqprime/Zp.v | 411 ++++++++++++++ coqprime-8.4/Makefile | 253 +++++++++ coqprime-8.4/README.md | 9 + coqprime-8.4/_CoqProject | 24 + coqprime-8.5/Coqprime/Cyclic.v | 244 --------- coqprime-8.5/Coqprime/EGroup.v | 605 -------------------- coqprime-8.5/Coqprime/Euler.v | 88 --- coqprime-8.5/Coqprime/FGroup.v | 123 ----- coqprime-8.5/Coqprime/IGroup.v | 253 --------- coqprime-8.5/Coqprime/Iterator.v | 180 ------ coqprime-8.5/Coqprime/Lagrange.v | 179 ------ coqprime-8.5/Coqprime/ListAux.v | 271 --------- coqprime-8.5/Coqprime/LucasLehmer.v | 597 -------------------- coqprime-8.5/Coqprime/NatAux.v | 72 --- coqprime-8.5/Coqprime/PGroup.v | 347 ------------ coqprime-8.5/Coqprime/Permutation.v | 506 ----------------- coqprime-8.5/Coqprime/Pmod.v | 617 --------------------- coqprime-8.5/Coqprime/Pocklington.v | 261 --------- coqprime-8.5/Coqprime/PocklingtonCertificat.v | 756 ------------------------- coqprime-8.5/Coqprime/Root.v | 239 -------- coqprime-8.5/Coqprime/Tactic.v | 84 --- coqprime-8.5/Coqprime/UList.v | 286 ---------- coqprime-8.5/Coqprime/ZCAux.v | 295 ---------- coqprime-8.5/Coqprime/ZCmisc.v | 186 ------- coqprime-8.5/Coqprime/ZProgression.v | 104 ---- coqprime-8.5/Coqprime/ZSum.v | 335 ------------ coqprime-8.5/Coqprime/Zp.v | 411 -------------- coqprime-8.5/Makefile | 319 ----------- coqprime-8.5/README.md | 9 - coqprime-8.5/_CoqProject | 24 - coqprime/Coqprime/Cyclic.v | 14 +- coqprime/Coqprime/EGroup.v | 36 +- coqprime/Coqprime/Euler.v | 8 +- coqprime/Coqprime/FGroup.v | 8 +- coqprime/Coqprime/IGroup.v | 12 +- coqprime/Coqprime/Iterator.v | 6 +- coqprime/Coqprime/Lagrange.v | 12 +- coqprime/Coqprime/ListAux.v | 10 +- coqprime/Coqprime/LucasLehmer.v | 36 +- coqprime/Coqprime/Makefile.bak | 203 ------- coqprime/Coqprime/NatAux.v | 2 +- coqprime/Coqprime/Note.pdf | Bin 134038 -> 0 bytes coqprime/Coqprime/PGroup.v | 18 +- coqprime/Coqprime/Permutation.v | 4 +- coqprime/Coqprime/Pmod.v | 10 +- coqprime/Coqprime/Pocklington.v | 16 +- coqprime/Coqprime/PocklingtonCertificat.v | 219 ++++---- coqprime/Coqprime/Root.v | 14 +- coqprime/Coqprime/UList.v | 70 +-- coqprime/Coqprime/ZCAux.v | 8 +- coqprime/Coqprime/ZCmisc.v | 2 +- coqprime/Coqprime/ZProgression.v | 6 +- coqprime/Coqprime/ZSum.v | 12 +- coqprime/Coqprime/Zp.v | 20 +- coqprime/Makefile | 160 ++++-- coqprime/README.md | 2 +- 83 files changed, 7924 insertions(+), 7923 deletions(-) create mode 100644 coqprime-8.4/Coqprime/Cyclic.v create mode 100644 coqprime-8.4/Coqprime/EGroup.v create mode 100644 coqprime-8.4/Coqprime/Euler.v create mode 100644 coqprime-8.4/Coqprime/FGroup.v create mode 100644 coqprime-8.4/Coqprime/IGroup.v create mode 100644 coqprime-8.4/Coqprime/Iterator.v create mode 100644 coqprime-8.4/Coqprime/Lagrange.v create mode 100644 coqprime-8.4/Coqprime/ListAux.v create mode 100644 coqprime-8.4/Coqprime/LucasLehmer.v create mode 100644 coqprime-8.4/Coqprime/Makefile.bak create mode 100644 coqprime-8.4/Coqprime/NatAux.v create mode 100644 coqprime-8.4/Coqprime/Note.pdf create mode 100644 coqprime-8.4/Coqprime/PGroup.v create mode 100644 coqprime-8.4/Coqprime/Permutation.v create mode 100644 coqprime-8.4/Coqprime/Pmod.v create mode 100644 coqprime-8.4/Coqprime/Pocklington.v create mode 100644 coqprime-8.4/Coqprime/PocklingtonCertificat.v create mode 100644 coqprime-8.4/Coqprime/Root.v create mode 100644 coqprime-8.4/Coqprime/Tactic.v create mode 100644 coqprime-8.4/Coqprime/UList.v create mode 100644 coqprime-8.4/Coqprime/ZCAux.v create mode 100644 coqprime-8.4/Coqprime/ZCmisc.v create mode 100644 coqprime-8.4/Coqprime/ZProgression.v create mode 100644 coqprime-8.4/Coqprime/ZSum.v create mode 100644 coqprime-8.4/Coqprime/Zp.v create mode 100644 coqprime-8.4/Makefile create mode 100644 coqprime-8.4/README.md create mode 100644 coqprime-8.4/_CoqProject delete mode 100644 coqprime-8.5/Coqprime/Cyclic.v delete mode 100644 coqprime-8.5/Coqprime/EGroup.v delete mode 100644 coqprime-8.5/Coqprime/Euler.v delete mode 100644 coqprime-8.5/Coqprime/FGroup.v delete mode 100644 coqprime-8.5/Coqprime/IGroup.v delete mode 100644 coqprime-8.5/Coqprime/Iterator.v delete mode 100644 coqprime-8.5/Coqprime/Lagrange.v delete mode 100644 coqprime-8.5/Coqprime/ListAux.v delete mode 100644 coqprime-8.5/Coqprime/LucasLehmer.v delete mode 100644 coqprime-8.5/Coqprime/NatAux.v delete mode 100644 coqprime-8.5/Coqprime/PGroup.v delete mode 100644 coqprime-8.5/Coqprime/Permutation.v delete mode 100644 coqprime-8.5/Coqprime/Pmod.v delete mode 100644 coqprime-8.5/Coqprime/Pocklington.v delete mode 100644 coqprime-8.5/Coqprime/PocklingtonCertificat.v delete mode 100644 coqprime-8.5/Coqprime/Root.v delete mode 100644 coqprime-8.5/Coqprime/Tactic.v delete mode 100644 coqprime-8.5/Coqprime/UList.v delete mode 100644 coqprime-8.5/Coqprime/ZCAux.v delete mode 100644 coqprime-8.5/Coqprime/ZCmisc.v delete mode 100644 coqprime-8.5/Coqprime/ZProgression.v delete mode 100644 coqprime-8.5/Coqprime/ZSum.v delete mode 100644 coqprime-8.5/Coqprime/Zp.v delete mode 100644 coqprime-8.5/Makefile delete mode 100644 coqprime-8.5/README.md delete mode 100644 coqprime-8.5/_CoqProject delete mode 100644 coqprime/Coqprime/Makefile.bak delete mode 100644 coqprime/Coqprime/Note.pdf diff --git a/.travis.yml b/.travis.yml index b4d747d6a..1092e385a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,12 +5,8 @@ dist: trusty env: matrix: - - COQ_VERSION="8.4" COQPRIME="coqprime" - - COQ_VERSION="8.5" COQPRIME="coqprime-8.5" - -matrix: - allow_failures: - - env: COQ_VERSION="8.5" COQPRIME="coqprime-8.5" + - COQ_VERSION="8.4" COQPRIME="coqprime-8.4" + - COQ_VERSION="8.5" COQPRIME="coqprime" before_install: - if [ "$COQ_VERSION" == "8.5" ]; then sudo add-apt-repository ppa:jgross-h/coq-backports -y; fi diff --git a/Makefile b/Makefile index 01fc0938e..519c1b040 100644 --- a/Makefile +++ b/Makefile @@ -32,10 +32,10 @@ coqprime: coqprime-8.4 endif coqprime-8.4: - $(MAKE) -C coqprime + $(MAKE) -C coqprime-8.4 coqprime-8.5: - $(MAKE) -C coqprime-8.5 + $(MAKE) -C coqprime Makefile.coq: Makefile _CoqProject $(Q)$(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq diff --git a/README.md b/README.md index 450259863..c20a08528 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,12 @@ Fiat-Crypto: Synthesizing Correct-by-Construction Assembly for Cryptographic Pri NOTE: The github.com repo is only intermittently synced with github.mit.edu. -To build: +To build (Coq 8.5): export COQPATH="$(pwd)/coqprime${COQPATH:+:}$COQPATH" make + +To build with Coq 8.4 + + export COQPATH="$(pwd)/coqprime-8.4${COQPATH:+:}$COQPATH" + make diff --git a/coqprime-8.4/Coqprime/Cyclic.v b/coqprime-8.4/Coqprime/Cyclic.v new file mode 100644 index 000000000..e2daa4d67 --- /dev/null +++ b/coqprime-8.4/Coqprime/Cyclic.v @@ -0,0 +1,244 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(*********************************************************************** + Cyclic.v + + Proof that an abelien ring is cyclic + ************************************************************************) +Require Import Coqprime.ZCAux. +Require Import Coq.Lists.List. +Require Import Coqprime.Root. +Require Import Coqprime.UList. +Require Import Coqprime.IGroup. +Require Import Coqprime.EGroup. +Require Import Coqprime.FGroup. + +Open Scope Z_scope. + +Section Cyclic. + +Variable A: Set. +Variable plus mult: A -> A -> A. +Variable op: A -> A. +Variable zero one: A. +Variable support: list A. +Variable e: A. + +Hypothesis A_dec: forall a b: A, {a = b} + {a <> b}. +Hypothesis e_not_zero: zero <> e. +Hypothesis support_ulist: ulist support. +Hypothesis e_in_support: In e support. +Hypothesis zero_in_support: In zero support. +Hypothesis mult_internal: forall a b, In a support -> In b support -> In (mult a b) support. +Hypothesis mult_assoc: forall a b c, In a support -> In b support -> In c support -> mult a (mult b c) = mult (mult a b) c. +Hypothesis e_is_zero_l: forall a, In a support -> mult e a = a. +Hypothesis e_is_zero_r: forall a, In a support -> mult a e = a. +Hypothesis plus_internal: forall a b, In a support -> In b support -> In (plus a b) support. +Hypothesis plus_zero: forall a, In a support -> plus zero a = a. +Hypothesis plus_comm: forall a b, In a support -> In b support -> plus a b = plus b a. +Hypothesis plus_assoc: forall a b c, In a support -> In b support -> In c support -> plus a (plus b c) = plus (plus a b) c. +Hypothesis mult_zero: forall a, In a support -> mult zero a = zero. +Hypothesis mult_comm: forall a b, In a support -> In b support ->mult a b = mult b a. +Hypothesis mult_plus_distr: forall a b c, In a support -> In b support -> In c support -> mult a (plus b c) = plus (mult a b) (mult a c). +Hypothesis op_internal: forall a, In a support -> In (op a) support. +Hypothesis plus_op_zero: forall a, In a support -> plus a (op a) = zero. +Hypothesis mult_integral: forall a b, In a support -> In b support -> mult a b = zero -> a = zero \/ b = zero. + +Definition IA := (IGroup A mult support e A_dec support_ulist e_in_support mult_internal + mult_assoc + e_is_zero_l e_is_zero_r). + +Hint Resolve (fun x => isupport_incl _ mult support e A_dec x). + +Theorem gpow_evaln: forall n, 0 < n -> + exists p, (length p <= Zabs_nat n)%nat /\ (forall i, In i p -> In i support) /\ + forall x, In x IA.(s) -> eval A plus mult zero (zero::p) x = gpow x IA n. +intros n Hn; generalize Hn; pattern n; apply natlike_ind; auto with zarith. +intros H1; contradict H1; auto with zarith. +intros x Hx Rec _. +case Zle_lt_or_eq with (1 := Hx); clear Hx; intros Hx; subst; simpl. +case Rec; auto; simpl; intros p (Hp1, (Hp2, Hp3)); clear Rec. +exists (zero::p); split; simpl. +rewrite Zabs_nat_Zsucc; auto with arith zarith. +split. +intros i [Hi | Hi]; try rewrite <- Hi; auto. +intros x1 Hx1; simpl. +rewrite Hp3; repeat rewrite plus_zero; unfold Zsucc; try rewrite gpow_add; auto with zarith. +rewrite gpow_1; try apply mult_comm; auto. +apply (fun x => isupport_incl _ mult support e A_dec x); auto. +change (In (gpow x1 IA x) IA.(s)). +apply gpow_in; auto. +apply mult_internal; auto. +apply (fun x => isupport_incl _ mult support e A_dec x); auto. +change (In (gpow x1 IA x) IA.(s)). +apply gpow_in; auto. +exists (e:: nil); split; simpl. +compute; auto with arith. +split. +intros i [Hi | Hi]; try rewrite <- Hi; auto; case Hi. +intros x Hx; simpl. +rewrite plus_zero; rewrite (fun x => mult_comm x zero); try rewrite mult_zero; auto. +rewrite plus_comm; try rewrite plus_zero; auto. +Qed. + +Definition check_list_gpow: forall l n, (incl l IA.(s)) -> {forall a, In a l -> gpow a IA n = e} + {exists a, In a l /\ gpow a IA n <> e}. +intros l n; elim l; simpl; auto. +intros H; left; intros a H1; case H1. +intros a l1 Rec H. +case (A_dec (gpow a IA n) e); intros H2. +case Rec; try intros H3. +apply incl_tran with (2 := H); auto with datatypes. +left; intros a1 H4; case H4; auto. +intros H5; rewrite <- H5; auto. +right; case H3; clear H3; intros a1 (H3, H4). +exists a1; auto. +right; exists a; auto. +Defined. + + +Theorem prime_power_div: forall p q i, prime p -> 0 <= q -> 0 <= i -> (q | p ^ i) -> exists j, 0 <= j <= i /\ q = p ^ j. +intros p q i Hp Hq Hi H. +assert (Hp1: 0 < p). +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +pattern q; apply prime_div_induction with (p ^ i); auto with zarith. +exists 0; rewrite Zpower_0_r; auto with zarith. +intros p1 i1 Hp2 Hi1 H1. +case Zle_lt_or_eq with (1 := Hi1); clear Hi1; intros Hi1; subst. +assert (Heq: p1 = p). +apply prime_div_Zpower_prime with i; auto. +apply Zdivide_trans with (2 := H1). +apply Zpower_divide; auto with zarith. +exists i1; split; auto; try split; auto with zarith. +case (Zle_or_lt i1 i); auto; intros H2. +absurd (p1 ^ i1 <= p ^ i). +apply Zlt_not_le; rewrite Heq; apply Zpower_lt_monotone; auto with zarith. +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +apply Zdivide_le; auto with zarith. +rewrite Heq; auto. +exists 0; repeat rewrite Zpower_exp_0; auto with zarith. +intros p1 q1 Hpq (j1,((Hj1, Hj2), Hj3)) (j2, ((Hj4, Hj5), Hj6)). +case Zle_lt_or_eq with (1 := Hj1); clear Hj1; intros Hj1; subst. +case Zle_lt_or_eq with (1 := Hj4); clear Hj4; intros Hj4; subst. +inversion Hpq as [ H0 H1 H2]. +absurd (p | 1). +intros H3; absurd (1 < p). +apply Zle_not_lt; apply Zdivide_le; auto with zarith. +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +apply H2; apply Zpower_divide; auto with zarith. +exists j1; rewrite Zpower_0_r; auto with zarith. +exists j2; rewrite Zpower_0_r; auto with zarith. +Qed. + +Theorem inj_lt_inv: forall n m : nat, Z_of_nat n < Z_of_nat m -> (n < m)%nat. +intros n m H; case (le_or_lt m n); auto; intros H1; contradict H. +apply Zle_not_lt; apply inj_le; auto. +Qed. + +Theorem not_all_solutions: forall i, 0 < i < g_order IA -> exists a, In a IA.(s) /\ gpow a IA i <> e. +intros i (Hi, Hi2). +case (check_list_gpow IA.(s) i); try intros H; auto with datatypes. +case (gpow_evaln i); auto; intros p (Hp1, (Hp2, Hp3)). +absurd ((op e) = zero). +intros H1; case e_not_zero. +rewrite <- (plus_op_zero e); try rewrite H1; auto. +rewrite plus_comm; auto. +apply (root_max_is_zero _ (fun x => In x support) plus mult op zero) with (l := IA.(s)) (p := op e :: p); auto with datatypes. +simpl; intros x [Hx | Hx]; try rewrite <- Hx; auto. +intros x Hx. +generalize (Hp3 _ Hx); simpl; rewrite plus_zero; auto. +intros tmp; rewrite tmp; clear tmp. +rewrite H; auto; rewrite plus_comm; auto with datatypes. +apply mult_internal; auto. +apply eval_P; auto. +simpl; apply lt_le_S; apply le_lt_trans with (1 := Hp1). +apply inj_lt_inv. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +Qed. + +Theorem divide_g_order_e_order: forall n, 0 <= n -> (n | g_order IA) -> exists a, In a IA.(s) /\ e_order A_dec a IA = n. +intros n Hn H. +assert (Hg: 0 < g_order IA). +apply g_order_pos. +assert (He: forall a, 0 <= e_order A_dec a IA). +intros a; apply Zlt_le_weak; apply e_order_pos. +pattern n; apply prime_div_induction with (n := g_order IA); auto. +exists e; split; auto. +apply IA.(e_in_s). +apply Zle_antisym. +apply Zdivide_le; auto with zarith. +apply e_order_divide_gpow; auto with zarith. +apply IA.(e_in_s). +rewrite gpow_1; auto. +apply IA.(e_in_s). +match goal with |- (_ <= ?X) => assert (0 < X) end; try apply e_order_pos; auto with zarith. +intros p i Hp Hi K. +assert (Hp1: 0 < p). +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +assert (Hi1: 0 < p ^ i). +apply Zpower_gt_0; auto. +case Zle_lt_or_eq with (1 := Hi); clear Hi; intros Hi; subst. +case (not_all_solutions (g_order IA / p)). +apply Zdivide_Zdiv_lt_pos; auto with zarith. +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +apply Zdivide_trans with (2 := K). +apply Zpower_divide; auto. +intros a (Ha1, Ha2). +exists (gpow a IA (g_order IA / p ^ i)); split. +apply gpow_in; auto. +match goal with |- ?X = ?Y => assert (H1: (X | Y) ) end; auto. +apply e_order_divide_gpow; auto with zarith. +apply gpow_in; auto. +rewrite <- gpow_gpow; auto with zarith. +rewrite Zmult_comm; rewrite <- Zdivide_Zdiv_eq; auto with zarith. +apply fermat_gen; auto. +apply Z_div_pos; auto with zarith. +case prime_power_div with (4 := H1); auto with zarith. +intros j ((Hj1, Hj2), Hj3). +case Zle_lt_or_eq with (1 := Hj2); intros Hj4; subst; auto. +case Ha2. +replace (g_order IA) with (((g_order IA / p ^i) * p ^ j) * p ^ (i - j - 1) * p). +rewrite Z_div_mult; auto with zarith. +repeat rewrite gpow_gpow; auto with zarith. +rewrite <- Hj3. +rewrite gpow_e_order_is_e; auto with zarith. +rewrite gpow_e; auto. +apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. +apply gpow_in; auto. +apply Z_div_pos; auto with zarith. +apply Zmult_le_0_compat; try apply Z_div_pos; auto with zarith. +pattern p at 4; rewrite <- Zpower_1_r. +repeat rewrite <- Zmult_assoc; repeat rewrite <- Zpower_exp; auto with zarith. +replace (j + (i - j - 1 + 1)) with i; auto with zarith. +apply sym_equal; rewrite Zmult_comm; apply Zdivide_Zdiv_eq; auto with zarith. +rewrite Zpower_0_r; exists e; split. +apply IA.(e_in_s). +match goal with |- ?X = 1 => assert (tmp: 0 < X); try apply e_order_pos; +case Zle_lt_or_eq with 1 X; auto with zarith; clear tmp; intros H1 end. +absurd (gpow IA.(FGroup.e) IA 1 = IA.(FGroup.e)). +apply gpow_e_order_lt_is_not_e with A_dec; auto with zarith. +apply gpow_e; auto with zarith. +intros p q H1 (a, (Ha1, Ha2)) (b, (Hb1, Hb2)). +exists (mult a b); split. +apply IA.(internal); auto. +rewrite <- Ha2; rewrite <- Hb2; apply order_mult; auto. +rewrite Ha2; rewrite Hb2; auto. +Qed. + +Set Implicit Arguments. +Definition cyclic (A: Set) A_dec (op: A -> A -> A) (G: FGroup op):= exists a, In a G.(s) /\ e_order A_dec a G = g_order G. +Unset Implicit Arguments. + +Theorem cyclic_field: cyclic A_dec IA. +red; apply divide_g_order_e_order; auto. +apply Zlt_le_weak; apply g_order_pos. +exists 1; ring. +Qed. + +End Cyclic. diff --git a/coqprime-8.4/Coqprime/EGroup.v b/coqprime-8.4/Coqprime/EGroup.v new file mode 100644 index 000000000..553cb746c --- /dev/null +++ b/coqprime-8.4/Coqprime/EGroup.v @@ -0,0 +1,605 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + EGroup.v + + Given an element a, create the group {e, a, a^2, ..., a^n} + **********************************************************************) +Require Import Coq.ZArith.ZArith. +Require Import Coqprime.Tactic. +Require Import Coq.Lists.List. +Require Import Coqprime.ZCAux. +Require Import Coq.ZArith.ZArith Coq.ZArith.Znumtheory. +Require Import Coq.Arith.Wf_nat. +Require Import Coqprime.UList. +Require Import Coqprime.FGroup. +Require Import Coqprime.Lagrange. + +Open Scope Z_scope. + +Section EGroup. + +Variable A: Set. + +Variable A_dec: forall a b: A, {a = b} + {~ a = b}. + +Variable op: A -> A -> A. + +Variable a: A. + +Variable G: FGroup op. + +Hypothesis a_in_G: In a G.(s). + + +(************************************** + The power function for the group + **************************************) + +Set Implicit Arguments. +Definition gpow n := match n with Zpos p => iter_pos p _ (op a) G.(e) | _ => G.(e) end. +Unset Implicit Arguments. + +Theorem gpow_0: gpow 0 = G.(e). +simpl; sauto. +Qed. + +Theorem gpow_1 : gpow 1 = a. +simpl; sauto. +Qed. + +(************************************** + Some properties of the power function + **************************************) + +Theorem gpow_in: forall n, In (gpow n) G.(s). +intros n; case n; simpl; auto. +intros p; apply iter_pos_invariant with (Inv := fun x => In x G.(s)); auto. +Qed. + +Theorem gpow_op: forall b p, In b G.(s) -> iter_pos p _ (op a) b = op (iter_pos p _ (op a) G.(e)) b. +intros b p; generalize b; elim p; simpl; auto; clear b p. +intros p Rec b Hb. +assert (H: In (gpow (Zpos p)) G.(s)). +apply gpow_in. +rewrite (Rec b); try rewrite (fun x y => Rec (op x y)); try rewrite (fun x y => Rec (iter_pos p A x y)); auto. +repeat rewrite G.(assoc); auto. +intros p Rec b Hb. +assert (H: In (gpow (Zpos p)) G.(s)). +apply gpow_in. +rewrite (Rec b); try rewrite (fun x y => Rec (op x y)); try rewrite (fun x y => Rec (iter_pos p A x y)); auto. +repeat rewrite G.(assoc); auto. +intros b H; rewrite e_is_zero_r; auto. +Qed. + +Theorem gpow_add: forall n m, 0 <= n -> 0 <= m -> gpow (n + m) = op (gpow n) (gpow m). +intros n; case n. +intros m _ _; simpl; apply sym_equal; apply e_is_zero_l; apply gpow_in. +2: intros p m H; contradict H; auto with zarith. +intros p1 m; case m. +intros _ _; simpl; apply sym_equal; apply e_is_zero_r. +exact (gpow_in (Zpos p1)). +2: intros p2 _ H; contradict H; auto with zarith. +intros p2 _ _; simpl. +rewrite iter_pos_plus; rewrite (fun x y => gpow_op (iter_pos p2 A x y)); auto. +exact (gpow_in (Zpos p2)). +Qed. + +Theorem gpow_1_more: + forall n, 0 < n -> gpow n = G.(e) -> forall m, 0 <= m -> exists p, 0 <= p < n /\ gpow m = gpow p. +intros n H1 H2 m Hm; generalize Hm; pattern m; apply Z_lt_induction; auto with zarith; clear m Hm. +intros m Rec Hm. +case (Zle_or_lt n m); intros H3. +case (Rec (m - n)); auto with zarith. +intros p (H4,H5); exists p; split; auto. +replace m with (n + (m - n)); auto with zarith. +rewrite gpow_add; try rewrite H2; try rewrite H5; sauto; auto with zarith. +generalize gpow_in; sauto. +exists m; auto. +Qed. + +Theorem gpow_i: forall n m, 0 <= n -> 0 <= m -> gpow n = gpow (n + m) -> gpow m = G.(e). +intros n m H1 H2 H3; generalize gpow_in; intro PI. +apply g_cancel_l with (g:= G) (a := gpow n); sauto. +rewrite <- gpow_add; try rewrite <- H3; sauto. +Qed. + +(************************************** + We build the support by iterating the power function + **************************************) + +Set Implicit Arguments. + +Fixpoint support_aux (b: A) (n: nat) {struct n}: list A := +b::let c := op a b in + match n with + O => nil | + (S n1) =>if A_dec c G.(e) then nil else support_aux c n1 + end. + +Definition support := support_aux G.(e) (Zabs_nat (g_order G)). + +Unset Implicit Arguments. + +(************************************** + Some properties of the support that helps to prove that we have a group + **************************************) + +Theorem support_aux_gpow: + forall n m b, 0 <= m -> In b (support_aux (gpow m) n) -> + exists p, (0 <= p < length (support_aux (gpow m) n))%nat /\ b = gpow (m + Z_of_nat p). +intros n; elim n; simpl. +intros n1 b Hm [H1 | H1]; exists 0%nat; simpl; rewrite Zplus_0_r; auto; case H1. +intros n1 Rec m b Hm [H1 | H1]. +exists 0%nat; simpl; rewrite Zplus_0_r; auto; auto with arith. +generalize H1; case (A_dec (op a (gpow m)) G.(e)); clear H1; simpl; intros H1 H2. +case H2. +case (Rec (1 + m) b); auto with zarith. +rewrite gpow_add; auto with zarith. +rewrite gpow_1; auto. +intros p (Hp1, Hp2); exists (S p); split; auto with zarith. +rewrite <- gpow_1. +rewrite <- gpow_add; auto with zarith. +rewrite inj_S; rewrite Hp2; eq_tac; auto with zarith. +Qed. + +Theorem gpow_support_aux_not_e: + forall n m p, 0 <= m -> m < p < m + Z_of_nat (length (support_aux (gpow m) n)) -> gpow p <> G.(e). +intros n; elim n; simpl. +intros m p Hm (H1, H2); contradict H2; auto with zarith. +intros n1 Rec m p Hm; case (A_dec (op a (gpow m)) G.(e)); simpl. +intros _ (H1, H2); contradict H2; auto with zarith. +assert (tmp: forall p, Zpos (P_of_succ_nat p) = 1 + Z_of_nat p). +intros p1; apply trans_equal with (Z_of_nat (S p1)); auto; rewrite inj_S; auto with zarith. +rewrite tmp. +intros H1 (H2, H3); case (Zle_lt_or_eq (1 + m) p); auto with zarith; intros H4; subst. +apply (Rec (1 + m)); try split; auto with zarith. +rewrite gpow_add; auto with zarith. +rewrite gpow_1; auto with zarith. +rewrite gpow_add; try rewrite gpow_1; auto with zarith. +Qed. + +Theorem support_aux_not_e: forall n m b, 0 <= m -> In b (tail (support_aux (gpow m) n)) -> ~ b = G.(e). +intros n; elim n; simpl. +intros m b Hm H; case H. +intros n1 Rec m b Hm; case (A_dec (op a (gpow m)) G.(e)); intros H1 H2; simpl; auto. +assert (Hm1: 0 <= 1 + m); auto with zarith. +generalize( Rec (1 + m) b Hm1) H2; case n1; auto; clear Hm1. +intros _ [H3 | H3]; auto. +contradict H1; subst; auto. +rewrite gpow_add; simpl; try rewrite e_is_zero_r; auto with zarith. +intros n2; case (A_dec (op a (op a (gpow m))) G.(e)); intros H3. +intros _ [H4 | H4]. +contradict H1; subst; auto. +case H4. +intros H4 [H5 | H5]; subst; auto. +Qed. + +Theorem support_aux_length_le: forall n a, (length (support_aux a n) <= n + 1)%nat. +intros n; elim n; simpl; auto. +intros n1 Rec a1; case (A_dec (op a a1) G.(e)); simpl; auto with arith. +Qed. + +Theorem support_aux_length_le_is_e: + forall n m, 0 <= m -> (length (support_aux (gpow m) n) <= n)%nat -> + gpow (m + Z_of_nat (length (support_aux (gpow m) n))) = G.(e) . +intros n; elim n; simpl; auto. +intros m _ H1; contradict H1; auto with arith. +intros n1 Rec m Hm; case (A_dec (op a (gpow m)) G.(e)); simpl; intros H1. +intros H2; rewrite Zplus_comm; rewrite gpow_add; simpl; try rewrite e_is_zero_r; auto with zarith. +assert (tmp: forall p, Zpos (P_of_succ_nat p) = 1 + Z_of_nat p). +intros p1; apply trans_equal with (Z_of_nat (S p1)); auto; rewrite inj_S; auto with zarith. +rewrite tmp; clear tmp. +rewrite <- gpow_1. +rewrite <- gpow_add; auto with zarith. +rewrite Zplus_assoc; rewrite (Zplus_comm 1); intros H2; apply Rec; auto with zarith. +Qed. + +Theorem support_aux_in: + forall n m p, 0 <= m -> (p < length (support_aux (gpow m) n))% nat -> + (In (gpow (m + Z_of_nat p)) (support_aux (gpow m) n)). +intros n; elim n; simpl; auto; clear n. +intros m p Hm H1; replace p with 0%nat. +left; eq_tac; auto with zarith. +generalize H1; case p; simpl; auto with arith. +intros n H2; contradict H2; apply le_not_lt; auto with arith. +intros n1 Rec m p Hm; case (A_dec (op a (gpow m)) G.(e)); simpl; intros H1 H2; auto. +replace p with 0%nat. +left; eq_tac; auto with zarith. +generalize H2; case p; simpl; auto with arith. +intros n H3; contradict H3; apply le_not_lt; auto with arith. +generalize H2; case p; simpl; clear H2. +rewrite Zplus_0_r; auto. +intros n. +assert (tmp: forall p, Zpos (P_of_succ_nat p) = 1 + Z_of_nat p). +intros p1; apply trans_equal with (Z_of_nat (S p1)); auto; rewrite inj_S; auto with zarith. +rewrite tmp; clear tmp. +rewrite <- gpow_1; rewrite <- gpow_add; auto with zarith. +rewrite Zplus_assoc; rewrite (Zplus_comm 1); intros H2; right; apply Rec; auto with zarith. +Qed. + +Theorem support_aux_ulist: + forall n m, 0 <= m -> (forall p, 0 <= p < m -> gpow (1 + p) <> G.(e)) -> ulist (support_aux (gpow m) n). +intros n; elim n; auto; clear n. +intros m _ _; auto. +simpl; apply ulist_cons; auto. +intros n1 Rec m Hm H. +simpl; case (A_dec (op a (gpow m)) G.(e)); auto. +intros He; apply ulist_cons; auto. +intros H1; case (support_aux_gpow n1 (1 + m) (gpow m)); auto with zarith. +rewrite gpow_add; try rewrite gpow_1; auto with zarith. +intros p (Hp1, Hp2). +assert (H2: gpow (1 + Z_of_nat p) = G.(e)). +apply gpow_i with m; auto with zarith. +rewrite Hp2; eq_tac; auto with zarith. +case (Zle_or_lt m (Z_of_nat p)); intros H3; auto. +2: case (H (Z_of_nat p)); auto with zarith. +case (support_aux_not_e (S n1) m (gpow (1 + Z_of_nat p))); auto. +rewrite gpow_add; auto with zarith; simpl; rewrite e_is_zero_r; auto. +case (A_dec (op a (gpow m)) G.(e)); auto. +intros _; rewrite <- gpow_1; repeat rewrite <- gpow_add; auto with zarith. +replace (1 + Z_of_nat p) with ((1 + m) + (Z_of_nat (p - Zabs_nat m))); auto with zarith. +apply support_aux_in; auto with zarith. +rewrite inj_minus1; auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +apply inj_le_rev. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +rewrite <- gpow_1; repeat rewrite <- gpow_add; auto with zarith. +apply (Rec (1 + m)); auto with zarith. +intros p H1; case (Zle_lt_or_eq p m); intros; subst; auto with zarith. +rewrite gpow_add; auto with zarith. +rewrite gpow_1; auto. +Qed. + +Theorem support_gpow: forall b, (In b support) -> exists p, 0 <= p < Z_of_nat (length support) /\ b = gpow p. +intros b H; case (support_aux_gpow (Zabs_nat (g_order G)) 0 b); auto with zarith. +intros p ((H1, H2), H3); exists (Z_of_nat p); repeat split; auto with zarith. +apply inj_lt; auto. +Qed. + +Theorem support_incl_G: incl support G.(s). +intros a1 H; case (support_gpow a1); auto; intros p (H1, H2); subst; apply gpow_in. +Qed. + +Theorem gpow_support_not_e: forall p, 0 < p < Z_of_nat (length support) -> gpow p <> G.(e). +intros p (H1, H2); apply gpow_support_aux_not_e with (m := 0) (n := length G.(s)); simpl; + try split; auto with zarith. +rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. +Qed. + +Theorem support_not_e: forall b, In b (tail support) -> ~ b = G.(e). +intros b H; apply (support_aux_not_e (Zabs_nat (g_order G)) 0); auto with zarith. +Qed. + +Theorem support_ulist: ulist support. +apply (support_aux_ulist (Zabs_nat (g_order G)) 0); auto with zarith. +Qed. + +Theorem support_in_e: In G.(e) support. +unfold support; case (Zabs_nat (g_order G)); simpl; auto with zarith. +Qed. + +Theorem gpow_length_support_is_e: gpow (Z_of_nat (length support)) = G.(e). +apply (support_aux_length_le_is_e (Zabs_nat (g_order G)) 0); simpl; auto with zarith. +unfold g_order; rewrite Zabs_nat_Z_of_nat; apply ulist_incl_length. +rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. +exact support_ulist. +rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. +exact support_incl_G. +Qed. + +Theorem support_in: forall p, 0 <= p < Z_of_nat (length support) -> In (gpow p) support. +intros p (H, H1); unfold support. +rewrite <- (Zabs_eq p); auto with zarith. +rewrite <- (inj_Zabs_nat p); auto. +generalize (support_aux_in (Zabs_nat (g_order G)) 0); simpl; intros H2; apply H2; auto with zarith. +rewrite <- (fun x => Zabs_nat_Z_of_nat (@length A x)); auto. +apply Zabs_nat_lt; split; auto. +Qed. + +Theorem support_internal: forall a b, In a support -> In b support -> In (op a b) support. +intros a1 b1 H1 H2. +case support_gpow with (1 := H1); auto; intros p1 ((H3, H4), H5); subst. +case support_gpow with (1 := H2); auto; intros p2 ((H5, H6), H7); subst. +rewrite <- gpow_add; auto with zarith. +case gpow_1_more with (m:= p1 + p2) (2 := gpow_length_support_is_e); auto with zarith. +intros p3 ((H8, H9), H10); rewrite H10; apply support_in; auto with zarith. +Qed. + +Theorem support_i_internal: forall a, In a support -> In (G.(i) a) support. +generalize gpow_in; intros Hp. +intros a1 H1. +case support_gpow with (1 := H1); auto. +intros p1 ((H2, H3), H4); case Zle_lt_or_eq with (1 := H2); clear H2; intros H2; subst. +2: rewrite gpow_0; rewrite i_e; apply support_in_e. +replace (G.(i) (gpow p1)) with (gpow (Z_of_nat (length support - Zabs_nat p1))). +apply support_in; auto with zarith. +rewrite inj_minus1. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +apply inj_le_rev; rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +apply g_cancel_l with (g:= G) (a := gpow p1); sauto. +rewrite <- gpow_add; auto with zarith. +replace (p1 + Z_of_nat (length support - Zabs_nat p1)) with (Z_of_nat (length support)). +rewrite gpow_length_support_is_e; sauto. +rewrite inj_minus1; auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +apply inj_le_rev; rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +Qed. + +(************************************** + We are now ready to build the group + **************************************) + +Definition Gsupport: (FGroup op). +generalize support_incl_G; unfold incl; intros Ho. +apply mkGroup with support G.(e) G.(i); sauto. +apply support_ulist. +apply support_internal. +intros a1 b1 c1 H1 H2 H3; apply G.(assoc); sauto. +apply support_in_e. +apply support_i_internal. +Defined. + +(************************************** + Definition of the order of an element + **************************************) +Set Implicit Arguments. + +Definition e_order := Z_of_nat (length support). + +Unset Implicit Arguments. + +(************************************** + Some properties of the order of an element + **************************************) + +Theorem gpow_e_order_is_e: gpow e_order = G.(e). +apply (support_aux_length_le_is_e (Zabs_nat (g_order G)) 0); simpl; auto with zarith. +unfold g_order; rewrite Zabs_nat_Z_of_nat; apply ulist_incl_length. +rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. +exact support_ulist. +rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. +exact support_incl_G. +Qed. + +Theorem gpow_e_order_lt_is_not_e: forall n, 1 <= n < e_order -> gpow n <> G.(e). +intros n (H1, H2); apply gpow_support_not_e; auto with zarith. +Qed. + +Theorem e_order_divide_g_order: (e_order | g_order G). +change ((g_order Gsupport) | g_order G). +apply lagrange; auto. +exact support_incl_G. +Qed. + +Theorem e_order_pos: 0 < e_order. +unfold e_order, support; case (Zabs_nat (g_order G)); simpl; auto with zarith. +Qed. + +Theorem e_order_divide_gpow: forall n, 0 <= n -> gpow n = G.(e) -> (e_order | n). +generalize gpow_in; intros Hp. +generalize e_order_pos; intros Hp1. +intros n Hn; generalize Hn; pattern n; apply Z_lt_induction; auto; clear n Hn. +intros n Rec Hn H. +case (Zle_or_lt e_order n); intros H1. +case (Rec (n - e_order)); auto with zarith. +apply g_cancel_l with (g:= G) (a := gpow e_order); sauto. +rewrite G.(e_is_zero_r); auto with zarith. +rewrite <- gpow_add; try (rewrite gpow_e_order_is_e; rewrite <- H; eq_tac); auto with zarith. +intros k Hk; exists (1 + k). +rewrite Zmult_plus_distr_l; rewrite <- Hk; auto with zarith. +case (Zle_lt_or_eq 0 n); auto with arith; intros H2; subst. +contradict H; apply support_not_e. +generalize H1; unfold e_order, support. +case (Zabs_nat (g_order G)); simpl; auto. +intros H3; contradict H3; auto with zarith. +intros n1; case (A_dec (op a G.(e)) G.(e)); simpl; intros _ H3. +contradict H3; auto with zarith. +generalize H3; clear H3. +assert (tmp: forall p, Zpos (P_of_succ_nat p) = 1 + Z_of_nat p). +intros p1; apply trans_equal with (Z_of_nat (S p1)); auto; rewrite inj_S; auto with zarith. +rewrite tmp; clear tmp; intros H3. +change (In (gpow n) (support_aux (gpow 1) n1)). +replace n with (1 + Z_of_nat (Zabs_nat n - 1)). +apply support_aux_in; auto with zarith. +rewrite <- (fun x => Zabs_nat_Z_of_nat (@length A x)). +replace (Zabs_nat n - 1)%nat with (Zabs_nat (n - 1)). +apply Zabs_nat_lt; split; auto with zarith. +rewrite G.(e_is_zero_r) in H3; try rewrite gpow_1; auto with zarith. +apply inj_eq_rev; rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +rewrite inj_minus1; auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +apply inj_le_rev; rewrite inj_Zabs_nat; simpl; auto with zarith. +rewrite Zabs_eq; auto with zarith. +rewrite inj_minus1; auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +rewrite Zplus_comm; simpl; auto with zarith. +apply inj_le_rev; rewrite inj_Zabs_nat; simpl; auto with zarith. +rewrite Zabs_eq; auto with zarith. +exists 0; auto with arith. +Qed. + +End EGroup. + +Theorem gpow_gpow: forall (A : Set) (op : A -> A -> A) (a : A) (G : FGroup op), + In a (s G) -> forall n m, 0 <= n -> 0 <= m -> gpow a G (n * m ) = gpow (gpow a G n) G m. +intros A op a G H n m; case n. +simpl; intros _ H1; generalize H1. +pattern m; apply natlike_ind; simpl; auto. +intros x H2 Rec _; unfold Zsucc; rewrite gpow_add; simpl; auto with zarith. +repeat rewrite G.(e_is_zero_r); auto with zarith. +apply gpow_in; sauto. +intros p1 _; case m; simpl; auto. +assert(H1: In (iter_pos p1 A (op a) (e G)) (s G)). +refine (gpow_in _ _ _ _ _ (Zpos p1)); auto. +intros p2 _; pattern p2; apply Pind; simpl; auto. +rewrite Pmult_1_r; rewrite G.(e_is_zero_r); try rewrite G.(e_is_zero_r); auto. +intros p3 Rec; rewrite Pplus_one_succ_r; rewrite Pmult_plus_distr_l. +rewrite Pmult_1_r. +simpl; repeat rewrite iter_pos_plus; simpl. +rewrite G.(e_is_zero_r); auto. +rewrite gpow_op with (G:= G); try rewrite Rec; auto. +apply sym_equal; apply gpow_op; auto. +intros p Hp; contradict Hp; auto with zarith. +Qed. + +Theorem gpow_e: forall (A : Set) (op : A -> A -> A) (G : FGroup op) n, 0 <= n -> gpow G.(e) G n = G.(e). +intros A op G n; case n; simpl; auto with zarith. +intros p _; elim p; simpl; auto; intros p1 Rec; repeat rewrite Rec; auto. +Qed. + +Theorem gpow_pow: forall (A : Set) (op : A -> A -> A) (a : A) (G : FGroup op), + In a (s G) -> forall n, 0 <= n -> gpow a G (2 ^ n) = G.(e) -> forall m, n <= m -> gpow a G (2 ^ m) = G.(e). +intros A op a G H n H1 H2 m Hm. +replace m with (n + (m - n)); auto with zarith. +rewrite Zpower_exp; auto with zarith. +rewrite gpow_gpow; auto with zarith. +rewrite H2; apply gpow_e. +apply Zpower_ge_0; auto with zarith. +Qed. + +Theorem gpow_mult: forall (A : Set) (op : A -> A -> A) (a b: A) (G : FGroup op) + (comm: forall a b, In a (s G) -> In b (s G) -> op a b = op b a), + In a (s G) -> In b (s G) -> forall n, 0 <= n -> gpow (op a b) G n = op (gpow a G n) (gpow b G n). +intros A op a b G comm Ha Hb n; case n; simpl; auto. +intros _; rewrite G.(e_is_zero_r); auto. +2: intros p Hp; contradict Hp; auto with zarith. +intros p _; pattern p; apply Pind; simpl; auto. +repeat rewrite G.(e_is_zero_r); auto. +intros p3 Rec; rewrite Pplus_one_succ_r. +repeat rewrite iter_pos_plus; simpl. +repeat rewrite (fun x y H z => gpow_op A op x G H (op y z)) ; auto. +rewrite Rec. +repeat rewrite G.(e_is_zero_r); auto. +assert(H1: In (iter_pos p3 A (op a) (e G)) (s G)). +refine (gpow_in _ _ _ _ _ (Zpos p3)); auto. +assert(H2: In (iter_pos p3 A (op b) (e G)) (s G)). +refine (gpow_in _ _ _ _ _ (Zpos p3)); auto. +repeat rewrite <- G.(assoc); try eq_tac; auto. +rewrite (fun x y => comm (iter_pos p3 A x y) b); auto. +rewrite (G.(assoc) a); try apply comm; auto. +Qed. + +Theorem Zdivide_mult_rel_prime: forall a b c : Z, (a | c) -> (b | c) -> rel_prime a b -> (a * b | c). +intros a b c (q1, H1) (q2, H2) H3. +assert (H4: (a | q2)). +apply Gauss with (2 := H3). +exists q1; rewrite <- H1; rewrite H2; auto with zarith. +case H4; intros q3 H5; exists q3; rewrite H2; rewrite H5; auto with zarith. +Qed. + +Theorem order_mult: forall (A : Set) (op : A -> A -> A) (A_dec: forall a b: A, {a = b} + {~ a = b}) (G : FGroup op) + (comm: forall a b, In a (s G) -> In b (s G) -> op a b = op b a) (a b: A), + In a (s G) -> In b (s G) -> rel_prime (e_order A_dec a G) (e_order A_dec b G) -> + e_order A_dec (op a b) G = e_order A_dec a G * e_order A_dec b G. +intros A op A_dec G comm a b Ha Hb Hab. +assert (Hoat: 0 < e_order A_dec a G); try apply e_order_pos. +assert (Hobt: 0 < e_order A_dec b G); try apply e_order_pos. +assert (Hoabt: 0 < e_order A_dec (op a b) G); try apply e_order_pos. +assert (Hoa: 0 <= e_order A_dec a G); auto with zarith. +assert (Hob: 0 <= e_order A_dec b G); auto with zarith. +apply Zle_antisym; apply Zdivide_le; auto with zarith. +apply Zmult_lt_O_compat; auto. +apply e_order_divide_gpow; sauto; auto with zarith. +rewrite gpow_mult; auto with zarith. +rewrite gpow_gpow; auto with zarith. +rewrite gpow_e_order_is_e; auto with zarith. +rewrite gpow_e; auto. +rewrite Zmult_comm. +rewrite gpow_gpow; auto with zarith. +rewrite gpow_e_order_is_e; auto with zarith. +rewrite gpow_e; auto. +apply Zdivide_mult_rel_prime; auto. +apply Gauss with (2 := Hab). +apply e_order_divide_gpow; auto with zarith. +rewrite <- (gpow_e _ _ G (e_order A_dec b G)); auto. +rewrite <- (gpow_e_order_is_e _ A_dec _ (op a b) G); auto with zarith. +rewrite <- gpow_gpow; auto with zarith. +rewrite (Zmult_comm (e_order A_dec (op a b) G)). +rewrite gpow_mult; auto with zarith. +rewrite gpow_gpow with (a := b); auto with zarith. +rewrite gpow_e_order_is_e; auto with zarith. +rewrite gpow_e; auto with zarith. +rewrite G.(e_is_zero_r); auto with zarith. +apply gpow_in; auto. +apply Gauss with (2 := rel_prime_sym _ _ Hab). +apply e_order_divide_gpow; auto with zarith. +rewrite <- (gpow_e _ _ G (e_order A_dec a G)); auto. +rewrite <- (gpow_e_order_is_e _ A_dec _ (op a b) G); auto with zarith. +rewrite <- gpow_gpow; auto with zarith. +rewrite (Zmult_comm (e_order A_dec (op a b) G)). +rewrite gpow_mult; auto with zarith. +rewrite gpow_gpow with (a := a); auto with zarith. +rewrite gpow_e_order_is_e; auto with zarith. +rewrite gpow_e; auto with zarith. +rewrite G.(e_is_zero_l); auto with zarith. +apply gpow_in; auto. +Qed. + +Theorem fermat_gen: forall (A : Set) (A_dec: forall (a b: A), {a = b} + {a <>b}) (op : A -> A -> A) (a: A) (G : FGroup op), + In a G.(s) -> gpow a G (g_order G) = G.(e). +intros A A_dec op a G H. +assert (H1: (e_order A_dec a G | g_order G)). +apply e_order_divide_g_order; auto. +case H1; intros q; intros Hq; rewrite Hq. +assert (Hq1: 0 <= q). +apply Zmult_le_reg_r with (e_order A_dec a G); auto with zarith. +apply Zlt_gt; apply e_order_pos. +rewrite Zmult_0_l; rewrite <- Hq; apply Zlt_le_weak; apply g_order_pos. +rewrite Zmult_comm; rewrite gpow_gpow; auto with zarith. +rewrite gpow_e_order_is_e; auto with zarith. +apply gpow_e; auto. +apply Zlt_le_weak; apply e_order_pos. +Qed. + +Theorem order_div: forall (A : Set) (A_dec: forall (a b: A), {a = b} + {a <>b}) (op : A -> A -> A) (a: A) (G : FGroup op) m, + 0 < m -> (forall p, prime p -> (p | m) -> gpow a G (m / p) <> G.(e)) -> + In a G.(s) -> gpow a G m = G.(e) -> e_order A_dec a G = m. +intros A Adec op a G m Hm H H1 H2. +assert (F1: 0 <= m); auto with zarith. +case (e_order_divide_gpow A Adec op a G H1 m F1 H2); intros q Hq. +assert (F2: 1 <= q). + case (Zle_or_lt 0 q); intros HH. + case (Zle_lt_or_eq _ _ HH); auto with zarith. + intros HH1; generalize Hm; rewrite Hq; rewrite <- HH1; + auto with zarith. + assert (F2: 0 <= (- q) * e_order Adec a G); auto with zarith. + apply Zmult_le_0_compat; auto with zarith. + apply Zlt_le_weak; apply e_order_pos. + generalize F2; rewrite Zopp_mult_distr_l_reverse; + rewrite <- Hq; auto with zarith. +case (Zle_lt_or_eq _ _ F2); intros H3; subst; auto with zarith. +case (prime_dec q); intros Hq. + case (H q); auto with zarith. + rewrite Zmult_comm; rewrite Z_div_mult; auto with zarith. + apply gpow_e_order_is_e; auto. +case (Zdivide_div_prime_le_square _ H3 Hq); intros r (Hr1, (Hr2, Hr3)). +case (H _ Hr1); auto. + apply Zdivide_trans with (1 := Hr2). + apply Zdivide_factor_r. +case Hr2; intros q1 Hq1; subst. +assert (F3: 0 < r). + generalize (prime_ge_2 _ Hr1); auto with zarith. +rewrite <- Zmult_assoc; rewrite Zmult_comm; rewrite <- Zmult_assoc; + rewrite Zmult_comm; rewrite Z_div_mult; auto with zarith. +rewrite gpow_gpow; auto with zarith. + rewrite gpow_e_order_is_e; try rewrite gpow_e; auto. + apply Zmult_le_reg_r with r; auto with zarith. + apply Zlt_le_weak; apply e_order_pos. +apply Zmult_le_reg_r with r; auto with zarith. +Qed. diff --git a/coqprime-8.4/Coqprime/Euler.v b/coqprime-8.4/Coqprime/Euler.v new file mode 100644 index 000000000..e571d8e3c --- /dev/null +++ b/coqprime-8.4/Coqprime/Euler.v @@ -0,0 +1,88 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(************************************************************************ + + Definition of the Euler Totient function + +*************************************************************************) +Require Import Coq.ZArith.ZArith. +Require Export Coq.ZArith.Znumtheory. +Require Import Coqprime.Tactic. +Require Export Coqprime.ZSum. + +Open Scope Z_scope. + +Definition phi n := Zsum 1 (n - 1) (fun x => if rel_prime_dec x n then 1 else 0). + +Theorem phi_def_with_0: + forall n, 1< n -> phi n = Zsum 0 (n - 1) (fun x => if rel_prime_dec x n then 1 else 0). +intros n H; rewrite Zsum_S_left; auto with zarith. +case (rel_prime_dec 0 n); intros H2. +contradict H2; apply not_rel_prime_0; auto. +rewrite Zplus_0_l; auto. +Qed. + +Theorem phi_pos: forall n, 1 < n -> 0 < phi n. +intros n H; unfold phi. +case (Zle_lt_or_eq 2 n); auto with zarith; intros H1; subst. +rewrite Zsum_S_left; simpl; auto with zarith. +case (rel_prime_dec 1 n); intros H2. +apply Zlt_le_trans with (1 + 0); auto with zarith. +apply Zplus_le_compat_l. +pattern 0 at 1; replace 0 with ((1 + (n - 1) - 2) * 0); auto with zarith. +rewrite <- Zsum_c; auto with zarith. +apply Zsum_le; auto with zarith. +intros x H3; case (rel_prime_dec x n); auto with zarith. +case H2; apply rel_prime_1; auto with zarith. +rewrite Zsum_nn. +case (rel_prime_dec (2 - 1) 2); auto with zarith. +intros H1; contradict H1; apply rel_prime_1; auto with zarith. +Qed. + +Theorem phi_le_n_minus_1: forall n, 1 < n -> phi n <= n - 1. +intros n H; replace (n-1) with ((1 + (n - 1) - 1) * 1); auto with zarith. +rewrite <- Zsum_c; auto with zarith. +unfold phi; apply Zsum_le; auto with zarith. +intros x H1; case (rel_prime_dec x n); auto with zarith. +Qed. + +Theorem prime_phi_n_minus_1: forall n, prime n -> phi n = n - 1. +intros n H; replace (n-1) with ((1 + (n - 1) - 1) * 1); auto with zarith. +assert (Hu: 1 <= n - 1). +assert (2 <= n); auto with zarith. +apply prime_ge_2; auto. +rewrite <- Zsum_c; auto with zarith; unfold phi; apply Zsum_ext; auto. +intros x (H2, H3); case H; clear H; intros H H1. +generalize (H1 x); case (rel_prime_dec x n); auto with zarith. +intros H6 H7; contradict H6; apply H7; split; auto with zarith. +Qed. + +Theorem phi_n_minus_1_prime: forall n, 1 < n -> phi n = n - 1 -> prime n. +intros n H H1; case (prime_dec n); auto; intros H2. +assert (H3: phi n < n - 1); auto with zarith. +replace (n-1) with ((1 + (n - 1) - 1) * 1); auto with zarith. +assert (Hu: 1 <= n - 1); auto with zarith. +rewrite <- Zsum_c; auto with zarith; unfold phi; apply Zsum_lt; auto. +intros x _; case (rel_prime_dec x n); auto with zarith. +case not_prime_divide with n; auto. +intros x (H3, H4); exists x; repeat split; auto with zarith. +case (rel_prime_dec x n); auto with zarith. +intros H5; absurd (x = 1 \/ x = -1); auto with zarith. +case (Zis_gcd_unique x n x 1); auto. +apply Zis_gcd_intro; auto; exists 1; auto with zarith. +contradict H3; rewrite H1; auto with zarith. +Qed. + +Theorem phi_divide_prime: forall n, 1 < n -> (n - 1 | phi n) -> prime n. +intros n H1 H2; apply phi_n_minus_1_prime; auto. +apply Zle_antisym. +apply phi_le_n_minus_1; auto. +apply Zdivide_le; auto; auto with zarith. +apply phi_pos; auto. +Qed. diff --git a/coqprime-8.4/Coqprime/FGroup.v b/coqprime-8.4/Coqprime/FGroup.v new file mode 100644 index 000000000..0bcc9ebf1 --- /dev/null +++ b/coqprime-8.4/Coqprime/FGroup.v @@ -0,0 +1,123 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + FGroup.v + + Defintion and properties of finite groups + + Definition: FGroup + **********************************************************************) +Require Import Coq.Lists.List. +Require Import Coqprime.UList. +Require Import Coqprime.Tactic. +Require Import Coq.ZArith.ZArith. + +Open Scope Z_scope. + +Set Implicit Arguments. + +(************************************** + A finite group is defined for an operation op + it has a support (s) + op operates inside the group (internal) + op is associative (assoc) + it has an element (e) that is neutral (e_is_zero_l e_is_zero_r) + it has an inverse operator (i) + the inverse operates inside the group (i_internal) + it gives an inverse (i_is_inverse_l is_is_inverse_r) + **************************************) + +Record FGroup (A: Set) (op: A -> A -> A): Set := mkGroup + {s : (list A); + unique_s: ulist s; + internal: forall a b, In a s -> In b s -> In (op a b) s; + assoc: forall a b c, In a s -> In b s -> In c s -> op a (op b c) = op (op a b) c; + e: A; + e_in_s: In e s; + e_is_zero_l: forall a, In a s -> op e a = a; + e_is_zero_r: forall a, In a s -> op a e = a; + i: A -> A; + i_internal: forall a, In a s -> In (i a) s; + i_is_inverse_l: forall a, (In a s) -> op (i a) a = e; + i_is_inverse_r: forall a, (In a s) -> op a (i a) = e +}. + +(************************************** + The order of a group is the lengh of the support + **************************************) + +Definition g_order (A: Set) (op: A -> A -> A) (g: FGroup op) := Z_of_nat (length g.(s)). + +Unset Implicit Arguments. + +Hint Resolve unique_s internal e_in_s e_is_zero_l e_is_zero_r i_internal + i_is_inverse_l i_is_inverse_r assoc. + + +Section FGroup. + +Variable A: Set. +Variable op: A -> A -> A. + +(************************************** + Some properties of a finite group + **************************************) + +Theorem g_cancel_l: forall (g : FGroup op), forall a b c, In a g.(s) -> In b g.(s) -> In c g.(s) -> op a b = op a c -> b = c. +intros g a b c H1 H2 H3 H4; apply trans_equal with (op g.(e) b); sauto. +replace (g.(e)) with (op (g.(i) a) a); sauto. +apply trans_equal with (op (i g a) (op a b)); sauto. +apply sym_equal; apply assoc with g; auto. +rewrite H4. +apply trans_equal with (op (op (i g a) a) c); sauto. +apply assoc with g; auto. +replace (op (g.(i) a) a) with g.(e); sauto. +Qed. + +Theorem g_cancel_r: forall (g : FGroup op), forall a b c, In a g.(s) -> In b g.(s) -> In c g.(s) -> op b a = op c a -> b = c. +intros g a b c H1 H2 H3 H4; apply trans_equal with (op b g.(e)); sauto. +replace (g.(e)) with (op a (g.(i) a)); sauto. +apply trans_equal with (op (op b a) (i g a)); sauto. +apply assoc with g; auto. +rewrite H4. +apply trans_equal with (op c (op a (i g a))); sauto. +apply sym_equal; apply assoc with g; sauto. +replace (op a (g.(i) a)) with g.(e); sauto. +Qed. + +Theorem e_unique: forall (g : FGroup op), forall e1, In e1 g.(s) -> (forall a, In a g.(s) -> op e1 a = a) -> e1 = g.(e). +intros g e1 He1 H2. +apply trans_equal with (op e1 g.(e)); sauto. +Qed. + +Theorem inv_op: forall (g: FGroup op) a b, In a g.(s) -> In b g.(s) -> g.(i) (op a b) = op (g.(i) b) (g.(i) a). +intros g a1 b1 H1 H2; apply g_cancel_l with (g := g) (a := op a1 b1); sauto. +repeat rewrite g.(assoc); sauto. +apply trans_equal with g.(e); sauto. +rewrite <- g.(assoc) with (a := a1); sauto. +rewrite g.(i_is_inverse_r); sauto. +rewrite g.(e_is_zero_r); sauto. +Qed. + +Theorem i_e: forall (g: FGroup op), g.(i) g.(e) = g.(e). +intro g; apply g_cancel_l with (g:= g) (a := g.(e)); sauto. +apply trans_equal with g.(e); sauto. +Qed. + +(************************************** + A group has at least one element + **************************************) + +Theorem g_order_pos: forall g: FGroup op, 0 < g_order g. +intro g; generalize g.(e_in_s); unfold g_order; case g.(s); simpl; auto with zarith. +Qed. + + + +End FGroup. diff --git a/coqprime-8.4/Coqprime/IGroup.v b/coqprime-8.4/Coqprime/IGroup.v new file mode 100644 index 000000000..04219be5a --- /dev/null +++ b/coqprime-8.4/Coqprime/IGroup.v @@ -0,0 +1,253 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + Igroup + + Build the group of the inversible elements for the operation + + Definition: ZpGroup + **********************************************************************) +Require Import Coq.ZArith.ZArith. +Require Import Coqprime.Tactic. +Require Import Coq.Arith.Wf_nat. +Require Import Coqprime.UList. +Require Import Coqprime.ListAux. +Require Import Coqprime.FGroup. + +Open Scope Z_scope. + +Section IG. + +Variable A: Set. +Variable op: A -> A -> A. +Variable support: list A. +Variable e: A. + +Hypothesis A_dec: forall a b: A, {a = b} + {a <> b}. +Hypothesis support_ulist: ulist support. +Hypothesis e_in_support: In e support. +Hypothesis op_internal: forall a b, In a support -> In b support -> In (op a b) support. +Hypothesis op_assoc: forall a b c, In a support -> In b support -> In c support -> op a (op b c) = op (op a b) c. +Hypothesis e_is_zero_l: forall a, In a support -> op e a = a. +Hypothesis e_is_zero_r: forall a, In a support -> op a e = a. + +(************************************** + is_inv_aux tests if there is an inverse of a for op in l + **************************************) + +Fixpoint is_inv_aux (l: list A) (a: A) {struct l}: bool := + match l with nil => false | cons b l1 => + if (A_dec (op a b) e) then if (A_dec (op b a) e) then true else is_inv_aux l1 a else is_inv_aux l1 a + end. + +Theorem is_inv_aux_false: forall b l, (forall a, (In a l) -> op b a <> e \/ op a b <> e) -> is_inv_aux l b = false. +intros b l; elim l; simpl; auto. +intros a l1 Rec H; case (A_dec (op a b) e); case (A_dec (op b a) e); auto. +intros H1 H2; case (H a); auto; intros H3; case H3; auto. +Qed. + +(************************************** + is_inv tests if there is an inverse in support + **************************************) +Definition is_inv := is_inv_aux support. + +(************************************** + isupport_aux returns the sublist of inversible element of support + **************************************) + +Fixpoint isupport_aux (l: list A) : list A := + match l with nil => nil | cons a l1 => if is_inv a then a::isupport_aux l1 else isupport_aux l1 end. + +(************************************** + Some properties of isupport_aux + **************************************) + +Theorem isupport_aux_is_inv_true: forall l a, In a (isupport_aux l) -> is_inv a = true. +intros l a; elim l; simpl; auto. +intros b l1 H; case_eq (is_inv b); intros H1; simpl; auto. +intros [H2 | H2]; subst; auto. +Qed. + +Theorem isupport_aux_is_in: forall l a, is_inv a = true -> In a l -> In a (isupport_aux l). +intros l a; elim l; simpl; auto. +intros b l1 Rec H [H1 | H1]; subst. +rewrite H; auto with datatypes. +case (is_inv b); auto with datatypes. +Qed. + + +Theorem isupport_aux_not_in: + forall b l, (forall a, (In a support) -> op b a <> e \/ op a b <> e) -> ~ In b (isupport_aux l). +intros b l; elim l; simpl; simpl; auto. +intros a l1 H; case_eq (is_inv a); intros H1; simpl; auto. +intros H2 [H3 | H3]; subst. +contradict H1. +unfold is_inv; rewrite is_inv_aux_false; auto. +case H; auto; apply isupport_aux_is_in; auto. +Qed. + +Theorem isupport_aux_incl: forall l, incl (isupport_aux l) l. +intros l; elim l; simpl; auto with datatypes. +intros a l1 H1; case (is_inv a); auto with datatypes. +Qed. + +Theorem isupport_aux_ulist: forall l, ulist l -> ulist (isupport_aux l). +intros l; elim l; simpl; auto with datatypes. +intros a l1 H1 H2; case_eq (is_inv a); intros H3; auto with datatypes. +apply ulist_cons; auto with datatypes. +intros H4; apply (ulist_app_inv _ (a::nil) l1 a); auto with datatypes. +apply (isupport_aux_incl l1 a); auto. +apply H1; apply ulist_app_inv_r with (a:: nil); auto. +apply H1; apply ulist_app_inv_r with (a:: nil); auto. +Qed. + +(************************************** + isupport is the sublist of inversible element of support + **************************************) + +Definition isupport := isupport_aux support. + +(************************************** + Some properties of isupport + **************************************) + +Theorem isupport_is_inv_true: forall a, In a isupport -> is_inv a = true. +unfold isupport; intros a H; apply isupport_aux_is_inv_true with (1 := H). +Qed. + +Theorem isupport_is_in: forall a, is_inv a = true -> In a support -> In a isupport. +intros a H H1; unfold isupport; apply isupport_aux_is_in; auto. +Qed. + +Theorem isupport_incl: incl isupport support. +unfold isupport; apply isupport_aux_incl. +Qed. + +Theorem isupport_ulist: ulist isupport. +unfold isupport; apply isupport_aux_ulist. +apply support_ulist. +Qed. + +Theorem isupport_length: (length isupport <= length support)%nat. +apply ulist_incl_length. +apply isupport_ulist. +apply isupport_incl. +Qed. + +Theorem isupport_length_strict: + forall b, (In b support) -> (forall a, (In a support) -> op b a <> e \/ op a b <> e) -> + (length isupport < length support)%nat. +intros b H H1; apply ulist_incl_length_strict. +apply isupport_ulist. +apply isupport_incl. +intros H2; case (isupport_aux_not_in b support); auto. +Qed. + +Fixpoint inv_aux (l: list A) (a: A) {struct l}: A := + match l with nil => e | cons b l1 => + if A_dec (op a b) e then if (A_dec (op b a) e) then b else inv_aux l1 a else inv_aux l1 a + end. + +Theorem inv_aux_prop_r: forall l a, is_inv_aux l a = true -> op a (inv_aux l a) = e. +intros l a; elim l; simpl. +intros; discriminate. +intros b l1 H1; case (A_dec (op a b) e); case (A_dec (op b a) e); intros H3 H4; subst; auto. +Qed. + +Theorem inv_aux_prop_l: forall l a, is_inv_aux l a = true -> op (inv_aux l a) a = e. +intros l a; elim l; simpl. +intros; discriminate. +intros b l1 H1; case (A_dec (op a b) e); case (A_dec (op b a) e); intros H3 H4; subst; auto. +Qed. + +Theorem inv_aux_inv: forall l a b, op a b = e -> op b a = e -> (In a l) -> is_inv_aux l b = true. +intros l a b; elim l; simpl. +intros _ _ H; case H. +intros c l1 Rec H H0 H1; case H1; clear H1; intros H1; subst; rewrite H. +case (A_dec (op b a) e); case (A_dec e e); auto. +intros H1 H2; contradict H2; rewrite H0; auto. +case (A_dec (op b c) e); case (A_dec (op c b) e); auto. +Qed. + +Theorem inv_aux_in: forall l a, In (inv_aux l a) l \/ inv_aux l a = e. +intros l a; elim l; simpl; auto. +intros b l1; case (A_dec (op a b) e); case (A_dec (op b a) e); intros _ _ [H1 | H1]; auto. +Qed. + +(************************************** + The inverse function + **************************************) + +Definition inv := inv_aux support. + +(************************************** + Some properties of inv + **************************************) + +Theorem inv_prop_r: forall a, In a isupport -> op a (inv a) = e. +intros a H; unfold inv; apply inv_aux_prop_r with (l := support). +change (is_inv a = true). +apply isupport_is_inv_true; auto. +Qed. + +Theorem inv_prop_l: forall a, In a isupport -> op (inv a) a = e. +intros a H; unfold inv; apply inv_aux_prop_l with (l := support). +change (is_inv a = true). +apply isupport_is_inv_true; auto. +Qed. + +Theorem is_inv_true: forall a b, op b a = e -> op a b = e -> (In a support) -> is_inv b = true. +intros a b H H1 H2; unfold is_inv; apply inv_aux_inv with a; auto. +Qed. + +Theorem is_inv_false: forall b, (forall a, (In a support) -> op b a <> e \/ op a b <> e) -> is_inv b = false. +intros b H; unfold is_inv; apply is_inv_aux_false; auto. +Qed. + +Theorem inv_internal: forall a, In a isupport -> In (inv a) isupport. +intros a H; apply isupport_is_in. +apply is_inv_true with a; auto. +apply inv_prop_l; auto. +apply inv_prop_r; auto. +apply (isupport_incl a); auto. +case (inv_aux_in support a); unfold inv; auto. +intros H1; rewrite H1; apply e_in_support; auto with zarith. +Qed. + +(************************************** + We are now ready to build our group + **************************************) + +Definition IGroup : (FGroup op). +generalize (fun x=> (isupport_incl x)); intros Hx. +apply mkGroup with (s := isupport) (e := e) (i := inv); auto. +apply isupport_ulist. +intros a b H H1. +assert (Haii: In (inv a) isupport); try apply inv_internal; auto. +assert (Hbii: In (inv b) isupport); try apply inv_internal; auto. +apply isupport_is_in; auto. +apply is_inv_true with (op (inv b) (inv a)); auto. +rewrite op_assoc; auto. +rewrite <- (op_assoc a); auto. +rewrite inv_prop_r; auto. +rewrite e_is_zero_r; auto. +apply inv_prop_r; auto. +rewrite <- (op_assoc (inv b)); auto. +rewrite (op_assoc (inv a)); auto. +rewrite inv_prop_l; auto. +rewrite e_is_zero_l; auto. +apply inv_prop_l; auto. +apply isupport_is_in; auto. +apply is_inv_true with e; auto. +intros a H; apply inv_internal; auto. +intros; apply inv_prop_l; auto. +intros; apply inv_prop_r; auto. +Defined. + +End IG. diff --git a/coqprime-8.4/Coqprime/Iterator.v b/coqprime-8.4/Coqprime/Iterator.v new file mode 100644 index 000000000..e84687cd4 --- /dev/null +++ b/coqprime-8.4/Coqprime/Iterator.v @@ -0,0 +1,180 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +Require Export Coq.Lists.List. +Require Export Coqprime.Permutation. +Require Import Coq.Arith.Arith. + +Section Iterator. +Variables A B : Set. +Variable zero : B. +Variable f : A -> B. +Variable g : B -> B -> B. +Hypothesis g_zero : forall a, g a zero = a. +Hypothesis g_trans : forall a b c, g a (g b c) = g (g a b) c. +Hypothesis g_sym : forall a b, g a b = g b a. + +Definition iter := fold_right (fun a r => g (f a) r) zero. +Hint Unfold iter . + +Theorem iter_app: forall l1 l2, iter (app l1 l2) = g (iter l1) (iter l2). +intros l1; elim l1; simpl; auto. +intros l2; rewrite g_sym; auto. +intros a l H l2; rewrite H. +rewrite g_trans; auto. +Qed. + +Theorem iter_permutation: forall l1 l2, permutation l1 l2 -> iter l1 = iter l2. +intros l1 l2 H; elim H; simpl; auto; clear H l1 l2. +intros a l1 l2 H1 H2; apply f_equal2 with ( f := g ); auto. +intros a b l; (repeat rewrite g_trans). +apply f_equal2 with ( f := g ); auto. +intros l1 l2 l3 H H0 H1 H2; apply trans_equal with ( 1 := H0 ); auto. +Qed. + +Lemma iter_inv: + forall P l, + P zero -> + (forall a b, P a -> P b -> P (g a b)) -> + (forall x, In x l -> P (f x)) -> P (iter l). +intros P l H H0; (elim l; simpl; auto). +Qed. +Variable next : A -> A. + +Fixpoint progression (m : A) (n : nat) {struct n} : list A := + match n with 0 => nil + | S n1 => cons m (progression (next m) n1) end. + +Fixpoint next_n (c : A) (n : nat) {struct n} : A := + match n with 0 => c | S n1 => next_n (next c) n1 end. + +Theorem progression_app: + forall a b n m, + le m n -> + b = next_n a m -> + progression a n = app (progression a m) (progression b (n - m)). +intros a b n m; generalize a b n; clear a b n; elim m; clear m; simpl. +intros a b n H H0; apply f_equal2 with ( f := progression ); auto with arith. +intros m H a b n; case n; simpl; clear n. +intros H1; absurd (0 < 1 + m); auto with arith. +intros n H0 H1; apply f_equal2 with ( f := @cons A ); auto with arith. +Qed. + +Let iter_progression := fun m n => iter (progression m n). + +Theorem iter_progression_app: + forall a b n m, + le m n -> + b = next_n a m -> + iter (progression a n) = + g (iter (progression a m)) (iter (progression b (n - m))). +intros a b n m H H0; unfold iter_progression; rewrite (progression_app a b n m); + (try apply iter_app); auto. +Qed. + +Theorem length_progression: forall z n, length (progression z n) = n. +intros z n; generalize z; elim n; simpl; auto. +Qed. + +End Iterator. +Implicit Arguments iter [A B]. +Implicit Arguments progression [A]. +Implicit Arguments next_n [A]. +Hint Unfold iter . +Hint Unfold progression . +Hint Unfold next_n . + +Theorem iter_ext: + forall (A B : Set) zero (f1 : A -> B) f2 g l, + (forall a, In a l -> f1 a = f2 a) -> iter zero f1 g l = iter zero f2 g l. +intros A B zero f1 f2 g l; elim l; simpl; auto. +intros a l0 H H0; apply f_equal2 with ( f := g ); auto. +Qed. + +Theorem iter_map: + forall (A B C : Set) zero (f : B -> C) g (k : A -> B) l, + iter zero f g (map k l) = iter zero (fun x => f (k x)) g l. +intros A B C zero f g k l; elim l; simpl; auto. +intros; apply f_equal2 with ( f := g ); auto with arith. +Qed. + +Theorem iter_comp: + forall (A B : Set) zero (f1 f2 : A -> B) g l, + (forall a, g a zero = a) -> + (forall a b c, g a (g b c) = g (g a b) c) -> + (forall a b, g a b = g b a) -> + g (iter zero f1 g l) (iter zero f2 g l) = + iter zero (fun x => g (f1 x) (f2 x)) g l. +intros A B zero f1 f2 g l g_zero g_trans g_sym; elim l; simpl; auto. +intros a l0 H; rewrite <- H; (repeat rewrite <- g_trans). +apply f_equal2 with ( f := g ); auto. +(repeat rewrite g_trans); apply f_equal2 with ( f := g ); auto. +Qed. + +Theorem iter_com: + forall (A B : Set) zero (f : A -> A -> B) g l1 l2, + (forall a, g a zero = a) -> + (forall a b c, g a (g b c) = g (g a b) c) -> + (forall a b, g a b = g b a) -> + iter zero (fun x => iter zero (fun y => f x y) g l1) g l2 = + iter zero (fun y => iter zero (fun x => f x y) g l2) g l1. +intros A B zero f g l1 l2 H H0 H1; generalize l2; elim l1; simpl; auto; + clear l1 l2. +intros l2; elim l2; simpl; auto with arith. +intros; rewrite H1; rewrite H; auto with arith. +intros a l1 H2 l2; case l2; clear l2; simpl; auto. +elim l1; simpl; auto with arith. +intros; rewrite H1; rewrite H; auto with arith. +intros b l2. +rewrite <- (iter_comp + _ _ zero (fun x => f x a) + (fun x => iter zero (fun (y : A) => f x y) g l1)); auto with arith. +rewrite <- (iter_comp + _ _ zero (fun y => f b y) + (fun y => iter zero (fun (x : A) => f x y) g l2)); auto with arith. +(repeat rewrite H0); auto. +apply f_equal2 with ( f := g ); auto. +(repeat rewrite <- H0); auto. +apply f_equal2 with ( f := g ); auto. +Qed. + +Theorem iter_comp_const: + forall (A B : Set) zero (f : A -> B) g k l, + k zero = zero -> + (forall a b, k (g a b) = g (k a) (k b)) -> + k (iter zero f g l) = iter zero (fun x => k (f x)) g l. +intros A B zero f g k l H H0; elim l; simpl; auto. +intros a l0 H1; rewrite H0; apply f_equal2 with ( f := g ); auto. +Qed. + +Lemma next_n_S: forall n m, next_n S n m = plus n m. +intros n m; generalize n; elim m; clear n m; simpl; auto with arith. +intros m H n; case n; simpl; auto with arith. +rewrite H; auto with arith. +intros n1; rewrite H; simpl; auto with arith. +Qed. + +Theorem progression_S_le_init: + forall n m p, In p (progression S n m) -> le n p. +intros n m; generalize n; elim m; clear n m; simpl; auto. +intros; contradiction. +intros m H n p [H1|H1]; auto with arith. +subst n; auto. +apply le_S_n; auto with arith. +Qed. + +Theorem progression_S_le_end: + forall n m p, In p (progression S n m) -> lt p (n + m). +intros n m; generalize n; elim m; clear n m; simpl; auto. +intros; contradiction. +intros m H n p [H1|H1]; auto with arith. +subst n; auto with arith. +rewrite <- plus_n_Sm; auto with arith. +rewrite <- plus_n_Sm; auto with arith. +generalize (H (S n) p); auto with arith. +Qed. diff --git a/coqprime-8.4/Coqprime/Lagrange.v b/coqprime-8.4/Coqprime/Lagrange.v new file mode 100644 index 000000000..b890c5621 --- /dev/null +++ b/coqprime-8.4/Coqprime/Lagrange.v @@ -0,0 +1,179 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + Lagrange.v + + Proof of Lagrange theorem: + the oder of a subgroup divides the order of a group + + Definition: lagrange + **********************************************************************) +Require Import Coq.Lists.List. +Require Import Coqprime.UList. +Require Import Coqprime.ListAux. +Require Import Coq.ZArith.ZArith Coq.ZArith.Znumtheory. +Require Import Coqprime.NatAux. +Require Import Coqprime.FGroup. + +Open Scope Z_scope. + +Section Lagrange. + +Variable A: Set. + +Variable A_dec: forall a b: A, {a = b} + {~ a = b}. + +Variable op: A -> A -> A. + +Variable G: (FGroup op). + +Variable H:(FGroup op). + +Hypothesis G_in_H: (incl G.(s) H.(s)). + +(************************************** + A group and a subgroup have the same neutral element + **************************************) + +Theorem same_e_for_H_and_G: H.(e) = G.(e). +apply trans_equal with (op H.(e) H.(e)); sauto. +apply trans_equal with (op H.(e) (op G.(e) (H.(i) G.(e)))); sauto. +eq_tac; sauto. +apply trans_equal with (op G.(e) (op G.(e) (H.(i) G.(e)))); sauto. +repeat rewrite H.(assoc); sauto. +eq_tac; sauto. +apply trans_equal with G.(e); sauto. +apply trans_equal with (op G.(e) H.(e)); sauto. +eq_tac; sauto. +Qed. + +(************************************** + The proof works like this. + If G = {e, g1, g2, g3, .., gn} and {e, h1, h2, h3, ..., hm} + we construct the list mkGH + {e, g1, g2, g3, ...., gn + hi*e, hi * g1, hi * g2, ..., hi * gn if hi does not appear before + .... + hk*e, hk * g1, hk * g2, ..., hk * gn if hk does not appear before + } + that contains all the element of H. + We show that this list does not contain double (ulist). + **************************************) + +Fixpoint mkList (base l: (list A)) { struct l} : (list A) := + match l with + nil => nil + | cons a l1 => let r1 := mkList base l1 in + if (In_dec A_dec a r1) then r1 else + (map (op a) base) ++ r1 + end. + +Definition mkGH := mkList G.(s) H.(s). + +Theorem mkGH_length: divide (length G.(s)) (length mkGH). +unfold mkGH; elim H.(s); simpl. +exists 0%nat; auto with arith. +intros a l1 (c, H1); case (In_dec A_dec a (mkList G.(s) l1)); intros H2. +exists c; auto. +exists (1 + c)%nat; rewrite ListAux.length_app; rewrite ListAux.length_map; rewrite H1; ring. +Qed. + +Theorem mkGH_incl: incl H.(s) mkGH. +assert (H1: forall l, incl l H.(s) -> incl l (mkList G.(s) l)). +intros l; elim l; simpl; auto with datatypes. +intros a l1 H1 H2. +case (In_dec A_dec a (mkList (s G) l1)); auto with datatypes. +intros H3; assert (H4: incl l1 (mkList (s G) l1)). +apply H1; auto with datatypes. +intros b H4; apply H2; auto with datatypes. +intros b; simpl; intros [H5 | H5]; subst; auto. +intros _ b; simpl; intros [H3 | H3]; subst; auto. +apply in_or_app; left. +cut (In H.(e) G.(s)). +elim (s G); simpl; auto. +intros c l2 Hl2 [H3 | H3]; subst; sauto. +assert (In b H.(s)); sauto. +apply (H2 b); auto with datatypes. +rewrite same_e_for_H_and_G; sauto. +apply in_or_app; right. +apply H1; auto with datatypes. +apply incl_tran with (2:= H2); auto with datatypes. +unfold mkGH; apply H1; auto with datatypes. +Qed. + +Theorem incl_mkGH: incl mkGH H.(s). +assert (H1: forall l, incl l H.(s) -> incl (mkList G.(s) l) H.(s)). +intros l; elim l; simpl; auto with datatypes. +intros a l1 H1 H2. +case (In_dec A_dec a (mkList (s G) l1)); intros H3; auto with datatypes. +apply H1; apply incl_tran with (2 := H2); auto with datatypes. +apply incl_app. +intros b H4. +case ListAux.in_map_inv with (1:= H4); auto. +intros c (Hc1, Hc2); subst; sauto. +apply internal; auto with datatypes. +apply H1; apply incl_tran with (2 := H2); auto with datatypes. +unfold mkGH; apply H1; auto with datatypes. +Qed. + +Theorem ulist_mkGH: ulist mkGH. +assert (H1: forall l, incl l H.(s) -> ulist (mkList G.(s) l)). +intros l; elim l; simpl; auto with datatypes. +intros a l1 H1 H2. +case (In_dec A_dec a (mkList (s G) l1)); intros H3; auto with datatypes. +apply H1; apply incl_tran with (2 := H2); auto with datatypes. +apply ulist_app; auto. +apply ulist_map; sauto. +intros x y H4 H5 H6; apply g_cancel_l with (g:= H) (a := a); sauto. +apply H2; auto with datatypes. +apply H1; apply incl_tran with (2 := H2); auto with datatypes. +intros b H4 H5. +case ListAux.in_map_inv with (1:= H4); auto. +intros c (Hc, Hc1); subst. +assert (H6: forall l a b, In b G.(s) -> incl l H.(s) -> In a (mkList G.(s) l) -> In (op a b) (mkList G.(s) l)). +intros ll u v; elim ll; simpl; auto with datatypes. +intros w ll1 T0 T1 T2. +case (In_dec A_dec w (mkList (s G) ll1)); intros T3 T4; auto with datatypes. +apply T0; auto; apply incl_tran with (2:= T2); auto with datatypes. +case in_app_or with (1 := T4); intros T5; auto with datatypes. +apply in_or_app; left. +case ListAux.in_map_inv with (1:= T5); auto. +intros z (Hz1, Hz2); subst. +replace (op (op w z) v) with (op w (op z v)); sauto. +apply in_map; sauto. +apply assoc with H; auto with datatypes. +apply in_or_app; right; auto with datatypes. +apply T0; try apply incl_tran with (2 := T2); auto with datatypes. +case H3; replace a with (op (op a c) (G.(i) c)); auto with datatypes. +apply H6; sauto. +apply incl_tran with (2 := H2); auto with datatypes. +apply trans_equal with (op a (op c (G.(i) c))); sauto. +apply sym_equal; apply assoc with H; auto with datatypes. +replace (op c (G.(i) c)) with (G.(e)); sauto. +rewrite <- same_e_for_H_and_G. +assert (In a H.(s)); sauto; apply (H2 a); auto with datatypes. +unfold mkGH; apply H1; auto with datatypes. +Qed. + +(************************************** + Lagrange theorem + **************************************) + +Theorem lagrange: (g_order G | (g_order H)). +unfold g_order. +rewrite Permutation.permutation_length with (l := H.(s)) (m:= mkGH). +case mkGH_length; intros x H1; exists (Z_of_nat x). +rewrite H1; rewrite Zmult_comm; apply inj_mult. +apply ulist_incl2_permutation; auto. +apply ulist_mkGH. +apply mkGH_incl. +apply incl_mkGH. +Qed. + +End Lagrange. diff --git a/coqprime-8.4/Coqprime/ListAux.v b/coqprime-8.4/Coqprime/ListAux.v new file mode 100644 index 000000000..4ed154685 --- /dev/null +++ b/coqprime-8.4/Coqprime/ListAux.v @@ -0,0 +1,271 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + Aux.v + + Auxillary functions & Theorems + **********************************************************************) +Require Export Coq.Lists.List. +Require Export Coq.Arith.Arith. +Require Export Coqprime.Tactic. +Require Import Coq.Wellfounded.Inverse_Image. +Require Import Coq.Arith.Wf_nat. + +(************************************** + Some properties on list operators: app, map,... +**************************************) + +Section List. +Variables (A : Set) (B : Set) (C : Set). +Variable f : A -> B. + +(************************************** + An induction theorem for list based on length +**************************************) + +Theorem list_length_ind: + forall (P : list A -> Prop), + (forall (l1 : list A), + (forall (l2 : list A), length l2 < length l1 -> P l2) -> P l1) -> + forall (l : list A), P l. +intros P H l; + apply well_founded_ind with ( R := fun (x y : list A) => length x < length y ); + auto. +apply wf_inverse_image with ( R := lt ); auto. +apply lt_wf. +Qed. + +Definition list_length_induction: + forall (P : list A -> Set), + (forall (l1 : list A), + (forall (l2 : list A), length l2 < length l1 -> P l2) -> P l1) -> + forall (l : list A), P l. +intros P H l; + apply well_founded_induction + with ( R := fun (x y : list A) => length x < length y ); auto. +apply wf_inverse_image with ( R := lt ); auto. +apply lt_wf. +Qed. + +Theorem in_ex_app: + forall (a : A) (l : list A), + In a l -> (exists l1 : list A , exists l2 : list A , l = l1 ++ (a :: l2) ). +intros a l; elim l; clear l; simpl; auto. +intros H; case H. +intros a1 l H [H1|H1]; auto. +exists (nil (A:=A)); exists l; simpl; auto. +rewrite H1; auto. +case H; auto; intros l1 [l2 Hl2]; exists (a1 :: l1); exists l2; simpl; auto. +rewrite Hl2; auto. +Qed. + +(************************************** + Properties on app +**************************************) + +Theorem length_app: + forall (l1 l2 : list A), length (l1 ++ l2) = length l1 + length l2. +intros l1; elim l1; simpl; auto. +Qed. + +Theorem app_inv_head: + forall (l1 l2 l3 : list A), l1 ++ l2 = l1 ++ l3 -> l2 = l3. +intros l1; elim l1; simpl; auto. +intros a l H l2 l3 H0; apply H; injection H0; auto. +Qed. + +Theorem app_inv_tail: + forall (l1 l2 l3 : list A), l2 ++ l1 = l3 ++ l1 -> l2 = l3. +intros l1 l2; generalize l1; elim l2; clear l1 l2; simpl; auto. +intros l1 l3; case l3; auto. +intros b l H; absurd (length ((b :: l) ++ l1) <= length l1). +simpl; rewrite length_app; auto with arith. +rewrite <- H; auto with arith. +intros a l H l1 l3; case l3. +simpl; intros H1; absurd (length (a :: (l ++ l1)) <= length l1). +simpl; rewrite length_app; auto with arith. +rewrite H1; auto with arith. +simpl; intros b l0 H0; injection H0. +intros H1 H2; rewrite H2, (H _ _ H1); auto. +Qed. + +Theorem app_inv_app: + forall l1 l2 l3 l4 a, + l1 ++ l2 = l3 ++ (a :: l4) -> + (exists l5 : list A , l1 = l3 ++ (a :: l5) ) \/ + (exists l5 , l2 = l5 ++ (a :: l4) ). +intros l1; elim l1; simpl; auto. +intros l2 l3 l4 a H; right; exists l3; auto. +intros a l H l2 l3 l4 a0; case l3; simpl. +intros H0; left; exists l; injection H0; intros; subst; auto. +intros b l0 H0; case (H l2 l0 l4 a0); auto. +injection H0; auto. +intros [l5 H1]. +left; exists l5; injection H0; intros; subst; auto. +Qed. + +Theorem app_inv_app2: + forall l1 l2 l3 l4 a b, + l1 ++ l2 = l3 ++ (a :: (b :: l4)) -> + (exists l5 : list A , l1 = l3 ++ (a :: (b :: l5)) ) \/ + ((exists l5 , l2 = l5 ++ (a :: (b :: l4)) ) \/ + l1 = l3 ++ (a :: nil) /\ l2 = b :: l4). +intros l1; elim l1; simpl; auto. +intros l2 l3 l4 a b H; right; left; exists l3; auto. +intros a l H l2 l3 l4 a0 b; case l3; simpl. +case l; simpl. +intros H0; right; right; injection H0; split; auto. +rewrite H2; auto. +intros b0 l0 H0; left; exists l0; injection H0; intros; subst; auto. +intros b0 l0 H0; case (H l2 l0 l4 a0 b); auto. +injection H0; auto. +intros [l5 HH1]; left; exists l5; injection H0; intros; subst; auto. +intros [H1|[H1 H2]]; auto. +right; right; split; auto; injection H0; intros; subst; auto. +Qed. + +Theorem same_length_ex: + forall (a : A) l1 l2 l3, + length (l1 ++ (a :: l2)) = length l3 -> + (exists l4 , + exists l5 , + exists b : B , + length l1 = length l4 /\ (length l2 = length l5 /\ l3 = l4 ++ (b :: l5)) ). +intros a l1; elim l1; simpl; auto. +intros l2 l3; case l3; simpl; (try (intros; discriminate)). +intros b l H; exists (nil (A:=B)); exists l; exists b; (repeat (split; auto)). +intros a0 l H l2 l3; case l3; simpl; (try (intros; discriminate)). +intros b l0 H0. +case (H l2 l0); auto. +intros l4 [l5 [b1 [HH1 [HH2 HH3]]]]. +exists (b :: l4); exists l5; exists b1; (repeat (simpl; split; auto)). +rewrite HH3; auto. +Qed. + +(************************************** + Properties on map +**************************************) + +Theorem in_map_inv: + forall (b : B) (l : list A), + In b (map f l) -> (exists a : A , In a l /\ b = f a ). +intros b l; elim l; simpl; auto. +intros tmp; case tmp. +intros a0 l0 H [H1|H1]; auto. +exists a0; auto. +case (H H1); intros a1 [H2 H3]; exists a1; auto. +Qed. + +Theorem in_map_fst_inv: + forall a (l : list (B * C)), + In a (map (fst (B:=_)) l) -> (exists c , In (a, c) l ). +intros a l; elim l; simpl; auto. +intros H; case H. +intros a0 l0 H [H0|H0]; auto. +exists (snd a0); left; rewrite <- H0; case a0; simpl; auto. +case H; auto; intros l1 Hl1; exists l1; auto. +Qed. + +Theorem length_map: forall l, length (map f l) = length l. +intros l; elim l; simpl; auto. +Qed. + +Theorem map_app: forall l1 l2, map f (l1 ++ l2) = map f l1 ++ map f l2. +intros l; elim l; simpl; auto. +intros a l0 H l2; rewrite H; auto. +Qed. + +Theorem map_length_decompose: + forall l1 l2 l3 l4, + length l1 = length l2 -> + map f (app l1 l3) = app l2 l4 -> map f l1 = l2 /\ map f l3 = l4. +intros l1; elim l1; simpl; auto; clear l1. +intros l2; case l2; simpl; auto. +intros; discriminate. +intros a l1 Rec l2; case l2; simpl; clear l2; auto. +intros; discriminate. +intros b l2 l3 l4 H1 H2. +injection H2; clear H2; intros H2 H3. +case (Rec l2 l3 l4); auto. +intros H4 H5; split; auto. +subst; auto. +Qed. + +(************************************** + Properties of flat_map +**************************************) + +Theorem in_flat_map: + forall (l : list B) (f : B -> list C) a b, + In a (f b) -> In b l -> In a (flat_map f l). +intros l g; elim l; simpl; auto. +intros a l0 H a0 b H0 [H1|H1]; apply in_or_app; auto. +left; rewrite H1; auto. +right; apply H with ( b := b ); auto. +Qed. + +Theorem in_flat_map_ex: + forall (l : list B) (f : B -> list C) a, + In a (flat_map f l) -> (exists b , In b l /\ In a (f b) ). +intros l g; elim l; simpl; auto. +intros a H; case H. +intros a l0 H a0 H0; case in_app_or with ( 1 := H0 ); simpl; auto. +intros H1; exists a; auto. +intros H1; case H with ( 1 := H1 ). +intros b [H2 H3]; exists b; simpl; auto. +Qed. + +(************************************** + Properties of fold_left +**************************************) + +Theorem fold_left_invol: + forall (f: A -> B -> A) (P: A -> Prop) l a, + P a -> (forall x y, P x -> P (f x y)) -> P (fold_left f l a). +intros f1 P l; elim l; simpl; auto. +Qed. + +Theorem fold_left_invol_in: + forall (f: A -> B -> A) (P: A -> Prop) l a b, + In b l -> (forall x, P (f x b)) -> (forall x y, P x -> P (f x y)) -> + P (fold_left f l a). +intros f1 P l; elim l; simpl; auto. +intros a1 b HH; case HH. +intros a1 l1 Rec a2 b [V|V] V1 V2; subst; auto. +apply fold_left_invol; auto. +apply Rec with (b := b); auto. +Qed. + +End List. + + +(************************************** + Propertie of list_prod +**************************************) + +Theorem length_list_prod: + forall (A : Set) (l1 l2 : list A), + length (list_prod l1 l2) = length l1 * length l2. +intros A l1 l2; elim l1; simpl; auto. +intros a l H; rewrite length_app; rewrite length_map; rewrite H; auto. +Qed. + +Theorem in_list_prod_inv: + forall (A B : Set) a l1 l2, + In a (list_prod l1 l2) -> + (exists b : A , exists c : B , a = (b, c) /\ (In b l1 /\ In c l2) ). +intros A B a l1 l2; elim l1; simpl; auto; clear l1. +intros H; case H. +intros a1 l1 H1 H2. +case in_app_or with ( 1 := H2 ); intros H3; auto. +case in_map_inv with ( 1 := H3 ); intros b1 [Hb1 Hb2]; auto. +exists a1; exists b1; split; auto. +case H1; auto; intros b1 [c1 [Hb1 [Hb2 Hb3]]]. +exists b1; exists c1; split; auto. +Qed. diff --git a/coqprime-8.4/Coqprime/LucasLehmer.v b/coqprime-8.4/Coqprime/LucasLehmer.v new file mode 100644 index 000000000..c459195a8 --- /dev/null +++ b/coqprime-8.4/Coqprime/LucasLehmer.v @@ -0,0 +1,597 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + LucasLehamer.v + + Build the sequence for the primality test of Mersenne numbers + + Definition: LucasLehmer + **********************************************************************) +Require Import Coq.ZArith.ZArith. +Require Import Coqprime.ZCAux. +Require Import Coqprime.Tactic. +Require Import Coq.Arith.Wf_nat. +Require Import Coqprime.NatAux. +Require Import Coqprime.UList. +Require Import Coqprime.ListAux. +Require Import Coqprime.FGroup. +Require Import Coqprime.EGroup. +Require Import Coqprime.PGroup. +Require Import Coqprime.IGroup. + +Open Scope Z_scope. + +(************************************** + The seeds of the serie + **************************************) + +Definition w := (2, 1). + +Definition v := (2, -1). + +Theorem w_plus_v: pplus w v = (4, 0). +simpl; auto. +Qed. + +Theorem w_mult_v : pmult w v = (1, 0). +simpl; auto. +Qed. + +(************************************** + Definition of the power function for pairs p^n + **************************************) + +Definition ppow p n := match n with Zpos q => iter_pos q _ (pmult p) (1, 0) | _ => (1, 0) end. + +(************************************** + Some properties of ppow + **************************************) + +Theorem ppow_0: forall n, ppow n 0 = (1, 0). +simpl; auto. +Qed. + +Theorem ppow_1: forall n, ppow (1, 0) n = (1, 0). +intros n; case n; simpl; auto. +intros p; apply iter_pos_invariant with (Inv := fun x => x = (1, 0)); auto. +intros x H; rewrite H; auto. +Qed. + +Theorem ppow_op: forall a b p, iter_pos p _ (pmult a) b = pmult (iter_pos p _ (pmult a) (1, 0)) b. +intros a b p; generalize b; elim p; simpl; auto; clear b p. +intros p Rec b. +rewrite (Rec b). +try rewrite (fun x y => Rec (pmult x y)); try rewrite (fun x y => Rec (iter_pos p _ x y)); auto. +repeat rewrite pmult_assoc; auto. +intros p Rec b. +rewrite (Rec b); try rewrite (fun x y => Rec (pmult x y)); try rewrite (fun x y => Rec (iter_pos p _ x y)); auto. +repeat rewrite pmult_assoc; auto. +intros b; rewrite pmult_1_r; auto. +Qed. + +Theorem ppow_add: forall n m p, 0 <= m -> 0 <= p -> ppow n (m + p) = pmult (ppow n m) (ppow n p). +intros n m; case m; clear m. +intros p _ _; rewrite ppow_0; rewrite pmult_1_l; auto. +2: intros p m H; contradict H; auto with zarith. +intros p1 m _; case m. +intros _; rewrite Zplus_0_r; simpl; apply sym_equal; apply pmult_1_r. +2: intros p2 H; contradict H; auto with zarith. +intros p2 _; simpl. +rewrite iter_pos_plus. +rewrite ppow_op; auto. +Qed. + +Theorem ppow_ppow: forall n m p, 0 <= n -> 0 <= m -> ppow p (n * m ) = ppow (ppow p n) m. +intros n m; case n. +intros p _ Hm; rewrite Zmult_0_l. +rewrite ppow_0; apply sym_equal; apply ppow_1. +2: intros p p1 H; contradict H; auto with zarith. +intros p1 p _; case m; simpl; auto. +intros p2 _; pattern p2; apply Pind; simpl; auto. +rewrite Pmult_1_r; rewrite pmult_1_r; auto. +intros p3 Rec; rewrite Pplus_one_succ_r; rewrite Pmult_plus_distr_l. +rewrite Pmult_1_r. +simpl; repeat rewrite iter_pos_plus; simpl. +rewrite pmult_1_r. +rewrite ppow_op; try rewrite Rec; auto. +apply sym_equal; apply ppow_op; auto. +Qed. + + +Theorem ppow_mult: forall n m p, 0 <= n -> ppow (pmult m p) n = pmult (ppow m n) (ppow p n). +intros n m p; case n; simpl; auto. +intros p1 _; pattern p1; apply Pind; simpl; auto. +repeat rewrite pmult_1_r; auto. +intros p3 Rec; rewrite Pplus_one_succ_r. +repeat rewrite iter_pos_plus; simpl. +repeat rewrite (fun x y z => ppow_op x (pmult y z)) ; auto. +rewrite Rec. +repeat rewrite pmult_1_r; auto. +repeat rewrite <- pmult_assoc; try eq_tac; auto. +rewrite (fun x y => pmult_comm (iter_pos p3 _ x y) p); auto. +rewrite (pmult_assoc m); try apply pmult_comm; auto. +Qed. + +(************************************** + We can now define our series of pairs s + **************************************) + +Definition s n := pplus (ppow w (2 ^ n)) (ppow v (2 ^ n)). + +(************************************** + Some properties of s + **************************************) + +Theorem s0 : s 0 = (4, 0). +simpl; auto. +Qed. + +Theorem sn_aux: forall n, 0 <= n -> s (n+1) = (pplus (pmult (s n) (s n)) (-2, 0)). +intros n Hn. +assert (Hu: 0 <= 2 ^n); auto with zarith. +set (y := (fst (s n) * fst (s n) - 2, 0)). +unfold s; simpl; rewrite Zpower_exp; auto with zarith. +rewrite Zpower_1_r; rewrite ppow_ppow; auto with zarith. +repeat rewrite pplus_pmult_dist_r || rewrite pplus_pmult_dist_l. +repeat rewrite <- pplus_assoc. +eq_tac; auto. +pattern 2 at 2; replace 2 with (1 + 1); auto with zarith. +rewrite ppow_add; auto with zarith; simpl. +rewrite pmult_1_r; auto. +rewrite Zmult_comm; rewrite ppow_ppow; simpl; auto with zarith. +repeat rewrite <- ppow_mult; auto with zarith. +rewrite (pmult_comm v w); rewrite w_mult_v. +rewrite ppow_1. +repeat rewrite tpower_1. +rewrite pplus_comm; repeat rewrite <- pplus_assoc; +rewrite pplus_comm; repeat rewrite <- pplus_assoc. +simpl; case (ppow (7, -4) (2 ^n)); simpl; intros z1 z2; eq_tac; auto with zarith. +Qed. + +Theorem sn_snd: forall n, snd (s n) = 0. +intros n; case n; simpl; auto. +intros p; pattern p; apply Pind; auto. +intros p1 H; rewrite Zpos_succ_morphism; unfold Zsucc. +rewrite sn_aux; auto with zarith. +generalize H; case (s (Zpos p1)); simpl. +intros x y H1; rewrite H1; auto with zarith. +Qed. + +Theorem sn: forall n, 0 <= n -> s (n+1) = (fst (s n) * fst (s n) -2, 0). +intros n Hn; rewrite sn_aux; generalize (sn_snd n); case (s n); auto. +intros x y H; simpl in H; rewrite H; simpl. +eq_tac; ring. +Qed. + +Theorem sn_w: forall n, 0 <= n -> ppow w (2 ^ (n + 1)) = pplus (pmult (s n) (ppow w (2 ^ n))) (- 1, 0). +intros n H; unfold s; simpl; rewrite Zpower_exp; auto with zarith. +assert (Hu: 0 <= 2 ^n); auto with zarith. +rewrite Zpower_1_r; rewrite ppow_ppow; auto with zarith. +repeat rewrite pplus_pmult_dist_r || rewrite pplus_pmult_dist_l. +pattern 2 at 2; replace 2 with (1 + 1); auto with zarith. +rewrite ppow_add; auto with zarith; simpl. +rewrite pmult_1_r; auto. +repeat rewrite <- ppow_mult; auto with zarith. +rewrite (pmult_comm v w); rewrite w_mult_v. +rewrite ppow_1; simpl. +simpl; case (ppow (7, 4) (2 ^n)); simpl; intros z1 z2; eq_tac; auto with zarith. +Qed. + +Theorem sn_w_next: forall n, 0 <= n -> ppow w (2 ^ (n + 1)) = pplus (pmult (s n) (ppow w (2 ^ n))) (- 1, 0). +intros n H; unfold s; simpl; rewrite Zpower_exp; auto with zarith. +assert (Hu: 0 <= 2 ^n); auto with zarith. +rewrite Zpower_1_r; rewrite ppow_ppow; auto with zarith. +repeat rewrite pplus_pmult_dist_r || rewrite pplus_pmult_dist_l. +pattern 2 at 2; replace 2 with (1 + 1); auto with zarith. +rewrite ppow_add; auto with zarith; simpl. +rewrite pmult_1_r; auto. +repeat rewrite <- ppow_mult; auto with zarith. +rewrite (pmult_comm v w); rewrite w_mult_v. +rewrite ppow_1; simpl. +simpl; case (ppow (7, 4) (2 ^n)); simpl; intros z1 z2; eq_tac; auto with zarith. +Qed. + +Section Lucas. + +Variable p: Z. + +(************************************** + Definition of the mersenne number + **************************************) + +Definition Mp := 2^p -1. + +Theorem mersenne_pos: 1 < p -> 1 < Mp. +intros H; unfold Mp; assert (2 < 2 ^p); auto with zarith. +apply Zlt_le_trans with (2^2); auto with zarith. +refine (refl_equal _). +apply Zpower_le_monotone; auto with zarith. +Qed. + +Hypothesis p_pos2: 2 < p. + +(************************************** + We suppose that the mersenne number divides s + **************************************) + +Hypothesis Mp_divide_sn: (Mp | fst (s (p - 2))). + +Variable q: Z. + +(************************************** + We take a divisor of Mp and shows that Mp <= q^2, hence Mp is prime + **************************************) + +Hypothesis q_divide_Mp: (q | Mp). + +Hypothesis q_pos2: 2 < q. + +Theorem q_pos: 1 < q. +apply Zlt_trans with (2 := q_pos2); auto with zarith. +Qed. + +(************************************** + The definition of the groups of inversible pairs + **************************************) + +Definition pgroup := PGroup q q_pos. + +Theorem w_in_pgroup: (In w pgroup.(FGroup.s)). +generalize q_pos; intros HM. +generalize q_pos2; intros HM2. +assert (H0: 0 < q); auto with zarith. +simpl; apply isupport_is_in; auto. +assert (zpmult q w (2, q - 1) = (1, 0)). +unfold zpmult, w, pmult, base; repeat (rewrite Zmult_1_r || rewrite Zmult_1_l). +eq_tac. +apply trans_equal with ((3 * q + 1) mod q). +eq_tac; auto with zarith. +rewrite Zplus_mod; auto. +rewrite Zmult_mod; auto. +rewrite Z_mod_same; auto with zarith. +rewrite Zmult_0_r; repeat rewrite Zmod_small; auto with zarith. +apply trans_equal with (2 * q mod q). +eq_tac; auto with zarith. +apply Zdivide_mod; auto with zarith; exists 2; auto with zarith. +apply is_inv_true with (2, q - 1); auto. +apply mL_in; auto with zarith. +intros; apply zpmult_1_l; auto with zarith. +intros; apply zpmult_1_r; auto with zarith. +rewrite zpmult_comm; auto. +apply mL_in; auto with zarith. +unfold w; apply mL_in; auto with zarith. +Qed. + +Theorem e_order_divide_order: (e_order P_dec w pgroup | g_order pgroup). +apply e_order_divide_g_order. +apply w_in_pgroup. +Qed. + +Theorem order_lt: g_order pgroup < q * q. +unfold g_order, pgroup, PGroup; simpl. +rewrite <- (Zabs_eq (q * q)); auto with zarith. +rewrite <- (inj_Zabs_nat (q * q)); auto with zarith. +rewrite <- mL_length; auto with zarith. +apply inj_lt; apply isupport_length_strict with (0, 0). +apply mL_ulist. +apply mL_in; auto with zarith. +intros a _; left; rewrite zpmult_0_l; auto with zarith. +intros; discriminate. +Qed. + +(************************************** + The power function zpow: a^n + **************************************) + +Definition zpow a := gpow a pgroup. + +(************************************** + Some properties of zpow + **************************************) + +Theorem zpow_def: + forall a b, In a pgroup.(FGroup.s) -> 0 <= b -> + zpow a b = ((fst (ppow a b)) mod q, (snd (ppow a b)) mod q). +generalize q_pos; intros HM. +generalize q_pos2; intros HM2. +assert (H0: 0 < q); auto with zarith. +intros a b Ha Hb; generalize Hb; pattern b; apply natlike_ind; auto. +intros _; repeat rewrite Zmod_small; auto with zarith. +rewrite ppow_0; simpl; auto with zarith. +unfold zpow; intros n1 H Rec _; unfold Zsucc. +rewrite gpow_add; auto with zarith. +rewrite ppow_add; simpl; try rewrite pmult_1_r; auto with zarith. +rewrite Rec; unfold zpmult; auto with zarith. +case (ppow a n1); case a; unfold pmult, fst, snd. +intros x y z t. +repeat (rewrite Zmult_1_r || rewrite Zmult_0_r || rewrite Zplus_0_r || rewrite Zplus_0_l); eq_tac. +repeat rewrite (fun u v => Zplus_mod (u * v)); auto. +eq_tac; try eq_tac; auto. +repeat rewrite (Zmult_mod z); auto with zarith. +repeat rewrite (fun u v => Zmult_mod (u * v)); auto. +eq_tac; try eq_tac; auto with zarith. +repeat rewrite (Zmult_mod base); auto with zarith. +eq_tac; try eq_tac; auto with zarith. +apply Zmod_mod; auto. +apply Zmod_mod; auto. +repeat rewrite (fun u v => Zplus_mod (u * v)); auto. +eq_tac; try eq_tac; auto. +repeat rewrite (Zmult_mod z); auto with zarith. +repeat rewrite (Zmult_mod t); auto with zarith. +Qed. + +Theorem zpow_w_n_minus_1: zpow w (2 ^ (p - 1)) = (-1 mod q, 0). +generalize q_pos; intros HM. +generalize q_pos2; intros HM2. +assert (H0: 0 < q); auto with zarith. +rewrite zpow_def. +replace (p - 1) with ((p - 2) + 1); auto with zarith. +rewrite sn_w; auto with zarith. +generalize Mp_divide_sn (sn_snd (p - 2)); case (s (p -2)); case (ppow w (2 ^ (p -2))). +unfold fst, snd; intros x y z t H1 H2; unfold pmult, pplus; subst. +repeat (rewrite Zmult_0_l || rewrite Zmult_0_r || rewrite Zplus_0_l || rewrite Zplus_0_r). +assert (H2: z mod q = 0). +case H1; intros q1 Hq1; rewrite Hq1. +case q_divide_Mp; intros q2 Hq2; rewrite Hq2. +rewrite Zmult_mod; auto. +rewrite (Zmult_mod q2); auto. +rewrite Z_mod_same; auto with zarith. +repeat (rewrite Zmult_0_r; rewrite (Zmod_small 0)); auto with zarith. +assert (H3: forall x, (z * x) mod q = 0). +intros y1; rewrite Zmult_mod; try rewrite H2; auto. +assert (H4: forall x y, (z * x + y) mod q = y mod q). +intros x1 y1; rewrite Zplus_mod; try rewrite H3; auto. +rewrite Zplus_0_l; apply Zmod_mod; auto. +eq_tac; auto. +apply w_in_pgroup. +apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. +Qed. + +Theorem zpow_w_n: zpow w (2 ^ p) = (1, 0). +generalize q_pos; intros HM. +generalize q_pos2; intros HM2. +assert (H0: 0 < q); auto with zarith. +replace p with ((p - 1) + 1); auto with zarith. +rewrite Zpower_exp; try rewrite Zpower_exp_1; auto with zarith. +unfold zpow; rewrite gpow_gpow; auto with zarith. +generalize zpow_w_n_minus_1; unfold zpow; intros H1; rewrite H1; clear H1. +simpl; unfold zpmult, pmult. +repeat (rewrite Zmult_0_l || rewrite Zmult_0_r || rewrite Zplus_0_l || + rewrite Zplus_0_r || rewrite Zmult_1_r). +eq_tac; auto. +pattern (-1 mod q) at 1; rewrite <- (Zmod_mod (-1) q); auto with zarith. +repeat rewrite <- Zmult_mod; auto. +rewrite Zmod_small; auto with zarith. +apply w_in_pgroup. +Qed. + +(************************************** + As e = (1, 0), the previous equation implies that the order of the group divide 2^p + **************************************) + +Theorem e_order_divide_pow: (e_order P_dec w pgroup | 2 ^ p). +generalize q_pos; intros HM. +generalize q_pos2; intros HM2. +assert (H0: 0 < q); auto with zarith. +apply e_order_divide_gpow. +apply w_in_pgroup. +apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. +exact zpow_w_n. +Qed. + +(************************************** + So it is less than equal + **************************************) + +Theorem e_order_le_pow : e_order P_dec w pgroup <= 2 ^ p. +apply Zdivide_le. +apply Zlt_le_weak; apply e_order_pos. +apply Zpower_gt_0; auto with zarith. +apply e_order_divide_pow. +Qed. + +(************************************** + So order(w) must be 2^q + **************************************) + +Theorem e_order_eq_pow: exists q, (e_order P_dec w pgroup) = 2 ^ q. +case (Zdivide_power_2 (e_order P_dec w pgroup) 2 p); auto with zarith. +apply Zlt_le_weak; apply e_order_pos. +apply prime_2. +apply e_order_divide_pow; auto. +intros x H; exists x; auto with zarith. +Qed. + +(************************************** + Buth this q can only be p otherwise it would contradict w^2^(p -1) = (-1, 0) + **************************************) + +Theorem e_order_eq_p: e_order P_dec w pgroup = 2 ^ p. +case (Zdivide_power_2 (e_order P_dec w pgroup) 2 p); auto with zarith. +apply Zlt_le_weak; apply e_order_pos. +apply prime_2. +apply e_order_divide_pow; auto. +intros p1 Hp1. +case (Zle_lt_or_eq p1 p); try (intro H1; subst; auto; fail). +case (Zle_or_lt p1 p); auto; intros H1. +absurd (2 ^ p1 <= 2 ^ p); auto with zarith. +apply Zlt_not_le; apply Zpower_lt_monotone; auto with zarith. +apply Zdivide_le. +apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. +apply Zpower_gt_0; auto with zarith. +rewrite <- Hp1; apply e_order_divide_pow. +intros H1. +assert (Hu: 0 <= p1). +generalize Hp1; case p1; simpl; auto with zarith. +intros p2 Hu; absurd (0 < e_order P_dec w pgroup). +rewrite Hu; auto with zarith. +apply e_order_pos. +absurd (zpow w (2 ^ (p - 1)) = (1, 0)). +rewrite zpow_w_n_minus_1. +intros H2; injection H2; clear H2; intros H2. +assert (H0: 0 < q); auto with zarith. +absurd (0 mod q = 0). +pattern 0 at 1; replace 0 with (-1 + 1); auto with zarith. +rewrite Zplus_mod; auto with zarith. +rewrite H2; rewrite (Zmod_small 1); auto with zarith. +rewrite Zmod_small; auto with zarith. +rewrite Zmod_small; auto with zarith. +unfold zpow; apply (gpow_pow _ _ w pgroup) with p1; auto with zarith. +apply w_in_pgroup. +rewrite <- Hp1. +apply (gpow_e_order_is_e _ P_dec _ w pgroup). +apply w_in_pgroup. +Qed. + +(************************************** + We have then the expected conclusion + **************************************) + +Theorem q_more_than_square: Mp < q * q. +unfold Mp. +assert (2 ^ p <= q * q); auto with zarith. +rewrite <- e_order_eq_p. +apply Zle_trans with (g_order pgroup). +apply Zdivide_le; auto with zarith. +apply Zlt_le_weak; apply e_order_pos; auto with zarith. +2: apply e_order_divide_order. +2: apply Zlt_le_weak; apply order_lt. +apply Zlt_le_trans with 2; auto with zarith. +replace 2 with (Z_of_nat (length ((1, 0)::w::nil))); auto. +unfold g_order; apply inj_le. +apply ulist_incl_length. +apply ulist_cons; simpl; auto. +unfold w; intros [H2 | H2]; try (case H2; fail); discriminate. +intro a; simpl; intros [H1 | [H1 | H1]]; subst. +assert (In (1, 0) (mL q)). +apply mL_in; auto with zarith. +apply isupport_is_in; auto. +apply is_inv_true with (1, 0); simpl; auto. +intros; apply zpmult_1_l; auto with zarith. +intros; apply zpmult_1_r; auto with zarith. +rewrite zpmult_1_r; auto with zarith. +rewrite zpmult_1_r; auto with zarith. +exact w_in_pgroup. +case H1. +Qed. + +End Lucas. + +(************************************** + We build the sequence in Z + **************************************) + +Definition SS p := + let n := Mp p in + match p - 2 with + Zpos p1 => iter_pos p1 _ (fun x => Zmodd (Zsquare x - 2) n) (Zmodd 4 n) + | _ => (Zmodd 4 n) + end. + +Theorem SS_aux_correct: + forall p z1 z2 n, 0 <= n -> 0 < z1 -> z2 = fst (s n) mod z1 -> + iter_pos p _ (fun x => Zmodd (Zsquare x - 2) z1) z2 = fst (s (n + Zpos p)) mod z1. +intros p; pattern p; apply Pind. +simpl. +intros z1 z2 n Hn H H1; rewrite sn; auto; rewrite H1; rewrite Zmodd_correct; rewrite Zsquare_correct; simpl. +unfold Zminus; rewrite Zplus_mod; auto. +rewrite (Zplus_mod (fst (s n) * fst (s n))); auto with zarith. +eq_tac; auto. +eq_tac; auto. +apply sym_equal; apply Zmult_mod; auto. +intros n Rec z1 z2 n1 Hn1 H1 H2. +rewrite Pplus_one_succ_l; rewrite iter_pos_plus. +rewrite Rec with (n0 := n1); auto. +replace (n1 + Zpos (1 + n)) with ((n1 + Zpos n) + 1); auto with zarith. +rewrite sn; simpl; try rewrite Zmodd_correct; try rewrite Zsquare_correct; simpl; auto with zarith. +unfold Zminus; rewrite Zplus_mod; auto. +unfold Zmodd. +rewrite (Zplus_mod (fst (s (n1 + Zpos n)) * fst (s (n1 + Zpos n)))); auto with zarith. +eq_tac; auto. +eq_tac; auto. +apply sym_equal; apply Zmult_mod; auto. +rewrite Zpos_plus_distr; auto with zarith. +Qed. + +Theorem SS_prop: forall n, 1 < n -> SS n = fst(s (n -2)) mod (Mp n). +intros n Hn; unfold SS. +cut (0 <= n - 2); auto with zarith. +case (n - 2). +intros _; rewrite Zmodd_correct; rewrite s0; auto. +intros p1 H2; rewrite SS_aux_correct with (n := 0); auto with zarith. +apply Zle_lt_trans with 1; try apply mersenne_pos; auto with zarith. +rewrite Zmodd_correct; rewrite s0; auto. +intros p1 H2; case H2; auto. +Qed. + +Theorem SS_prop_cor: forall p, 1 < p -> SS p = 0 -> (Mp p | fst(s (p -2))). +intros p H H1. +apply Zmod_divide. +generalize (mersenne_pos _ H); auto with zarith. +apply trans_equal with (2:= H1); apply sym_equal; apply SS_prop; auto. +Qed. + +Theorem LucasLehmer: forall p, 2 < p -> SS p = 0 -> prime (Mp p). +intros p H H1; case (prime_dec (Mp p)); auto; intros H2. +case Zdivide_div_prime_le_square with (2 := H2). +apply mersenne_pos; apply Zlt_trans with 2; auto with zarith. +intros q (H3, (H4, H5)). +contradict H5; apply Zlt_not_le. +apply q_more_than_square; auto. +apply SS_prop_cor; auto. +apply Zlt_trans with 2; auto with zarith. +case (Zle_lt_or_eq 2 q); auto. +apply prime_ge_2; auto. +intros H5; subst. +absurd (2 <= 1); auto with arith. +apply Zdivide_le; auto with zarith. +case H4; intros x Hx. +exists (2 ^ (p -1) - x). +rewrite Zmult_minus_distr_r; rewrite <- Hx; unfold Mp. +pattern 2 at 2; rewrite <- Zpower_1_r; rewrite <- Zpower_exp; auto with zarith. +replace (p - 1 + 1) with p; auto with zarith. +Qed. + +(************************************** + The test + **************************************) + +Definition lucas_test n := + if Z_lt_dec 2 n then if Z_eq_dec (SS n) 0 then true else false else false. + +Theorem LucasTest: forall n, lucas_test n = true -> prime (Mp n). +intros n; unfold lucas_test; case (Z_lt_dec 2 n); intros H1; try (intros; discriminate). +case (Z_eq_dec (SS n) 0); intros H2; try (intros; discriminate). +intros _; apply LucasLehmer; auto. +Qed. + +Theorem prime7: prime 7. +exact (LucasTest 3 (refl_equal _)). +Qed. + +Theorem prime31: prime 31. +exact (LucasTest 5 (refl_equal _)). +Qed. + +Theorem prime127: prime 127. +exact (LucasTest 7 (refl_equal _)). +Qed. + +Theorem prime8191: prime 8191. +exact (LucasTest 13 (refl_equal _)). +Qed. + +Theorem prime131071: prime 131071. +exact (LucasTest 17 (refl_equal _)). +Qed. + +Theorem prime524287: prime 524287. +exact (LucasTest 19 (refl_equal _)). +Qed. + diff --git a/coqprime-8.4/Coqprime/Makefile.bak b/coqprime-8.4/Coqprime/Makefile.bak new file mode 100644 index 000000000..fe49dbf29 --- /dev/null +++ b/coqprime-8.4/Coqprime/Makefile.bak @@ -0,0 +1,203 @@ +############################################################################## +## The Calculus of Inductive Constructions ## +## ## +## Projet Coq ## +## ## +## INRIA ENS-CNRS ## +## Rocquencourt Lyon ## +## ## +## Coq V7 ## +## ## +## ## +############################################################################## + +# WARNING +# +# This Makefile has been automagically generated by coq_makefile +# Edit at your own risks ! +# +# END OF WARNING + +# +# This Makefile was generated by the command line : +# coq_makefile -f Make -o Makefile +# + +########################## +# # +# Variables definitions. # +# # +########################## + +CAMLP4LIB=`camlp4 -where` +COQSRC=-I $(COQTOP)/kernel -I $(COQTOP)/lib \ + -I $(COQTOP)/library -I $(COQTOP)/parsing \ + -I $(COQTOP)/pretyping -I $(COQTOP)/interp \ + -I $(COQTOP)/proofs -I $(COQTOP)/syntax -I $(COQTOP)/tactics \ + -I $(COQTOP)/toplevel -I $(COQTOP)/contrib/correctness \ + -I $(COQTOP)/contrib/extraction -I $(COQTOP)/contrib/field \ + -I $(COQTOP)/contrib/fourier -I $(COQTOP)/contrib/graphs \ + -I $(COQTOP)/contrib/interface -I $(COQTOP)/contrib/jprover \ + -I $(COQTOP)/contrib/omega -I $(COQTOP)/contrib/romega \ + -I $(COQTOP)/contrib/ring -I $(COQTOP)/contrib/xml \ + -I $(CAMLP4LIB) +ZFLAGS=$(OCAMLLIBS) $(COQSRC) +OPT= +COQFLAGS=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML) +COQC=$(COQBIN)coqc +GALLINA=gallina +COQDOC=coqdoc +CAMLC=ocamlc -c +CAMLOPTC=ocamlopt -c +CAMLLINK=ocamlc +CAMLOPTLINK=ocamlopt +COQDEP=$(COQBIN)coqdep -c +GRAMMARS=grammar.cma +CAMLP4EXTEND=pa_extend.cmo pa_ifdef.cmo q_MLast.cmo +PP=-pp "camlp4o -I . -I $(COQTOP)/parsing $(CAMLP4EXTEND) $(GRAMMARS) -impl" + +######################### +# # +# Libraries definition. # +# # +######################### + +OCAMLLIBS=-I .\ + -I ../Tactic\ + -I ../N\ + -I ../Z\ + -I ../List +COQLIBS=-I .\ + -I ../Tactic\ + -I ../N\ + -I ../Z\ + -I ../List + +################################### +# # +# Definition of the "all" target. # +# # +################################### + +VFILES=Cyclic.v\ + EGroup.v\ + Euler.v\ + FGroup.v\ + IGroup.v\ + Lagrange.v\ + LucasLehmer.v\ + Pepin.v\ + PGroup.v\ + PocklingtonCertificat.v\ + PocklingtonRefl.v\ + Pocklington.v\ + Proth.v\ + Root.v\ + Zp.v +VOFILES=$(VFILES:.v=.vo) +VIFILES=$(VFILES:.v=.vi) +GFILES=$(VFILES:.v=.g) +HTMLFILES=$(VFILES:.v=.html) +GHTMLFILES=$(VFILES:.v=.g.html) + +all: Cyclic.vo\ + EGroup.vo\ + Euler.vo\ + FGroup.vo\ + IGroup.vo\ + Lagrange.vo\ + LucasLehmer.vo\ + Pepin.vo\ + PGroup.vo\ + PocklingtonCertificat.vo\ + PocklingtonRefl.vo\ + Pocklington.vo\ + Proth.vo\ + Root.vo\ + Zp.vo + +spec: $(VIFILES) + +gallina: $(GFILES) + +html: $(HTMLFILES) + +gallinahtml: $(GHTMLFILES) + +all.ps: $(VFILES) + $(COQDOC) -ps -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` + +all-gal.ps: $(VFILES) + $(COQDOC) -ps -g -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` + + + +#################### +# # +# Special targets. # +# # +#################### + +.PHONY: all opt byte archclean clean install depend html + +.SUFFIXES: .v .vo .vi .g .html .tex .g.tex .g.html + +.v.vo: + $(COQC) $(COQDEBUG) $(COQFLAGS) $* + +.v.vi: + $(COQC) -i $(COQDEBUG) $(COQFLAGS) $* + +.v.g: + $(GALLINA) $< + +.v.tex: + $(COQDOC) -latex $< -o $@ + +.v.html: + $(COQDOC) -html $< -o $@ + +.v.g.tex: + $(COQDOC) -latex -g $< -o $@ + +.v.g.html: + $(COQDOC) -html -g $< -o $@ + +byte: + $(MAKE) all "OPT=" + +opt: + $(MAKE) all "OPT=-opt" + +include .depend + +.depend depend: + rm -f .depend + $(COQDEP) -i $(COQLIBS) $(VFILES) *.ml *.mli >.depend + $(COQDEP) $(COQLIBS) -suffix .html $(VFILES) >>.depend + +install: + mkdir -p `$(COQC) -where`/user-contrib + cp -f $(VOFILES) `$(COQC) -where`/user-contrib + +Makefile: Make + mv -f Makefile Makefile.bak + $(COQBIN)coq_makefile -f Make -o Makefile + + +clean: + rm -f *.cmo *.cmi *.cmx *.o $(VOFILES) $(VIFILES) $(GFILES) *~ + rm -f all.ps all-gal.ps $(HTMLFILES) $(GHTMLFILES) + +archclean: + rm -f *.cmx *.o + +html: + +# WARNING +# +# This Makefile has been automagically generated by coq_makefile +# Edit at your own risks ! +# +# END OF WARNING + diff --git a/coqprime-8.4/Coqprime/NatAux.v b/coqprime-8.4/Coqprime/NatAux.v new file mode 100644 index 000000000..6df511eed --- /dev/null +++ b/coqprime-8.4/Coqprime/NatAux.v @@ -0,0 +1,72 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + Aux.v + + Auxillary functions & Theorems + **********************************************************************) +Require Export Coq.Arith.Arith. + +(************************************** + Some properties of minus +**************************************) + +Theorem minus_O : forall a b : nat, a <= b -> a - b = 0. +intros a; elim a; simpl in |- *; auto with arith. +intros a1 Rec b; case b; elim b; auto with arith. +Qed. + + +(************************************** + Definitions and properties of the power for nat +**************************************) + +Fixpoint pow (n m: nat) {struct m} : nat := match m with O => 1%nat | (S m1) => (n * pow n m1)%nat end. + +Theorem pow_add: forall n m p, pow n (m + p) = (pow n m * pow n p)%nat. +intros n m; elim m; simpl. +intros p; rewrite plus_0_r; auto. +intros m1 Rec p; rewrite Rec; auto with arith. +Qed. + + +Theorem pow_pos: forall p n, (0 < p)%nat -> (0 < pow p n)%nat. +intros p1 n H; elim n; simpl; auto with arith. +intros n1 H1; replace 0%nat with (p1 * 0)%nat; auto with arith. +repeat rewrite (mult_comm p1); apply mult_lt_compat_r; auto with arith. +Qed. + + +Theorem pow_monotone: forall n p q, (1 < n)%nat -> (p < q)%nat -> (pow n p < pow n q)%nat. +intros n p1 q1 H H1; elim H1; simpl. +pattern (pow n p1) at 1; rewrite <- (mult_1_l (pow n p1)). +apply mult_lt_compat_r; auto. +apply pow_pos; auto with arith. +intros n1 H2 H3. +apply lt_trans with (1 := H3). +pattern (pow n n1) at 1; rewrite <- (mult_1_l (pow n n1)). +apply mult_lt_compat_r; auto. +apply pow_pos; auto with arith. +Qed. + +(************************************ + Definition of the divisibility for nat +**************************************) + +Definition divide a b := exists c, b = a * c. + + +Theorem divide_le: forall p q, (1 < q)%nat -> divide p q -> (p <= q)%nat. +intros p1 q1 H (x, H1); subst. +apply le_trans with (p1 * 1)%nat; auto with arith. +rewrite mult_1_r; auto with arith. +apply mult_le_compat_l. +case (le_lt_or_eq 0 x); auto with arith. +intros H2; subst; contradict H; rewrite mult_0_r; auto with arith. +Qed. diff --git a/coqprime-8.4/Coqprime/Note.pdf b/coqprime-8.4/Coqprime/Note.pdf new file mode 100644 index 000000000..239a38772 Binary files /dev/null and b/coqprime-8.4/Coqprime/Note.pdf differ diff --git a/coqprime-8.4/Coqprime/PGroup.v b/coqprime-8.4/Coqprime/PGroup.v new file mode 100644 index 000000000..19eff5850 --- /dev/null +++ b/coqprime-8.4/Coqprime/PGroup.v @@ -0,0 +1,347 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + PGroup.v + + Build the group of pairs modulo needed for the theorem of + lucas lehmer + + Definition: PGroup + **********************************************************************) +Require Import Coq.ZArith.ZArith. +Require Import Coq.ZArith.Znumtheory. +Require Import Coqprime.Tactic. +Require Import Coq.Arith.Wf_nat. +Require Import Coqprime.ListAux. +Require Import Coqprime.UList. +Require Import Coqprime.FGroup. +Require Import Coqprime.EGroup. +Require Import Coqprime.IGroup. + +Open Scope Z_scope. + +Definition base := 3. + + +(************************************** + Equality is decidable on pairs + **************************************) + +Definition P_dec: forall p q: Z * Z, {p = q} + {p <> q}. +intros p1 q1; case p1; case q1; intros z t x y; case (Z_eq_dec x z); intros H1. +case (Z_eq_dec y t); intros H2. +left; eq_tac; auto. +right; contradict H2; injection H2; auto. +right; contradict H1; injection H1; auto. +Defined. + + +(************************************** + Addition of two pairs + **************************************) + +Definition pplus (p q: Z * Z) := let (x ,y) := p in let (z,t) := q in (x + z, y + t). + +(************************************** + Properties of addition + **************************************) + +Theorem pplus_assoc: forall p q r, (pplus p (pplus q r)) = (pplus (pplus p q) r). +intros p q r; case p; case q; case r; intros r1 r2 q1 q2 p1 p2; unfold pplus. +eq_tac; ring. +Qed. + +Theorem pplus_comm: forall p q, (pplus p q) = (pplus q p). +intros p q; case p; case q; intros q1 q2 p1 p2; unfold pplus. +eq_tac; ring. +Qed. + +(************************************** + Multiplication of two pairs + **************************************) + +Definition pmult (p q: Z * Z) := let (x ,y) := p in let (z,t) := q in (x * z + base * y * t, x * t + y * z). + +(************************************** + Properties of multiplication + **************************************) + +Theorem pmult_assoc: forall p q r, (pmult p (pmult q r)) = (pmult (pmult p q) r). +intros p q r; case p; case q; case r; intros r1 r2 q1 q2 p1 p2; unfold pmult. +eq_tac; ring. +Qed. + +Theorem pmult_0_l: forall p, (pmult (0, 0) p) = (0, 0). +intros p; case p; intros x y; unfold pmult; eq_tac; ring. +Qed. + +Theorem pmult_0_r: forall p, (pmult p (0, 0)) = (0, 0). +intros p; case p; intros x y; unfold pmult; eq_tac; ring. +Qed. + +Theorem pmult_1_l: forall p, (pmult (1, 0) p) = p. +intros p; case p; intros x y; unfold pmult; eq_tac; ring. +Qed. + +Theorem pmult_1_r: forall p, (pmult p (1, 0)) = p. +intros p; case p; intros x y; unfold pmult; eq_tac; ring. +Qed. + +Theorem pmult_comm: forall p q, (pmult p q) = (pmult q p). +intros p q; case p; case q; intros q1 q2 p1 p2; unfold pmult. +eq_tac; ring. +Qed. + +Theorem pplus_pmult_dist_l: forall p q r, (pmult p (pplus q r)) = (pplus (pmult p q) (pmult p r)). +intros p q r; case p; case q; case r; intros r1 r2 q1 q2 p1 p2; unfold pplus, pmult. +eq_tac; ring. +Qed. + + +Theorem pplus_pmult_dist_r: forall p q r, (pmult (pplus q r) p) = (pplus (pmult q p) (pmult r p)). +intros p q r; case p; case q; case r; intros r1 r2 q1 q2 p1 p2; unfold pplus, pmult. +eq_tac; ring. +Qed. + +(************************************** + In this section we create the group PGroup of inversible elements {(p, q) | 0 <= p < m /\ 0 <= q < m} + **************************************) +Section Mod. + +Variable m : Z. + +Hypothesis m_pos: 1 < m. + +(************************************** + mkLine creates {(a, p) | 0 <= p < n} + **************************************) + +Fixpoint mkLine (a: Z) (n: nat) {struct n} : list (Z * Z) := + (a, Z_of_nat n) :: match n with O => nil | (S n1) => mkLine a n1 end. + +(************************************** + Some properties of mkLine + **************************************) + +Theorem mkLine_length: forall a n, length (mkLine a n) = (n + 1)%nat. +intros a n; elim n; simpl; auto. +Qed. + +Theorem mkLine_in: forall a n p, 0 <= p <= Z_of_nat n -> (In (a, p) (mkLine a n)). +intros a n; elim n. +simpl; auto with zarith. +intros p (H1, H2); replace p with 0; auto with zarith. +intros n1 Rec p (H1, H2). +case (Zle_lt_or_eq p (Z_of_nat (S n1))); auto with zarith. +rewrite inj_S in H2; auto with zarith. +rewrite inj_S; auto with zarith. +intros H3; right; apply Rec; auto with zarith. +intros H3; subst; simpl; auto. +Qed. + +Theorem in_mkLine: forall a n p, In p (mkLine a n) -> exists q, 0 <= q <= Z_of_nat n /\ p = (a, q). +intros a n p; elim n; clear n. +simpl; intros [H1 | H1]; exists 0; auto with zarith; case H1. +simpl; intros n Rec [H1 | H1]; auto. +exists (Z_of_nat (S n)); auto with zarith. +case Rec; auto; intros q ((H2, H3), H4); exists q; repeat split; auto with zarith. +change (q <= Z_of_nat (S n)). +rewrite inj_S; auto with zarith. +Qed. + +Theorem mkLine_ulist: forall a n, ulist (mkLine a n). +intros a n; elim n; simpl; auto. +intros n1 H; apply ulist_cons; auto. +change (~ In (a, Z_of_nat (S n1)) (mkLine a n1)). +rewrite inj_S; intros H1. +case in_mkLine with (1 := H1); auto with zarith. +intros x ((H2, H3), H4); injection H4. +intros H5; subst; auto with zarith. +Qed. + +(************************************** + mkRect creates the list {(p, q) | 0 <= p < n /\ 0 <= q < m} + **************************************) + +Fixpoint mkRect (n m: nat) {struct n} : list (Z * Z) := + (mkLine (Z_of_nat n) m) ++ match n with O => nil | (S n1) => mkRect n1 m end. + +(************************************** + Some properties of mkRect + **************************************) + +Theorem mkRect_length: forall n m, length (mkRect n m) = ((n + 1) * (m + 1))%nat. +intros n; elim n; simpl; auto. +intros n1; rewrite <- app_nil_end; rewrite mkLine_length; rewrite plus_0_r; auto. +intros n1 Rec m1; rewrite length_app; rewrite Rec; rewrite mkLine_length; auto. +Qed. + +Theorem mkRect_in: forall n m p q, 0 <= p <= Z_of_nat n -> 0 <= q <= Z_of_nat m -> (In (p, q) (mkRect n m)). +intros n m1; elim n; simpl. +intros p q (H1, H2) (H3, H4); replace p with 0; auto with zarith. +rewrite <- app_nil_end; apply mkLine_in; auto. +intros n1 Rec p q (H1, H2) (H3, H4). +case (Zle_lt_or_eq p (Z_of_nat (S n1))); auto with zarith; intros H5. +rewrite inj_S in H5; apply in_or_app; auto with zarith. +apply in_or_app; left; subst; apply mkLine_in; auto with zarith. +Qed. + +Theorem in_mkRect: forall n m p, In p (mkRect n m) -> exists p1, exists p2, 0 <= p1 <= Z_of_nat n /\ 0 <= p2 <= Z_of_nat m /\ p = (p1, p2). +intros n m1 p; elim n; clear n; simpl. +rewrite <- app_nil_end; intros H1. +case in_mkLine with (1 := H1). +intros p2 (H2, H3); exists 0; exists p2; auto with zarith. +intros n Rec H1. +case in_app_or with (1 := H1); intros H2. +case in_mkLine with (1 := H2). +intros p2 (H3, H4); exists (Z_of_nat (S n)); exists p2; subst; simpl; auto with zarith. +case Rec with (1 := H2); auto. +intros p1 (p2, (H3, (H4, H5))); exists p1; exists p2; repeat split; auto with zarith. +change (p1 <= Z_of_nat (S n)). +rewrite inj_S; auto with zarith. +Qed. + +Theorem mkRect_ulist: forall n m, ulist (mkRect n m). +intros n; elim n; simpl; auto. +intros n1; rewrite <- app_nil_end; apply mkLine_ulist; auto. +intros n1 Rec m1; apply ulist_app; auto. +apply mkLine_ulist. +intros a H1 H2. +case in_mkLine with (1 := H1); intros p1 ((H3, H4), H5). +case in_mkRect with (1 := H2); intros p2 (p3, ((H6, H7), ((H8, H9), H10))). +subst; injection H10; clear H10; intros; subst. +contradict H7. +change (~ Z_of_nat (S n1) <= Z_of_nat n1). +rewrite inj_S; auto with zarith. +Qed. + +(************************************** + mL is the list {(p, q) | 0 <= p < m-1 /\ 0 <= q < m - 1} + **************************************) +Definition mL := mkRect (Zabs_nat (m - 1)) (Zabs_nat (m -1)). + +(************************************** + Some properties of mL + **************************************) + +Theorem mL_length : length mL = Zabs_nat (m * m). +unfold mL; rewrite mkRect_length; simpl; apply inj_eq_rev. +repeat (rewrite inj_mult || rewrite inj_plus || rewrite inj_Zabs_nat || rewrite Zabs_eq); simpl; auto with zarith. +eq_tac; auto with zarith. +Qed. + +Theorem mL_in: forall p q, 0 <= p < m -> 0 <= q < m -> (In (p, q) mL). +intros p q (H1, H2) (H3, H4); unfold mL; apply mkRect_in; rewrite inj_Zabs_nat; + rewrite Zabs_eq; auto with zarith. +Qed. + +Theorem in_mL: forall p, In p mL-> exists p1, exists p2, 0 <= p1 < m /\ 0 <= p2 < m /\ p = (p1, p2). +unfold mL; intros p H1; case in_mkRect with (1 := H1). +repeat (rewrite inj_Zabs_nat || rewrite Zabs_eq); auto with zarith. +intros p1 (p2, ((H2, H3), ((H4, H5), H6))); exists p1; exists p2; repeat split; auto with zarith. +Qed. + +Theorem mL_ulist: ulist mL. +unfold mL; apply mkRect_ulist; auto. +Qed. + +(************************************** + We define zpmult the multiplication of pairs module m + **************************************) + +Definition zpmult (p q: Z * Z) := let (x ,y) := pmult p q in (Zmod x m, Zmod y m). + +(************************************** + Some properties of zpmult + **************************************) + +Theorem zpmult_internal: forall p q, (In (zpmult p q) mL). +intros p q; unfold zpmult; case (pmult p q); intros z y; apply mL_in; auto with zarith. +apply Z_mod_lt; auto with zarith. +apply Z_mod_lt; auto with zarith. +Qed. + +Theorem zpmult_assoc: forall p q r, (zpmult p (zpmult q r)) = (zpmult (zpmult p q) r). +assert (U: 0 < m); auto with zarith. +intros p q r; unfold zpmult. +generalize (pmult_assoc p q r). +case (pmult p q); intros x1 x2. +case (pmult q r); intros y1 y2. +case p; case r; unfold pmult. +intros z1 z2 t1 t2 H. +match goal with + H: (?X, ?Y) = (?Z, ?T) |- _ => + assert (H1: X = Z); assert (H2: Y = T); try (injection H; simpl; auto; fail); clear H +end. +eq_tac. +generalize (f_equal (fun x => x mod m) H1). +repeat rewrite <- Zmult_assoc. +repeat (rewrite (fun x => Zplus_mod (t1 * x))); auto. +repeat (rewrite (fun x => Zplus_mod (x1 * x))); auto. +repeat (rewrite (fun x => Zplus_mod (x1 mod m * x))); auto. +repeat (rewrite (Zmult_mod t1)); auto. +repeat (rewrite (Zmult_mod x1)); auto. +repeat (rewrite (Zmult_mod base)); auto. +repeat (rewrite (Zmult_mod t2)); auto. +repeat (rewrite (Zmult_mod x2)); auto. +repeat (rewrite (Zmult_mod (t2 mod m))); auto. +repeat (rewrite (Zmult_mod (x1 mod m))); auto. +repeat (rewrite (Zmult_mod (x2 mod m))); auto. +repeat (rewrite Zmod_mod); auto. +generalize (f_equal (fun x => x mod m) H2). +repeat (rewrite (fun x => Zplus_mod (t1 * x))); auto. +repeat (rewrite (fun x => Zplus_mod (x1 * x))); auto. +repeat (rewrite (fun x => Zplus_mod (x1 mod m * x))); auto. +repeat (rewrite (Zmult_mod t1)); auto. +repeat (rewrite (Zmult_mod x1)); auto. +repeat (rewrite (Zmult_mod t2)); auto. +repeat (rewrite (Zmult_mod x2)); auto. +repeat (rewrite (Zmult_mod (t2 mod m))); auto. +repeat (rewrite (Zmult_mod (x1 mod m))); auto. +repeat (rewrite (Zmult_mod (x2 mod m))); auto. +repeat (rewrite Zmod_mod); auto. +Qed. + +Theorem zpmult_0_l: forall p, (zpmult (0, 0) p) = (0, 0). +intros p; case p; intros x y; unfold zpmult, pmult; simpl. +rewrite Zmod_small; auto with zarith. +Qed. + +Theorem zpmult_1_l: forall p, In p mL -> zpmult (1, 0) p = p. +intros p H; case in_mL with (1 := H); clear H; intros p1 (p2, ((H1, H2), (H3, H4))); subst. +unfold zpmult; rewrite pmult_1_l. +repeat rewrite Zmod_small; auto with zarith. +Qed. + +Theorem zpmult_1_r: forall p, In p mL -> zpmult p (1, 0) = p. +intros p H; case in_mL with (1 := H); clear H; intros p1 (p2, ((H1, H2), (H3, H4))); subst. +unfold zpmult; rewrite pmult_1_r. +repeat rewrite Zmod_small; auto with zarith. +Qed. + +Theorem zpmult_comm: forall p q, zpmult p q = zpmult q p. +intros p q; unfold zpmult; rewrite pmult_comm; auto. +Qed. + +(************************************** + We are now ready to build our group + **************************************) + +Definition PGroup : (FGroup zpmult). +apply IGroup with (support := mL) (e:= (1, 0)). +exact P_dec. +apply mL_ulist. +apply mL_in; auto with zarith. +intros; apply zpmult_internal. +intros; apply zpmult_assoc. +exact zpmult_1_l. +exact zpmult_1_r. +Defined. + +End Mod. diff --git a/coqprime-8.4/Coqprime/Permutation.v b/coqprime-8.4/Coqprime/Permutation.v new file mode 100644 index 000000000..7cb6f629d --- /dev/null +++ b/coqprime-8.4/Coqprime/Permutation.v @@ -0,0 +1,506 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + Permutation.v + + Defintion and properties of permutations + **********************************************************************) +Require Export Coq.Lists.List. +Require Export Coqprime.ListAux. + +Section permutation. +Variable A : Set. + +(************************************** + Definition of permutations as sequences of adjacent transpositions + **************************************) + +Inductive permutation : list A -> list A -> Prop := + | permutation_nil : permutation nil nil + | permutation_skip : + forall (a : A) (l1 l2 : list A), + permutation l2 l1 -> permutation (a :: l2) (a :: l1) + | permutation_swap : + forall (a b : A) (l : list A), permutation (a :: b :: l) (b :: a :: l) + | permutation_trans : + forall l1 l2 l3 : list A, + permutation l1 l2 -> permutation l2 l3 -> permutation l1 l3. +Hint Constructors permutation. + +(************************************** + Reflexivity + **************************************) + +Theorem permutation_refl : forall l : list A, permutation l l. +simple induction l. +apply permutation_nil. +intros a l1 H. +apply permutation_skip with (1 := H). +Qed. +Hint Resolve permutation_refl. + +(************************************** + Symmetry + **************************************) + +Theorem permutation_sym : + forall l m : list A, permutation l m -> permutation m l. +intros l1 l2 H'; elim H'. +apply permutation_nil. +intros a l1' l2' H1 H2. +apply permutation_skip with (1 := H2). +intros a b l1'. +apply permutation_swap. +intros l1' l2' l3' H1 H2 H3 H4. +apply permutation_trans with (1 := H4) (2 := H2). +Qed. + +(************************************** + Compatibility with list length + **************************************) + +Theorem permutation_length : + forall l m : list A, permutation l m -> length l = length m. +intros l m H'; elim H'; simpl in |- *; auto. +intros l1 l2 l3 H'0 H'1 H'2 H'3. +rewrite <- H'3; auto. +Qed. + +(************************************** + A permutation of the nil list is the nil list + **************************************) + +Theorem permutation_nil_inv : forall l : list A, permutation l nil -> l = nil. +intros l H; generalize (permutation_length _ _ H); case l; simpl in |- *; + auto. +intros; discriminate. +Qed. + +(************************************** + A permutation of the singleton list is the singleton list + **************************************) + +Let permutation_one_inv_aux : + forall l1 l2 : list A, + permutation l1 l2 -> forall a : A, l1 = a :: nil -> l2 = a :: nil. +intros l1 l2 H; elim H; clear H l1 l2; auto. +intros a l3 l4 H0 H1 b H2. +injection H2; intros; subst; auto. +rewrite (permutation_nil_inv _ (permutation_sym _ _ H0)); auto. +intros; discriminate. +Qed. + +Theorem permutation_one_inv : + forall (a : A) (l : list A), permutation (a :: nil) l -> l = a :: nil. +intros a l H; apply permutation_one_inv_aux with (l1 := a :: nil); auto. +Qed. + +(************************************** + Compatibility with the belonging + **************************************) + +Theorem permutation_in : + forall (a : A) (l m : list A), permutation l m -> In a l -> In a m. +intros a l m H; elim H; simpl in |- *; auto; intuition. +Qed. + +(************************************** + Compatibility with the append function + **************************************) + +Theorem permutation_app_comp : + forall l1 l2 l3 l4, + permutation l1 l2 -> permutation l3 l4 -> permutation (l1 ++ l3) (l2 ++ l4). +intros l1 l2 l3 l4 H1; generalize l3 l4; elim H1; clear H1 l1 l2 l3 l4; + simpl in |- *; auto. +intros a b l l3 l4 H. +cut (permutation (l ++ l3) (l ++ l4)); auto. +intros; apply permutation_trans with (a :: b :: l ++ l4); auto. +elim l; simpl in |- *; auto. +intros l1 l2 l3 H H0 H1 H2 l4 l5 H3. +apply permutation_trans with (l2 ++ l4); auto. +Qed. +Hint Resolve permutation_app_comp. + +(************************************** + Swap two sublists + **************************************) + +Theorem permutation_app_swap : + forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1). +intros l1; elim l1; auto. +intros; rewrite <- app_nil_end; auto. +intros a l H l2. +replace (l2 ++ a :: l) with ((l2 ++ a :: nil) ++ l). +apply permutation_trans with (l ++ l2 ++ a :: nil); auto. +apply permutation_trans with (((a :: nil) ++ l2) ++ l); auto. +simpl in |- *; auto. +apply permutation_trans with (l ++ (a :: nil) ++ l2); auto. +apply permutation_sym; auto. +replace (l2 ++ a :: l) with ((l2 ++ a :: nil) ++ l). +apply permutation_app_comp; auto. +elim l2; simpl in |- *; auto. +intros a0 l0 H0. +apply permutation_trans with (a0 :: a :: l0); auto. +apply (app_ass l2 (a :: nil) l). +apply (app_ass l2 (a :: nil) l). +Qed. + +(************************************** + A transposition is a permutation + **************************************) + +Theorem permutation_transposition : + forall a b l1 l2 l3, + permutation (l1 ++ a :: l2 ++ b :: l3) (l1 ++ b :: l2 ++ a :: l3). +intros a b l1 l2 l3. +apply permutation_app_comp; auto. +change + (permutation ((a :: nil) ++ l2 ++ (b :: nil) ++ l3) + ((b :: nil) ++ l2 ++ (a :: nil) ++ l3)) in |- *. +repeat rewrite <- app_ass. +apply permutation_app_comp; auto. +apply permutation_trans with ((b :: nil) ++ (a :: nil) ++ l2); auto. +apply permutation_app_swap; auto. +repeat rewrite app_ass. +apply permutation_app_comp; auto. +apply permutation_app_swap; auto. +Qed. + +(************************************** + An element of a list can be put on top of the list to get a permutation + **************************************) + +Theorem in_permutation_ex : + forall a l, In a l -> exists l1 : list A, permutation (a :: l1) l. +intros a l; elim l; simpl in |- *; auto. +intros H; case H; auto. +intros a0 l0 H [H0| H0]. +exists l0; rewrite H0; auto. +case H; auto; intros l1 Hl1; exists (a0 :: l1). +apply permutation_trans with (a0 :: a :: l1); auto. +Qed. + +(************************************** + A permutation of a cons can be inverted + **************************************) + +Let permutation_cons_ex_aux : + forall (a : A) (l1 l2 : list A), + permutation l1 l2 -> + forall l11 l12 : list A, + l1 = l11 ++ a :: l12 -> + exists l3 : list A, + (exists l4 : list A, + l2 = l3 ++ a :: l4 /\ permutation (l11 ++ l12) (l3 ++ l4)). +intros a l1 l2 H; elim H; clear H l1 l2. +intros l11 l12; case l11; simpl in |- *; intros; discriminate. +intros a0 l1 l2 H H0 l11 l12; case l11; simpl in |- *. +exists (nil (A:=A)); exists l1; simpl in |- *; split; auto. +injection H1; intros; subst; auto. +injection H1; intros H2 H3; rewrite <- H2; auto. +intros a1 l111 H1. +case (H0 l111 l12); auto. +injection H1; auto. +intros l3 (l4, (Hl1, Hl2)). +exists (a0 :: l3); exists l4; split; simpl in |- *; auto. +injection H1; intros; subst; auto. +injection H1; intros H2 H3; rewrite H3; auto. +intros a0 b l l11 l12; case l11; simpl in |- *. +case l12; try (intros; discriminate). +intros a1 l0 H; exists (b :: nil); exists l0; simpl in |- *; split; auto. +injection H; intros; subst; auto. +injection H; intros H1 H2 H3; rewrite H2; auto. +intros a1 l111; case l111; simpl in |- *. +intros H; exists (nil (A:=A)); exists (a0 :: l12); simpl in |- *; split; auto. +injection H; intros; subst; auto. +injection H; intros H1 H2 H3; rewrite H3; auto. +intros a2 H1111 H; exists (a2 :: a1 :: H1111); exists l12; simpl in |- *; + split; auto. +injection H; intros; subst; auto. +intros l1 l2 l3 H H0 H1 H2 l11 l12 H3. +case H0 with (1 := H3). +intros l4 (l5, (Hl1, Hl2)). +case H2 with (1 := Hl1). +intros l6 (l7, (Hl3, Hl4)). +exists l6; exists l7; split; auto. +apply permutation_trans with (1 := Hl2); auto. +Qed. + +Theorem permutation_cons_ex : + forall (a : A) (l1 l2 : list A), + permutation (a :: l1) l2 -> + exists l3 : list A, + (exists l4 : list A, l2 = l3 ++ a :: l4 /\ permutation l1 (l3 ++ l4)). +intros a l1 l2 H. +apply (permutation_cons_ex_aux a (a :: l1) l2 H nil l1); simpl in |- *; auto. +Qed. + +(************************************** + A permutation can be simply inverted if the two list starts with a cons + **************************************) + +Theorem permutation_inv : + forall (a : A) (l1 l2 : list A), + permutation (a :: l1) (a :: l2) -> permutation l1 l2. +intros a l1 l2 H; case permutation_cons_ex with (1 := H). +intros l3 (l4, (Hl1, Hl2)). +apply permutation_trans with (1 := Hl2). +generalize Hl1; case l3; simpl in |- *; auto. +intros H1; injection H1; intros H2; rewrite H2; auto. +intros a0 l5 H1; injection H1; intros H2 H3; rewrite H2; rewrite H3; auto. +apply permutation_trans with (a0 :: l4 ++ l5); auto. +apply permutation_skip; apply permutation_app_swap. +apply (permutation_app_swap (a0 :: l4) l5). +Qed. + +(************************************** + Take a list and return tle list of all pairs of an element of the + list and the remaining list + **************************************) + +Fixpoint split_one (l : list A) : list (A * list A) := + match l with + | nil => nil (A:=A * list A) + | a :: l1 => + (a, l1) + :: map (fun p : A * list A => (fst p, a :: snd p)) (split_one l1) + end. + +(************************************** + The pairs of the list are a permutation + **************************************) + +Theorem split_one_permutation : + forall (a : A) (l1 l2 : list A), + In (a, l1) (split_one l2) -> permutation (a :: l1) l2. +intros a l1 l2; generalize a l1; elim l2; clear a l1 l2; simpl in |- *; auto. +intros a l1 H1; case H1. +intros a l H a0 l1 [H0| H0]. +injection H0; intros H1 H2; rewrite H2; rewrite H1; auto. +generalize H H0; elim (split_one l); simpl in |- *; auto. +intros H1 H2; case H2. +intros a1 l0 H1 H2 [H3| H3]; auto. +injection H3; intros H4 H5; (rewrite <- H4; rewrite <- H5). +apply permutation_trans with (a :: fst a1 :: snd a1); auto. +apply permutation_skip. +apply H2; auto. +case a1; simpl in |- *; auto. +Qed. + +(************************************** + All elements of the list are there + **************************************) + +Theorem split_one_in_ex : + forall (a : A) (l1 : list A), + In a l1 -> exists l2 : list A, In (a, l2) (split_one l1). +intros a l1; elim l1; simpl in |- *; auto. +intros H; case H. +intros a0 l H [H0| H0]; auto. +exists l; left; subst; auto. +case H; auto. +intros x H1; exists (a0 :: x); right; auto. +apply + (in_map (fun p : A * list A => (fst p, a0 :: snd p)) (split_one l) (a, x)); + auto. +Qed. + +(************************************** + An auxillary function to generate all permutations + **************************************) + +Fixpoint all_permutations_aux (l : list A) (n : nat) {struct n} : + list (list A) := + match n with + | O => nil :: nil + | S n1 => + flat_map + (fun p : A * list A => + map (cons (fst p)) (all_permutations_aux (snd p) n1)) ( + split_one l) + end. +(************************************** + Generate all the permutations + **************************************) + +Definition all_permutations (l : list A) := all_permutations_aux l (length l). + +(************************************** + All the elements of the list are permutations + **************************************) + +Let all_permutations_aux_permutation : + forall (n : nat) (l1 l2 : list A), + n = length l2 -> In l1 (all_permutations_aux l2 n) -> permutation l1 l2. +intros n; elim n; simpl in |- *; auto. +intros l1 l2; case l2. +simpl in |- *; intros H0 [H1| H1]. +rewrite <- H1; auto. +case H1. +simpl in |- *; intros; discriminate. +intros n0 H l1 l2 H0 H1. +case in_flat_map_ex with (1 := H1). +clear H1; intros x; case x; clear x; intros a1 l3 (H1, H2). +case in_map_inv with (1 := H2). +simpl in |- *; intros y (H3, H4). +rewrite H4; auto. +apply permutation_trans with (a1 :: l3); auto. +apply permutation_skip; auto. +apply H with (2 := H3). +apply eq_add_S. +apply trans_equal with (1 := H0). +change (length l2 = length (a1 :: l3)) in |- *. +apply permutation_length; auto. +apply permutation_sym; apply split_one_permutation; auto. +apply split_one_permutation; auto. +Qed. + +Theorem all_permutations_permutation : + forall l1 l2 : list A, In l1 (all_permutations l2) -> permutation l1 l2. +intros l1 l2 H; apply all_permutations_aux_permutation with (n := length l2); + auto. +Qed. + +(************************************** + A permutation is in the list + **************************************) + +Let permutation_all_permutations_aux : + forall (n : nat) (l1 l2 : list A), + n = length l2 -> permutation l1 l2 -> In l1 (all_permutations_aux l2 n). +intros n; elim n; simpl in |- *; auto. +intros l1 l2; case l2. +intros H H0; rewrite permutation_nil_inv with (1 := H0); auto with datatypes. +simpl in |- *; intros; discriminate. +intros n0 H l1; case l1. +intros l2 H0 H1; + rewrite permutation_nil_inv with (1 := permutation_sym _ _ H1) in H0; + discriminate. +clear l1; intros a1 l1 l2 H1 H2. +case (split_one_in_ex a1 l2); auto. +apply permutation_in with (1 := H2); auto with datatypes. +intros x H0. +apply in_flat_map with (b := (a1, x)); auto. +apply in_map; simpl in |- *. +apply H; auto. +apply eq_add_S. +apply trans_equal with (1 := H1). +change (length l2 = length (a1 :: x)) in |- *. +apply permutation_length; auto. +apply permutation_sym; apply split_one_permutation; auto. +apply permutation_inv with (a := a1). +apply permutation_trans with (1 := H2). +apply permutation_sym; apply split_one_permutation; auto. +Qed. + +Theorem permutation_all_permutations : + forall l1 l2 : list A, permutation l1 l2 -> In l1 (all_permutations l2). +intros l1 l2 H; unfold all_permutations in |- *; + apply permutation_all_permutations_aux; auto. +Qed. + +(************************************** + Permutation is decidable + **************************************) + +Definition permutation_dec : + (forall a b : A, {a = b} + {a <> b}) -> + forall l1 l2 : list A, {permutation l1 l2} + {~ permutation l1 l2}. +intros H l1 l2. +case (In_dec (list_eq_dec H) l1 (all_permutations l2)). +intros i; left; apply all_permutations_permutation; auto. +intros i; right; contradict i; apply permutation_all_permutations; auto. +Defined. + +End permutation. + +(************************************** + Hints + **************************************) + +Hint Constructors permutation. +Hint Resolve permutation_refl. +Hint Resolve permutation_app_comp. +Hint Resolve permutation_app_swap. + +(************************************** + Implicits + **************************************) + +Implicit Arguments permutation [A]. +Implicit Arguments split_one [A]. +Implicit Arguments all_permutations [A]. +Implicit Arguments permutation_dec [A]. + +(************************************** + Permutation is compatible with map + **************************************) + +Theorem permutation_map : + forall (A B : Set) (f : A -> B) l1 l2, + permutation l1 l2 -> permutation (map f l1) (map f l2). +intros A B f l1 l2 H; elim H; simpl in |- *; auto. +intros l0 l3 l4 H0 H1 H2 H3; apply permutation_trans with (2 := H3); auto. +Qed. +Hint Resolve permutation_map. + +(************************************** + Permutation of a map can be inverted + *************************************) + +Let permutation_map_ex_aux : + forall (A B : Set) (f : A -> B) l1 l2 l3, + permutation l1 l2 -> + l1 = map f l3 -> exists l4, permutation l4 l3 /\ l2 = map f l4. +intros A1 B1 f l1 l2 l3 H; generalize l3; elim H; clear H l1 l2 l3. +intros l3; case l3; simpl in |- *; auto. +intros H; exists (nil (A:=A1)); auto. +intros; discriminate. +intros a0 l1 l2 H H0 l3; case l3; simpl in |- *; auto. +intros; discriminate. +intros a1 l H1; case (H0 l); auto. +injection H1; auto. +intros l5 (H2, H3); exists (a1 :: l5); split; simpl in |- *; auto. +injection H1; intros; subst; auto. +intros a0 b l l3; case l3. +intros; discriminate. +intros a1 l0; case l0; simpl in |- *. +intros; discriminate. +intros a2 l1 H; exists (a2 :: a1 :: l1); split; simpl in |- *; auto. +injection H; intros; subst; auto. +intros l1 l2 l3 H H0 H1 H2 l0 H3. +case H0 with (1 := H3); auto. +intros l4 (HH1, HH2). +case H2 with (1 := HH2); auto. +intros l5 (HH3, HH4); exists l5; split; auto. +apply permutation_trans with (1 := HH3); auto. +Qed. + +Theorem permutation_map_ex : + forall (A B : Set) (f : A -> B) l1 l2, + permutation (map f l1) l2 -> + exists l3, permutation l3 l1 /\ l2 = map f l3. +intros A0 B f l1 l2 H; apply permutation_map_ex_aux with (l1 := map f l1); + auto. +Qed. + +(************************************** + Permutation is compatible with flat_map + **************************************) + +Theorem permutation_flat_map : + forall (A B : Set) (f : A -> list B) l1 l2, + permutation l1 l2 -> permutation (flat_map f l1) (flat_map f l2). +intros A B f l1 l2 H; elim H; simpl in |- *; auto. +intros a b l; auto. +repeat rewrite <- app_ass. +apply permutation_app_comp; auto. +intros k3 l4 l5 H0 H1 H2 H3; apply permutation_trans with (1 := H1); auto. +Qed. diff --git a/coqprime-8.4/Coqprime/Pmod.v b/coqprime-8.4/Coqprime/Pmod.v new file mode 100644 index 000000000..45961896e --- /dev/null +++ b/coqprime-8.4/Coqprime/Pmod.v @@ -0,0 +1,617 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +Require Export Coq.ZArith.ZArith. +Require Export Coqprime.ZCmisc. + +Open Local Scope positive_scope. + +Open Local Scope P_scope. + +(* [div_eucl a b] return [(q,r)] such that a = q*b + r *) +Fixpoint div_eucl (a b : positive) {struct a} : N * N := + match a with + | xH => if 1 ?< b then (0%N, 1%N) else (1%N, 0%N) + | xO a' => + let (q, r) := div_eucl a' b in + match q, r with + | N0, N0 => (0%N, 0%N) (* n'arrive jamais *) + | N0, Npos r => + if (xO r) ?< b then (0%N, Npos (xO r)) + else (1%N,PminusN (xO r) b) + | Npos q, N0 => (Npos (xO q), 0%N) + | Npos q, Npos r => + if (xO r) ?< b then (Npos (xO q), Npos (xO r)) + else (Npos (xI q),PminusN (xO r) b) + end + | xI a' => + let (q, r) := div_eucl a' b in + match q, r with + | N0, N0 => (0%N, 0%N) (* Impossible *) + | N0, Npos r => + if (xI r) ?< b then (0%N, Npos (xI r)) + else (1%N,PminusN (xI r) b) + | Npos q, N0 => if 1 ?< b then (Npos (xO q), 1%N) else (Npos (xI q), 0%N) + | Npos q, Npos r => + if (xI r) ?< b then (Npos (xO q), Npos (xI r)) + else (Npos (xI q),PminusN (xI r) b) + end + end. +Infix "/" := div_eucl : P_scope. + +Open Scope Z_scope. +Opaque Zmult. +Lemma div_eucl_spec : forall a b, + Zpos a = fst (a/b)%P * b + snd (a/b)%P + /\ snd (a/b)%P < b. +Proof with zsimpl;try apply Zlt_0_pos;try ((ring;fail) || omega). + intros a b;generalize a;clear a;induction a;simpl;zsimpl. + case IHa; destruct (a/b)%P as [q r]. + case q; case r; simpl fst; simpl snd. + rewrite Zmult_0_l; rewrite Zplus_0_r; intros HH; discriminate HH. + intros p H; rewrite H; + match goal with + | [|- context [ ?xx ?< b ]] => + generalize (is_lt_spec xx b);destruct (xx ?< b) + | _ => idtac + end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto. + rewrite PminusN_le... + generalize H1; zsimpl; auto. + rewrite PminusN_le... + generalize H1; zsimpl; auto. + intros p H; rewrite H; + match goal with + | [|- context [ ?xx ?< b ]] => + generalize (is_lt_spec xx b);destruct (xx ?< b) + | _ => idtac + end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto; try ring. + ring_simplify. + case (Zle_lt_or_eq _ _ H1); auto with zarith. + intros p p1 H; rewrite H. + match goal with + | [|- context [ ?xx ?< b ]] => + generalize (is_lt_spec xx b);destruct (xx ?< b) + | _ => idtac + end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto; try ring. + rewrite PminusN_le... + generalize H1; zsimpl; auto. + rewrite PminusN_le... + generalize H1; zsimpl; auto. + case IHa; destruct (a/b)%P as [q r]. + case q; case r; simpl fst; simpl snd. + rewrite Zmult_0_l; rewrite Zplus_0_r; intros HH; discriminate HH. + intros p H; rewrite H; + match goal with + | [|- context [ ?xx ?< b ]] => + generalize (is_lt_spec xx b);destruct (xx ?< b) + | _ => idtac + end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto. + rewrite PminusN_le... + generalize H1; zsimpl; auto. + rewrite PminusN_le... + generalize H1; zsimpl; auto. + intros p H; rewrite H; simpl; intros H1; split; auto. + zsimpl; ring. + intros p p1 H; rewrite H. + match goal with + | [|- context [ ?xx ?< b ]] => + generalize (is_lt_spec xx b);destruct (xx ?< b) + | _ => idtac + end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto; try ring. + rewrite PminusN_le... + generalize H1; zsimpl; auto. + rewrite PminusN_le... + generalize H1; zsimpl; auto. + match goal with + | [|- context [ ?xx ?< b ]] => + generalize (is_lt_spec xx b);destruct (xx ?< b) + | _ => idtac + end; zsimpl; simpl. + split; auto. + case (Zle_lt_or_eq 1 b); auto with zarith. + generalize (Zlt_0_pos b); auto with zarith. +Qed. +Transparent Zmult. + +(******** Definition du modulo ************) + +(* [mod a b] return [a] modulo [b] *) +Fixpoint Pmod (a b : positive) {struct a} : N := + match a with + | xH => if 1 ?< b then 1%N else 0%N + | xO a' => + let r := Pmod a' b in + match r with + | N0 => 0%N + | Npos r' => + if (xO r') ?< b then Npos (xO r') + else PminusN (xO r') b + end + | xI a' => + let r := Pmod a' b in + match r with + | N0 => if 1 ?< b then 1%N else 0%N + | Npos r' => + if (xI r') ?< b then Npos (xI r') + else PminusN (xI r') b + end + end. + +Infix "mod" := Pmod (at level 40, no associativity) : P_scope. +Open Local Scope P_scope. + +Lemma Pmod_div_eucl : forall a b, a mod b = snd (a/b). +Proof with auto. + intros a b;generalize a;clear a;induction a;simpl; + try (rewrite IHa; + assert (H1 := div_eucl_spec a b); destruct (a/b) as [q r]; + destruct q as [|q];destruct r as [|r];simpl in *; + match goal with + | [|- context [ ?xx ?< b ]] => + assert (H2 := is_lt_spec xx b);destruct (xx ?< b) + | _ => idtac + end;simpl) ... + destruct H1 as [H3 H4];discriminate H3. + destruct (1 ?< b);simpl ... +Qed. + +Lemma mod1: forall a, a mod 1 = 0%N. +Proof. induction a;simpl;try rewrite IHa;trivial. Qed. + +Lemma mod_a_a_0 : forall a, a mod a = N0. +Proof. + intros a;generalize (div_eucl_spec a a);rewrite <- Pmod_div_eucl. + destruct (fst (a / a));unfold Z_of_N at 1. + rewrite Zmult_0_l;intros (H1,H2);elimtype False;omega. + assert (a<=p*a). + pattern (Zpos a) at 1;rewrite <- (Zmult_1_l a). + assert (H1:= Zlt_0_pos p);assert (H2:= Zle_0_pos a); + apply Zmult_le_compat;trivial;try omega. + destruct (a mod a)%P;auto with zarith. + unfold Z_of_N;assert (H1:= Zlt_0_pos p0);intros (H2,H3);elimtype False;omega. +Qed. + +Lemma mod_le_2r : forall (a b r: positive) (q:N), + Zpos a = b*q + r -> b <= a -> r < b -> 2*r <= a. +Proof. + intros a b r q H0 H1 H2. + assert (H3:=Zlt_0_pos a). assert (H4:=Zlt_0_pos b). assert (H5:=Zlt_0_pos r). + destruct q as [|q]. rewrite Zmult_0_r in H0. elimtype False;omega. + assert (H6:=Zlt_0_pos q). unfold Z_of_N in H0. + assert (Zpos r = a - b*q). omega. + simpl;zsimpl. pattern r at 2;rewrite H. + assert (b <= b * q). + pattern (Zpos b) at 1;rewrite <- (Zmult_1_r b). + apply Zmult_le_compat;try omega. + apply Zle_trans with (a - b * q + b). omega. + apply Zle_trans with (a - b + b);omega. +Qed. + +Lemma mod_lt : forall a b r, a mod b = Npos r -> r < b. +Proof. + intros a b r H;generalize (div_eucl_spec a b);rewrite <- Pmod_div_eucl; + rewrite H;simpl;intros (H1,H2);omega. +Qed. + +Lemma mod_le : forall a b r, a mod b = Npos r -> r <= b. +Proof. intros a b r H;assert (H1:= mod_lt _ _ _ H);omega. Qed. + +Lemma mod_le_a : forall a b r, a mod b = r -> r <= a. +Proof. + intros a b r H;generalize (div_eucl_spec a b);rewrite <- Pmod_div_eucl; + rewrite H;simpl;intros (H1,H2). + assert (0 <= fst (a / b) * b). + destruct (fst (a / b));simpl;auto with zarith. + auto with zarith. +Qed. + +Lemma lt_mod : forall a b, Zpos a < Zpos b -> (a mod b)%P = Npos a. +Proof. + intros a b H; rewrite Pmod_div_eucl. case (div_eucl_spec a b). + assert (0 <= snd(a/b)). destruct (snd(a/b));simpl;auto with zarith. + destruct (fst (a/b)). + unfold Z_of_N at 1;rewrite Zmult_0_l;rewrite Zplus_0_l. + destruct (snd (a/b));simpl; intros H1 H2;inversion H1;trivial. + unfold Z_of_N at 1;assert (b <= p*b). + pattern (Zpos b) at 1; rewrite <- (Zmult_1_l (Zpos b)). + assert (H1 := Zlt_0_pos p);apply Zmult_le_compat;try omega. + apply Zle_0_pos. + intros;elimtype False;omega. +Qed. + +Fixpoint gcd_log2 (a b c:positive) {struct c}: option positive := + match a mod b with + | N0 => Some b + | Npos r => + match b mod r, c with + | N0, _ => Some r + | Npos r', xH => None + | Npos r', xO c' => gcd_log2 r r' c' + | Npos r', xI c' => gcd_log2 r r' c' + end + end. + +Fixpoint egcd_log2 (a b c:positive) {struct c}: + option (Z * Z * positive) := + match a/b with + | (_, N0) => Some (0, 1, b) + | (q, Npos r) => + match b/r, c with + | (_, N0), _ => Some (1, -q, r) + | (q', Npos r'), xH => None + | (q', Npos r'), xO c' => + match egcd_log2 r r' c' with + None => None + | Some (u', v', w') => + let u := u' - v' * q' in + Some (u, v' - q * u, w') + end + | (q', Npos r'), xI c' => + match egcd_log2 r r' c' with + None => None + | Some (u', v', w') => + let u := u' - v' * q' in + Some (u, v' - q * u, w') + end + end + end. + +Lemma egcd_gcd_log2: forall c a b, + match egcd_log2 a b c, gcd_log2 a b c with + None, None => True + | Some (u,v,r), Some r' => r = r' + | _, _ => False + end. +induction c; simpl; auto; try + (intros a b; generalize (Pmod_div_eucl a b); case (a/b); simpl; + intros q r1 H; subst; case (a mod b); auto; + intros r; generalize (Pmod_div_eucl b r); case (b/r); simpl; + intros q' r1 H; subst; case (b mod r); auto; + intros r'; generalize (IHc r r'); case egcd_log2; auto; + intros ((p1,p2),p3); case gcd_log2; auto). +Qed. + +Ltac rw l := + match l with + | (?r, ?r1) => + match type of r with + True => rewrite <- r1 + | _ => rw r; rw r1 + end + | ?r => rewrite r + end. + +Lemma egcd_log2_ok: forall c a b, + match egcd_log2 a b c with + None => True + | Some (u,v,r) => u * a + v * b = r + end. +induction c; simpl; auto; + intros a b; generalize (div_eucl_spec a b); case (a/b); + simpl fst; simpl snd; intros q r1; case r1; try (intros; ring); + simpl; intros r (Hr1, Hr2); clear r1; + generalize (div_eucl_spec b r); case (b/r); + simpl fst; simpl snd; intros q' r1; case r1; + try (intros; rewrite Hr1; ring); + simpl; intros r' (Hr'1, Hr'2); clear r1; auto; + generalize (IHc r r'); case egcd_log2; auto; + intros ((u',v'),w'); case gcd_log2; auto; intros; + rw ((I, H), Hr1, Hr'1); ring. +Qed. + + +Fixpoint log2 (a:positive) : positive := + match a with + | xH => xH + | xO a => Psucc (log2 a) + | xI a => Psucc (log2 a) + end. + +Lemma gcd_log2_1: forall a c, gcd_log2 a xH c = Some xH. +Proof. destruct c;simpl;try rewrite mod1;trivial. Qed. + +Lemma log2_Zle :forall a b, Zpos a <= Zpos b -> log2 a <= log2 b. +Proof with zsimpl;try omega. + induction a;destruct b;zsimpl;intros;simpl ... + assert (log2 a <= log2 b) ... apply IHa ... + assert (log2 a <= log2 b) ... apply IHa ... + assert (H1 := Zlt_0_pos a);elimtype False;omega. + assert (log2 a <= log2 b) ... apply IHa ... + assert (log2 a <= log2 b) ... apply IHa ... + assert (H1 := Zlt_0_pos a);elimtype False;omega. + assert (H1 := Zlt_0_pos (log2 b)) ... + assert (H1 := Zlt_0_pos (log2 b)) ... +Qed. + +Lemma log2_1_inv : forall a, Zpos (log2 a) = 1 -> a = xH. +Proof. + destruct a;simpl;zsimpl;intros;trivial. + assert (H1:= Zlt_0_pos (log2 a));elimtype False;omega. + assert (H1:= Zlt_0_pos (log2 a));elimtype False;omega. +Qed. + +Lemma mod_log2 : + forall a b r:positive, a mod b = Npos r -> b <= a -> log2 r + 1 <= log2 a. +Proof. + intros; cut (log2 (xO r) <= log2 a). simpl;zsimpl;trivial. + apply log2_Zle. + replace (Zpos (xO r)) with (2 * r)%Z;trivial. + generalize (div_eucl_spec a b);rewrite <- Pmod_div_eucl;rewrite H. + rewrite Zmult_comm;intros [H1 H2];apply mod_le_2r with b (fst (a/b));trivial. +Qed. + +Lemma gcd_log2_None_aux : + forall c a b, Zpos b <= Zpos a -> log2 b <= log2 c -> + gcd_log2 a b c <> None. +Proof. + induction c;simpl;intros; + (CaseEq (a mod b);[intros Heq|intros r Heq];try (intro;discriminate)); + (CaseEq (b mod r);[intros Heq'|intros r' Heq'];try (intro;discriminate)). + apply IHc. apply mod_le with b;trivial. + generalize H0 (mod_log2 _ _ _ Heq' (mod_le _ _ _ Heq));zsimpl;intros;omega. + apply IHc. apply mod_le with b;trivial. + generalize H0 (mod_log2 _ _ _ Heq' (mod_le _ _ _ Heq));zsimpl;intros;omega. + assert (Zpos (log2 b) = 1). + assert (H1 := Zlt_0_pos (log2 b));omega. + rewrite (log2_1_inv _ H1) in Heq;rewrite mod1 in Heq;discriminate Heq. +Qed. + +Lemma gcd_log2_None : forall a b, Zpos b <= Zpos a -> gcd_log2 a b b <> None. +Proof. intros;apply gcd_log2_None_aux;auto with zarith. Qed. + +Lemma gcd_log2_Zle : + forall c1 c2 a b, log2 c1 <= log2 c2 -> + gcd_log2 a b c1 <> None -> gcd_log2 a b c2 = gcd_log2 a b c1. +Proof with zsimpl;trivial;try omega. + induction c1;destruct c2;simpl;intros; + (destruct (a mod b) as [|r];[idtac | destruct (b mod r)]) ... + apply IHc1;trivial. generalize H;zsimpl;intros;omega. + apply IHc1;trivial. generalize H;zsimpl;intros;omega. + elim H;destruct (log2 c1);trivial. + apply IHc1;trivial. generalize H;zsimpl;intros;omega. + apply IHc1;trivial. generalize H;zsimpl;intros;omega. + elim H;destruct (log2 c1);trivial. + elim H0;trivial. elim H0;trivial. +Qed. + +Lemma gcd_log2_Zle_log : + forall a b c, log2 b <= log2 c -> Zpos b <= Zpos a -> + gcd_log2 a b c = gcd_log2 a b b. +Proof. + intros a b c H1 H2; apply gcd_log2_Zle; trivial. + apply gcd_log2_None; trivial. +Qed. + +Lemma gcd_log2_mod0 : + forall a b c, a mod b = N0 -> gcd_log2 a b c = Some b. +Proof. intros a b c H;destruct c;simpl;rewrite H;trivial. Qed. + + +Require Import Coq.ZArith.Zwf. + +Lemma Zwf_pos : well_founded (fun x y => Zpos x < Zpos y). +Proof. + unfold well_founded. + assert (forall x a ,x = Zpos a -> Acc (fun x y : positive => x < y) a). + intros x;assert (Hacc := Zwf_well_founded 0 x);induction Hacc;intros;subst x. + constructor;intros. apply H0 with (Zpos y);trivial. + split;auto with zarith. + intros a;apply H with (Zpos a);trivial. +Qed. + +Opaque Pmod. +Lemma gcd_log2_mod : forall a b, Zpos b <= Zpos a -> + forall r, a mod b = Npos r -> gcd_log2 a b b = gcd_log2 b r r. +Proof. + intros a b;generalize a;clear a; assert (Hacc := Zwf_pos b). + induction Hacc; intros a Hle r Hmod. + rename x into b. destruct b;simpl;rewrite Hmod. + CaseEq (xI b mod r)%P;intros. rewrite gcd_log2_mod0;trivial. + assert (H2 := mod_le _ _ _ H1);assert (H3 := mod_lt _ _ _ Hmod); + assert (H4 := mod_le _ _ _ Hmod). + rewrite (gcd_log2_Zle_log r p b);trivial. + symmetry;apply H0;trivial. + generalize (mod_log2 _ _ _ H1 H4);simpl;zsimpl;intros;omega. + CaseEq (xO b mod r)%P;intros. rewrite gcd_log2_mod0;trivial. + assert (H2 := mod_le _ _ _ H1);assert (H3 := mod_lt _ _ _ Hmod); + assert (H4 := mod_le _ _ _ Hmod). + rewrite (gcd_log2_Zle_log r p b);trivial. + symmetry;apply H0;trivial. + generalize (mod_log2 _ _ _ H1 H4);simpl;zsimpl;intros;omega. + rewrite mod1 in Hmod;discriminate Hmod. +Qed. + +Lemma gcd_log2_xO_Zle : + forall a b, Zpos b <= Zpos a -> gcd_log2 a b (xO b) = gcd_log2 a b b. +Proof. + intros a b Hle;apply gcd_log2_Zle. + simpl;zsimpl;auto with zarith. + apply gcd_log2_None_aux;auto with zarith. +Qed. + +Lemma gcd_log2_xO_Zlt : + forall a b, Zpos a < Zpos b -> gcd_log2 a b (xO b) = gcd_log2 b a a. +Proof. + intros a b H;simpl. assert (Hlt := Zlt_0_pos a). + assert (H0 := lt_mod _ _ H). + rewrite H0;simpl. + CaseEq (b mod a)%P;intros;simpl. + symmetry;apply gcd_log2_mod0;trivial. + assert (H2 := mod_lt _ _ _ H1). + rewrite (gcd_log2_Zle_log a p b);auto with zarith. + symmetry;apply gcd_log2_mod;auto with zarith. + apply log2_Zle. + replace (Zpos p) with (Z_of_N (Npos p));trivial. + apply mod_le_a with a;trivial. +Qed. + +Lemma gcd_log2_x0 : forall a b, gcd_log2 a b (xO b) <> None. +Proof. + intros;simpl;CaseEq (a mod b)%P;intros. intro;discriminate. + CaseEq (b mod p)%P;intros. intro;discriminate. + assert (H1 := mod_le_a _ _ _ H0). unfold Z_of_N in H1. + assert (H2 := mod_le _ _ _ H0). + apply gcd_log2_None_aux. trivial. + apply log2_Zle. trivial. +Qed. + +Lemma egcd_log2_x0 : forall a b, egcd_log2 a b (xO b) <> None. +Proof. +intros a b H; generalize (egcd_gcd_log2 (xO b) a b) (gcd_log2_x0 a b); + rw H; case gcd_log2; auto. +Qed. + +Definition gcd a b := + match gcd_log2 a b (xO b) with + | Some p => p + | None => (* can not appear *) 1%positive + end. + +Definition egcd a b := + match egcd_log2 a b (xO b) with + | Some p => p + | None => (* can not appear *) (1,1,1%positive) + end. + + +Lemma gcd_mod0 : forall a b, (a mod b)%P = N0 -> gcd a b = b. +Proof. + intros a b H;unfold gcd. + pattern (gcd_log2 a b (xO b)) at 1; + rewrite (gcd_log2_mod0 _ _ (xO b) H);trivial. +Qed. + +Lemma gcd1 : forall a, gcd a xH = xH. +Proof. intros a;rewrite gcd_mod0;[trivial|apply mod1]. Qed. + +Lemma gcd_mod : forall a b r, (a mod b)%P = Npos r -> + gcd a b = gcd b r. +Proof. + intros a b r H;unfold gcd. + assert (log2 r <= log2 (xO r)). simpl;zsimpl;omega. + assert (H1 := mod_lt _ _ _ H). + pattern (gcd_log2 b r (xO r)) at 1; rewrite gcd_log2_Zle_log;auto with zarith. + destruct (Z_lt_le_dec a b) as [z|z]. + pattern (gcd_log2 a b (xO b)) at 1; rewrite gcd_log2_xO_Zlt;trivial. + rewrite (lt_mod _ _ z) in H;inversion H. + assert (r <= b). omega. + generalize (gcd_log2_None _ _ H2). + destruct (gcd_log2 b r r);intros;trivial. + assert (log2 b <= log2 (xO b)). simpl;zsimpl;omega. + pattern (gcd_log2 a b (xO b)) at 1; rewrite gcd_log2_Zle_log;auto with zarith. + pattern (gcd_log2 a b b) at 1;rewrite (gcd_log2_mod _ _ z _ H). + assert (r <= b). omega. + generalize (gcd_log2_None _ _ H3). + destruct (gcd_log2 b r r);intros;trivial. +Qed. + +Require Import Coq.ZArith.ZArith. +Require Import Coq.ZArith.Znumtheory. + +Hint Rewrite Zpos_mult times_Zmult square_Zmult Psucc_Zplus: zmisc. + +Ltac mauto := + trivial;autorewrite with zmisc;trivial;auto with zarith. + +Lemma gcd_Zis_gcd : forall a b:positive, (Zis_gcd b a (gcd b a)%P). +Proof with mauto. + intros a;assert (Hacc := Zwf_pos a);induction Hacc;rename x into a;intros. + generalize (div_eucl_spec b a)... + rewrite <- (Pmod_div_eucl b a). + CaseEq (b mod a)%P;[intros Heq|intros r Heq]; intros (H1,H2). + simpl in H1;rewrite Zplus_0_r in H1. + rewrite (gcd_mod0 _ _ Heq). + constructor;mauto. + apply Zdivide_intro with (fst (b/a)%P);trivial. + rewrite (gcd_mod _ _ _ Heq). + rewrite H1;apply Zis_gcd_sym. + rewrite Zmult_comm;apply Zis_gcd_for_euclid2;simpl in *. + apply Zis_gcd_sym;auto. +Qed. + +Lemma egcd_Zis_gcd : forall a b:positive, + let (uv,w) := egcd a b in + let (u,v) := uv in + u * a + v * b = w /\ (Zis_gcd b a w). +Proof with mauto. + intros a b; unfold egcd. + generalize (egcd_log2_ok (xO b) a b) (egcd_gcd_log2 (xO b) a b) + (egcd_log2_x0 a b) (gcd_Zis_gcd b a); unfold egcd, gcd. + case egcd_log2; try (intros ((u,v),w)); case gcd_log2; + try (intros; match goal with H: False |- _ => case H end); + try (intros _ _ H1; case H1; auto; fail). + intros; subst; split; try apply Zis_gcd_sym; auto. +Qed. + +Definition Zgcd a b := + match a, b with + | Z0, _ => b + | _, Z0 => a + | Zpos a, Zneg b => Zpos (gcd a b) + | Zneg a, Zpos b => Zpos (gcd a b) + | Zpos a, Zpos b => Zpos (gcd a b) + | Zneg a, Zneg b => Zpos (gcd a b) + end. + + +Lemma Zgcd_is_gcd : forall x y, Zis_gcd x y (Zgcd x y). +Proof. + destruct x;destruct y;simpl. + apply Zis_gcd_0. + apply Zis_gcd_sym;apply Zis_gcd_0. + apply Zis_gcd_sym;apply Zis_gcd_0. + apply Zis_gcd_0. + apply gcd_Zis_gcd. + apply Zis_gcd_sym;apply Zis_gcd_minus;simpl;apply gcd_Zis_gcd. + apply Zis_gcd_0. + apply Zis_gcd_minus;simpl;apply Zis_gcd_sym;apply gcd_Zis_gcd. + apply Zis_gcd_minus;apply Zis_gcd_minus;simpl;apply gcd_Zis_gcd. +Qed. + +Definition Zegcd a b := + match a, b with + | Z0, Z0 => (0,0,0) + | Zpos _, Z0 => (1,0,a) + | Zneg _, Z0 => (-1,0,-a) + | Z0, Zpos _ => (0,1,b) + | Z0, Zneg _ => (0,-1,-b) + | Zpos a, Zneg b => + match egcd a b with (u,v,w) => (u,-v, Zpos w) end + | Zneg a, Zpos b => + match egcd a b with (u,v,w) => (-u,v, Zpos w) end + | Zpos a, Zpos b => + match egcd a b with (u,v,w) => (u,v, Zpos w) end + | Zneg a, Zneg b => + match egcd a b with (u,v,w) => (-u,-v, Zpos w) end + end. + +Lemma Zegcd_is_egcd : forall x y, + match Zegcd x y with + (u,v,w) => u * x + v * y = w /\ Zis_gcd x y w /\ 0 <= w + end. +Proof. + assert (zx0: forall x, Zneg x = -x). + simpl; auto. + assert (zx1: forall x, -(-x) = x). + intro x; case x; simpl; auto. + destruct x;destruct y;simpl; try (split; [idtac|split]); + auto; try (red; simpl; intros; discriminate); + try (rewrite zx0; apply Zis_gcd_minus; try rewrite zx1; auto; + apply Zis_gcd_minus; try rewrite zx1; simpl; auto); + try apply Zis_gcd_0; try (apply Zis_gcd_sym;apply Zis_gcd_0); + generalize (egcd_Zis_gcd p p0); case egcd; intros (u,v) w (H1, H2); + split; repeat rewrite zx0; try (rewrite <- H1; ring); auto; + (split; [idtac | red; intros; discriminate]). + apply Zis_gcd_sym; auto. + apply Zis_gcd_sym; apply Zis_gcd_minus; rw zx1; + apply Zis_gcd_sym; auto. + apply Zis_gcd_minus; rw zx1; auto. + apply Zis_gcd_minus; rw zx1; auto. + apply Zis_gcd_minus; rw zx1; auto. + apply Zis_gcd_sym; auto. +Qed. diff --git a/coqprime-8.4/Coqprime/Pocklington.v b/coqprime-8.4/Coqprime/Pocklington.v new file mode 100644 index 000000000..79e7dc616 --- /dev/null +++ b/coqprime-8.4/Coqprime/Pocklington.v @@ -0,0 +1,261 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +Require Import Coq.ZArith.ZArith. +Require Export Coq.ZArith.Znumtheory. +Require Import Coqprime.Tactic. +Require Import Coqprime.ZCAux. +Require Import Coqprime.Zp. +Require Import Coqprime.FGroup. +Require Import Coqprime.EGroup. +Require Import Coqprime.Euler. + +Open Scope Z_scope. + +Theorem Pocklington: +forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> + (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> + forall n, prime n -> (n | N) -> n mod F1 = 1. +intros N F1 R1 HF1 HR1 Neq Rec n Hn H. +assert (HN: 1 < N). +assert (0 < N - 1); auto with zarith. +rewrite Neq; auto with zarith. +apply Zlt_le_trans with (1* R1); auto with zarith. +assert (Hn1: 1 < n); auto with zarith. +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +assert (H1: (F1 | n - 1)). +2: rewrite <- (Zmod_small 1 F1); auto with zarith. +2: case H1; intros k H1'. +2: replace n with (1 + (n - 1)); auto with zarith. +2: rewrite H1'; apply Z_mod_plus; auto with zarith. +apply Zdivide_Zpower; auto with zarith. +intros p i Hp Hi HiF1. +case (Rec p); auto. +apply Zdivide_trans with (2 := HiF1). +apply Zpower_divide; auto with zarith. +intros a (Ha1, (Ha2, Ha3)). +assert (HNn: a ^ (N - 1) mod n = 1). +apply Zdivide_mod_minus; auto with zarith. +apply Zdivide_trans with (1 := H). +apply Zmod_divide_minus; auto with zarith. +assert (~(n | a)). +intros H1; absurd (0 = 1); auto with zarith. +rewrite <- HNn; auto. +apply sym_equal; apply Zdivide_mod; auto with zarith. +apply Zdivide_trans with (1 := H1); apply Zpower_divide; auto with zarith. +assert (Hr: rel_prime a n). +apply rel_prime_sym; apply prime_rel_prime; auto. +assert (Hz: 0 < Zorder a n). +apply Zorder_power_pos; auto. +apply Zdivide_trans with (Zorder a n). +apply prime_divide_Zpower_Zdiv with (N - 1); auto with zarith. +apply Zorder_div_power; auto with zarith. +intros H1; absurd (1 < n); auto; apply Zle_not_lt; apply Zdivide_le; auto with zarith. +rewrite <- Ha3; apply Zdivide_Zgcd; auto with zarith. +apply Zmod_divide_minus; auto with zarith. +case H1; intros t Ht; rewrite Ht. +assert (Ht1: 0 <= t). +apply Zmult_le_reg_r with (Zorder a n); auto with zarith. +rewrite Zmult_0_l; rewrite <- Ht. +apply Zge_le; apply Z_div_ge0; auto with zarith. +apply Zlt_gt; apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +rewrite Zmult_comm; rewrite Zpower_mult; auto with zarith. +rewrite Zpower_mod; auto with zarith. +rewrite Zorder_power_is_1; auto with zarith. +rewrite Zpower_1_l; auto with zarith. +apply Zmod_small; auto with zarith. +apply Zdivide_trans with (1:= HiF1); rewrite Neq; apply Zdivide_factor_r. +apply Zorder_div; auto. +Qed. + +Theorem PocklingtonCorollary1: +forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> N < F1 * F1 -> + (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> + prime N. +intros N F1 R1 H H1 H2 H3 H4; case (prime_dec N); intros H5; auto. +assert (HN: 1 < N). +assert (0 < N - 1); auto with zarith. +rewrite H2; auto with zarith. +apply Zlt_le_trans with (1* R1); auto with zarith. +case Zdivide_div_prime_le_square with (2:= H5); auto with zarith. +intros n (Hn, (Hn1, Hn2)). +assert (Hn3: 0 <= n). +apply Zle_trans with 2; try apply prime_ge_2; auto with zarith. +absurd (n = 1). +intros H6; contradict Hn; subst; apply not_prime_1. +rewrite <- (Zmod_small n F1); try split; auto. +apply Pocklington with (R1 := R1) (4 := H4); auto. +apply Zlt_square_mult_inv; auto with zarith. +Qed. + +Theorem PocklingtonCorollary2: +forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> + (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> + forall n, 0 <= n -> (n | N) -> n mod F1 = 1. +intros N F1 R1 H1 H2 H3 H4 n H5; pattern n; apply prime_induction; auto. +assert (HN: 1 < N). +assert (0 < N - 1); auto with zarith. +rewrite H3; auto with zarith. +apply Zlt_le_trans with (1* R1); auto with zarith. +intros (u, Hu); contradict HN; subst; rewrite Zmult_0_r; auto with zarith. +intro H6; rewrite Zmod_small; auto with zarith. +intros p q Hp Hp1 Hp2; rewrite Zmult_mod; auto with zarith. +rewrite Pocklington with (n := p) (R1 := R1) (4 := H4); auto. +rewrite Hp1. +rewrite Zmult_1_r; rewrite Zmod_small; auto with zarith. +apply Zdivide_trans with (2 := Hp2); apply Zdivide_factor_l. +apply Zdivide_trans with (2 := Hp2); apply Zdivide_factor_r; auto. +Qed. + +Definition isSquare x := exists y, x = y * y. + +Theorem PocklingtonExtra: +forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> Zeven F1 -> Zodd R1 -> + (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> + forall m, 1 <= m -> (forall l, 1 <= l < m -> ~((l * F1 + 1) | N)) -> + let s := (R1 / (2 * F1)) in + let r := (R1 mod (2 * F1)) in + N < (m * F1 + 1) * (2 * F1 * F1 + (r - m) * F1 + 1) -> + (s = 0 \/ ~ isSquare (r * r - 8 * s)) -> prime N. +intros N F1 R1 H1 H2 H3 OF1 ER1 H4 m H5 H6 s r H7 H8. +case (prime_dec N); auto; intros H9. +assert (HN: 1 < N). +assert (0 < N - 1); auto with zarith. +rewrite H3; auto with zarith. +apply Zlt_le_trans with (1* R1); auto with zarith. +case Zdivide_div_prime_le_square with N; auto. +intros X (Hx1, (Hx2, Hx3)). +assert (Hx0: 1 < X). +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +pose (c := (X / F1)). +assert(Hc1: 0 <= c); auto with zarith. +apply Zge_le; unfold c; apply Z_div_ge0; auto with zarith. +assert (Hc2: X = c * F1 + 1). +rewrite (Z_div_mod_eq X F1); auto with zarith. +eq_tac; auto. +rewrite (Zmult_comm F1); auto. +apply PocklingtonCorollary2 with (R1 := R1) (4 := H4); auto with zarith. +case Zle_lt_or_eq with (1 := Hc1); clear Hc1; intros Hc1. +2: contradict Hx0; rewrite Hc2; try rewrite <- Hc1; auto with zarith. +case (Zle_or_lt m c); intros Hc3. +2: case Zle_lt_or_eq with (1 := H5); clear H5; intros H5; auto with zarith. +2: case (H6 c); auto with zarith; rewrite <- Hc2; auto. +2: contradict Hc3; rewrite <- H5; auto with zarith. +pose (d := ((N / X) / F1)). +assert(Hd0: 0 <= N / X); try apply Z_div_pos; auto with zarith. +(* +apply Zge_le; unfold d; repeat apply Z_div_ge0; auto with zarith. +*) +assert(Hd1: 0 <= d); auto with zarith. +apply Zge_le; unfold d; repeat apply Z_div_ge0; auto with zarith. +assert (Hd2: N / X = d * F1 + 1). +rewrite (Z_div_mod_eq (N / X) F1); auto with zarith. +eq_tac; auto. +rewrite (Zmult_comm F1); auto. +apply PocklingtonCorollary2 with (R1 := R1) (4 := H4); auto with zarith. +exists X; auto with zarith. +apply Zdivide_Zdiv_eq; auto with zarith. +case Zle_lt_or_eq with (1 := Hd0); clear Hd0; intros Hd0. +2: contradict HN; rewrite (Zdivide_Zdiv_eq X N); auto with zarith. +2: rewrite <- Hd0; auto with zarith. +case (Zle_lt_or_eq 1 (N / X)); auto with zarith; clear Hd0; intros Hd0. +2: contradict H9; rewrite (Zdivide_Zdiv_eq X N); auto with zarith. +2: rewrite <- Hd0; rewrite Zmult_1_r; auto with zarith. +case Zle_lt_or_eq with (1 := Hd1); clear Hd1; intros Hd1. +2: contradict Hd0; rewrite Hd2; try rewrite <- Hd1; auto with zarith. +case (Zle_or_lt m d); intros Hd3. +2: case Zle_lt_or_eq with (1 := H5); clear H5; intros H5; auto with zarith. +2: case (H6 d); auto with zarith; rewrite <- Hd2; auto. +2: exists X; auto with zarith. +2: apply Zdivide_Zdiv_eq; auto with zarith. +2: contradict Hd3; rewrite <- H5; auto with zarith. +assert (L5: N = (c * F1 + 1) * (d * F1 + 1)). +rewrite <- Hc2; rewrite <- Hd2; apply Zdivide_Zdiv_eq; auto with zarith. +assert (L6: R1 = c * d * F1 + c + d). +apply trans_equal with ((N - 1) / F1). +rewrite H3; rewrite Zmult_comm; apply sym_equal; apply Z_div_mult; auto with zarith. +rewrite L5. +match goal with |- (?X / ?Y = ?Z) => replace X with (Z * Y) end; try ring; apply Z_div_mult; auto with zarith. +assert (L6_1: Zodd (c + d)). +case (Zeven_odd_dec (c + d)); auto; intros O1. +contradict ER1; apply Zeven_not_Zodd; rewrite L6; rewrite <- Zplus_assoc; apply Zeven_plus_Zeven; auto. +apply Zeven_mult_Zeven_r; auto. +assert (L6_2: Zeven (c * d)). +case (Zeven_odd_dec c); intros HH1. +apply Zeven_mult_Zeven_l; auto. +case (Zeven_odd_dec d); intros HH2. +apply Zeven_mult_Zeven_r; auto. +contradict L6_1; apply Zeven_not_Zodd; apply Zodd_plus_Zodd; auto. +assert ((c + d) mod (2 * F1) = r). +rewrite <- Z_mod_plus with (b := Zdiv2 (c * d)); auto with zarith. +match goal with |- ?X mod _ = _ => replace X with R1 end; auto. +rewrite L6; pattern (c * d) at 1. +rewrite Zeven_div2 with (1 := L6_2); ring. +assert (L9: c + d - r < 2 * F1). +apply Zplus_lt_reg_r with (r - m). +apply Zmult_lt_reg_r with (F1); auto with zarith. +apply Zplus_lt_reg_r with 1. +match goal with |- ?X < ?Y => + replace Y with (2 * F1 * F1 + (r - m) * F1 + 1); try ring; + replace X with ((((c + d) - m) * F1) + 1); try ring +end. +apply Zmult_lt_reg_r with (m * F1 + 1); auto with zarith. +apply Zlt_trans with (m * F1 + 0); auto with zarith. +rewrite Zplus_0_r; apply Zmult_lt_O_compat; auto with zarith. +repeat rewrite (fun x => Zmult_comm x (m * F1 + 1)). +apply Zle_lt_trans with (2 := H7). +rewrite L5. +match goal with |- ?X <= ?Y => + replace X with ((m * (c + d) - m * m ) * F1 * F1 + (c + d) * F1 + 1); try ring; + replace Y with ((c * d) * F1 * F1 + (c + d) * F1 + 1); try ring +end. +repeat apply Zplus_le_compat_r. +repeat apply Zmult_le_compat_r; auto with zarith. +assert (tmp: forall p q, 0 <= p - q -> q <= p); auto with zarith; try apply tmp. +match goal with |- _ <= ?X => + replace X with ((c - m) * (d - m)); try ring; auto with zarith +end. +assert (L10: c + d = r). +apply Zmod_closeby_eq with (2 * F1); auto with zarith. +unfold r; apply Z_mod_lt; auto with zarith. +assert (L11: 2 * s = c * d). +apply Zmult_reg_r with F1; auto with zarith. +apply trans_equal with (R1 - (c + d)). +rewrite L10; rewrite (Z_div_mod_eq R1 (2 * F1)); auto with zarith. +unfold s, r; ring. +rewrite L6; ring. +case H8; intro H10. +absurd (0 < c * d); auto with zarith. +apply Zmult_lt_O_compat; auto with zarith. +case H10; exists (c - d); auto with zarith. +rewrite <- L10. +replace (8 * s) with (4 * (2 * s)); auto with zarith; try rewrite L11; ring. +Qed. + +Theorem PocklingtonExtraCorollary: +forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> Zeven F1 -> Zodd R1 -> + (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> + let s := (R1 / (2 * F1)) in + let r := (R1 mod (2 * F1)) in + N < 2 * F1 * F1 * F1 -> (s = 0 \/ ~ isSquare (r * r - 8 * s)) -> prime N. +intros N F1 R1 H1 H2 H3 OF1 ER1 H4 s r H5 H6. +apply PocklingtonExtra with (6 := H4) (R1 := R1) (m := 1); auto with zarith. +apply Zlt_le_trans with (1 := H5). +match goal with |- ?X <= ?K * ((?Y + ?Z) + ?T) => + rewrite <- (Zplus_0_l X); + replace (K * ((Y + Z) + T)) with ((F1 * (Z + T) + Y + Z + T) + X);[idtac | ring] +end. +apply Zplus_le_compat_r. +case (Zle_lt_or_eq 0 r); unfold r; auto with zarith. +case (Z_mod_lt R1 (2 * F1)); auto with zarith. +intros HH; repeat ((rewrite <- (Zplus_0_r 0); apply Zplus_le_compat)); auto with zarith. +intros HH; contradict ER1; apply Zeven_not_Zodd. +rewrite (Z_div_mod_eq R1 (2 * F1)); auto with zarith. +rewrite <- HH; rewrite Zplus_0_r. +rewrite <- Zmult_assoc; apply Zeven_2p. +Qed. diff --git a/coqprime-8.4/Coqprime/PocklingtonCertificat.v b/coqprime-8.4/Coqprime/PocklingtonCertificat.v new file mode 100644 index 000000000..fccea30b6 --- /dev/null +++ b/coqprime-8.4/Coqprime/PocklingtonCertificat.v @@ -0,0 +1,759 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +Require Import Coq.Lists.List. +Require Import Coq.ZArith.ZArith. +Require Import Coq.ZArith.Zorder. +Require Import Coqprime.ZCAux. +Require Import Coqprime.LucasLehmer. +Require Import Coqprime.Pocklington. +Require Import Coqprime.ZCmisc. +Require Import Coqprime.Pmod. + +Definition dec_prime := list (positive * positive). + +Inductive singleCertif : Set := + | Proof_certif : forall N:positive, prime N -> singleCertif + | Lucas_certif : forall (n:positive) (p: Z), singleCertif + | Pock_certif : forall N a : positive, dec_prime -> positive -> singleCertif + | SPock_certif : forall N a : positive, dec_prime -> singleCertif + | Ell_certif: forall (N S: positive) (l: list (positive * positive)) + (A B x y: Z), singleCertif. + +Definition Certif := list singleCertif. + +Definition nprim sc := + match sc with + | Proof_certif n _ => n + | Lucas_certif n _ => n + | Pock_certif n _ _ _ => n + | SPock_certif n _ _ => n + | Ell_certif n _ _ _ _ _ _ => n + + end. + +Open Scope positive_scope. +Open Scope P_scope. + +Fixpoint pow (a p:positive) {struct p} : positive := + match p with + | xH => a + | xO p' =>let z := pow a p' in square z + | xI p' => let z := pow a p' in square z * a + end. + +Definition mkProd' (l:dec_prime) := + fold_right (fun (k:positive*positive) r => times (fst k) r) 1%positive l. + +Definition mkProd_pred (l:dec_prime) := + fold_right (fun (k:positive*positive) r => + if ((snd k) ?= 1)%P then r else times (pow (fst k) (Ppred (snd k))) r) + 1%positive l. + +Definition mkProd (l:dec_prime) := + fold_right (fun (k:positive*positive) r => times (pow (fst k) (snd k)) r) 1%positive l. + +(* [pow_mod a m n] return [a^m mod n] *) +Fixpoint pow_mod (a m n : positive) {struct m} : N := + match m with + | xH => (a mod n) + | xO m' => + let z := pow_mod a m' n in + match z with + | N0 => 0%N + | Npos z' => ((square z') mod n) + end + | xI m' => + let z := pow_mod a m' n in + match z with + | N0 => 0%N + | Npos z' => ((square z') * a)%P mod n + end + end. + +Definition Npow_mod a m n := + match a with + | N0 => 0%N + | Npos a => pow_mod a m n + end. + +(* [fold_pow_mod a [q1,_;...;qn,_]] b = a ^(q1*...*qn) mod b *) +(* invariant a mod N = a *) +Definition fold_pow_mod a l n := + fold_left + (fun a' (qp:positive*positive) => Npow_mod a' (fst qp) n) + l a. + +Definition times_mod x y n := + match x, y with + | N0, _ => N0 + | _, N0 => N0 + | Npos x, Npos y => ((x * y)%P mod n) + end. + +Definition Npred_mod p n := + match p with + | N0 => Npos (Ppred n) + | Npos p => + if (p ?= 1) then N0 + else Npos (Ppred p) + end. + +Fixpoint all_pow_mod (prod a : N) (l:dec_prime) (n:positive) {struct l}: N*N := + match l with + | nil => (prod,a) + | (q,_) :: l => + let m := Npred_mod (fold_pow_mod a l n) n in + all_pow_mod (times_mod prod m n) (Npow_mod a q n) l n + end. + +Fixpoint pow_mod_pred (a:N) (l:dec_prime) (n:positive) {struct l} : N := + match l with + | nil => a + | (q,p)::l => + if (p ?= 1) then pow_mod_pred a l n + else + let a' := iter_pos (Ppred p) _ (fun x => Npow_mod x q n) a in + pow_mod_pred a' l n + end. + +Definition is_odd p := + match p with + | xO _ => false + | _ => true + end. + +Definition is_even p := + match p with + | xO _ => true + | _ => false + end. + +Definition check_s_r s r sqrt := + match s with + | N0 => true + | Npos p => + match (Zminus (square r) (xO (xO (xO p)))) with + | Zpos x => + let sqrt2 := square sqrt in + let sqrt12 := square (Psucc sqrt) in + if sqrt2 ?< x then x ?< sqrt12 + else false + | Zneg _ => true + | Z0 => false + end + end. + +Definition test_pock N a dec sqrt := + if (2 ?< N) then + let Nm1 := Ppred N in + let F1 := mkProd dec in + match Nm1 / F1 with + | (Npos R1, N0) => + if is_odd R1 then + if is_even F1 then + if (1 ?< a) then + let (s,r') := (R1 / (xO F1))in + match r' with + | Npos r => + let A := pow_mod_pred (pow_mod a R1 N) dec N in + match all_pow_mod 1%N A dec N with + | (Npos p, Npos aNm1) => + if (aNm1 ?= 1) then + if gcd p N ?= 1 then + if check_s_r s r sqrt then + (N ?< (times ((times ((xO F1)+r+1) F1) + r) F1) + 1) + else false + else false + else false + | _ => false + end + | _ => false + end + else false + else false + else false + | _=> false + end + else false. + +Fixpoint is_in (p : positive) (lc : Certif) {struct lc} : bool := + match lc with + | nil => false + | c :: l => if p ?= (nprim c) then true else is_in p l + end. + +Fixpoint all_in (lc : Certif) (lp : dec_prime) {struct lp} : bool := + match lp with + | nil => true + | (p,_) :: lp => + if all_in lc lp + then is_in p lc + else false + end. + +Definition gt2 n := + match n with + | Zpos p => (2 ?< p)%positive + | _ => false + end. + +Fixpoint test_Certif (lc : Certif) : bool := + match lc with + | nil => true + | (Proof_certif _ _) :: lc => test_Certif lc + | (Lucas_certif n p) :: lc => + if test_Certif lc then + if gt2 p then + match Mp p with + | Zpos n' => + if (n ?= n') then + match SS p with + | Z0 => true + | _ => false + end + else false + | _ => false + end + else false + else false + | (Pock_certif n a dec sqrt) :: lc => + if test_pock n a dec sqrt then + if all_in lc dec then test_Certif lc else false + else false +(* Shoudl be done later to do it with Z *) + | (SPock_certif n a dec) :: lc => false + | (Ell_certif _ _ _ _ _ _ _):: lc => false + end. + +Lemma pos_eq_1_spec : + forall p, + if (p ?= 1)%P then p = xH + else (1 < p). +Proof. + unfold Zlt;destruct p;simpl; auto; red;reflexivity. +Qed. + +Open Scope Z_scope. +Lemma mod_unique : forall b q1 r1 q2 r2, + 0 <= r1 < b -> + 0 <= r2 < b -> + b * q1 + r1 = b * q2 + r2 -> + q1 = q2 /\ r1 = r2. +Proof with auto with zarith. + intros b q1 r1 q2 r2 H1 H2 H3. + assert (r2 = (b * q1 + r1) -b*q2). rewrite H3;ring. + assert (b*(q2 - q1) = r1 - r2 ). rewrite H;ring. + assert (-b < r1 - r2 < b). omega. + destruct (Ztrichotomy q1 q2) as [H5 | [H5 | H5]]. + assert (q2 - q1 >= 1). omega. + assert (r1- r2 >= b). + rewrite <- H0. + pattern b at 2; replace b with (b*1). + apply Zmult_ge_compat_l; omega. ring. + elimtype False; omega. + split;trivial. rewrite H;rewrite H5;ring. + assert (r1- r2 <= -b). + rewrite <- H0. + replace (-b) with (b*(-1)); try (ring;fail). + apply Zmult_le_compat_l; omega. + elimtype False; omega. +Qed. + +Lemma Zge_0_pos : forall p:positive, p>= 0. +Proof. + intros;unfold Zge;simpl;intro;discriminate. +Qed. + +Lemma Zge_0_pos_add : forall p:positive, p+p>= 0. +Proof. + intros;simpl;apply Zge_0_pos. +Qed. + +Hint Resolve Zpower_gt_0 Zlt_0_pos Zge_0_pos Zlt_le_weak Zge_0_pos_add: zmisc. + +Hint Rewrite Zpos_mult Zpower_mult Zpower_1_r Zmod_mod Zpower_exp + times_Zmult square_Zmult Psucc_Zplus: zmisc. + +Ltac mauto := + trivial;autorewrite with zmisc;trivial;auto with zmisc zarith. + +Lemma mod_lt : forall a (b:positive), a mod b < b. +Proof. + intros a b;destruct (Z_mod_lt a b);mauto. +Qed. +Hint Resolve mod_lt : zmisc. + +Lemma Zmult_mod_l : forall (n:positive) a b, (a mod n * b) mod n = (a * b) mod n. +Proof with mauto. + intros;rewrite Zmult_mod ... rewrite (Zmult_mod a) ... +Qed. + +Lemma Zmult_mod_r : forall (n:positive) a b, (a * (b mod n)) mod n = (a * b) mod n. +Proof with mauto. + intros;rewrite Zmult_mod ... rewrite (Zmult_mod a) ... +Qed. + +Lemma Zminus_mod_l : forall (n:positive) a b, (a mod n - b) mod n = (a - b) mod n. +Proof with mauto. + intros;rewrite Zminus_mod ... rewrite (Zminus_mod a) ... +Qed. + +Lemma Zminus_mod_r : forall (n:positive) a b, (a - (b mod n)) mod n = (a - b) mod n. +Proof with mauto. + intros;rewrite Zminus_mod ... rewrite (Zminus_mod a) ... +Qed. + +Hint Rewrite Zmult_mod_l Zmult_mod_r Zminus_mod_l Zminus_mod_r : zmisc. +Hint Rewrite <- Zpower_mod : zmisc. + +Lemma Pmod_Zmod : forall a b, Z_of_N (a mod b)%P = a mod b. +Proof. + intros a b; rewrite Pmod_div_eucl. + assert (b>0). mauto. + unfold Zmod; assert (H1 := Z_div_mod a b H). + destruct (Zdiv_eucl a b) as (q2, r2). + assert (H2 := div_eucl_spec a b). + assert (Z_of_N (fst (a / b)%P) = q2 /\ Z_of_N (snd (a/b)%P) = r2). + destruct H1;destruct H2. + apply mod_unique with b;mauto. + split;mauto. + unfold Zle;destruct (snd (a / b)%P);intro;discriminate. + rewrite <- H0;symmetry;rewrite Zmult_comm;trivial. + destruct H0;auto. +Qed. +Hint Rewrite Pmod_Zmod : zmisc. + +Lemma Zpower_0 : forall p : positive, 0^p = 0. +Proof. + intros;simpl;destruct p;unfold Zpower_pos;simpl;trivial. + generalize (iter_pos p Z (Z.mul 0) 1). + induction p;simpl;trivial. +Qed. + +Opaque Zpower. +Opaque Zmult. + +Lemma pow_Zpower : forall a p, Zpos (pow a p) = a ^ p. +Proof with mauto. + induction p;simpl... rewrite IHp... rewrite IHp... +Qed. +Hint Rewrite pow_Zpower : zmisc. + +Lemma pow_mod_spec : forall n a m, Z_of_N (pow_mod a m n) = a^m mod n. +Proof with mauto. + induction m;simpl;intros... + rewrite Zmult_mod; auto with zmisc. + rewrite (Zmult_mod (a^m)); auto with zmisc. rewrite <- IHm. + destruct (pow_mod a m n);simpl... + rewrite Zmult_mod; auto with zmisc. + rewrite <- IHm. destruct (pow_mod a m n);simpl... +Qed. +Hint Rewrite pow_mod_spec Zpower_0 : zmisc. + +Lemma Npow_mod_spec : forall a p n, Z_of_N (Npow_mod a p n) = a^p mod n. +Proof with mauto. + intros a p n;destruct a;simpl ... +Qed. +Hint Rewrite Npow_mod_spec : zmisc. + +Lemma iter_Npow_mod_spec : forall n q p a, + Z_of_N (iter_pos p N (fun x : N => Npow_mod x q n) a) = a^q^p mod n. +Proof with mauto. + induction p;simpl;intros ... + repeat rewrite IHp. + rewrite (Zpower_mod ((a ^ q ^ p) ^ q ^ p));auto with zmisc. + rewrite (Zpower_mod (a ^ q ^ p))... + repeat rewrite IHp... +Qed. +Hint Rewrite iter_Npow_mod_spec : zmisc. + + +Lemma fold_pow_mod_spec : forall (n:positive) l (a:N), + Z_of_N a = a mod n -> + Z_of_N (fold_pow_mod a l n) = a^(mkProd' l) mod n. +Proof with mauto. + unfold fold_pow_mod;induction l;simpl;intros ... + rewrite IHl... +Qed. +Hint Rewrite fold_pow_mod_spec : zmisc. + +Lemma pow_mod_pred_spec : forall (n:positive) l (a:N), + Z_of_N a = a mod n -> + Z_of_N (pow_mod_pred a l n) = a^(mkProd_pred l) mod n. +Proof with mauto. + unfold pow_mod_pred;induction l;simpl;intros ... + destruct a as (q,p);simpl. + destruct (p ?= 1)%P; rewrite IHl... +Qed. +Hint Rewrite pow_mod_pred_spec : zmisc. + +Lemma mkProd_pred_mkProd : forall l, + (mkProd_pred l)*(mkProd' l) = mkProd l. +Proof with mauto. + induction l;simpl;intros ... + generalize (pos_eq_1_spec (snd a)); destruct (snd a ?= 1)%P;intros. + rewrite H... + replace (mkProd_pred l * (fst a * mkProd' l)) with + (fst a *(mkProd_pred l * mkProd' l));try ring. + rewrite IHl... + rewrite Zmult_assoc. rewrite times_Zmult. + rewrite (Zmult_comm (pow (fst a) (Ppred (snd a)) * mkProd_pred l)). + rewrite Zmult_assoc. rewrite pow_Zpower. rewrite <-Ppred_Zminus;trivial. + rewrite <- Zpower_Zsucc; try omega. + replace (Zsucc (snd a - 1)) with ((snd a - 1)+1). + replace ((snd a - 1)+1) with (Zpos (snd a)) ... + rewrite <- IHl;repeat rewrite Zmult_assoc ... + destruct (snd a - 1);trivial. + assert (1 < snd a); auto with zarith. +Qed. +Hint Rewrite mkProd_pred_mkProd : zmisc. + +Lemma lt_Zmod : forall p n, 0 <= p < n -> p mod n = p. +Proof with mauto. + intros a b H. + assert ( 0 <= a mod b < b). + apply Z_mod_lt... + destruct (mod_unique b (a/b) (a mod b) 0 a H0 H)... + rewrite <- Z_div_mod_eq... +Qed. + +Opaque Zminus. +Lemma Npred_mod_spec : forall p n, Z_of_N p < Zpos n -> + 1 < Zpos n -> Z_of_N (Npred_mod p n) = (p - 1) mod n. +Proof with mauto. + destruct p;intros;simpl. + rewrite <- Ppred_Zminus... + change (-1) with (0 -1). rewrite <- (Z_mod_same n) ... + pattern 1 at 2;rewrite <- (lt_Zmod 1 n) ... + symmetry;apply lt_Zmod. +Transparent Zminus. + omega. + assert (H1 := pos_eq_1_spec p);destruct (p?=1)%P. + rewrite H1 ... + unfold Z_of_N;rewrite <- Ppred_Zminus... + simpl in H;symmetry; apply (lt_Zmod (p-1) n)... + assert (1 < p); auto with zarith. +Qed. +Hint Rewrite Npred_mod_spec : zmisc. + +Lemma times_mod_spec : forall x y n, Z_of_N (times_mod x y n) = (x * y) mod n. +Proof with mauto. + intros; destruct x ... + destruct y;simpl ... +Qed. +Hint Rewrite times_mod_spec : zmisc. + +Lemma snd_all_pow_mod : + forall n l (prod a :N), + a mod (Zpos n) = a -> + Z_of_N (snd (all_pow_mod prod a l n)) = (a^(mkProd' l)) mod n. +Proof with mauto. + induction l;simpl;intros... + destruct a as (q,p);simpl. + rewrite IHl... +Qed. + +Lemma fold_aux : forall a N (n:positive) l prod, + fold_left + (fun (r : Z) (k : positive * positive) => + r * (a ^(N / fst k) - 1) mod n) l (prod mod n) mod n = + fold_left + (fun (r : Z) (k : positive * positive) => + r * (a^(N / fst k) - 1)) l prod mod n. +Proof with mauto. + induction l;simpl;intros ... +Qed. + +Lemma fst_all_pow_mod : + forall (n a:positive) l (R:positive) (prod A :N), + 1 < n -> + Z_of_N prod = prod mod n -> + Z_of_N A = a^R mod n -> + Z_of_N (fst (all_pow_mod prod A l n)) = + (fold_left + (fun r (k:positive*positive) => + (r * (a ^ (R* mkProd' l / (fst k)) - 1))) l prod) mod n. +Proof with mauto. + induction l;simpl;intros... + destruct a0 as (q,p);simpl. + assert (Z_of_N A = A mod n). + rewrite H1 ... + rewrite (IHl (R * q)%positive)... + pattern (q * mkProd' l) at 2;rewrite (Zmult_comm q). + repeat rewrite Zmult_assoc. + rewrite Z_div_mult;auto with zmisc zarith. + rewrite <- fold_aux. + rewrite <- (fold_aux a (R * q * mkProd' l) n l (prod * (a ^ (R * mkProd' l) - 1)))... + assert ( ((prod * (A ^ mkProd' l - 1)) mod n) = + ((prod * ((a ^ R) ^ mkProd' l - 1)) mod n)). + repeat rewrite (Zmult_mod prod);auto with zmisc. + rewrite Zminus_mod;auto with zmisc. + rewrite (Zminus_mod ((a ^ R) ^ mkProd' l));auto with zmisc. + rewrite (Zpower_mod (a^R));auto with zmisc. rewrite H1... + rewrite H3... + rewrite H1 ... +Qed. + + +Lemma is_odd_Zodd : forall p, is_odd p = true -> Zodd p. +Proof. + destruct p;intros;simpl;trivial;discriminate. +Qed. + +Lemma is_even_Zeven : forall p, is_even p = true -> Zeven p. +Proof. + destruct p;intros;simpl;trivial;discriminate. +Qed. + +Lemma lt_square : forall x y, 0 < x -> x < y -> x*x < y*y. +Proof. + intros; apply Zlt_trans with (x*y). + apply Zmult_lt_compat_l;trivial. + apply Zmult_lt_compat_r;trivial. omega. +Qed. + +Lemma le_square : forall x y, 0 <= x -> x <= y -> x*x <= y*y. +Proof. + intros; apply Zle_trans with (x*y). + apply Zmult_le_compat_l;trivial. + apply Zmult_le_compat_r;trivial. omega. +Qed. + +Lemma borned_square : forall x y, 0 <= x -> 0 <= y -> + x*x < y*y < (x+1)*(x+1) -> False. +Proof. + intros;destruct (Z_lt_ge_dec x y) as [z|z]. + assert (x + 1 <= y). omega. + assert (0 <= x+1). omega. + assert (H4 := le_square _ _ H3 H2). omega. + assert (H4 := le_square _ _ H0 (Zge_le _ _ z)). omega. +Qed. + +Lemma not_square : forall (sqrt:positive) n, sqrt * sqrt < n < (sqrt+1)*(sqrt + 1) -> ~(isSquare n). +Proof. + intros sqrt n H (y,H0). + destruct (Z_lt_ge_dec 0 y). + apply (borned_square sqrt y);mauto. + assert (y*y = (-y)*(-y)). ring. rewrite H1 in H0;clear H1. + apply (borned_square sqrt (-y));mauto. +Qed. + +Ltac spec_dec := + repeat match goal with + | [H:(?x ?= ?y)%P = _ |- _] => + generalize (is_eq_spec x y); + rewrite H;clear H;simpl; autorewrite with zmisc; + intro + | [H:(?x ?< ?y)%P = _ |- _] => + generalize (is_lt_spec x y); + rewrite H; clear H;simpl; autorewrite with zmisc; + intro + end. + +Ltac elimif := + match goal with + | [H: (if ?b then _ else _) = _ |- _] => + let H1 := fresh "H" in + (CaseEq b;intros H1; rewrite H1 in H; + try discriminate H); elimif + | _ => spec_dec + end. + +Lemma check_s_r_correct : forall s r sqrt, check_s_r s r sqrt = true -> + Z_of_N s = 0 \/ ~ isSquare (r * r - 8 * s). +Proof. + unfold check_s_r;intros. + destruct s as [|s]; trivial;auto. + right;CaseEq (square r - xO (xO (xO s)));[intros H1|intros p1 H1| intros p1 H1]; + rewrite H1 in H;try discriminate H. + elimif. + assert (Zpos (xO (xO (xO s))) = 8 * s). repeat rewrite Zpos_xO_add;ring. + generalizeclear H1; rewrite H2;mauto;intros. + apply (not_square sqrt). + rewrite H1;auto. + intros (y,Heq). + generalize H1 Heq;mauto. + unfold Z_of_N. + match goal with |- ?x = _ -> ?y = _ -> _ => + replace x with y; try ring + end. + intros Heq1;rewrite Heq1;intros Heq2. + destruct y;discriminate Heq2. +Qed. + +Opaque Zplus Pplus. +Lemma in_mkProd_prime_div_in : + forall p:positive, prime p -> + forall (l:dec_prime), + (forall k, In k l -> prime (fst k)) -> + Zdivide p (mkProd l) -> exists n,In (p, n) l. +Proof with mauto. + induction l;simpl ... + intros _ H1; absurd (p <= 1). + apply Zlt_not_le; apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. + apply Zdivide_le; auto with zarith. + intros; case prime_mult with (2 := H1); auto with zarith; intros H2. + exists (snd a);left. + destruct a;simpl in *. + assert (Zpos p = Zpos p0). + rewrite (prime_div_Zpower_prime p1 p p0)... + apply (H0 (p0,p1));auto. + inversion H3... + destruct IHl as (n,H3)... + exists n... +Qed. + +Lemma gcd_Zis_gcd : forall a b:positive, (Zis_gcd b a (gcd b a)%P). +Proof with mauto. + intros a;assert (Hacc := Zwf_pos a);induction Hacc;rename x into a;intros. + generalize (div_eucl_spec b a)... + rewrite <- (Pmod_div_eucl b a). + CaseEq (b mod a)%P;[intros Heq|intros r Heq]; intros (H1,H2). + simpl in H1;rewrite Zplus_0_r in H1. + rewrite (gcd_mod0 _ _ Heq). + constructor;mauto. + apply Zdivide_intro with (fst (b/a)%P);trivial. + rewrite (gcd_mod _ _ _ Heq). + rewrite H1;apply Zis_gcd_sym. + rewrite Zmult_comm;apply Zis_gcd_for_euclid2;simpl in *. + apply Zis_gcd_sym;auto. +Qed. + +Lemma test_pock_correct : forall N a dec sqrt, + (forall k, In k dec -> prime (Zpos (fst k))) -> + test_pock N a dec sqrt = true -> + prime N. +Proof with mauto. + unfold test_pock;intros. + elimif. + generalize (div_eucl_spec (Ppred N) (mkProd dec)); + destruct ((Ppred N) / (mkProd dec))%P as (R1,n);simpl;mauto;intros (H2,H3). + destruct R1 as [|R1];try discriminate H0. + destruct n;try discriminate H0. + elimif. + generalize (div_eucl_spec R1 (xO (mkProd dec))); + destruct ((R1 / xO (mkProd dec))%P) as (s,r');simpl;mauto;intros (H7,H8). + destruct r' as [|r];try discriminate H0. + generalize (fst_all_pow_mod N a dec (R1*mkProd_pred dec) 1 + (pow_mod_pred (pow_mod a R1 N) dec N)). + generalize (snd_all_pow_mod N dec 1 (pow_mod_pred (pow_mod a R1 N) dec N)). + destruct (all_pow_mod 1 (pow_mod_pred (pow_mod a R1 N) dec N) dec N) as + (prod,aNm1);simpl... + destruct prod as [|prod];try discriminate H0. + destruct aNm1 as [|aNm1];try discriminate H0;elimif. + simpl in H2;rewrite Zplus_0_r in H2. + rewrite <- Ppred_Zminus in H2;try omega. + rewrite <- Zmult_assoc;rewrite mkProd_pred_mkProd. + intros H12;assert (a^(N-1) mod N = 1). + pattern 1 at 2;rewrite <- H9;symmetry. + rewrite H2;rewrite H12 ... + rewrite <- Zpower_mult... + clear H12. + intros H14. + match type of H14 with _ -> _ -> _ -> ?X => + assert (H12:X); try apply H14; clear H14 + end... + rewrite Zmod_small... + assert (1 < mkProd dec). + assert (H14 := Zlt_0_pos (mkProd dec)). + assert (1 <= mkProd dec)... + destruct (Zle_lt_or_eq _ _ H15)... + inversion H16. rewrite <- H18 in H5;discriminate H5. + simpl in H8. + assert (Z_of_N s = R1 / (2 * mkProd dec) /\ Zpos r = R1 mod (2 * mkProd dec)). + apply mod_unique with (2 * mkProd dec);auto with zarith. + apply Z_mod_lt ... + rewrite <- Z_div_mod_eq... rewrite H7. simpl;ring. + destruct H15 as (H15,Heqr). + apply PocklingtonExtra with (F1:=mkProd dec) (R1:=R1) (m:=1); + auto with zmisc zarith. + rewrite H2;ring. + apply is_even_Zeven... + apply is_odd_Zodd... + intros p; case p; clear p. + intros HH; contradict HH. + apply not_prime_0. + 2: intros p (V1, _); contradict V1; apply Zle_not_lt; red; simpl; intros; + discriminate. + intros p Hprime Hdec; exists (Zpos a);repeat split; auto with zarith. + apply Zis_gcd_gcd; auto with zarith. + change (rel_prime (a ^ ((N - 1) / p) - 1) N). + match type of H12 with _ = ?X mod _ => + apply rel_prime_div with (p := X); auto with zarith + end. + apply rel_prime_mod_rev; auto with zarith. + red. + pattern 1 at 3; rewrite <- H10; rewrite <- H12. + apply Pmod.gcd_Zis_gcd. + destruct (in_mkProd_prime_div_in _ Hprime _ H Hdec) as (q,Hin). + rewrite <- H2. + match goal with |- context [fold_left ?f _ _] => + apply (ListAux.fold_left_invol_in _ _ f (fun k => Zdivide (a ^ ((N - 1) / p) - 1) k)) + with (b := (p, q)); auto with zarith + end. + rewrite <- Heqr. + generalizeclear H0; ring_simplify + (((mkProd dec + mkProd dec + r + 1) * mkProd dec + r) * mkProd dec + 1) + ((1 * mkProd dec + 1) * (2 * mkProd dec * mkProd dec + (r - 1) * mkProd dec + 1))... + rewrite <- H15;rewrite <- Heqr. + apply check_s_r_correct with sqrt ... +Qed. + +Lemma is_in_In : + forall p lc, is_in p lc = true -> exists c, In c lc /\ p = nprim c. +Proof. + induction lc;simpl;try (intros;discriminate). + intros;elimif. + exists a;split;auto. inversion H0;trivial. + destruct (IHlc H) as [c [H1 H2]];exists c;auto. +Qed. + +Lemma all_in_In : + forall lc lp, all_in lc lp = true -> + forall pq, In pq lp -> exists c, In c lc /\ fst pq = nprim c. +Proof. + induction lp;simpl. intros H pq HF;elim HF. + intros;destruct a;elimif. + destruct H0;auto. + rewrite <- H0;simpl;apply is_in_In;trivial. +Qed. + +Lemma test_Certif_In_Prime : + forall lc, test_Certif lc = true -> + forall c, In c lc -> prime (nprim c). +Proof with mauto. + induction lc;simpl;intros. elim H0. + destruct H0. + subst c;destruct a;simpl... + elimif. + CaseEq (Mp p);[intros Heq|intros N' Heq|intros N' Heq];rewrite Heq in H; + try discriminate H. elimif. + CaseEq (SS p);[intros Heq'|intros N'' Heq'|intros N'' Heq'];rewrite Heq' in H; + try discriminate H. + rewrite H2;rewrite <- Heq. +apply LucasLehmer;trivial. +(destruct p; try discriminate H1). +simpl in H1; generalize (is_lt_spec 2 p); rewrite H1; auto. +elimif. +apply (test_pock_correct N a d p); mauto. + intros k Hin;destruct (all_in_In _ _ H1 _ Hin) as (c,(H2,H3)). + rewrite H3;auto. +discriminate. +discriminate. + destruct a;elimif;auto. +discriminate. +discriminate. +Qed. + +Lemma Pocklington_refl : + forall c lc, test_Certif (c::lc) = true -> prime (nprim c). +Proof. + intros c lc Heq;apply test_Certif_In_Prime with (c::lc);trivial;simpl;auto. +Qed. + diff --git a/coqprime-8.4/Coqprime/Root.v b/coqprime-8.4/Coqprime/Root.v new file mode 100644 index 000000000..4e74a4d2f --- /dev/null +++ b/coqprime-8.4/Coqprime/Root.v @@ -0,0 +1,239 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(*********************************************************************** + Root.v + + Proof that a polynomial has at most n roots +************************************************************************) +Require Import Coq.ZArith.ZArith. +Require Import Coq.Lists.List. +Require Import Coqprime.UList. +Require Import Coqprime.Tactic. +Require Import Coqprime.Permutation. + +Open Scope Z_scope. + +Section Root. + +Variable A: Set. +Variable P: A -> Prop. +Variable plus mult: A -> A -> A. +Variable op: A -> A. +Variable zero one: A. + + +Let pol := list A. + +Definition toA z := +match z with + Z0 => zero +| Zpos p => iter_pos p _ (plus one) zero +| Zneg p => op (iter_pos p _ (plus one) zero) +end. + +Fixpoint eval (p: pol) (x: A) {struct p} : A := +match p with + nil => zero +| a::p1 => plus a (mult x (eval p1 x)) +end. + +Fixpoint div (p: pol) (x: A) {struct p} : pol * A := +match p with + nil => (nil, zero) +| a::nil => (nil, a) +| a::p1 => + (snd (div p1 x)::fst (div p1 x), + (plus a (mult x (snd (div p1 x))))) +end. + +Hypothesis Pzero: P zero. +Hypothesis Pplus: forall x y, P x -> P y -> P (plus x y). +Hypothesis Pmult: forall x y, P x -> P y -> P (mult x y). +Hypothesis Pop: forall x, P x -> P (op x). +Hypothesis plus_zero: forall a, P a -> plus zero a = a. +Hypothesis plus_comm: forall a b, P a -> P b -> plus a b = plus b a. +Hypothesis plus_assoc: forall a b c, P a -> P b -> P c -> plus a (plus b c) = plus (plus a b) c. +Hypothesis mult_zero: forall a, P a -> mult zero a = zero. +Hypothesis mult_comm: forall a b, P a -> P b -> mult a b = mult b a. +Hypothesis mult_assoc: forall a b c, P a -> P b -> P c -> mult a (mult b c) = mult (mult a b) c. +Hypothesis mult_plus_distr: forall a b c, P a -> P b -> P c -> mult a (plus b c) = plus (mult a b) (mult a c). +Hypothesis plus_op_zero: forall a, P a -> plus a (op a) = zero. +Hypothesis mult_integral: forall a b, P a -> P b -> mult a b = zero -> a = zero \/ b = zero. +(* Not necessary in Set just handy *) +Hypothesis A_dec: forall a b: A, {a = b} + {a <> b}. + +Theorem eval_P: forall p a, P a -> (forall i, In i p -> P i) -> P (eval p a). +intros p a Pa; elim p; simpl; auto with datatypes. +intros a1 l1 Rec H; apply Pplus; auto. +Qed. + +Hint Resolve eval_P. + +Theorem div_P: forall p a, P a -> (forall i, In i p -> P i) -> (forall i, In i (fst (div p a)) -> P i) /\ P (snd (div p a)). +intros p a Pa; elim p; auto with datatypes. +intros a1 l1; case l1. +simpl; intuition. +intros a2 p2 Rec Hi; split. +case Rec; auto with datatypes. +intros H H1 i. +replace (In i (fst (div (a1 :: a2 :: p2) a))) with + (snd (div (a2::p2) a) = i \/ In i (fst (div (a2::p2) a))); auto. +intros [Hi1 | Hi1]; auto. +rewrite <- Hi1; auto. +change ( P (plus a1 (mult a (snd (div (a2::p2) a))))); auto with datatypes. +apply Pplus; auto with datatypes. +apply Pmult; auto with datatypes. +case Rec; auto with datatypes. +Qed. + + +Theorem div_correct: + forall p x y, P x -> P y -> (forall i, In i p -> P i) -> eval p y = plus (mult (eval (fst (div p x)) y) (plus y (op x))) (snd (div p x)). +intros p x y; elim p; simpl. +intros; rewrite mult_zero; try rewrite plus_zero; auto. +intros a l; case l; simpl; auto. +intros _ px py pa; rewrite (fun x => mult_comm x zero); repeat rewrite mult_zero; try apply plus_comm; auto. +intros a1 l1. +generalize (div_P (a1::l1) x); simpl. +match goal with |- context[fst ?A] => case A end; simpl. +intros q r Hd Rec px py pi. +assert (pr: P r). +case Hd; auto. +assert (pa1: P a1). +case Hd; auto. +assert (pey: P (eval q y)). +apply eval_P; auto. +case Hd; auto. +rewrite Rec; auto with datatypes. +rewrite (fun x y => plus_comm x (plus a y)); try rewrite <- plus_assoc; auto. +apply f_equal2 with (f := plus); auto. +repeat rewrite mult_plus_distr; auto. +repeat (rewrite (fun x y => (mult_comm (plus x y))) || rewrite mult_plus_distr); auto. +rewrite (fun x => (plus_comm x (mult y r))); auto. +repeat rewrite plus_assoc; try apply f_equal2 with (f := plus); auto. +2: repeat rewrite mult_assoc; try rewrite (fun y => mult_comm y (op x)); + repeat rewrite mult_assoc; auto. +rewrite (fun z => (plus_comm z (mult (op x) r))); auto. +repeat rewrite plus_assoc; try apply f_equal2 with (f := plus); auto. +2: apply f_equal2 with (f := mult); auto. +repeat rewrite (fun x => mult_comm x r); try rewrite <- mult_plus_distr; auto. +rewrite (plus_comm (op x)); try rewrite plus_op_zero; auto. +rewrite (fun x => mult_comm x zero); try rewrite mult_zero; try rewrite plus_zero; auto. +Qed. + +Theorem div_correct_factor: + forall p a, (forall i, In i p -> P i) -> P a -> + eval p a = zero -> forall x, P x -> eval p x = (mult (eval (fst (div p a)) x) (plus x (op a))). +intros p a Hp Ha H x px. +case (div_P p a); auto; intros Hd1 Hd2. +rewrite (div_correct p a x); auto. +generalize (div_correct p a a). +rewrite plus_op_zero; try rewrite (fun x => mult_comm x zero); try rewrite mult_zero; try rewrite plus_zero; try rewrite H; auto. +intros H1; rewrite <- H1; auto. +rewrite (fun x => plus_comm x zero); auto. +Qed. + +Theorem length_decrease: forall p x, p <> nil -> (length (fst (div p x)) < length p)%nat. +intros p x; elim p; simpl; auto. +intros H1; case H1; auto. +intros a l; case l; simpl; auto. +intros a1 l1. +match goal with |- context[fst ?A] => case A end; simpl; auto with zarith. +intros p1 _ H H1. +apply lt_n_S; apply H; intros; discriminate. +Qed. + +Theorem root_max: +forall p l, ulist l -> (forall i, In i p -> P i) -> (forall i, In i l -> P i) -> + (forall x, In x l -> eval p x = zero) -> (length p <= length l)%nat -> forall x, P x -> eval p x = zero. +intros p l; generalize p; elim l; clear l p; simpl; auto. +intros p; case p; simpl; auto. +intros a p1 _ _ _ _ H; contradict H; auto with arith. +intros a p1 Rec p; case p. +simpl; auto. +intros a1 p2 H H1 H2 H3 H4 x px. +assert (Hu: eval (a1 :: p2) a = zero); auto with datatypes. +rewrite (div_correct_factor (a1 :: p2) a); auto with datatypes. +match goal with |- mult ?X _ = _ => replace X with zero end; try apply mult_zero; auto. +apply sym_equal; apply Rec; auto with datatypes. +apply ulist_inv with (1 := H). +intros i Hi; case (div_P (a1 :: p2) a); auto. +intros x1 H5; case (mult_integral (eval (fst (div (a1 :: p2) a)) x1) (plus x1 (op a))); auto. +apply eval_P; auto. +intros i Hi; case (div_P (a1 :: p2) a); auto. +rewrite <- div_correct_factor; auto. +intros H6; case (ulist_app_inv _ (a::nil) p1 x1); simpl; auto. +left. +apply trans_equal with (plus zero x1); auto. +rewrite <- (plus_op_zero a); try rewrite <- plus_assoc; auto. +rewrite (fun x => plus_comm (op x)); try rewrite H6; try rewrite plus_comm; auto. +apply sym_equal; apply plus_zero; auto. +apply lt_n_Sm_le;apply lt_le_trans with (length (a1 :: p2)); auto with zarith. +apply length_decrease; auto with datatypes. +Qed. + +Theorem root_max_is_zero: +forall p l, ulist l -> (forall i, In i p -> P i) -> (forall i, In i l -> P i) -> + (forall x, In x l -> eval p x = zero) -> (length p <= length l)%nat -> forall x, (In x p) -> x = zero. +intros p l; generalize p; elim l; clear l p; simpl; auto. +intros p; case p; simpl; auto. +intros _ _ _ _ _ x H; case H. +intros a p1 _ _ _ _ H; contradict H; auto with arith. +intros a p1 Rec p; case p. +simpl; auto. +intros _ _ _ _ _ x H; case H. +simpl; intros a1 p2 H H1 H2 H3 H4 x H5. +assert (Ha1: a1 = zero). +assert (Hu: (eval (a1::p2) zero = zero)). +apply root_max with (l := a :: p1); auto. +rewrite <- Hu; simpl; rewrite mult_zero; try rewrite plus_comm; sauto. +case H5; clear H5; intros H5; subst; auto. +apply Rec with p2; auto with arith. +apply ulist_inv with (1 := H). +intros x1 Hx1. +case (In_dec A_dec zero p1); intros Hz. +case (in_permutation_ex _ zero p1); auto; intros p3 Hp3. +apply root_max with (l := a::p3); auto. +apply ulist_inv with zero. +apply ulist_perm with (a::p1); auto. +apply permutation_trans with (a:: (zero:: p3)); auto. +apply permutation_skip; auto. +apply permutation_sym; auto. +simpl; intros x2 [Hx2 | Hx2]; subst; auto. +apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. +simpl; intros x2 [Hx2 | Hx2]; subst. +case (mult_integral x2 (eval p2 x2)); auto. +rewrite <- H3 with x2; sauto. +rewrite plus_zero; auto. +intros H6; case (ulist_app_inv _ (x2::nil) p1 x2) ; auto with datatypes. +rewrite H6; apply permutation_in with (1 := Hp3); auto with datatypes. +case (mult_integral x2 (eval p2 x2)); auto. +apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. +apply eval_P; auto. +apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. +rewrite <- H3 with x2; sauto; try right. +apply sym_equal; apply plus_zero; auto. +apply Pmult; auto. +apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. +apply eval_P; auto. +apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. +apply permutation_in with (1 := Hp3); auto with datatypes. +intros H6; case (ulist_app_inv _ (zero::nil) p3 x2) ; auto with datatypes. +simpl; apply ulist_perm with (1:= (permutation_sym _ _ _ Hp3)). +apply ulist_inv with (1 := H). +rewrite H6; auto with datatypes. +replace (length (a :: p3)) with (length (zero::p3)); auto. +rewrite permutation_length with (1 := Hp3); auto with arith. +case (mult_integral x1 (eval p2 x1)); auto. +rewrite <- H3 with x1; sauto; try right. +apply sym_equal; apply plus_zero; auto. +intros HH; case Hz; rewrite <- HH; auto. +Qed. + +End Root. \ No newline at end of file diff --git a/coqprime-8.4/Coqprime/Tactic.v b/coqprime-8.4/Coqprime/Tactic.v new file mode 100644 index 000000000..93a244149 --- /dev/null +++ b/coqprime-8.4/Coqprime/Tactic.v @@ -0,0 +1,84 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + + +(********************************************************************** + Tactic.v + Useful tactics + **********************************************************************) + +(************************************** + A simple tactic to end a proof +**************************************) +Ltac finish := intros; auto; trivial; discriminate. + + +(************************************** + A tactic for proof by contradiction + with contradict H + H: ~A |- B gives |- A + H: ~A |- ~ B gives H: B |- A + H: A |- B gives |- ~ A + H: A |- B gives |- ~ A + H: A |- ~ B gives H: A |- ~ A +**************************************) + +Ltac contradict name := + let term := type of name in ( + match term with + (~_) => + match goal with + |- ~ _ => let x := fresh in + (intros x; case name; + generalize x; clear x name; + intro name) + | |- _ => case name; clear name + end + | _ => + match goal with + |- ~ _ => let x := fresh in + (intros x; absurd term; + [idtac | exact name]; generalize x; clear x name; + intros name) + | |- _ => generalize name; absurd term; + [idtac | exact name]; clear name + end + end). + + +(************************************** + A tactic to do case analysis keeping the equality +**************************************) + +Ltac case_eq name := + generalize (refl_equal name); pattern name at -1 in |- *; case name. + + +(************************************** + A tactic to use f_equal? theorems +**************************************) + +Ltac eq_tac := + match goal with + |- (?g _ = ?g _) => apply f_equal with (f := g) + | |- (?g ?X _ = ?g ?X _) => apply f_equal with (f := g X) + | |- (?g _ _ = ?g _ _) => apply f_equal2 with (f := g) + | |- (?g ?X ?Y _ = ?g ?X ?Y _) => apply f_equal with (f := g X Y) + | |- (?g ?X _ _ = ?g ?X _ _) => apply f_equal2 with (f := g X) + | |- (?g _ _ _ = ?g _ _ _) => apply f_equal3 with (f := g) + | |- (?g ?X ?Y ?Z _ = ?g ?X ?Y ?Z _) => apply f_equal with (f := g X Y Z) + | |- (?g ?X ?Y _ _ = ?g ?X ?Y _ _) => apply f_equal2 with (f := g X Y) + | |- (?g ?X _ _ _ = ?g ?X _ _ _) => apply f_equal3 with (f := g X) + | |- (?g _ _ _ _ _ = ?g _ _ _ _) => apply f_equal4 with (f := g) + end. + +(************************************** + A stupid tactic that tries auto also after applying sym_equal +**************************************) + +Ltac sauto := (intros; apply sym_equal; auto; fail) || auto. diff --git a/coqprime-8.4/Coqprime/UList.v b/coqprime-8.4/Coqprime/UList.v new file mode 100644 index 000000000..32ca6b2a0 --- /dev/null +++ b/coqprime-8.4/Coqprime/UList.v @@ -0,0 +1,284 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(*********************************************************************** + UList.v + + Definition of list with distinct elements + + Definition: ulist +************************************************************************) +Require Import Coq.Lists.List. +Require Import Coq.Arith.Arith. +Require Import Coqprime.Permutation. +Require Import Coq.Lists.ListSet. + +Section UniqueList. +Variable A : Set. +Variable eqA_dec : forall (a b : A), ({ a = b }) + ({ a <> b }). +(* A list is unique if there is not twice the same element in the list *) + +Inductive ulist : list A -> Prop := + ulist_nil: ulist nil + | ulist_cons: forall a l, ~ In a l -> ulist l -> ulist (a :: l) . +Hint Constructors ulist . +(* Inversion theorem *) + +Theorem ulist_inv: forall a l, ulist (a :: l) -> ulist l. +intros a l H; inversion H; auto. +Qed. +(* The append of two unique list is unique if the list are distinct *) + +Theorem ulist_app: + forall l1 l2, + ulist l1 -> + ulist l2 -> (forall (a : A), In a l1 -> In a l2 -> False) -> ulist (l1 ++ l2). +intros L1; elim L1; simpl; auto. +intros a l H l2 H0 H1 H2; apply ulist_cons; simpl; auto. +red; intros H3; case in_app_or with ( 1 := H3 ); auto; intros H4. +inversion H0; auto. +apply H2 with a; auto. +apply H; auto. +apply ulist_inv with ( 1 := H0 ); auto. +intros a0 H3 H4; apply (H2 a0); auto. +Qed. +(* Iinversion theorem the appended list *) + +Theorem ulist_app_inv: + forall l1 l2 (a : A), ulist (l1 ++ l2) -> In a l1 -> In a l2 -> False. +intros l1; elim l1; simpl; auto. +intros a l H l2 a0 H0 [H1|H1] H2; +inversion H0 as [|a1 l0 H3 H4 H5]; clear H0; auto; + subst; eauto using ulist_inv with datatypes. +Qed. +(* Iinversion theorem the appended list *) + +Theorem ulist_app_inv_l: forall (l1 l2 : list A), ulist (l1 ++ l2) -> ulist l1. +intros l1; elim l1; simpl; auto. +intros a l H l2 H0. +inversion H0 as [|il1 iH1 iH2 il2 [iH4 iH5]]; apply ulist_cons; auto. +intros H5; case iH2; auto with datatypes. +apply H with l2; auto. +Qed. +(* Iinversion theorem the appended list *) + +Theorem ulist_app_inv_r: forall (l1 l2 : list A), ulist (l1 ++ l2) -> ulist l2. +intros l1; elim l1; simpl; auto. +intros a l H l2 H0; inversion H0; auto. +Qed. +(* Uniqueness is decidable *) + +Definition ulist_dec: forall l, ({ ulist l }) + ({ ~ ulist l }). +intros l; elim l; auto. +intros a l1 [H|H]; auto. +case (In_dec eqA_dec a l1); intros H2; auto. +right; red; intros H1; inversion H1; auto. +right; intros H1; case H; apply ulist_inv with ( 1 := H1 ). +Defined. +(* Uniqueness is compatible with permutation *) + +Theorem ulist_perm: + forall (l1 l2 : list A), permutation l1 l2 -> ulist l1 -> ulist l2. +intros l1 l2 H; elim H; clear H l1 l2; simpl; auto. +intros a l1 l2 H0 H1 H2; apply ulist_cons; auto. +inversion_clear H2 as [|ia il iH1 iH2 [iH3 iH4]]; auto. +intros H3; case iH1; + apply permutation_in with ( 1 := permutation_sym _ _ _ H0 ); auto. +inversion H2; auto. +intros a b L H0; apply ulist_cons; auto. +inversion_clear H0 as [|ia il iH1 iH2]; auto. +inversion_clear iH2 as [|ia il iH3 iH4]; auto. +intros H; case H; auto. +intros H1; case iH1; rewrite H1; simpl; auto. +apply ulist_cons; auto. +inversion_clear H0 as [|ia il iH1 iH2]; auto. +intros H; case iH1; simpl; auto. +inversion_clear H0 as [|ia il iH1 iH2]; auto. +inversion iH2; auto. +Qed. + +Theorem ulist_def: + forall l a, + In a l -> ulist l -> ~ (exists l1 , permutation l (a :: (a :: l1)) ). +intros l a H H0 [l1 H1]. +absurd (ulist (a :: (a :: l1))); auto. +intros H2; inversion_clear H2; simpl; auto with datatypes. +apply ulist_perm with ( 1 := H1 ); auto. +Qed. + +Theorem ulist_incl_permutation: + forall (l1 l2 : list A), + ulist l1 -> incl l1 l2 -> (exists l3 , permutation l2 (l1 ++ l3) ). +intros l1; elim l1; simpl; auto. +intros l2 H H0; exists l2; simpl; auto. +intros a l H l2 H0 H1; auto. +case (in_permutation_ex _ a l2); auto with datatypes. +intros l3 Hl3. +case (H l3); auto. +apply ulist_inv with ( 1 := H0 ); auto. +intros b Hb. +assert (H2: In b (a :: l3)). +apply permutation_in with ( 1 := permutation_sym _ _ _ Hl3 ); + auto with datatypes. +simpl in H2 |-; case H2; intros H3; simpl; auto. +inversion_clear H0 as [|c lc Hk1]; auto. +case Hk1; subst a; auto. +intros l4 H4; exists l4. +apply permutation_trans with (a :: l3); auto. +apply permutation_sym; auto. +Qed. + +Theorem ulist_eq_permutation: + forall (l1 l2 : list A), + ulist l1 -> incl l1 l2 -> length l1 = length l2 -> permutation l1 l2. +intros l1 l2 H1 H2 H3. +case (ulist_incl_permutation l1 l2); auto. +intros l3 H4. +assert (H5: l3 = @nil A). +generalize (permutation_length _ _ _ H4); rewrite length_app; rewrite H3. +rewrite plus_comm; case l3; simpl; auto. +intros a l H5; absurd (lt (length l2) (length l2)); auto with arith. +pattern (length l2) at 2; rewrite H5; auto with arith. +replace l1 with (app l1 l3); auto. +apply permutation_sym; auto. +rewrite H5; rewrite app_nil_end; auto. +Qed. + + +Theorem ulist_incl_length: + forall (l1 l2 : list A), ulist l1 -> incl l1 l2 -> le (length l1) (length l2). +intros l1 l2 H1 Hi; case ulist_incl_permutation with ( 2 := Hi ); auto. +intros l3 Hl3; rewrite permutation_length with ( 1 := Hl3 ); auto. +rewrite length_app; simpl; auto with arith. +Qed. + +Theorem ulist_incl2_permutation: + forall (l1 l2 : list A), + ulist l1 -> ulist l2 -> incl l1 l2 -> incl l2 l1 -> permutation l1 l2. +intros l1 l2 H1 H2 H3 H4. +apply ulist_eq_permutation; auto. +apply le_antisym; apply ulist_incl_length; auto. +Qed. + + +Theorem ulist_incl_length_strict: + forall (l1 l2 : list A), + ulist l1 -> incl l1 l2 -> ~ incl l2 l1 -> lt (length l1) (length l2). +intros l1 l2 H1 Hi Hi0; case ulist_incl_permutation with ( 2 := Hi ); auto. +intros l3 Hl3; rewrite permutation_length with ( 1 := Hl3 ); auto. +rewrite length_app; simpl; auto with arith. +generalize Hl3; case l3; simpl; auto with arith. +rewrite <- app_nil_end; auto. +intros H2; case Hi0; auto. +intros a HH; apply permutation_in with ( 1 := H2 ); auto. +intros a l Hl0; (rewrite plus_comm; simpl; rewrite plus_comm; auto with arith). +Qed. + +Theorem in_inv_dec: + forall (a b : A) l, In a (cons b l) -> a = b \/ ~ a = b /\ In a l. +intros a b l H; case (eqA_dec a b); auto; intros H1. +right; split; auto; inversion H; auto. +case H1; auto. +Qed. + +Theorem in_ex_app_first: + forall (a : A) (l : list A), + In a l -> + (exists l1 : list A , exists l2 : list A , l = l1 ++ (a :: l2) /\ ~ In a l1 ). +intros a l; elim l; clear l; auto. +intros H; case H. +intros a1 l H H1; auto. +generalize (in_inv_dec _ _ _ H1); intros [H2|[H2 H3]]. +exists (nil (A:=A)); exists l; simpl; split; auto. +subst; auto. +case H; auto; intros l1 [l2 [Hl2 Hl3]]; exists (a1 :: l1); exists l2; simpl; + split; auto. +subst; auto. +intros H4; case H4; auto. +Qed. + +Theorem ulist_inv_ulist: + forall (l : list A), + ~ ulist l -> + (exists a , + exists l1 , + exists l2 , + exists l3 , l = l1 ++ ((a :: l2) ++ (a :: l3)) /\ ulist (l1 ++ (a :: l2)) ). +intros l; elim l using list_length_ind; clear l. +intros l; case l; simpl; auto; clear l. +intros Rec H0; case H0; auto. +intros a l H H0. +case (In_dec eqA_dec a l); intros H1; auto. +case in_ex_app_first with ( 1 := H1 ); intros l1 [l2 [Hl1 Hl2]]; subst l. +case (ulist_dec l1); intros H2. +exists a; exists (@nil A); exists l1; exists l2; split; auto. +simpl; apply ulist_cons; auto. +case (H l1); auto. +rewrite length_app; auto with arith. +intros b [l3 [l4 [l5 [Hl3 Hl4]]]]; subst l1. +exists b; exists (a :: l3); exists l4; exists (l5 ++ (a :: l2)); split; simpl; + auto. +(repeat (rewrite <- ass_app; simpl)); auto. +apply ulist_cons; auto. +contradict Hl2; auto. +replace (l3 ++ (b :: (l4 ++ (b :: l5)))) with ((l3 ++ (b :: l4)) ++ (b :: l5)); + auto with datatypes. +(repeat (rewrite <- ass_app; simpl)); auto. +case (H l); auto; intros a1 [l1 [l2 [l3 [Hl3 Hl4]]]]; subst l. +exists a1; exists (a :: l1); exists l2; exists l3; split; auto. +simpl; apply ulist_cons; auto. +contradict H1. +replace (l1 ++ (a1 :: (l2 ++ (a1 :: l3)))) + with ((l1 ++ (a1 :: l2)) ++ (a1 :: l3)); auto with datatypes. +(repeat (rewrite <- ass_app; simpl)); auto. +Qed. + +Theorem incl_length_repetition: + forall (l1 l2 : list A), + incl l1 l2 -> + lt (length l2) (length l1) -> + (exists a , + exists ll1 , + exists ll2 , + exists ll3 , + l1 = ll1 ++ ((a :: ll2) ++ (a :: ll3)) /\ ulist (ll1 ++ (a :: ll2)) ). +intros l1 l2 H H0; apply ulist_inv_ulist. +intros H1; absurd (le (length l1) (length l2)); auto with arith. +apply ulist_incl_length; auto. +Qed. + +End UniqueList. +Implicit Arguments ulist [A]. +Hint Constructors ulist . + +Theorem ulist_map: + forall (A B : Set) (f : A -> B) l, + (forall x y, (In x l) -> (In y l) -> f x = f y -> x = y) -> ulist l -> ulist (map f l). +intros a b f l Hf Hl; generalize Hf; elim Hl; clear Hf; auto. +simpl; auto. +intros a1 l1 H1 H2 H3 Hf; simpl. +apply ulist_cons; auto with datatypes. +contradict H1. +case in_map_inv with ( 1 := H1 ); auto with datatypes. +intros b1 [Hb1 Hb2]. +replace a1 with b1; auto with datatypes. +Qed. + +Theorem ulist_list_prod: + forall (A : Set) (l1 l2 : list A), + ulist l1 -> ulist l2 -> ulist (list_prod l1 l2). +intros A l1 l2 Hl1 Hl2; elim Hl1; simpl; auto. +intros a l H1 H2 H3; apply ulist_app; auto. +apply ulist_map; auto. +intros x y _ _ H; inversion H; auto. +intros p Hp1 Hp2; case H1. +case in_map_inv with ( 1 := Hp1 ); intros a1 [Ha1 Ha2]; auto. +case in_list_prod_inv with ( 1 := Hp2 ); intros b1 [c1 [Hb1 [Hb2 Hb3]]]; auto. +replace a with b1; auto. +rewrite Ha2 in Hb1; injection Hb1; auto. +Qed. diff --git a/coqprime-8.4/Coqprime/ZCAux.v b/coqprime-8.4/Coqprime/ZCAux.v new file mode 100644 index 000000000..aa47fb655 --- /dev/null +++ b/coqprime-8.4/Coqprime/ZCAux.v @@ -0,0 +1,295 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + ZCAux.v + + Auxillary functions & Theorems + **********************************************************************) + +Require Import Coq.setoid_ring.ArithRing. +Require Export Coq.ZArith.ZArith Coq.ZArith.Zpow_facts. +Require Export Coq.ZArith.Znumtheory. +Require Export Coqprime.Tactic. + +Theorem Zdivide_div_prime_le_square: forall x, 1 < x -> ~prime x -> exists p, prime p /\ (p | x) /\ p * p <= x. +intros x Hx; generalize Hx; pattern x; apply Z_lt_induction; auto with zarith. +clear x Hx; intros x Rec H H1. +case (not_prime_divide x); auto. +intros x1 ((H2, H3), H4); case (prime_dec x1); intros H5. +case (Zle_or_lt (x1 * x1) x); intros H6. +exists x1; auto. +case H4; clear H4; intros x2 H4; subst. +assert (Hx2: x2 <= x1). +case (Zle_or_lt x2 x1); auto; intros H8; contradict H6; apply Zle_not_lt. +apply Zmult_le_compat_r; auto with zarith. +case (prime_dec x2); intros H7. +exists x2; repeat (split; auto with zarith). +apply Zmult_le_compat_l; auto with zarith. +apply Zle_trans with 2%Z; try apply prime_ge_2; auto with zarith. +case (Zle_or_lt 0 x2); intros H8. +case Zle_lt_or_eq with (1 := H8); auto with zarith; clear H8; intros H8; subst; auto with zarith. +case (Zle_lt_or_eq 1 x2); auto with zarith; clear H8; intros H8; subst; auto with zarith. +case (Rec x2); try split; auto with zarith. +intros x3 (H9, (H10, H11)). +exists x3; repeat (split; auto with zarith). +contradict H; apply Zle_not_lt; auto with zarith. +apply Zle_trans with (0 * x1); auto with zarith. +case (Rec x1); try split; auto with zarith. +intros x3 (H9, (H10, H11)). +exists x3; repeat (split; auto with zarith). +apply Zdivide_trans with x1; auto with zarith. +Qed. + + +Theorem Zmult_interval: forall p q, 0 < p * q -> 1 < p -> 0 < q < p * q. +intros p q H1 H2; assert (0 < q). +case (Zle_or_lt q 0); auto; intros H3; contradict H1; apply Zle_not_lt. +rewrite <- (Zmult_0_r p). +apply Zmult_le_compat_l; auto with zarith. +split; auto. +pattern q at 1; rewrite <- (Zmult_1_l q). +apply Zmult_lt_compat_r; auto with zarith. +Qed. + +Theorem prime_induction: forall (P: Z -> Prop), P 0 -> P 1 -> (forall p q, prime p -> P q -> P (p * q)) -> forall p, 0 <= p -> P p. +intros P H H1 H2 p Hp. +generalize Hp; pattern p; apply Z_lt_induction; auto; clear p Hp. +intros p Rec Hp. +case Zle_lt_or_eq with (1 := Hp); clear Hp; intros Hp; subst; auto. +case (Zle_lt_or_eq 1 p); auto with zarith; clear Hp; intros Hp; subst; auto. +case (prime_dec p); intros H3. +rewrite <- (Zmult_1_r p); apply H2; auto. + case (Zdivide_div_prime_le_square p); auto. +intros q (Hq1, ((q2, Hq2), Hq3)); subst. +case (Zmult_interval q q2). +rewrite Zmult_comm; apply Zlt_trans with 1; auto with zarith. +apply Zlt_le_trans with 2; auto with zarith; apply prime_ge_2; auto. +intros H4 H5; rewrite Zmult_comm; apply H2; auto. +apply Rec; try split; auto with zarith. +rewrite Zmult_comm; auto. +Qed. + +Theorem div_power_max: forall p q, 1 < p -> 0 < q -> exists n, 0 <= n /\ (p ^n | q) /\ ~(p ^(1 + n) | q). +intros p q H1 H2; generalize H2; pattern q; apply Z_lt_induction; auto with zarith; clear q H2. +intros q Rec H2. +case (Zdivide_dec p q); intros H3. +case (Zdivide_Zdiv_lt_pos p q); auto with zarith; intros H4 H5. +case (Rec (Zdiv q p)); auto with zarith. +intros n (Ha1, (Ha2, Ha3)); exists (n + 1); split; auto with zarith; split. +case Ha2; intros q1 Hq; exists q1. +rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith. +rewrite Zmult_assoc; rewrite <- Hq. +rewrite Zmult_comm; apply Zdivide_Zdiv_eq; auto with zarith. +intros (q1, Hu); case Ha3; exists q1. +apply Zmult_reg_r with p; auto with zarith. +rewrite (Zmult_comm (q / p)); rewrite <- Zdivide_Zdiv_eq; auto with zarith. +apply trans_equal with (1 := Hu); repeat rewrite Zpower_exp; try rewrite Zpower_exp_1; auto with zarith. +ring. +exists 0; repeat split; try rewrite Zpower_1_r; try rewrite Zpower_exp_0; auto with zarith. +Qed. + +Theorem prime_div_induction: + forall (P: Z -> Prop) n, + 0 < n -> + (P 1) -> + (forall p i, prime p -> 0 <= i -> (p^i | n) -> P (p^i)) -> + (forall p q, rel_prime p q -> P p -> P q -> P (p * q)) -> + forall m, 0 <= m -> (m | n) -> P m. +intros P n P1 Hn H H1 m Hm. +generalize Hm; pattern m; apply Z_lt_induction; auto; clear m Hm. +intros m Rec Hm H2. +case (prime_dec m); intros Hm1. +rewrite <- Zpower_1_r; apply H; auto with zarith. +rewrite Zpower_1_r; auto. +case Zle_lt_or_eq with (1 := Hm); clear Hm; intros Hm; subst. +2: contradict P1; case H2; intros; subst; auto with zarith. +case (Zle_lt_or_eq 1 m); auto with zarith; clear Hm; intros Hm; subst; auto. +case Zdivide_div_prime_le_square with m; auto. +intros p (Hp1, (Hp2, Hp3)). +case (div_power_max p m); auto with zarith. +generalize (prime_ge_2 p Hp1); auto with zarith. +intros i (Hi, (Hi1, Hi2)). +case Zle_lt_or_eq with (1 := Hi); clear Hi; intros Hi. +assert (Hpi: 0 < p ^ i). +apply Zpower_gt_0; auto with zarith. +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +rewrite (Z_div_exact_2 m (p ^ i)); auto with zarith. +apply H1; auto with zarith. +apply rel_prime_sym; apply rel_prime_Zpower_r; auto with zarith. +apply rel_prime_sym. +apply prime_rel_prime; auto. +contradict Hi2. +case Hi1; intros; subst. +rewrite Z_div_mult in Hi2; auto with zarith. +case Hi2; intros q0 Hq0; subst. +exists q0; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith. +apply H; auto with zarith. +apply Zdivide_trans with (1 := Hi1); auto. +apply Rec; auto with zarith. +split; auto with zarith. +apply Z_div_pos; auto with zarith. +apply Z_div_lt; auto with zarith. +apply Zle_ge; apply Zle_trans with p. +apply prime_ge_2; auto. +pattern p at 1; rewrite <- Zpower_1_r; apply Zpower_le_monotone; auto with zarith. +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +apply Z_div_pos; auto with zarith. +apply Zdivide_trans with (2 := H2); auto. +exists (p ^ i); apply Z_div_exact_2; auto with zarith. +apply Zdivide_mod; auto with zarith. +apply Zdivide_mod; auto with zarith. +case Hi2; rewrite <- Hi; rewrite Zplus_0_r; rewrite Zpower_1_r; auto. +Qed. + +Theorem prime_div_Zpower_prime: forall n p q, 0 <= n -> prime p -> prime q -> (p | q ^ n) -> p = q. +intros n p q Hp Hq; generalize p q Hq; pattern n; apply natlike_ind; auto; clear n p q Hp Hq. +intros p q Hp Hq; rewrite Zpower_0_r. +intros (r, H); subst. +case (Zmult_interval p r); auto; try rewrite Zmult_comm. +rewrite <- H; auto with zarith. +apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. +rewrite <- H; intros H1 H2; contradict H2; auto with zarith. +intros n1 H Rec p q Hp Hq; try rewrite Zpower_Zsucc; auto with zarith; intros H1. +case prime_mult with (2 := H1); auto. +intros H2; apply prime_div_prime; auto. +Qed. + +Definition Zmodd a b := +match a with +| Z0 => 0 +| Zpos a' => + match b with + | Z0 => 0 + | Zpos _ => Zmod_POS a' b + | Zneg b' => + let r := Zmod_POS a' (Zpos b') in + match r with Z0 => 0 | _ => b + r end + end +| Zneg a' => + match b with + | Z0 => 0 + | Zpos _ => + let r := Zmod_POS a' b in + match r with Z0 => 0 | _ => b - r end + | Zneg b' => - (Zmod_POS a' (Zpos b')) + end +end. + +Theorem Zmodd_correct: forall a b, Zmodd a b = Zmod a b. +intros a b; unfold Zmod; case a; simpl; auto. +intros p; case b; simpl; auto. +intros p1; refine (Zmod_POS_correct _ _); auto. +intros p1; rewrite Zmod_POS_correct; auto. +case (Zdiv_eucl_POS p (Zpos p1)); simpl; intros z1 z2; case z2; auto. +intros p; case b; simpl; auto. +intros p1; rewrite Zmod_POS_correct; auto. +case (Zdiv_eucl_POS p (Zpos p1)); simpl; intros z1 z2; case z2; auto. +intros p1; rewrite Zmod_POS_correct; simpl; auto. +case (Zdiv_eucl_POS p (Zpos p1)); auto. +Qed. + +Theorem prime_divide_prime_eq: + forall p1 p2, prime p1 -> prime p2 -> Zdivide p1 p2 -> p1 = p2. +intros p1 p2 Hp1 Hp2 Hp3. +assert (Ha: 1 < p1). +inversion Hp1; auto. +assert (Ha1: 1 < p2). +inversion Hp2; auto. +case (Zle_lt_or_eq p1 p2); auto with zarith. +apply Zdivide_le; auto with zarith. +intros Hp4. +case (prime_div_prime p1 p2); auto with zarith. +Qed. + +Theorem Zdivide_Zpower: forall n m, 0 < n -> (forall p i, prime p -> 0 < i -> (p^i | n) -> (p^i | m)) -> (n | m). +intros n m Hn; generalize m Hn; pattern n; apply prime_induction; auto with zarith; clear n m Hn. +intros m H1; contradict H1; auto with zarith. +intros p q H Rec m H1 H2. +assert (H3: (p | m)). +rewrite <- (Zpower_1_r p); apply H2; auto with zarith; rewrite Zpower_1_r; apply Zdivide_factor_r. +case (Zmult_interval p q); auto. +apply Zlt_le_trans with 2; auto with zarith; apply prime_ge_2; auto. +case H3; intros k Hk; subst. +intros Hq Hq1. +rewrite (Zmult_comm k); apply Zmult_divide_compat_l. +apply Rec; auto. +intros p1 i Hp1 Hp2 Hp3. +case (Z_eq_dec p p1); intros Hpp1; subst. +case (H2 p1 (Zsucc i)); auto with zarith. +rewrite Zpower_Zsucc; try apply Zmult_divide_compat_l; auto with zarith. +intros q2 Hq2; exists q2. +apply Zmult_reg_r with p1. +contradict H; subst; apply not_prime_0. +rewrite Hq2; rewrite Zpower_Zsucc; try ring; auto with zarith. +apply Gauss with p. +rewrite Zmult_comm; apply H2; auto. +apply Zdivide_trans with (1:= Hp3). +apply Zdivide_factor_l. +apply rel_prime_sym; apply rel_prime_Zpower_r; auto with zarith. +apply prime_rel_prime; auto. +contradict Hpp1; apply prime_divide_prime_eq; auto. +Qed. + +Theorem prime_divide_Zpower_Zdiv: forall m a p i, 0 <= i -> prime p -> (m | a) -> ~(m | (a/p)) -> (p^i | a) -> (p^i | m). +intros m a p i Hi Hp (k, Hk) H (l, Hl); subst. +case (Zle_lt_or_eq 0 i); auto with arith; intros Hi1; subst. +assert (Hp0: 0 < p). +apply Zlt_le_trans with 2; auto with zarith; apply prime_ge_2; auto. +case (Zdivide_dec p k); intros H1. +case H1; intros k' H2; subst. +case H; replace (k' * p * m) with ((k' * m) * p); try ring; rewrite Z_div_mult; auto with zarith. +apply Gauss with k. +exists l; rewrite Hl; ring. +apply rel_prime_sym; apply rel_prime_Zpower_r; auto. +apply rel_prime_sym; apply prime_rel_prime; auto. +rewrite Zpower_0_r; apply Zone_divide. +Qed. + +Theorem Zle_square_mult: forall a b, 0 <= a <= b -> a * a <= b * b. +intros a b (H1, H2); apply Zle_trans with (a * b); auto with zarith. +Qed. + +Theorem Zlt_square_mult_inv: forall a b, 0 <= a -> 0 <= b -> a * a < b * b -> a < b. +intros a b H1 H2 H3; case (Zle_or_lt b a); auto; intros H4; apply Zmult_lt_reg_r with a; + contradict H3; apply Zle_not_lt; apply Zle_square_mult; auto. +Qed. + + +Theorem Zmod_closeby_eq: forall a b n, 0 <= a -> 0 <= b < n -> a - b < n -> a mod n = b -> a = b. +intros a b n H H1 H2 H3. +case (Zle_or_lt 0 (a - b)); intros H4. +case Zle_lt_or_eq with (1 := H4); clear H4; intros H4; auto with zarith. +contradict H2; apply Zle_not_lt; apply Zdivide_le; auto with zarith. +apply Zmod_divide_minus; auto with zarith. +rewrite <- (Zmod_small a n); try split; auto with zarith. +Qed. + + +Theorem Zpow_mod_pos_Zpower_pos_correct: forall a m n, 0 < n -> Zpow_mod_pos a m n = (Zpower_pos a m) mod n. +intros a m; elim m; simpl; auto. +intros p Rec n H1; rewrite xI_succ_xO; rewrite Pplus_one_succ_r; rewrite <- Pplus_diag; auto. +repeat rewrite Zpower_pos_is_exp; auto. +repeat rewrite Rec; auto. +replace (Zpower_pos a 1) with a; auto. +2: unfold Zpower_pos; simpl; auto with zarith. +repeat rewrite (fun x => (Zmult_mod x a)); auto. +rewrite (Zmult_mod (Zpower_pos a p)); auto. +case (Zpower_pos a p mod n); auto. +intros p Rec n H1; rewrite <- Pplus_diag; auto. +repeat rewrite Zpower_pos_is_exp; auto. +repeat rewrite Rec; auto. +rewrite (Zmult_mod (Zpower_pos a p)); auto. +case (Zpower_pos a p mod n); auto. +unfold Zpower_pos; simpl; rewrite Zmult_1_r; auto with zarith. +Qed. + +Theorem Zpow_mod_Zpower_correct: forall a m n, 1 < n -> 0 <= m -> Zpow_mod a m n = (a ^ m) mod n. +intros a m n; case m; simpl; auto. +intros; apply Zpow_mod_pos_Zpower_pos_correct; auto with zarith. +Qed. diff --git a/coqprime-8.4/Coqprime/ZCmisc.v b/coqprime-8.4/Coqprime/ZCmisc.v new file mode 100644 index 000000000..e2ec66ba1 --- /dev/null +++ b/coqprime-8.4/Coqprime/ZCmisc.v @@ -0,0 +1,186 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +Require Export Coq.ZArith.ZArith. +Open Local Scope Z_scope. + +Coercion Zpos : positive >-> Z. +Coercion Z_of_N : N >-> Z. + +Lemma Zpos_plus : forall p q, Zpos (p + q) = p + q. +Proof. intros;trivial. Qed. + +Lemma Zpos_mult : forall p q, Zpos (p * q) = p * q. +Proof. intros;trivial. Qed. + +Lemma Zpos_xI_add : forall p, Zpos (xI p) = Zpos p + Zpos p + Zpos 1. +Proof. intros p;rewrite Zpos_xI;ring. Qed. + +Lemma Zpos_xO_add : forall p, Zpos (xO p) = Zpos p + Zpos p. +Proof. intros p;rewrite Zpos_xO;ring. Qed. + +Lemma Psucc_Zplus : forall p, Zpos (Psucc p) = p + 1. +Proof. intros p;rewrite Zpos_succ_morphism;unfold Zsucc;trivial. Qed. + +Hint Rewrite Zpos_xI_add Zpos_xO_add Pplus_carry_spec + Psucc_Zplus Zpos_plus : zmisc. + +Lemma Zlt_0_pos : forall p, 0 < Zpos p. +Proof. unfold Zlt;trivial. Qed. + + +Lemma Pminus_mask_carry_spec : forall p q, + Pminus_mask_carry p q = Pminus_mask p (Psucc q). +Proof. + intros p q;generalize q p;clear q p. + induction q;destruct p;simpl;try rewrite IHq;trivial. + destruct p;trivial. destruct p;trivial. +Qed. + +Hint Rewrite Pminus_mask_carry_spec : zmisc. + +Ltac zsimpl := autorewrite with zmisc. +Ltac CaseEq t := generalize (refl_equal t);pattern t at -1;case t. +Ltac generalizeclear H := generalize H;clear H. + +Lemma Pminus_mask_spec : + forall p q, + match Pminus_mask p q with + | IsNul => Zpos p = Zpos q + | IsPos k => Zpos p = q + k + | IsNeq => p < q + end. +Proof with zsimpl;auto with zarith. + induction p;destruct q;simpl;zsimpl; + match goal with + | [|- context [(Pminus_mask ?p1 ?q1)]] => + assert (H1 := IHp q1);destruct (Pminus_mask p1 q1) + | _ => idtac + end;simpl ... + inversion H1 ... inversion H1 ... + rewrite Psucc_Zplus in H1 ... + clear IHp;induction p;simpl ... + rewrite IHp;destruct (Pdouble_minus_one p) ... + assert (H:= Zlt_0_pos q) ... assert (H:= Zlt_0_pos q) ... +Qed. + +Definition PminusN x y := + match Pminus_mask x y with + | IsPos k => Npos k + | _ => N0 + end. + +Lemma PminusN_le : forall x y:positive, x <= y -> Z_of_N (PminusN y x) = y - x. +Proof. + intros x y Hle;unfold PminusN. + assert (H := Pminus_mask_spec y x);destruct (Pminus_mask y x). + rewrite H;unfold Z_of_N;auto with zarith. + rewrite H;unfold Z_of_N;auto with zarith. + elimtype False;omega. +Qed. + +Lemma Ppred_Zminus : forall p, 1< Zpos p -> (p-1)%Z = Ppred p. +Proof. destruct p;simpl;trivial. intros;elimtype False;omega. Qed. + + +Open Local Scope positive_scope. + +Delimit Scope P_scope with P. +Open Local Scope P_scope. + +Definition is_lt (n m : positive) := + match (n ?= m) with + | Lt => true + | _ => false + end. +Infix "?<" := is_lt (at level 70, no associativity) : P_scope. + +Lemma is_lt_spec : forall n m, if n ?< m then (n < m)%Z else (m <= n)%Z. +Proof. +intros n m; unfold is_lt, Zlt, Zle, Zcompare. +rewrite Pos.compare_antisym. +case (m ?= n); simpl; auto; intros HH; discriminate HH. +Qed. + +Definition is_eq a b := + match (a ?= b) with + | Eq => true + | _ => false + end. +Infix "?=" := is_eq (at level 70, no associativity) : P_scope. + +Lemma is_eq_refl : forall n, n ?= n = true. +Proof. intros n;unfold is_eq;rewrite Pos.compare_refl;trivial. Qed. + +Lemma is_eq_eq : forall n m, n ?= m = true -> n = m. +Proof. + unfold is_eq;intros n m H; apply Pos.compare_eq. +destruct (n ?= m)%positive;trivial;try discriminate. +Qed. + +Lemma is_eq_spec_pos : forall n m, if n ?= m then n = m else m <> n. +Proof. + intros n m; CaseEq (n ?= m);intro H. + rewrite (is_eq_eq _ _ H);trivial. + intro H1;rewrite H1 in H;rewrite is_eq_refl in H;discriminate H. +Qed. + +Lemma is_eq_spec : forall n m, if n ?= m then Zpos n = m else Zpos m <> n. +Proof. + intros n m; CaseEq (n ?= m);intro H. + rewrite (is_eq_eq _ _ H);trivial. + intro H1;inversion H1. + rewrite H2 in H;rewrite is_eq_refl in H;discriminate H. +Qed. + +Definition is_Eq a b := + match a, b with + | N0, N0 => true + | Npos a', Npos b' => a' ?= b' + | _, _ => false + end. + +Lemma is_Eq_spec : + forall n m, if is_Eq n m then Z_of_N n = m else Z_of_N m <> n. +Proof. + destruct n;destruct m;simpl;trivial;try (intro;discriminate). + apply is_eq_spec. +Qed. + +(* [times x y] return [x * y], a litle bit more efficiant *) +Fixpoint times (x y : positive) {struct y} : positive := + match x, y with + | xH, _ => y + | _, xH => x + | xO x', xO y' => xO (xO (times x' y')) + | xO x', xI y' => xO (x' + xO (times x' y')) + | xI x', xO y' => xO (y' + xO (times x' y')) + | xI x', xI y' => xI (x' + y' + xO (times x' y')) + end. + +Infix "*" := times : P_scope. + +Lemma times_Zmult : forall p q, Zpos (p * q)%P = (p * q)%Z. +Proof. + intros p q;generalize q p;clear p q. + induction q;destruct p; unfold times; try fold (times p q); + autorewrite with zmisc; try rewrite IHq; ring. +Qed. + +Fixpoint square (x:positive) : positive := + match x with + | xH => xH + | xO x => xO (xO (square x)) + | xI x => xI (xO (square x + x)) + end. + +Lemma square_Zmult : forall x, Zpos (square x) = (x * x) %Z. +Proof. + induction x as [x IHx|x IHx |];unfold square;try (fold (square x)); + autorewrite with zmisc; try rewrite IHx; ring. +Qed. diff --git a/coqprime-8.4/Coqprime/ZProgression.v b/coqprime-8.4/Coqprime/ZProgression.v new file mode 100644 index 000000000..4cf30d692 --- /dev/null +++ b/coqprime-8.4/Coqprime/ZProgression.v @@ -0,0 +1,104 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +Require Export Coqprime.Iterator. +Require Import Coq.ZArith.ZArith. +Require Export Coqprime.UList. +Open Scope Z_scope. + +Theorem next_n_Z: forall n m, next_n Zsucc n m = n + Z_of_nat m. +intros n m; generalize n; elim m; clear n m. +intros n; simpl; auto with zarith. +intros m H n. +replace (n + Z_of_nat (S m)) with (Zsucc n + Z_of_nat m); auto with zarith. +rewrite <- H; auto with zarith. +rewrite inj_S; auto with zarith. +Qed. + +Theorem Zprogression_end: + forall n m, + progression Zsucc n (S m) = + app (progression Zsucc n m) (cons (n + Z_of_nat m) nil). +intros n m; generalize n; elim m; clear n m. +simpl; intros; apply f_equal2 with ( f := @cons Z ); auto with zarith. +intros m1 Hm1 n1. +apply trans_equal with (cons n1 (progression Zsucc (Zsucc n1) (S m1))); auto. +rewrite Hm1. +replace (Zsucc n1 + Z_of_nat m1) with (n1 + Z_of_nat (S m1)); auto with zarith. +replace (Z_of_nat (S m1)) with (1 + Z_of_nat m1); auto with zarith. +rewrite inj_S; auto with zarith. +Qed. + +Theorem Zprogression_pred_end: + forall n m, + progression Zpred n (S m) = + app (progression Zpred n m) (cons (n - Z_of_nat m) nil). +intros n m; generalize n; elim m; clear n m. +simpl; intros; apply f_equal2 with ( f := @cons Z ); auto with zarith. +intros m1 Hm1 n1. +apply trans_equal with (cons n1 (progression Zpred (Zpred n1) (S m1))); auto. +rewrite Hm1. +replace (Zpred n1 - Z_of_nat m1) with (n1 - Z_of_nat (S m1)); auto with zarith. +replace (Z_of_nat (S m1)) with (1 + Z_of_nat m1); auto with zarith. +rewrite inj_S; auto with zarith. +Qed. + +Theorem Zprogression_opp: + forall n m, + rev (progression Zsucc n m) = progression Zpred (n + Z_of_nat (pred m)) m. +intros n m; generalize n; elim m; clear n m. +simpl; auto. +intros m Hm n. +rewrite (Zprogression_end n); auto. +rewrite distr_rev. +rewrite Hm; simpl; auto. +case m. +simpl; auto. +intros m1; + replace (n + Z_of_nat (pred (S m1))) with (Zpred (n + Z_of_nat (S m1))); auto. +rewrite inj_S; simpl; (unfold Zpred; unfold Zsucc); auto with zarith. +Qed. + +Theorem Zprogression_le_init: + forall n m p, In p (progression Zsucc n m) -> (n <= p). +intros n m; generalize n; elim m; clear n m; simpl; auto. +intros; contradiction. +intros m H n p [H1|H1]; auto with zarith. +generalize (H _ _ H1); auto with zarith. +Qed. + +Theorem Zprogression_le_end: + forall n m p, In p (progression Zsucc n m) -> (p < n + Z_of_nat m). +intros n m; generalize n; elim m; clear n m; auto. +intros; contradiction. +intros m H n p H1; simpl in H1 |-; case H1; clear H1; intros H1; + auto with zarith. +subst n; auto with zarith. +apply Zle_lt_trans with (p + 0); auto with zarith. +apply Zplus_lt_compat_l; red; simpl; auto with zarith. +apply Zlt_le_trans with (Zsucc n + Z_of_nat m); auto with zarith. +rewrite inj_S; rewrite Zplus_succ_comm; auto with zarith. +Qed. + +Theorem ulist_Zprogression: forall a n, ulist (progression Zsucc a n). +intros a n; generalize a; elim n; clear a n; simpl; auto with zarith. +intros n H1 a; apply ulist_cons; auto. +intros H2; absurd (Zsucc a <= a); auto with zarith. +apply Zprogression_le_init with ( 1 := H2 ). +Qed. + +Theorem in_Zprogression: + forall a b n, ( a <= b < a + Z_of_nat n ) -> In b (progression Zsucc a n). +intros a b n; generalize a b; elim n; clear a b n; auto with zarith. +simpl; auto with zarith. +intros n H a b. +replace (a + Z_of_nat (S n)) with (Zsucc a + Z_of_nat n); auto with zarith. +intros [H1 H2]; simpl; auto with zarith. +case (Zle_lt_or_eq _ _ H1); auto with zarith. +rewrite inj_S; auto with zarith. +Qed. diff --git a/coqprime-8.4/Coqprime/ZSum.v b/coqprime-8.4/Coqprime/ZSum.v new file mode 100644 index 000000000..907720f7c --- /dev/null +++ b/coqprime-8.4/Coqprime/ZSum.v @@ -0,0 +1,335 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(*********************************************************************** + Summation.v from Z to Z + *********************************************************************) +Require Import Coq.Arith.Arith. +Require Import Coq.setoid_ring.ArithRing. +Require Import Coqprime.ListAux. +Require Import Coq.ZArith.ZArith. +Require Import Coqprime.Iterator. +Require Import Coqprime.ZProgression. + + +Open Scope Z_scope. +(* Iterated Sum *) + +Definition Zsum := + fun n m f => + if Zle_bool n m + then iter 0 f Zplus (progression Zsucc n (Zabs_nat ((1 + m) - n))) + else iter 0 f Zplus (progression Zpred n (Zabs_nat ((1 + n) - m))). +Hint Unfold Zsum . + +Lemma Zsum_nn: forall n f, Zsum n n f = f n. +intros n f; unfold Zsum; rewrite Zle_bool_refl. +replace ((1 + n) - n) with 1; auto with zarith. +simpl; ring. +Qed. + +Theorem permutation_rev: forall (A:Set) (l : list A), permutation (rev l) l. +intros a l; elim l; simpl; auto. +intros a1 l1 Hl1. +apply permutation_trans with (cons a1 (rev l1)); auto. +change (permutation (rev l1 ++ (a1 :: nil)) (app (cons a1 nil) (rev l1))); auto. +Qed. + +Lemma Zsum_swap: forall (n m : Z) (f : Z -> Z), Zsum n m f = Zsum m n f. +intros n m f; unfold Zsum. +generalize (Zle_cases n m) (Zle_cases m n); case (Zle_bool n m); + case (Zle_bool m n); auto with arith. +intros; replace n with m; auto with zarith. +3:intros H1 H2; contradict H2; auto with zarith. +intros H1 H2; apply iter_permutation; auto with zarith. +apply permutation_trans + with (rev (progression Zsucc n (Zabs_nat ((1 + m) - n)))). +apply permutation_sym; apply permutation_rev. +rewrite Zprogression_opp; auto with zarith. +replace (n + Z_of_nat (pred (Zabs_nat ((1 + m) - n)))) with m; auto. +replace (Zabs_nat ((1 + m) - n)) with (S (Zabs_nat (m - n))); auto with zarith. +simpl. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +replace ((1 + m) - n) with (1 + (m - n)); auto with zarith. +cut (0 <= m - n); auto with zarith; unfold Zabs_nat. +case (m - n); auto with zarith. +intros p; case p; simpl; auto with zarith. +intros p1 Hp1; rewrite nat_of_P_xO; rewrite nat_of_P_xI; + rewrite nat_of_P_succ_morphism. +simpl; repeat rewrite plus_0_r. +repeat rewrite <- plus_n_Sm; simpl; auto. +intros p H3; contradict H3; auto with zarith. +intros H1 H2; apply iter_permutation; auto with zarith. +apply permutation_trans + with (rev (progression Zsucc m (Zabs_nat ((1 + n) - m)))). +rewrite Zprogression_opp; auto with zarith. +replace (m + Z_of_nat (pred (Zabs_nat ((1 + n) - m)))) with n; auto. +replace (Zabs_nat ((1 + n) - m)) with (S (Zabs_nat (n - m))); auto with zarith. +simpl. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +replace ((1 + n) - m) with (1 + (n - m)); auto with zarith. +cut (0 <= n - m); auto with zarith; unfold Zabs_nat. +case (n - m); auto with zarith. +intros p; case p; simpl; auto with zarith. +intros p1 Hp1; rewrite nat_of_P_xO; rewrite nat_of_P_xI; + rewrite nat_of_P_succ_morphism. +simpl; repeat rewrite plus_0_r. +repeat rewrite <- plus_n_Sm; simpl; auto. +intros p H3; contradict H3; auto with zarith. +apply permutation_rev. +Qed. + +Lemma Zsum_split_up: + forall (n m p : Z) (f : Z -> Z), + ( n <= m < p ) -> Zsum n p f = Zsum n m f + Zsum (m + 1) p f. +intros n m p f [H H0]. +case (Zle_lt_or_eq _ _ H); clear H; intros H. +unfold Zsum; (repeat rewrite Zle_imp_le_bool); auto with zarith. +assert (H1: n < p). +apply Zlt_trans with ( 1 := H ); auto with zarith. +assert (H2: m < 1 + p). +apply Zlt_trans with ( 1 := H0 ); auto with zarith. +assert (H3: n < 1 + m). +apply Zlt_trans with ( 1 := H ); auto with zarith. +assert (H4: n < 1 + p). +apply Zlt_trans with ( 1 := H1 ); auto with zarith. +replace (Zabs_nat ((1 + p) - (m + 1))) + with (minus (Zabs_nat ((1 + p) - n)) (Zabs_nat ((1 + m) - n))). +apply iter_progression_app; auto with zarith. +apply inj_le_rev. +(repeat rewrite inj_Zabs_nat); auto with zarith. +(repeat rewrite Zabs_eq); auto with zarith. +rewrite next_n_Z; auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +apply inj_eq_rev; auto with zarith. +rewrite inj_minus1; auto with zarith. +(repeat rewrite inj_Zabs_nat); auto with zarith. +(repeat rewrite Zabs_eq); auto with zarith. +apply inj_le_rev. +(repeat rewrite inj_Zabs_nat); auto with zarith. +(repeat rewrite Zabs_eq); auto with zarith. +subst m. +rewrite Zsum_nn; auto with zarith. +unfold Zsum; generalize (Zle_cases n p); generalize (Zle_cases (n + 1) p); + case (Zle_bool n p); case (Zle_bool (n + 1) p); auto with zarith. +intros H1 H2. +replace (Zabs_nat ((1 + p) - n)) with (S (Zabs_nat (p - n))); auto with zarith. +replace (n + 1) with (Zsucc n); auto with zarith. +replace ((1 + p) - Zsucc n) with (p - n); auto with zarith. +apply inj_eq_rev; auto with zarith. +rewrite inj_S; (repeat rewrite inj_Zabs_nat); auto with zarith. +(repeat rewrite Zabs_eq); auto with zarith. +Qed. + +Lemma Zsum_S_left: + forall (n m : Z) (f : Z -> Z), n < m -> Zsum n m f = f n + Zsum (n + 1) m f. +intros n m f H; rewrite (Zsum_split_up n n m f); auto with zarith. +rewrite Zsum_nn; auto with zarith. +Qed. + +Lemma Zsum_S_right: + forall (n m : Z) (f : Z -> Z), + n <= m -> Zsum n (m + 1) f = Zsum n m f + f (m + 1). +intros n m f H; rewrite (Zsum_split_up n m (m + 1) f); auto with zarith. +rewrite Zsum_nn; auto with zarith. +Qed. + +Lemma Zsum_split_down: + forall (n m p : Z) (f : Z -> Z), + ( p < m <= n ) -> Zsum n p f = Zsum n m f + Zsum (m - 1) p f. +intros n m p f [H H0]. +case (Zle_lt_or_eq p (m - 1)); auto with zarith; intros H1. +pattern m at 1; replace m with ((m - 1) + 1); auto with zarith. +repeat rewrite (Zsum_swap n). +rewrite (Zsum_swap (m - 1)). +rewrite Zplus_comm. +apply Zsum_split_up; auto with zarith. +subst p. +repeat rewrite (Zsum_swap n). +rewrite Zsum_nn. +unfold Zsum; (repeat rewrite Zle_imp_le_bool); auto with zarith. +replace (Zabs_nat ((1 + n) - (m - 1))) with (S (Zabs_nat (n - (m - 1)))). +rewrite Zplus_comm. +replace (Zabs_nat ((1 + n) - m)) with (Zabs_nat (n - (m - 1))); auto with zarith. +pattern m at 4; replace m with (Zsucc (m - 1)); auto with zarith. +apply f_equal with ( f := Zabs_nat ); auto with zarith. +apply inj_eq_rev; auto with zarith. +rewrite inj_S. +(repeat rewrite inj_Zabs_nat); auto with zarith. +(repeat rewrite Zabs_eq); auto with zarith. +Qed. + + +Lemma Zsum_ext: + forall (n m : Z) (f g : Z -> Z), + n <= m -> + (forall (x : Z), ( n <= x <= m ) -> f x = g x) -> Zsum n m f = Zsum n m g. +intros n m f g HH H. +unfold Zsum; auto. +unfold Zsum; (repeat rewrite Zle_imp_le_bool); auto with zarith. +apply iter_ext; auto with zarith. +intros a H1; apply H; auto; split. +apply Zprogression_le_init with ( 1 := H1 ). +cut (a < Zsucc m); auto with zarith. +replace (Zsucc m) with (n + Z_of_nat (Zabs_nat ((1 + m) - n))); auto with zarith. +apply Zprogression_le_end; auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +(repeat rewrite Zabs_eq); auto with zarith. +Qed. + +Lemma Zsum_add: + forall (n m : Z) (f g : Z -> Z), + Zsum n m f + Zsum n m g = Zsum n m (fun (i : Z) => f i + g i). +intros n m f g; unfold Zsum; case (Zle_bool n m); apply iter_comp; + auto with zarith. +Qed. + +Lemma Zsum_times: + forall n m x f, x * Zsum n m f = Zsum n m (fun i=> x * f i). +intros n m x f. +unfold Zsum. case (Zle_bool n m); intros; apply iter_comp_const with (k := (fun y : Z => x * y)); auto with zarith. +Qed. + +Lemma inv_Zsum: + forall (P : Z -> Prop) (n m : Z) (f : Z -> Z), + n <= m -> + P 0 -> + (forall (a b : Z), P a -> P b -> P (a + b)) -> + (forall (x : Z), ( n <= x <= m ) -> P (f x)) -> P (Zsum n m f). +intros P n m f HH H H0 H1. +unfold Zsum; rewrite Zle_imp_le_bool; auto with zarith; apply iter_inv; auto. +intros x H3; apply H1; auto; split. +apply Zprogression_le_init with ( 1 := H3 ). +cut (x < Zsucc m); auto with zarith. +replace (Zsucc m) with (n + Z_of_nat (Zabs_nat ((1 + m) - n))); auto with zarith. +apply Zprogression_le_end; auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +(repeat rewrite Zabs_eq); auto with zarith. +Qed. + + +Lemma Zsum_pred: + forall (n m : Z) (f : Z -> Z), + Zsum n m f = Zsum (n + 1) (m + 1) (fun (i : Z) => f (Zpred i)). +intros n m f. +unfold Zsum. +generalize (Zle_cases n m); generalize (Zle_cases (n + 1) (m + 1)); + case (Zle_bool n m); case (Zle_bool (n + 1) (m + 1)); auto with zarith. +replace ((1 + (m + 1)) - (n + 1)) with ((1 + m) - n); auto with zarith. +intros H1 H2; cut (exists c , c = Zabs_nat ((1 + m) - n) ). +intros [c H3]; rewrite <- H3. +generalize n; elim c; auto with zarith; clear H1 H2 H3 c n. +intros c H n; simpl; eq_tac; auto with zarith. +eq_tac; unfold Zpred; auto with zarith. +replace (Zsucc (n + 1)) with (Zsucc n + 1); auto with zarith. +exists (Zabs_nat ((1 + m) - n)); auto. +replace ((1 + (n + 1)) - (m + 1)) with ((1 + n) - m); auto with zarith. +intros H1 H2; cut (exists c , c = Zabs_nat ((1 + n) - m) ). +intros [c H3]; rewrite <- H3. +generalize n; elim c; auto with zarith; clear H1 H2 H3 c n. +intros c H n; simpl; (eq_tac; auto with zarith). +eq_tac; unfold Zpred; auto with zarith. +replace (Zpred (n + 1)) with (Zpred n + 1); auto with zarith. +unfold Zpred; auto with zarith. +exists (Zabs_nat ((1 + n) - m)); auto. +Qed. + +Theorem Zsum_c: + forall (c p q : Z), p <= q -> Zsum p q (fun x => c) = ((1 + q) - p) * c. +intros c p q Hq; unfold Zsum. +rewrite Zle_imp_le_bool; auto with zarith. +pattern ((1 + q) - p) at 2. + rewrite <- Zabs_eq; auto with zarith. + rewrite <- inj_Zabs_nat; auto with zarith. +cut (exists r , r = Zabs_nat ((1 + q) - p) ); + [intros [r H1]; rewrite <- H1 | exists (Zabs_nat ((1 + q) - p))]; auto. +generalize p; elim r; auto with zarith. +intros n H p0; replace (Z_of_nat (S n)) with (Z_of_nat n + 1); auto with zarith. +simpl; rewrite H; ring. +rewrite inj_S; auto with zarith. +Qed. + +Theorem Zsum_Zsum_f: + forall (i j k l : Z) (f : Z -> Z -> Z), + i <= j -> + k < l -> + Zsum i j (fun x => Zsum k (l + 1) (fun y => f x y)) = + Zsum i j (fun x => Zsum k l (fun y => f x y) + f x (l + 1)). +intros; apply Zsum_ext; intros; auto with zarith. +rewrite Zsum_S_right; auto with zarith. +Qed. + +Theorem Zsum_com: + forall (i j k l : Z) (f : Z -> Z -> Z), + Zsum i j (fun x => Zsum k l (fun y => f x y)) = + Zsum k l (fun y => Zsum i j (fun x => f x y)). +intros; unfold Zsum; case (Zle_bool i j); case (Zle_bool k l); apply iter_com; + auto with zarith. +Qed. + +Theorem Zsum_le: + forall (n m : Z) (f g : Z -> Z), + n <= m -> + (forall (x : Z), ( n <= x <= m ) -> (f x <= g x )) -> + (Zsum n m f <= Zsum n m g ). +intros n m f g Hl H. +unfold Zsum; rewrite Zle_imp_le_bool; auto with zarith. +unfold Zsum; + cut + (forall x, + In x (progression Zsucc n (Zabs_nat ((1 + m) - n))) -> ( f x <= g x )). +elim (progression Zsucc n (Zabs_nat ((1 + m) - n))); simpl; auto with zarith. +intros x H1; apply H; split. +apply Zprogression_le_init with ( 1 := H1 ); auto. +cut (x < m + 1); auto with zarith. +replace (m + 1) with (n + Z_of_nat (Zabs_nat ((1 + m) - n))); auto with zarith. +apply Zprogression_le_end; auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +Qed. + +Theorem iter_le: +forall (f g: Z -> Z) l, (forall a, In a l -> f a <= g a) -> + iter 0 f Zplus l <= iter 0 g Zplus l. +intros f g l; elim l; simpl; auto with zarith. +Qed. + +Theorem Zsum_lt: + forall n m f g, + (forall x, n <= x -> x <= m -> f x <= g x) -> + (exists x, n <= x /\ x <= m /\ f x < g x) -> + Zsum n m f < Zsum n m g. +intros n m f g H (d, (Hd1, (Hd2, Hd3))); unfold Zsum; rewrite Zle_imp_le_bool; auto with zarith. +cut (In d (progression Zsucc n (Zabs_nat (1 + m - n)))). +cut (forall x, In x (progression Zsucc n (Zabs_nat (1 + m - n)))-> f x <= g x). +elim (progression Zsucc n (Zabs_nat (1 + m - n))); simpl; auto with zarith. +intros a l Rec H0 [H1 | H1]; subst; auto. +apply Zle_lt_trans with (f d + iter 0 g Zplus l); auto with zarith. +apply Zplus_le_compat_l. +apply iter_le; auto. +apply Zlt_le_trans with (f a + iter 0 g Zplus l); auto with zarith. +intros x H1; apply H. +apply Zprogression_le_init with ( 1 := H1 ); auto. +cut (x < m + 1); auto with zarith. +replace (m + 1) with (n + Z_of_nat (Zabs_nat ((1 + m) - n))); auto with zarith. +apply Zprogression_le_end with ( 1 := H1 ); auto with arith. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +apply in_Zprogression. +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +Qed. + +Theorem Zsum_minus: + forall n m f g, Zsum n m f - Zsum n m g = Zsum n m (fun x => f x - g x). +intros n m f g; apply trans_equal with (Zsum n m f + (-1) * Zsum n m g); auto with zarith. +rewrite Zsum_times; rewrite Zsum_add; auto with zarith. +Qed. diff --git a/coqprime-8.4/Coqprime/Zp.v b/coqprime-8.4/Coqprime/Zp.v new file mode 100644 index 000000000..2f7d28d69 --- /dev/null +++ b/coqprime-8.4/Coqprime/Zp.v @@ -0,0 +1,411 @@ + +(*************************************************************) +(* This file is distributed under the terms of the *) +(* GNU Lesser General Public License Version 2.1 *) +(*************************************************************) +(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) +(*************************************************************) + +(********************************************************************** + Zp.v + + Build the group of the inversible element on {1, 2, .., n-1} + for the multiplication modulo n + + Definition: ZpGroup + **********************************************************************) +Require Import Coq.ZArith.ZArith Coq.ZArith.Znumtheory Coq.ZArith.Zpow_facts. +Require Import Coqprime.Tactic. +Require Import Coq.Arith.Wf_nat. +Require Import Coqprime.UList. +Require Import Coqprime.FGroup. +Require Import Coqprime.EGroup. +Require Import Coqprime.IGroup. +Require Import Coqprime.Cyclic. +Require Import Coqprime.Euler. +Require Import Coqprime.ZProgression. + +Open Scope Z_scope. + +Section Zp. + +Variable n: Z. + +Hypothesis n_pos: 1 < n. + + +(************************************** + mkZp m creates {m, m - 1, ..., 0} + **************************************) + +Fixpoint mkZp_aux (m: nat): list Z:= + Z_of_nat m :: match m with O => nil | (S m1) => mkZp_aux m1 end. + +(************************************** + Some properties of mkZp_aux + **************************************) + +Theorem mkZp_aux_length: forall m, length (mkZp_aux m) = (m + 1)%nat. +intros m; elim m; simpl; auto. +Qed. + +Theorem mkZp_aux_in: forall m p, 0 <= p <= Z_of_nat m -> In p (mkZp_aux m). +intros m; elim m. +simpl; auto with zarith. +intros n1 Rec p (H1, H2); case Zle_lt_or_eq with (1 := H2); clear H2; intro H2. +rewrite inj_S in H2. +simpl; right; apply Rec; split; auto with zarith. +rewrite H2; simpl; auto. +Qed. + +Theorem in_mkZp_aux: forall m p, In p (mkZp_aux m) -> 0 <= p <= Z_of_nat m. +intros m; elim m; clear m. +simpl; intros p H1; case H1; clear H1; intros H1; subst; auto with zarith. +intros m1; generalize (inj_S m1); simpl. +intros H Rec p [H1 | H1]. +rewrite <- H1; rewrite H; auto with zarith. +rewrite H; case (Rec p); auto with zarith. +Qed. + +Theorem mkZp_aux_ulist: forall m, ulist (mkZp_aux m). +intros m; elim m; simpl; auto. +intros m1 H; apply ulist_cons; auto. +change (~ In (Z_of_nat (S m1)) (mkZp_aux m1)). +rewrite inj_S; intros H1. +case in_mkZp_aux with (1 := H1); auto with zarith. +Qed. + +(************************************** + mkZp creates {n - 1, ..., 1, 0} + **************************************) + +Definition mkZp := mkZp_aux (Zabs_nat (n - 1)). + +(************************************** + Some properties of mkZp + **************************************) + +Theorem mkZp_length: length mkZp = Zabs_nat n. +unfold mkZp; rewrite mkZp_aux_length. +apply inj_eq_rev. +rewrite inj_plus. +simpl; repeat rewrite inj_Zabs_nat; auto with zarith. +repeat rewrite Zabs_eq; auto with zarith. +Qed. + +Theorem mkZp_in: forall p, 0 <= p < n -> In p mkZp. +intros p (H1, H2); unfold mkZp; apply mkZp_aux_in. +rewrite inj_Zabs_nat; auto with zarith. +repeat rewrite Zabs_eq; auto with zarith. +Qed. + +Theorem in_mkZp: forall p, In p mkZp -> 0 <= p < n. +intros p H; case (in_mkZp_aux (Zabs_nat (n - 1)) p); auto with zarith. +rewrite inj_Zabs_nat; auto with zarith. +repeat rewrite Zabs_eq; auto with zarith. +Qed. + +Theorem mkZp_ulist: ulist mkZp. +unfold mkZp; apply mkZp_aux_ulist; auto. +Qed. + +(************************************** + Multiplication of two pairs + **************************************) + +Definition pmult (p q: Z) := (p * q) mod n. + +(************************************** + Properties of multiplication + **************************************) + +Theorem pmult_assoc: forall p q r, (pmult p (pmult q r)) = (pmult (pmult p q) r). +assert (Hu: 0 < n); try apply Zlt_trans with 1; auto with zarith. +generalize Zmod_mod; intros H. +intros p q r; unfold pmult. +rewrite (Zmult_mod p); auto. +repeat rewrite Zmod_mod; auto. +rewrite (Zmult_mod q); auto. +rewrite <- Zmult_mod; auto. +rewrite Zmult_assoc. +rewrite (Zmult_mod (p * (q mod n))); auto. +rewrite (Zmult_mod ((p * q) mod n)); auto. +eq_tac; auto. +eq_tac; auto. +rewrite (Zmult_mod p); sauto. +rewrite Zmod_mod; auto. +rewrite <- Zmult_mod; sauto. +Qed. + +Theorem pmult_1_l: forall p, In p mkZp -> pmult 1 p = p. +intros p H; unfold pmult; rewrite Zmult_1_l. +apply Zmod_small. +case (in_mkZp p); auto with zarith. +Qed. + +Theorem pmult_1_r: forall p, In p mkZp -> pmult p 1 = p. +intros p H; unfold pmult; rewrite Zmult_1_r. +apply Zmod_small. +case (in_mkZp p); auto with zarith. +Qed. + +Theorem pmult_comm: forall p q, pmult p q = pmult q p. +intros p q; unfold pmult; rewrite Zmult_comm; auto. +Qed. + +Definition Lrel := isupport_aux _ pmult mkZp 1 Z_eq_dec (progression Zsucc 0 (Zabs_nat n)). + +Theorem rel_prime_is_inv: + forall a, is_inv Z pmult mkZp 1 Z_eq_dec a = if (rel_prime_dec a n) then true else false. +assert (Hu: 0 < n); try apply Zlt_trans with 1; auto with zarith. +intros a; case (rel_prime_dec a n); intros H. +assert (H1: Bezout a n 1); try apply rel_prime_bezout; auto. +inversion H1 as [c d Hcd]; clear H1. +assert (pmult (c mod n) a = 1). +unfold pmult; rewrite Zmult_mod; try rewrite Zmod_mod; auto. +rewrite <- Zmult_mod; auto. +replace (c * a) with (1 + (-d) * n). +rewrite Z_mod_plus; auto with zarith. +rewrite Zmod_small; auto with zarith. +rewrite <- Hcd; ring. +apply is_inv_true with (a := (c mod n)); auto. +apply mkZp_in; auto with zarith. +exact pmult_1_l. +exact pmult_1_r. +rewrite pmult_comm; auto. +apply mkZp_in; auto with zarith. +apply Z_mod_lt; auto with zarith. +apply is_inv_false. +intros c H1; left; intros H2; contradict H. +apply bezout_rel_prime. +apply Bezout_intro with c (- (Zdiv (c * a) n)). +pattern (c * a) at 1; rewrite (Z_div_mod_eq (c * a) n); auto with zarith. +unfold pmult in H2; rewrite (Zmult_comm c); try rewrite H2. +ring. +Qed. + +(************************************** + We are now ready to build our group + **************************************) + +Definition ZPGroup : (FGroup pmult). +apply IGroup with (support := mkZp) (e:= 1). +exact Z_eq_dec. +apply mkZp_ulist. +apply mkZp_in; auto with zarith. +intros a b H1 H2; apply mkZp_in. +unfold pmult; apply Z_mod_lt; auto with zarith. +intros; apply pmult_assoc. +exact pmult_1_l. +exact pmult_1_r. +Defined. + +Theorem in_ZPGroup: forall p, rel_prime p n -> 0 <= p < n -> In p ZPGroup.(s). +intros p H (H1, H2); unfold ZPGroup; simpl. +apply isupport_is_in. +generalize (rel_prime_is_inv p); case (rel_prime_dec p); auto. +apply mkZp_in; auto with zarith. +Qed. + + +Theorem phi_is_length: phi n = Z_of_nat (length Lrel). +assert (Hu: 0 < n); try apply Zlt_trans with 1; auto with zarith. +rewrite phi_def_with_0; auto. +unfold Zsum, Lrel; rewrite Zle_imp_le_bool; auto with zarith. +replace (1 + (n - 1) - 0) with n; auto with zarith. +elim (progression Zsucc 0 (Zabs_nat n)); simpl; auto. +intros a l1 Rec. +rewrite Rec. +rewrite rel_prime_is_inv. +case (rel_prime_dec a n); auto with zarith. +simpl length; rewrite inj_S; auto with zarith. +Qed. + +Theorem phi_is_order: phi n = g_order ZPGroup. +unfold g_order; rewrite phi_is_length. +eq_tac; apply permutation_length. +apply ulist_incl2_permutation. +unfold Lrel; apply isupport_aux_ulist. +apply ulist_Zprogression; auto. +apply ZPGroup.(unique_s). +intros a H; unfold ZPGroup; simpl. +apply isupport_is_in. +unfold Lrel in H; apply isupport_aux_is_inv_true with (1 := H). +apply mkZp_in; auto. +assert (In a (progression Zsucc 0 (Zabs_nat n))). +apply (isupport_aux_incl _ pmult mkZp 1 Z_eq_dec); auto. +split. +apply Zprogression_le_init with (1 := H0). +replace n with (0 + Z_of_nat (Zabs_nat n)). +apply Zprogression_le_end with (1 := H0). +rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +intros a H; unfold Lrel; simpl. +apply isupport_aux_is_in. +simpl in H; apply isupport_is_inv_true with (1 := H). +apply in_Zprogression. +rewrite Zplus_0_l; rewrite inj_Zabs_nat; auto with zarith. +rewrite Zabs_eq; auto with zarith. +assert (In a mkZp). +apply (isupport_aux_incl _ pmult mkZp 1 Z_eq_dec); auto. +apply in_mkZp; auto. +Qed. + +Theorem Zp_cyclic: prime n -> cyclic Z_eq_dec ZPGroup. +intros H1. +unfold ZPGroup, pmult; +generalize (cyclic_field _ (fun x y => (x + y) mod n) (fun x y => (x * y) mod n) (fun x => (-x) mod n) 0); +unfold IA; intros tmp; apply tmp; clear tmp; auto. +intros; discriminate. +apply mkZp_in; auto with zarith. +intros; apply mkZp_in; auto with zarith. +apply Z_mod_lt; auto with zarith. +intros; rewrite Zplus_0_l; auto. +apply Zmod_small; auto. +apply in_mkZp; auto. +intros; rewrite Zplus_comm; auto. +intros a b c Ha Hb Hc. +pattern a at 1; rewrite <- (Zmod_small a n); auto with zarith. +pattern c at 2; rewrite <- (Zmod_small c n); auto with zarith. +repeat rewrite <- Zplus_mod; auto with zarith. +eq_tac; auto with zarith. +apply in_mkZp; auto. +apply in_mkZp; auto. +intros; eq_tac; auto with zarith. +intros a b c Ha Hb Hc. +pattern a at 1; rewrite <- (Zmod_small a n); auto with zarith. +repeat rewrite <- Zmult_mod; auto with zarith. +repeat rewrite <- Zplus_mod; auto with zarith. +eq_tac; auto with zarith. +apply in_mkZp; auto. +intros; apply mkZp_in; apply Z_mod_lt; auto with zarith. +intros a Ha. +pattern a at 1; rewrite <- (Zmod_small a n); auto with zarith. +repeat rewrite <- Zplus_mod; auto with zarith. +rewrite <- (Zmod_small 0 n); auto with zarith. +eq_tac; auto with zarith. +apply in_mkZp; auto. +intros a b Ha Hb H; case (prime_mult n H1 a b). +apply Zmod_divide; auto with zarith. +intros H2; left. +case (Zle_lt_or_eq 0 a); auto. +case (in_mkZp a); auto. +intros H3; absurd (n <= a). +apply Zlt_not_le. +case (in_mkZp a); auto. +apply Zdivide_le; auto with zarith. +intros H2; right. +case (Zle_lt_or_eq 0 b); auto. +case (in_mkZp b); auto. +intros H3; absurd (n <= b). +apply Zlt_not_le. +case (in_mkZp b); auto. +apply Zdivide_le; auto with zarith. +Qed. + +End Zp. + +(* Definition of the order (0 for q < 1) *) + +Definition Zorder: Z -> Z -> Z. +intros p q; case (Z_le_dec q 1); intros H. +exact 0. +refine (e_order Z_eq_dec (p mod q) (ZPGroup q _)); auto with zarith. +Defined. + +Theorem Zorder_pos: forall p n, 0 <= Zorder p n. +intros p n; unfold Zorder. +case (Z_le_dec n 1); auto with zarith. +intros n1. +apply Zlt_le_weak; apply e_order_pos. +Qed. + +Theorem in_mod_ZPGroup + : forall (n : Z) (n_pos : 1 < n) (p : Z), + rel_prime p n -> In (p mod n) (s (ZPGroup n n_pos)). +intros n H p H1. +apply in_ZPGroup; auto. +apply rel_prime_mod; auto with zarith. +apply Z_mod_lt; auto with zarith. +Qed. + + +Theorem Zpower_mod_is_gpow: + forall p q n (Hn: 1 < n), rel_prime p n -> 0 <= q -> p ^ q mod n = gpow (p mod n) (ZPGroup n Hn) q. +intros p q n H Hp H1; generalize H1; pattern q; apply natlike_ind; simpl; auto. +intros _; apply Zmod_small; auto with zarith. +intros n1 Hn1 Rec _; simpl. +generalize (in_mod_ZPGroup _ H _ Hp); intros Hu. +unfold Zsucc; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith. +rewrite gpow_add; auto with zarith. +rewrite gpow_1; auto; rewrite <- Rec; auto. +rewrite Zmult_mod; auto. +Qed. + + +Theorem Zorder_div_power: forall p q n, 1 < n -> rel_prime p n -> p ^ q mod n = 1 -> (Zorder p n | q). +intros p q n H H1 H2. +assert (Hq: 0 <= q). +generalize H2; case q; simpl; auto with zarith. +intros p1 H3; contradict H3; rewrite Zmod_small; auto with zarith. +unfold Zorder; case (Z_le_dec n 1). +intros H3; contradict H; auto with zarith. +intros H3; apply e_order_divide_gpow; auto. +apply in_mod_ZPGroup; auto. +rewrite <- Zpower_mod_is_gpow; auto with zarith. +Qed. + +Theorem Zorder_div: forall p n, prime n -> ~(n | p) -> (Zorder p n | n - 1). +intros p n H; unfold Zorder. +case (Z_le_dec n 1); intros H1 H2. +contradict H1; generalize (prime_ge_2 n H); auto with zarith. +rewrite <- prime_phi_n_minus_1; auto. +match goal with |- context[ZPGroup _ ?H2] => rewrite phi_is_order with (n_pos := H2) end. +apply e_order_divide_g_order; auto. +apply in_mod_ZPGroup; auto. +apply rel_prime_sym; apply prime_rel_prime; auto. +Qed. + + +Theorem Zorder_power_is_1: forall p n, 1 < n -> rel_prime p n -> p ^ (Zorder p n) mod n = 1. +intros p n H H1; unfold Zorder. +case (Z_le_dec n 1); intros H2. +contradict H; auto with zarith. +let x := match goal with |- context[ZPGroup _ ?X] => X end in rewrite Zpower_mod_is_gpow with (Hn := x); auto with zarith. +rewrite gpow_e_order_is_e. +reflexivity. +apply in_mod_ZPGroup; auto. +apply Zlt_le_weak; apply e_order_pos. +Qed. + +Theorem Zorder_power_pos: forall p n, 1 < n -> rel_prime p n -> 0 < Zorder p n. +intros p n H H1; unfold Zorder. +case (Z_le_dec n 1); intros H2. +contradict H; auto with zarith. +apply e_order_pos. +Qed. + +Theorem phi_power_is_1: forall p n, 1 < n -> rel_prime p n -> p ^ (phi n) mod n = 1. +intros p n H H1. +assert (V1:= Zorder_power_pos p n H H1). +assert (H2: (Zorder p n | phi n)). +unfold Zorder. +case (Z_le_dec n 1); intros H2. +contradict H; auto with zarith. +match goal with |- context[ZPGroup n ?H] => +rewrite phi_is_order with (n_pos := H) +end. +apply e_order_divide_g_order. +apply in_mod_ZPGroup; auto. +case H2; clear H2; intros q H2; rewrite H2. +rewrite Zmult_comm. +assert (V2 := (phi_pos _ H)). +assert (V3: 0 <= q). +rewrite H2 in V2. +apply Zlt_le_weak; apply Zmult_lt_0_reg_r with (2 := V2); auto with zarith. +rewrite Zpower_mult; auto with zarith. +rewrite Zpower_mod; auto with zarith. +rewrite Zorder_power_is_1; auto. +rewrite Zpower_1_l; auto with zarith. +apply Zmod_small; auto with zarith. +Qed. diff --git a/coqprime-8.4/Makefile b/coqprime-8.4/Makefile new file mode 100644 index 000000000..8fa838a1e --- /dev/null +++ b/coqprime-8.4/Makefile @@ -0,0 +1,253 @@ +############################################################################# +## v # The Coq Proof Assistant ## +## "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) + +%.v.beautified: + $(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $* + +# WARNING +# +# This Makefile has been automagically generated +# Edit at your own risks ! +# +# END OF WARNING + diff --git a/coqprime-8.4/README.md b/coqprime-8.4/README.md new file mode 100644 index 000000000..8f1b93b12 --- /dev/null +++ b/coqprime-8.4/README.md @@ -0,0 +1,9 @@ +# Coqprime (LGPL subset) + +This is a mirror of the LGPL-licensed and autogenerated files from [Coqprime](http://coqprime.gforge.inria.fr/) for Coq 8.4. It was generated from [coqprime_par.zip](https://gforge.inria.fr/frs/download.php/file/35201/coqprime_par.zip). Due to the removal of files that are missing license headers in the upstream source, `make` no longer completes successfully. However, a large part of the codebase does build and contains theorems useful to us. Fixing the build system would be nice, but is not a priority for us. + +## Usage + + make PrimalityTest/Zp.vo PrimalityTest/PocklingtonCertificat.vo + cd .. + coqide -R coqprime/Tactic Coqprime -R coqprime/N Coqprime -R coqprime/Z Coqprime -R coqprime/List Coqprime -R coqprime/PrimalityTest Coqprime YOUR_FILE.v # these are the dependencies for PrimalityTest/Zp, other modules can be added in a similar fashion diff --git a/coqprime-8.4/_CoqProject b/coqprime-8.4/_CoqProject new file mode 100644 index 000000000..95b224864 --- /dev/null +++ b/coqprime-8.4/_CoqProject @@ -0,0 +1,24 @@ +-R Coqprime Coqprime +Coqprime/Cyclic.v +Coqprime/EGroup.v +Coqprime/Euler.v +Coqprime/FGroup.v +Coqprime/IGroup.v +Coqprime/Iterator.v +Coqprime/Lagrange.v +Coqprime/ListAux.v +Coqprime/LucasLehmer.v +Coqprime/NatAux.v +Coqprime/PGroup.v +Coqprime/Permutation.v +Coqprime/Pmod.v +Coqprime/Pocklington.v +Coqprime/PocklingtonCertificat.v +Coqprime/Root.v +Coqprime/Tactic.v +Coqprime/UList.v +Coqprime/ZCAux.v +Coqprime/ZCmisc.v +Coqprime/ZProgression.v +Coqprime/ZSum.v +Coqprime/Zp.v diff --git a/coqprime-8.5/Coqprime/Cyclic.v b/coqprime-8.5/Coqprime/Cyclic.v deleted file mode 100644 index c25f683ca..000000000 --- a/coqprime-8.5/Coqprime/Cyclic.v +++ /dev/null @@ -1,244 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(*********************************************************************** - Cyclic.v - - Proof that an abelien ring is cyclic - ************************************************************************) -Require Import ZCAux. -Require Import List. -Require Import Root. -Require Import UList. -Require Import IGroup. -Require Import EGroup. -Require Import FGroup. - -Open Scope Z_scope. - -Section Cyclic. - -Variable A: Set. -Variable plus mult: A -> A -> A. -Variable op: A -> A. -Variable zero one: A. -Variable support: list A. -Variable e: A. - -Hypothesis A_dec: forall a b: A, {a = b} + {a <> b}. -Hypothesis e_not_zero: zero <> e. -Hypothesis support_ulist: ulist support. -Hypothesis e_in_support: In e support. -Hypothesis zero_in_support: In zero support. -Hypothesis mult_internal: forall a b, In a support -> In b support -> In (mult a b) support. -Hypothesis mult_assoc: forall a b c, In a support -> In b support -> In c support -> mult a (mult b c) = mult (mult a b) c. -Hypothesis e_is_zero_l: forall a, In a support -> mult e a = a. -Hypothesis e_is_zero_r: forall a, In a support -> mult a e = a. -Hypothesis plus_internal: forall a b, In a support -> In b support -> In (plus a b) support. -Hypothesis plus_zero: forall a, In a support -> plus zero a = a. -Hypothesis plus_comm: forall a b, In a support -> In b support -> plus a b = plus b a. -Hypothesis plus_assoc: forall a b c, In a support -> In b support -> In c support -> plus a (plus b c) = plus (plus a b) c. -Hypothesis mult_zero: forall a, In a support -> mult zero a = zero. -Hypothesis mult_comm: forall a b, In a support -> In b support ->mult a b = mult b a. -Hypothesis mult_plus_distr: forall a b c, In a support -> In b support -> In c support -> mult a (plus b c) = plus (mult a b) (mult a c). -Hypothesis op_internal: forall a, In a support -> In (op a) support. -Hypothesis plus_op_zero: forall a, In a support -> plus a (op a) = zero. -Hypothesis mult_integral: forall a b, In a support -> In b support -> mult a b = zero -> a = zero \/ b = zero. - -Definition IA := (IGroup A mult support e A_dec support_ulist e_in_support mult_internal - mult_assoc - e_is_zero_l e_is_zero_r). - -Hint Resolve (fun x => isupport_incl _ mult support e A_dec x). - -Theorem gpow_evaln: forall n, 0 < n -> - exists p, (length p <= Zabs_nat n)%nat /\ (forall i, In i p -> In i support) /\ - forall x, In x IA.(s) -> eval A plus mult zero (zero::p) x = gpow x IA n. -intros n Hn; generalize Hn; pattern n; apply natlike_ind; auto with zarith. -intros H1; contradict H1; auto with zarith. -intros x Hx Rec _. -case Zle_lt_or_eq with (1 := Hx); clear Hx; intros Hx; subst; simpl. -case Rec; auto; simpl; intros p (Hp1, (Hp2, Hp3)); clear Rec. -exists (zero::p); split; simpl. -rewrite Zabs_nat_Zsucc; auto with arith zarith. -split. -intros i [Hi | Hi]; try rewrite <- Hi; auto. -intros x1 Hx1; simpl. -rewrite Hp3; repeat rewrite plus_zero; unfold Zsucc; try rewrite gpow_add; auto with zarith. -rewrite gpow_1; try apply mult_comm; auto. -apply (fun x => isupport_incl _ mult support e A_dec x); auto. -change (In (gpow x1 IA x) IA.(s)). -apply gpow_in; auto. -apply mult_internal; auto. -apply (fun x => isupport_incl _ mult support e A_dec x); auto. -change (In (gpow x1 IA x) IA.(s)). -apply gpow_in; auto. -exists (e:: nil); split; simpl. -compute; auto with arith. -split. -intros i [Hi | Hi]; try rewrite <- Hi; auto; case Hi. -intros x Hx; simpl. -rewrite plus_zero; rewrite (fun x => mult_comm x zero); try rewrite mult_zero; auto. -rewrite plus_comm; try rewrite plus_zero; auto. -Qed. - -Definition check_list_gpow: forall l n, (incl l IA.(s)) -> {forall a, In a l -> gpow a IA n = e} + {exists a, In a l /\ gpow a IA n <> e}. -intros l n; elim l; simpl; auto. -intros H; left; intros a H1; case H1. -intros a l1 Rec H. -case (A_dec (gpow a IA n) e); intros H2. -case Rec; try intros H3. -apply incl_tran with (2 := H); auto with datatypes. -left; intros a1 H4; case H4; auto. -intros H5; rewrite <- H5; auto. -right; case H3; clear H3; intros a1 (H3, H4). -exists a1; auto. -right; exists a; auto. -Defined. - - -Theorem prime_power_div: forall p q i, prime p -> 0 <= q -> 0 <= i -> (q | p ^ i) -> exists j, 0 <= j <= i /\ q = p ^ j. -intros p q i Hp Hq Hi H. -assert (Hp1: 0 < p). -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -pattern q; apply prime_div_induction with (p ^ i); auto with zarith. -exists 0; rewrite Zpower_0_r; auto with zarith. -intros p1 i1 Hp2 Hi1 H1. -case Zle_lt_or_eq with (1 := Hi1); clear Hi1; intros Hi1; subst. -assert (Heq: p1 = p). -apply prime_div_Zpower_prime with i; auto. -apply Zdivide_trans with (2 := H1). -apply Zpower_divide; auto with zarith. -exists i1; split; auto; try split; auto with zarith. -case (Zle_or_lt i1 i); auto; intros H2. -absurd (p1 ^ i1 <= p ^ i). -apply Zlt_not_le; rewrite Heq; apply Zpower_lt_monotone; auto with zarith. -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -apply Zdivide_le; auto with zarith. -rewrite Heq; auto. -exists 0; repeat rewrite Zpower_exp_0; auto with zarith. -intros p1 q1 Hpq (j1,((Hj1, Hj2), Hj3)) (j2, ((Hj4, Hj5), Hj6)). -case Zle_lt_or_eq with (1 := Hj1); clear Hj1; intros Hj1; subst. -case Zle_lt_or_eq with (1 := Hj4); clear Hj4; intros Hj4; subst. -inversion Hpq as [ H0 H1 H2]. -absurd (p | 1). -intros H3; absurd (1 < p). -apply Zle_not_lt; apply Zdivide_le; auto with zarith. -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -apply H2; apply Zpower_divide; auto with zarith. -exists j1; rewrite Zpower_0_r; auto with zarith. -exists j2; rewrite Zpower_0_r; auto with zarith. -Qed. - -Theorem inj_lt_inv: forall n m : nat, Z_of_nat n < Z_of_nat m -> (n < m)%nat. -intros n m H; case (le_or_lt m n); auto; intros H1; contradict H. -apply Zle_not_lt; apply inj_le; auto. -Qed. - -Theorem not_all_solutions: forall i, 0 < i < g_order IA -> exists a, In a IA.(s) /\ gpow a IA i <> e. -intros i (Hi, Hi2). -case (check_list_gpow IA.(s) i); try intros H; auto with datatypes. -case (gpow_evaln i); auto; intros p (Hp1, (Hp2, Hp3)). -absurd ((op e) = zero). -intros H1; case e_not_zero. -rewrite <- (plus_op_zero e); try rewrite H1; auto. -rewrite plus_comm; auto. -apply (root_max_is_zero _ (fun x => In x support) plus mult op zero) with (l := IA.(s)) (p := op e :: p); auto with datatypes. -simpl; intros x [Hx | Hx]; try rewrite <- Hx; auto. -intros x Hx. -generalize (Hp3 _ Hx); simpl; rewrite plus_zero; auto. -intros tmp; rewrite tmp; clear tmp. -rewrite H; auto; rewrite plus_comm; auto with datatypes. -apply mult_internal; auto. -apply eval_P; auto. -simpl; apply lt_le_S; apply le_lt_trans with (1 := Hp1). -apply inj_lt_inv. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -Qed. - -Theorem divide_g_order_e_order: forall n, 0 <= n -> (n | g_order IA) -> exists a, In a IA.(s) /\ e_order A_dec a IA = n. -intros n Hn H. -assert (Hg: 0 < g_order IA). -apply g_order_pos. -assert (He: forall a, 0 <= e_order A_dec a IA). -intros a; apply Zlt_le_weak; apply e_order_pos. -pattern n; apply prime_div_induction with (n := g_order IA); auto. -exists e; split; auto. -apply IA.(e_in_s). -apply Zle_antisym. -apply Zdivide_le; auto with zarith. -apply e_order_divide_gpow; auto with zarith. -apply IA.(e_in_s). -rewrite gpow_1; auto. -apply IA.(e_in_s). -match goal with |- (_ <= ?X) => assert (0 < X) end; try apply e_order_pos; auto with zarith. -intros p i Hp Hi K. -assert (Hp1: 0 < p). -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -assert (Hi1: 0 < p ^ i). -apply Zpower_gt_0; auto. -case Zle_lt_or_eq with (1 := Hi); clear Hi; intros Hi; subst. -case (not_all_solutions (g_order IA / p)). -apply Zdivide_Zdiv_lt_pos; auto with zarith. -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -apply Zdivide_trans with (2 := K). -apply Zpower_divide; auto. -intros a (Ha1, Ha2). -exists (gpow a IA (g_order IA / p ^ i)); split. -apply gpow_in; auto. -match goal with |- ?X = ?Y => assert (H1: (X | Y) ) end; auto. -apply e_order_divide_gpow; auto with zarith. -apply gpow_in; auto. -rewrite <- gpow_gpow; auto with zarith. -rewrite Zmult_comm; rewrite <- Zdivide_Zdiv_eq; auto with zarith. -apply fermat_gen; auto. -apply Z_div_pos; auto with zarith. -case prime_power_div with (4 := H1); auto with zarith. -intros j ((Hj1, Hj2), Hj3). -case Zle_lt_or_eq with (1 := Hj2); intros Hj4; subst; auto. -case Ha2. -replace (g_order IA) with (((g_order IA / p ^i) * p ^ j) * p ^ (i - j - 1) * p). -rewrite Z_div_mult; auto with zarith. -repeat rewrite gpow_gpow; auto with zarith. -rewrite <- Hj3. -rewrite gpow_e_order_is_e; auto with zarith. -rewrite gpow_e; auto. -apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. -apply gpow_in; auto. -apply Z_div_pos; auto with zarith. -apply Zmult_le_0_compat; try apply Z_div_pos; auto with zarith. -pattern p at 4; rewrite <- Zpower_1_r. -repeat rewrite <- Zmult_assoc; repeat rewrite <- Zpower_exp; auto with zarith. -replace (j + (i - j - 1 + 1)) with i; auto with zarith. -apply sym_equal; rewrite Zmult_comm; apply Zdivide_Zdiv_eq; auto with zarith. -rewrite Zpower_0_r; exists e; split. -apply IA.(e_in_s). -match goal with |- ?X = 1 => assert (tmp: 0 < X); try apply e_order_pos; -case Zle_lt_or_eq with 1 X; auto with zarith; clear tmp; intros H1 end. -absurd (gpow IA.(FGroup.e) IA 1 = IA.(FGroup.e)). -apply gpow_e_order_lt_is_not_e with A_dec; auto with zarith. -apply gpow_e; auto with zarith. -intros p q H1 (a, (Ha1, Ha2)) (b, (Hb1, Hb2)). -exists (mult a b); split. -apply IA.(internal); auto. -rewrite <- Ha2; rewrite <- Hb2; apply order_mult; auto. -rewrite Ha2; rewrite Hb2; auto. -Qed. - -Set Implicit Arguments. -Definition cyclic (A: Set) A_dec (op: A -> A -> A) (G: FGroup op):= exists a, In a G.(s) /\ e_order A_dec a G = g_order G. -Unset Implicit Arguments. - -Theorem cyclic_field: cyclic A_dec IA. -red; apply divide_g_order_e_order; auto. -apply Zlt_le_weak; apply g_order_pos. -exists 1; ring. -Qed. - -End Cyclic. diff --git a/coqprime-8.5/Coqprime/EGroup.v b/coqprime-8.5/Coqprime/EGroup.v deleted file mode 100644 index 933176abd..000000000 --- a/coqprime-8.5/Coqprime/EGroup.v +++ /dev/null @@ -1,605 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - EGroup.v - - Given an element a, create the group {e, a, a^2, ..., a^n} - **********************************************************************) -Require Import ZArith. -Require Import Tactic. -Require Import List. -Require Import ZCAux. -Require Import ZArith Znumtheory. -Require Import Wf_nat. -Require Import UList. -Require Import FGroup. -Require Import Lagrange. - -Open Scope Z_scope. - -Section EGroup. - -Variable A: Set. - -Variable A_dec: forall a b: A, {a = b} + {~ a = b}. - -Variable op: A -> A -> A. - -Variable a: A. - -Variable G: FGroup op. - -Hypothesis a_in_G: In a G.(s). - - -(************************************** - The power function for the group - **************************************) - -Set Implicit Arguments. -Definition gpow n := match n with Zpos p => iter_pos _ (op a) G.(e) p | _ => G.(e) end. -Unset Implicit Arguments. - -Theorem gpow_0: gpow 0 = G.(e). -simpl; sauto. -Qed. - -Theorem gpow_1 : gpow 1 = a. -simpl; sauto. -Qed. - -(************************************** - Some properties of the power function - **************************************) - -Theorem gpow_in: forall n, In (gpow n) G.(s). -intros n; case n; simpl; auto. -intros p; apply iter_pos_invariant with (Inv := fun x => In x G.(s)); auto. -Qed. - -Theorem gpow_op: forall b p, In b G.(s) -> iter_pos _ (op a) b p = op (iter_pos _ (op a) G.(e) p) b. -intros b p; generalize b; elim p; simpl; auto; clear b p. -intros p Rec b Hb. -assert (H: In (gpow (Zpos p)) G.(s)). -apply gpow_in. -rewrite (Rec b); try rewrite (fun x y => Rec (op x y)); try rewrite (fun x y => Rec (iter_pos A x y p)); auto. -repeat rewrite G.(assoc); auto. -intros p Rec b Hb. -assert (H: In (gpow (Zpos p)) G.(s)). -apply gpow_in. -rewrite (Rec b); try rewrite (fun x y => Rec (op x y)); try rewrite (fun x y => Rec (iter_pos A x y p)); auto. -repeat rewrite G.(assoc); auto. -intros b H; rewrite e_is_zero_r; auto. -Qed. - -Theorem gpow_add: forall n m, 0 <= n -> 0 <= m -> gpow (n + m) = op (gpow n) (gpow m). -intros n; case n. -intros m _ _; simpl; apply sym_equal; apply e_is_zero_l; apply gpow_in. -2: intros p m H; contradict H; auto with zarith. -intros p1 m; case m. -intros _ _; simpl; apply sym_equal; apply e_is_zero_r. -exact (gpow_in (Zpos p1)). -2: intros p2 _ H; contradict H; auto with zarith. -intros p2 _ _; simpl. -rewrite iter_pos_plus; rewrite (fun x y => gpow_op (iter_pos A x y p2)); auto. -exact (gpow_in (Zpos p2)). -Qed. - -Theorem gpow_1_more: - forall n, 0 < n -> gpow n = G.(e) -> forall m, 0 <= m -> exists p, 0 <= p < n /\ gpow m = gpow p. -intros n H1 H2 m Hm; generalize Hm; pattern m; apply Z_lt_induction; auto with zarith; clear m Hm. -intros m Rec Hm. -case (Zle_or_lt n m); intros H3. -case (Rec (m - n)); auto with zarith. -intros p (H4,H5); exists p; split; auto. -replace m with (n + (m - n)); auto with zarith. -rewrite gpow_add; try rewrite H2; try rewrite H5; sauto; auto with zarith. -generalize gpow_in; sauto. -exists m; auto. -Qed. - -Theorem gpow_i: forall n m, 0 <= n -> 0 <= m -> gpow n = gpow (n + m) -> gpow m = G.(e). -intros n m H1 H2 H3; generalize gpow_in; intro PI. -apply g_cancel_l with (g:= G) (a := gpow n); sauto. -rewrite <- gpow_add; try rewrite <- H3; sauto. -Qed. - -(************************************** - We build the support by iterating the power function - **************************************) - -Set Implicit Arguments. - -Fixpoint support_aux (b: A) (n: nat) {struct n}: list A := -b::let c := op a b in - match n with - O => nil | - (S n1) =>if A_dec c G.(e) then nil else support_aux c n1 - end. - -Definition support := support_aux G.(e) (Zabs_nat (g_order G)). - -Unset Implicit Arguments. - -(************************************** - Some properties of the support that helps to prove that we have a group - **************************************) - -Theorem support_aux_gpow: - forall n m b, 0 <= m -> In b (support_aux (gpow m) n) -> - exists p, (0 <= p < length (support_aux (gpow m) n))%nat /\ b = gpow (m + Z_of_nat p). -intros n; elim n; simpl. -intros n1 b Hm [H1 | H1]; exists 0%nat; simpl; rewrite Zplus_0_r; auto; case H1. -intros n1 Rec m b Hm [H1 | H1]. -exists 0%nat; simpl; rewrite Zplus_0_r; auto; auto with arith. -generalize H1; case (A_dec (op a (gpow m)) G.(e)); clear H1; simpl; intros H1 H2. -case H2. -case (Rec (1 + m) b); auto with zarith. -rewrite gpow_add; auto with zarith. -rewrite gpow_1; auto. -intros p (Hp1, Hp2); exists (S p); split; auto with zarith. -rewrite <- gpow_1. -rewrite <- gpow_add; auto with zarith. -rewrite inj_S; rewrite Hp2; eq_tac; auto with zarith. -Qed. - -Theorem gpow_support_aux_not_e: - forall n m p, 0 <= m -> m < p < m + Z_of_nat (length (support_aux (gpow m) n)) -> gpow p <> G.(e). -intros n; elim n; simpl. -intros m p Hm (H1, H2); contradict H2; auto with zarith. -intros n1 Rec m p Hm; case (A_dec (op a (gpow m)) G.(e)); simpl. -intros _ (H1, H2); contradict H2; auto with zarith. -assert (tmp: forall p, Zpos (P_of_succ_nat p) = 1 + Z_of_nat p). -intros p1; apply trans_equal with (Z_of_nat (S p1)); auto; rewrite inj_S; auto with zarith. -rewrite tmp. -intros H1 (H2, H3); case (Zle_lt_or_eq (1 + m) p); auto with zarith; intros H4; subst. -apply (Rec (1 + m)); try split; auto with zarith. -rewrite gpow_add; auto with zarith. -rewrite gpow_1; auto with zarith. -rewrite gpow_add; try rewrite gpow_1; auto with zarith. -Qed. - -Theorem support_aux_not_e: forall n m b, 0 <= m -> In b (tail (support_aux (gpow m) n)) -> ~ b = G.(e). -intros n; elim n; simpl. -intros m b Hm H; case H. -intros n1 Rec m b Hm; case (A_dec (op a (gpow m)) G.(e)); intros H1 H2; simpl; auto. -assert (Hm1: 0 <= 1 + m); auto with zarith. -generalize( Rec (1 + m) b Hm1) H2; case n1; auto; clear Hm1. -intros _ [H3 | H3]; auto. -contradict H1; subst; auto. -rewrite gpow_add; simpl; try rewrite e_is_zero_r; auto with zarith. -intros n2; case (A_dec (op a (op a (gpow m))) G.(e)); intros H3. -intros _ [H4 | H4]. -contradict H1; subst; auto. -case H4. -intros H4 [H5 | H5]; subst; auto. -Qed. - -Theorem support_aux_length_le: forall n a, (length (support_aux a n) <= n + 1)%nat. -intros n; elim n; simpl; auto. -intros n1 Rec a1; case (A_dec (op a a1) G.(e)); simpl; auto with arith. -Qed. - -Theorem support_aux_length_le_is_e: - forall n m, 0 <= m -> (length (support_aux (gpow m) n) <= n)%nat -> - gpow (m + Z_of_nat (length (support_aux (gpow m) n))) = G.(e) . -intros n; elim n; simpl; auto. -intros m _ H1; contradict H1; auto with arith. -intros n1 Rec m Hm; case (A_dec (op a (gpow m)) G.(e)); simpl; intros H1. -intros H2; rewrite Zplus_comm; rewrite gpow_add; simpl; try rewrite e_is_zero_r; auto with zarith. -assert (tmp: forall p, Zpos (P_of_succ_nat p) = 1 + Z_of_nat p). -intros p1; apply trans_equal with (Z_of_nat (S p1)); auto; rewrite inj_S; auto with zarith. -rewrite tmp; clear tmp. -rewrite <- gpow_1. -rewrite <- gpow_add; auto with zarith. -rewrite Zplus_assoc; rewrite (Zplus_comm 1); intros H2; apply Rec; auto with zarith. -Qed. - -Theorem support_aux_in: - forall n m p, 0 <= m -> (p < length (support_aux (gpow m) n))% nat -> - (In (gpow (m + Z_of_nat p)) (support_aux (gpow m) n)). -intros n; elim n; simpl; auto; clear n. -intros m p Hm H1; replace p with 0%nat. -left; eq_tac; auto with zarith. -generalize H1; case p; simpl; auto with arith. -intros n H2; contradict H2; apply le_not_lt; auto with arith. -intros n1 Rec m p Hm; case (A_dec (op a (gpow m)) G.(e)); simpl; intros H1 H2; auto. -replace p with 0%nat. -left; eq_tac; auto with zarith. -generalize H2; case p; simpl; auto with arith. -intros n H3; contradict H3; apply le_not_lt; auto with arith. -generalize H2; case p; simpl; clear H2. -rewrite Zplus_0_r; auto. -intros n. -assert (tmp: forall p, Zpos (P_of_succ_nat p) = 1 + Z_of_nat p). -intros p1; apply trans_equal with (Z_of_nat (S p1)); auto; rewrite inj_S; auto with zarith. -rewrite tmp; clear tmp. -rewrite <- gpow_1; rewrite <- gpow_add; auto with zarith. -rewrite Zplus_assoc; rewrite (Zplus_comm 1); intros H2; right; apply Rec; auto with zarith. -Qed. - -Theorem support_aux_ulist: - forall n m, 0 <= m -> (forall p, 0 <= p < m -> gpow (1 + p) <> G.(e)) -> ulist (support_aux (gpow m) n). -intros n; elim n; auto; clear n. -intros m _ _; auto. -simpl; apply ulist_cons; auto. -intros n1 Rec m Hm H. -simpl; case (A_dec (op a (gpow m)) G.(e)); auto. -intros He; apply ulist_cons; auto. -intros H1; case (support_aux_gpow n1 (1 + m) (gpow m)); auto with zarith. -rewrite gpow_add; try rewrite gpow_1; auto with zarith. -intros p (Hp1, Hp2). -assert (H2: gpow (1 + Z_of_nat p) = G.(e)). -apply gpow_i with m; auto with zarith. -rewrite Hp2; eq_tac; auto with zarith. -case (Zle_or_lt m (Z_of_nat p)); intros H3; auto. -2: case (H (Z_of_nat p)); auto with zarith. -case (support_aux_not_e (S n1) m (gpow (1 + Z_of_nat p))); auto. -rewrite gpow_add; auto with zarith; simpl; rewrite e_is_zero_r; auto. -case (A_dec (op a (gpow m)) G.(e)); auto. -intros _; rewrite <- gpow_1; repeat rewrite <- gpow_add; auto with zarith. -replace (1 + Z_of_nat p) with ((1 + m) + (Z_of_nat (p - Zabs_nat m))); auto with zarith. -apply support_aux_in; auto with zarith. -rewrite inj_minus1; auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -apply inj_le_rev. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -rewrite <- gpow_1; repeat rewrite <- gpow_add; auto with zarith. -apply (Rec (1 + m)); auto with zarith. -intros p H1; case (Zle_lt_or_eq p m); intros; subst; auto with zarith. -rewrite gpow_add; auto with zarith. -rewrite gpow_1; auto. -Qed. - -Theorem support_gpow: forall b, (In b support) -> exists p, 0 <= p < Z_of_nat (length support) /\ b = gpow p. -intros b H; case (support_aux_gpow (Zabs_nat (g_order G)) 0 b); auto with zarith. -intros p ((H1, H2), H3); exists (Z_of_nat p); repeat split; auto with zarith. -apply inj_lt; auto. -Qed. - -Theorem support_incl_G: incl support G.(s). -intros a1 H; case (support_gpow a1); auto; intros p (H1, H2); subst; apply gpow_in. -Qed. - -Theorem gpow_support_not_e: forall p, 0 < p < Z_of_nat (length support) -> gpow p <> G.(e). -intros p (H1, H2); apply gpow_support_aux_not_e with (m := 0) (n := length G.(s)); simpl; - try split; auto with zarith. -rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. -Qed. - -Theorem support_not_e: forall b, In b (tail support) -> ~ b = G.(e). -intros b H; apply (support_aux_not_e (Zabs_nat (g_order G)) 0); auto with zarith. -Qed. - -Theorem support_ulist: ulist support. -apply (support_aux_ulist (Zabs_nat (g_order G)) 0); auto with zarith. -Qed. - -Theorem support_in_e: In G.(e) support. -unfold support; case (Zabs_nat (g_order G)); simpl; auto with zarith. -Qed. - -Theorem gpow_length_support_is_e: gpow (Z_of_nat (length support)) = G.(e). -apply (support_aux_length_le_is_e (Zabs_nat (g_order G)) 0); simpl; auto with zarith. -unfold g_order; rewrite Zabs_nat_Z_of_nat; apply ulist_incl_length. -rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. -exact support_ulist. -rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. -exact support_incl_G. -Qed. - -Theorem support_in: forall p, 0 <= p < Z_of_nat (length support) -> In (gpow p) support. -intros p (H, H1); unfold support. -rewrite <- (Zabs_eq p); auto with zarith. -rewrite <- (inj_Zabs_nat p); auto. -generalize (support_aux_in (Zabs_nat (g_order G)) 0); simpl; intros H2; apply H2; auto with zarith. -rewrite <- (fun x => Zabs_nat_Z_of_nat (@length A x)); auto. -apply Zabs_nat_lt; split; auto. -Qed. - -Theorem support_internal: forall a b, In a support -> In b support -> In (op a b) support. -intros a1 b1 H1 H2. -case support_gpow with (1 := H1); auto; intros p1 ((H3, H4), H5); subst. -case support_gpow with (1 := H2); auto; intros p2 ((H5, H6), H7); subst. -rewrite <- gpow_add; auto with zarith. -case gpow_1_more with (m:= p1 + p2) (2 := gpow_length_support_is_e); auto with zarith. -intros p3 ((H8, H9), H10); rewrite H10; apply support_in; auto with zarith. -Qed. - -Theorem support_i_internal: forall a, In a support -> In (G.(i) a) support. -generalize gpow_in; intros Hp. -intros a1 H1. -case support_gpow with (1 := H1); auto. -intros p1 ((H2, H3), H4); case Zle_lt_or_eq with (1 := H2); clear H2; intros H2; subst. -2: rewrite gpow_0; rewrite i_e; apply support_in_e. -replace (G.(i) (gpow p1)) with (gpow (Z_of_nat (length support - Zabs_nat p1))). -apply support_in; auto with zarith. -rewrite inj_minus1. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -apply inj_le_rev; rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -apply g_cancel_l with (g:= G) (a := gpow p1); sauto. -rewrite <- gpow_add; auto with zarith. -replace (p1 + Z_of_nat (length support - Zabs_nat p1)) with (Z_of_nat (length support)). -rewrite gpow_length_support_is_e; sauto. -rewrite inj_minus1; auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -apply inj_le_rev; rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -Qed. - -(************************************** - We are now ready to build the group - **************************************) - -Definition Gsupport: (FGroup op). -generalize support_incl_G; unfold incl; intros Ho. -apply mkGroup with support G.(e) G.(i); sauto. -apply support_ulist. -apply support_internal. -intros a1 b1 c1 H1 H2 H3; apply G.(assoc); sauto. -apply support_in_e. -apply support_i_internal. -Defined. - -(************************************** - Definition of the order of an element - **************************************) -Set Implicit Arguments. - -Definition e_order := Z_of_nat (length support). - -Unset Implicit Arguments. - -(************************************** - Some properties of the order of an element - **************************************) - -Theorem gpow_e_order_is_e: gpow e_order = G.(e). -apply (support_aux_length_le_is_e (Zabs_nat (g_order G)) 0); simpl; auto with zarith. -unfold g_order; rewrite Zabs_nat_Z_of_nat; apply ulist_incl_length. -rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. -exact support_ulist. -rewrite <- (Zabs_nat_Z_of_nat (length G.(s))); auto. -exact support_incl_G. -Qed. - -Theorem gpow_e_order_lt_is_not_e: forall n, 1 <= n < e_order -> gpow n <> G.(e). -intros n (H1, H2); apply gpow_support_not_e; auto with zarith. -Qed. - -Theorem e_order_divide_g_order: (e_order | g_order G). -change ((g_order Gsupport) | g_order G). -apply lagrange; auto. -exact support_incl_G. -Qed. - -Theorem e_order_pos: 0 < e_order. -unfold e_order, support; case (Zabs_nat (g_order G)); simpl; auto with zarith. -Qed. - -Theorem e_order_divide_gpow: forall n, 0 <= n -> gpow n = G.(e) -> (e_order | n). -generalize gpow_in; intros Hp. -generalize e_order_pos; intros Hp1. -intros n Hn; generalize Hn; pattern n; apply Z_lt_induction; auto; clear n Hn. -intros n Rec Hn H. -case (Zle_or_lt e_order n); intros H1. -case (Rec (n - e_order)); auto with zarith. -apply g_cancel_l with (g:= G) (a := gpow e_order); sauto. -rewrite G.(e_is_zero_r); auto with zarith. -rewrite <- gpow_add; try (rewrite gpow_e_order_is_e; rewrite <- H; eq_tac); auto with zarith. -intros k Hk; exists (1 + k). -rewrite Zmult_plus_distr_l; rewrite <- Hk; auto with zarith. -case (Zle_lt_or_eq 0 n); auto with arith; intros H2; subst. -contradict H; apply support_not_e. -generalize H1; unfold e_order, support. -case (Zabs_nat (g_order G)); simpl; auto. -intros H3; contradict H3; auto with zarith. -intros n1; case (A_dec (op a G.(e)) G.(e)); simpl; intros _ H3. -contradict H3; auto with zarith. -generalize H3; clear H3. -assert (tmp: forall p, Zpos (P_of_succ_nat p) = 1 + Z_of_nat p). -intros p1; apply trans_equal with (Z_of_nat (S p1)); auto; rewrite inj_S; auto with zarith. -rewrite tmp; clear tmp; intros H3. -change (In (gpow n) (support_aux (gpow 1) n1)). -replace n with (1 + Z_of_nat (Zabs_nat n - 1)). -apply support_aux_in; auto with zarith. -rewrite <- (fun x => Zabs_nat_Z_of_nat (@length A x)). -replace (Zabs_nat n - 1)%nat with (Zabs_nat (n - 1)). -apply Zabs_nat_lt; split; auto with zarith. -rewrite G.(e_is_zero_r) in H3; try rewrite gpow_1; auto with zarith. -apply inj_eq_rev; rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -rewrite inj_minus1; auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -apply inj_le_rev; rewrite inj_Zabs_nat; simpl; auto with zarith. -rewrite Zabs_eq; auto with zarith. -rewrite inj_minus1; auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -rewrite Zplus_comm; simpl; auto with zarith. -apply inj_le_rev; rewrite inj_Zabs_nat; simpl; auto with zarith. -rewrite Zabs_eq; auto with zarith. -exists 0; auto with arith. -Qed. - -End EGroup. - -Theorem gpow_gpow: forall (A : Set) (op : A -> A -> A) (a : A) (G : FGroup op), - In a (s G) -> forall n m, 0 <= n -> 0 <= m -> gpow a G (n * m ) = gpow (gpow a G n) G m. -intros A op a G H n m; case n. -simpl; intros _ H1; generalize H1. -pattern m; apply natlike_ind; simpl; auto. -intros x H2 Rec _; unfold Zsucc; rewrite gpow_add; simpl; auto with zarith. -repeat rewrite G.(e_is_zero_r); auto with zarith. -apply gpow_in; sauto. -intros p1 _; case m; simpl; auto. -assert(H1: In (iter_pos A (op a) (e G) p1) (s G)). -refine (gpow_in _ _ _ _ _ (Zpos p1)); auto. -intros p2 _; pattern p2; apply Pind; simpl; auto. -rewrite Pmult_1_r; rewrite G.(e_is_zero_r); try rewrite G.(e_is_zero_r); auto. -intros p3 Rec; rewrite Pplus_one_succ_r; rewrite Pmult_plus_distr_l. -rewrite Pmult_1_r. -simpl; repeat rewrite iter_pos_plus; simpl. -rewrite G.(e_is_zero_r); auto. -rewrite gpow_op with (G:= G); try rewrite Rec; auto. -apply sym_equal; apply gpow_op; auto. -intros p Hp; contradict Hp; auto with zarith. -Qed. - -Theorem gpow_e: forall (A : Set) (op : A -> A -> A) (G : FGroup op) n, 0 <= n -> gpow G.(e) G n = G.(e). -intros A op G n; case n; simpl; auto with zarith. -intros p _; elim p; simpl; auto; intros p1 Rec; repeat rewrite Rec; auto. -Qed. - -Theorem gpow_pow: forall (A : Set) (op : A -> A -> A) (a : A) (G : FGroup op), - In a (s G) -> forall n, 0 <= n -> gpow a G (2 ^ n) = G.(e) -> forall m, n <= m -> gpow a G (2 ^ m) = G.(e). -intros A op a G H n H1 H2 m Hm. -replace m with (n + (m - n)); auto with zarith. -rewrite Zpower_exp; auto with zarith. -rewrite gpow_gpow; auto with zarith. -rewrite H2; apply gpow_e. -apply Zpower_ge_0; auto with zarith. -Qed. - -Theorem gpow_mult: forall (A : Set) (op : A -> A -> A) (a b: A) (G : FGroup op) - (comm: forall a b, In a (s G) -> In b (s G) -> op a b = op b a), - In a (s G) -> In b (s G) -> forall n, 0 <= n -> gpow (op a b) G n = op (gpow a G n) (gpow b G n). -intros A op a b G comm Ha Hb n; case n; simpl; auto. -intros _; rewrite G.(e_is_zero_r); auto. -2: intros p Hp; contradict Hp; auto with zarith. -intros p _; pattern p; apply Pind; simpl; auto. -repeat rewrite G.(e_is_zero_r); auto. -intros p3 Rec; rewrite Pplus_one_succ_r. -repeat rewrite iter_pos_plus; simpl. -repeat rewrite (fun x y H z => gpow_op A op x G H (op y z)) ; auto. -rewrite Rec. -repeat rewrite G.(e_is_zero_r); auto. -assert(H1: In (iter_pos A (op a) (e G) p3) (s G)). -refine (gpow_in _ _ _ _ _ (Zpos p3)); auto. -assert(H2: In (iter_pos A (op b) (e G) p3) (s G)). -refine (gpow_in _ _ _ _ _ (Zpos p3)); auto. -repeat rewrite <- G.(assoc); try eq_tac; auto. -rewrite (fun x y => comm (iter_pos A x y p3) b); auto. -rewrite (G.(assoc) a); try apply comm; auto. -Qed. - -Theorem Zdivide_mult_rel_prime: forall a b c : Z, (a | c) -> (b | c) -> rel_prime a b -> (a * b | c). -intros a b c (q1, H1) (q2, H2) H3. -assert (H4: (a | q2)). -apply Gauss with (2 := H3). -exists q1; rewrite <- H1; rewrite H2; auto with zarith. -case H4; intros q3 H5; exists q3; rewrite H2; rewrite H5; auto with zarith. -Qed. - -Theorem order_mult: forall (A : Set) (op : A -> A -> A) (A_dec: forall a b: A, {a = b} + {~ a = b}) (G : FGroup op) - (comm: forall a b, In a (s G) -> In b (s G) -> op a b = op b a) (a b: A), - In a (s G) -> In b (s G) -> rel_prime (e_order A_dec a G) (e_order A_dec b G) -> - e_order A_dec (op a b) G = e_order A_dec a G * e_order A_dec b G. -intros A op A_dec G comm a b Ha Hb Hab. -assert (Hoat: 0 < e_order A_dec a G); try apply e_order_pos. -assert (Hobt: 0 < e_order A_dec b G); try apply e_order_pos. -assert (Hoabt: 0 < e_order A_dec (op a b) G); try apply e_order_pos. -assert (Hoa: 0 <= e_order A_dec a G); auto with zarith. -assert (Hob: 0 <= e_order A_dec b G); auto with zarith. -apply Zle_antisym; apply Zdivide_le; auto with zarith. -apply Zmult_lt_O_compat; auto. -apply e_order_divide_gpow; sauto; auto with zarith. -rewrite gpow_mult; auto with zarith. -rewrite gpow_gpow; auto with zarith. -rewrite gpow_e_order_is_e; auto with zarith. -rewrite gpow_e; auto. -rewrite Zmult_comm. -rewrite gpow_gpow; auto with zarith. -rewrite gpow_e_order_is_e; auto with zarith. -rewrite gpow_e; auto. -apply Zdivide_mult_rel_prime; auto. -apply Gauss with (2 := Hab). -apply e_order_divide_gpow; auto with zarith. -rewrite <- (gpow_e _ _ G (e_order A_dec b G)); auto. -rewrite <- (gpow_e_order_is_e _ A_dec _ (op a b) G); auto with zarith. -rewrite <- gpow_gpow; auto with zarith. -rewrite (Zmult_comm (e_order A_dec (op a b) G)). -rewrite gpow_mult; auto with zarith. -rewrite gpow_gpow with (a := b); auto with zarith. -rewrite gpow_e_order_is_e; auto with zarith. -rewrite gpow_e; auto with zarith. -rewrite G.(e_is_zero_r); auto with zarith. -apply gpow_in; auto. -apply Gauss with (2 := rel_prime_sym _ _ Hab). -apply e_order_divide_gpow; auto with zarith. -rewrite <- (gpow_e _ _ G (e_order A_dec a G)); auto. -rewrite <- (gpow_e_order_is_e _ A_dec _ (op a b) G); auto with zarith. -rewrite <- gpow_gpow; auto with zarith. -rewrite (Zmult_comm (e_order A_dec (op a b) G)). -rewrite gpow_mult; auto with zarith. -rewrite gpow_gpow with (a := a); auto with zarith. -rewrite gpow_e_order_is_e; auto with zarith. -rewrite gpow_e; auto with zarith. -rewrite G.(e_is_zero_l); auto with zarith. -apply gpow_in; auto. -Qed. - -Theorem fermat_gen: forall (A : Set) (A_dec: forall (a b: A), {a = b} + {a <>b}) (op : A -> A -> A) (a: A) (G : FGroup op), - In a G.(s) -> gpow a G (g_order G) = G.(e). -intros A A_dec op a G H. -assert (H1: (e_order A_dec a G | g_order G)). -apply e_order_divide_g_order; auto. -case H1; intros q; intros Hq; rewrite Hq. -assert (Hq1: 0 <= q). -apply Zmult_le_reg_r with (e_order A_dec a G); auto with zarith. -apply Zlt_gt; apply e_order_pos. -rewrite Zmult_0_l; rewrite <- Hq; apply Zlt_le_weak; apply g_order_pos. -rewrite Zmult_comm; rewrite gpow_gpow; auto with zarith. -rewrite gpow_e_order_is_e; auto with zarith. -apply gpow_e; auto. -apply Zlt_le_weak; apply e_order_pos. -Qed. - -Theorem order_div: forall (A : Set) (A_dec: forall (a b: A), {a = b} + {a <>b}) (op : A -> A -> A) (a: A) (G : FGroup op) m, - 0 < m -> (forall p, prime p -> (p | m) -> gpow a G (m / p) <> G.(e)) -> - In a G.(s) -> gpow a G m = G.(e) -> e_order A_dec a G = m. -intros A Adec op a G m Hm H H1 H2. -assert (F1: 0 <= m); auto with zarith. -case (e_order_divide_gpow A Adec op a G H1 m F1 H2); intros q Hq. -assert (F2: 1 <= q). - case (Zle_or_lt 0 q); intros HH. - case (Zle_lt_or_eq _ _ HH); auto with zarith. - intros HH1; generalize Hm; rewrite Hq; rewrite <- HH1; - auto with zarith. - assert (F2: 0 <= (- q) * e_order Adec a G); auto with zarith. - apply Zmult_le_0_compat; auto with zarith. - apply Zlt_le_weak; apply e_order_pos. - generalize F2; rewrite Zopp_mult_distr_l_reverse; - rewrite <- Hq; auto with zarith. -case (Zle_lt_or_eq _ _ F2); intros H3; subst; auto with zarith. -case (prime_dec q); intros Hq. - case (H q); auto with zarith. - rewrite Zmult_comm; rewrite Z_div_mult; auto with zarith. - apply gpow_e_order_is_e; auto. -case (Zdivide_div_prime_le_square _ H3 Hq); intros r (Hr1, (Hr2, Hr3)). -case (H _ Hr1); auto. - apply Zdivide_trans with (1 := Hr2). - apply Zdivide_factor_r. -case Hr2; intros q1 Hq1; subst. -assert (F3: 0 < r). - generalize (prime_ge_2 _ Hr1); auto with zarith. -rewrite <- Zmult_assoc; rewrite Zmult_comm; rewrite <- Zmult_assoc; - rewrite Zmult_comm; rewrite Z_div_mult; auto with zarith. -rewrite gpow_gpow; auto with zarith. - rewrite gpow_e_order_is_e; try rewrite gpow_e; auto. - apply Zmult_le_reg_r with r; auto with zarith. - apply Zlt_le_weak; apply e_order_pos. -apply Zmult_le_reg_r with r; auto with zarith. -Qed. diff --git a/coqprime-8.5/Coqprime/Euler.v b/coqprime-8.5/Coqprime/Euler.v deleted file mode 100644 index 06d92ce57..000000000 --- a/coqprime-8.5/Coqprime/Euler.v +++ /dev/null @@ -1,88 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(************************************************************************ - - Definition of the Euler Totient function - -*************************************************************************) -Require Import ZArith. -Require Export Znumtheory. -Require Import Tactic. -Require Export ZSum. - -Open Scope Z_scope. - -Definition phi n := Zsum 1 (n - 1) (fun x => if rel_prime_dec x n then 1 else 0). - -Theorem phi_def_with_0: - forall n, 1< n -> phi n = Zsum 0 (n - 1) (fun x => if rel_prime_dec x n then 1 else 0). -intros n H; rewrite Zsum_S_left; auto with zarith. -case (rel_prime_dec 0 n); intros H2. -contradict H2; apply not_rel_prime_0; auto. -rewrite Zplus_0_l; auto. -Qed. - -Theorem phi_pos: forall n, 1 < n -> 0 < phi n. -intros n H; unfold phi. -case (Zle_lt_or_eq 2 n); auto with zarith; intros H1; subst. -rewrite Zsum_S_left; simpl; auto with zarith. -case (rel_prime_dec 1 n); intros H2. -apply Zlt_le_trans with (1 + 0); auto with zarith. -apply Zplus_le_compat_l. -pattern 0 at 1; replace 0 with ((1 + (n - 1) - 2) * 0); auto with zarith. -rewrite <- Zsum_c; auto with zarith. -apply Zsum_le; auto with zarith. -intros x H3; case (rel_prime_dec x n); auto with zarith. -case H2; apply rel_prime_1; auto with zarith. -rewrite Zsum_nn. -case (rel_prime_dec (2 - 1) 2); auto with zarith. -intros H1; contradict H1; apply rel_prime_1; auto with zarith. -Qed. - -Theorem phi_le_n_minus_1: forall n, 1 < n -> phi n <= n - 1. -intros n H; replace (n-1) with ((1 + (n - 1) - 1) * 1); auto with zarith. -rewrite <- Zsum_c; auto with zarith. -unfold phi; apply Zsum_le; auto with zarith. -intros x H1; case (rel_prime_dec x n); auto with zarith. -Qed. - -Theorem prime_phi_n_minus_1: forall n, prime n -> phi n = n - 1. -intros n H; replace (n-1) with ((1 + (n - 1) - 1) * 1); auto with zarith. -assert (Hu: 1 <= n - 1). -assert (2 <= n); auto with zarith. -apply prime_ge_2; auto. -rewrite <- Zsum_c; auto with zarith; unfold phi; apply Zsum_ext; auto. -intros x (H2, H3); case H; clear H; intros H H1. -generalize (H1 x); case (rel_prime_dec x n); auto with zarith. -intros H6 H7; contradict H6; apply H7; split; auto with zarith. -Qed. - -Theorem phi_n_minus_1_prime: forall n, 1 < n -> phi n = n - 1 -> prime n. -intros n H H1; case (prime_dec n); auto; intros H2. -assert (H3: phi n < n - 1); auto with zarith. -replace (n-1) with ((1 + (n - 1) - 1) * 1); auto with zarith. -assert (Hu: 1 <= n - 1); auto with zarith. -rewrite <- Zsum_c; auto with zarith; unfold phi; apply Zsum_lt; auto. -intros x _; case (rel_prime_dec x n); auto with zarith. -case not_prime_divide with n; auto. -intros x (H3, H4); exists x; repeat split; auto with zarith. -case (rel_prime_dec x n); auto with zarith. -intros H5; absurd (x = 1 \/ x = -1); auto with zarith. -case (Zis_gcd_unique x n x 1); auto. -apply Zis_gcd_intro; auto; exists 1; auto with zarith. -contradict H3; rewrite H1; auto with zarith. -Qed. - -Theorem phi_divide_prime: forall n, 1 < n -> (n - 1 | phi n) -> prime n. -intros n H1 H2; apply phi_n_minus_1_prime; auto. -apply Zle_antisym. -apply phi_le_n_minus_1; auto. -apply Zdivide_le; auto; auto with zarith. -apply phi_pos; auto. -Qed. diff --git a/coqprime-8.5/Coqprime/FGroup.v b/coqprime-8.5/Coqprime/FGroup.v deleted file mode 100644 index a55710e7c..000000000 --- a/coqprime-8.5/Coqprime/FGroup.v +++ /dev/null @@ -1,123 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - FGroup.v - - Defintion and properties of finite groups - - Definition: FGroup - **********************************************************************) -Require Import List. -Require Import UList. -Require Import Tactic. -Require Import ZArith. - -Open Scope Z_scope. - -Set Implicit Arguments. - -(************************************** - A finite group is defined for an operation op - it has a support (s) - op operates inside the group (internal) - op is associative (assoc) - it has an element (e) that is neutral (e_is_zero_l e_is_zero_r) - it has an inverse operator (i) - the inverse operates inside the group (i_internal) - it gives an inverse (i_is_inverse_l is_is_inverse_r) - **************************************) - -Record FGroup (A: Set) (op: A -> A -> A): Set := mkGroup - {s : (list A); - unique_s: ulist s; - internal: forall a b, In a s -> In b s -> In (op a b) s; - assoc: forall a b c, In a s -> In b s -> In c s -> op a (op b c) = op (op a b) c; - e: A; - e_in_s: In e s; - e_is_zero_l: forall a, In a s -> op e a = a; - e_is_zero_r: forall a, In a s -> op a e = a; - i: A -> A; - i_internal: forall a, In a s -> In (i a) s; - i_is_inverse_l: forall a, (In a s) -> op (i a) a = e; - i_is_inverse_r: forall a, (In a s) -> op a (i a) = e -}. - -(************************************** - The order of a group is the lengh of the support - **************************************) - -Definition g_order (A: Set) (op: A -> A -> A) (g: FGroup op) := Z_of_nat (length g.(s)). - -Unset Implicit Arguments. - -Hint Resolve unique_s internal e_in_s e_is_zero_l e_is_zero_r i_internal - i_is_inverse_l i_is_inverse_r assoc. - - -Section FGroup. - -Variable A: Set. -Variable op: A -> A -> A. - -(************************************** - Some properties of a finite group - **************************************) - -Theorem g_cancel_l: forall (g : FGroup op), forall a b c, In a g.(s) -> In b g.(s) -> In c g.(s) -> op a b = op a c -> b = c. -intros g a b c H1 H2 H3 H4; apply trans_equal with (op g.(e) b); sauto. -replace (g.(e)) with (op (g.(i) a) a); sauto. -apply trans_equal with (op (i g a) (op a b)); sauto. -apply sym_equal; apply assoc with g; auto. -rewrite H4. -apply trans_equal with (op (op (i g a) a) c); sauto. -apply assoc with g; auto. -replace (op (g.(i) a) a) with g.(e); sauto. -Qed. - -Theorem g_cancel_r: forall (g : FGroup op), forall a b c, In a g.(s) -> In b g.(s) -> In c g.(s) -> op b a = op c a -> b = c. -intros g a b c H1 H2 H3 H4; apply trans_equal with (op b g.(e)); sauto. -replace (g.(e)) with (op a (g.(i) a)); sauto. -apply trans_equal with (op (op b a) (i g a)); sauto. -apply assoc with g; auto. -rewrite H4. -apply trans_equal with (op c (op a (i g a))); sauto. -apply sym_equal; apply assoc with g; sauto. -replace (op a (g.(i) a)) with g.(e); sauto. -Qed. - -Theorem e_unique: forall (g : FGroup op), forall e1, In e1 g.(s) -> (forall a, In a g.(s) -> op e1 a = a) -> e1 = g.(e). -intros g e1 He1 H2. -apply trans_equal with (op e1 g.(e)); sauto. -Qed. - -Theorem inv_op: forall (g: FGroup op) a b, In a g.(s) -> In b g.(s) -> g.(i) (op a b) = op (g.(i) b) (g.(i) a). -intros g a1 b1 H1 H2; apply g_cancel_l with (g := g) (a := op a1 b1); sauto. -repeat rewrite g.(assoc); sauto. -apply trans_equal with g.(e); sauto. -rewrite <- g.(assoc) with (a := a1); sauto. -rewrite g.(i_is_inverse_r); sauto. -rewrite g.(e_is_zero_r); sauto. -Qed. - -Theorem i_e: forall (g: FGroup op), g.(i) g.(e) = g.(e). -intro g; apply g_cancel_l with (g:= g) (a := g.(e)); sauto. -apply trans_equal with g.(e); sauto. -Qed. - -(************************************** - A group has at least one element - **************************************) - -Theorem g_order_pos: forall g: FGroup op, 0 < g_order g. -intro g; generalize g.(e_in_s); unfold g_order; case g.(s); simpl; auto with zarith. -Qed. - - - -End FGroup. diff --git a/coqprime-8.5/Coqprime/IGroup.v b/coqprime-8.5/Coqprime/IGroup.v deleted file mode 100644 index 11a73d414..000000000 --- a/coqprime-8.5/Coqprime/IGroup.v +++ /dev/null @@ -1,253 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - Igroup - - Build the group of the inversible elements for the operation - - Definition: ZpGroup - **********************************************************************) -Require Import ZArith. -Require Import Tactic. -Require Import Wf_nat. -Require Import UList. -Require Import ListAux. -Require Import FGroup. - -Open Scope Z_scope. - -Section IG. - -Variable A: Set. -Variable op: A -> A -> A. -Variable support: list A. -Variable e: A. - -Hypothesis A_dec: forall a b: A, {a = b} + {a <> b}. -Hypothesis support_ulist: ulist support. -Hypothesis e_in_support: In e support. -Hypothesis op_internal: forall a b, In a support -> In b support -> In (op a b) support. -Hypothesis op_assoc: forall a b c, In a support -> In b support -> In c support -> op a (op b c) = op (op a b) c. -Hypothesis e_is_zero_l: forall a, In a support -> op e a = a. -Hypothesis e_is_zero_r: forall a, In a support -> op a e = a. - -(************************************** - is_inv_aux tests if there is an inverse of a for op in l - **************************************) - -Fixpoint is_inv_aux (l: list A) (a: A) {struct l}: bool := - match l with nil => false | cons b l1 => - if (A_dec (op a b) e) then if (A_dec (op b a) e) then true else is_inv_aux l1 a else is_inv_aux l1 a - end. - -Theorem is_inv_aux_false: forall b l, (forall a, (In a l) -> op b a <> e \/ op a b <> e) -> is_inv_aux l b = false. -intros b l; elim l; simpl; auto. -intros a l1 Rec H; case (A_dec (op a b) e); case (A_dec (op b a) e); auto. -intros H1 H2; case (H a); auto; intros H3; case H3; auto. -Qed. - -(************************************** - is_inv tests if there is an inverse in support - **************************************) -Definition is_inv := is_inv_aux support. - -(************************************** - isupport_aux returns the sublist of inversible element of support - **************************************) - -Fixpoint isupport_aux (l: list A) : list A := - match l with nil => nil | cons a l1 => if is_inv a then a::isupport_aux l1 else isupport_aux l1 end. - -(************************************** - Some properties of isupport_aux - **************************************) - -Theorem isupport_aux_is_inv_true: forall l a, In a (isupport_aux l) -> is_inv a = true. -intros l a; elim l; simpl; auto. -intros b l1 H; case_eq (is_inv b); intros H1; simpl; auto. -intros [H2 | H2]; subst; auto. -Qed. - -Theorem isupport_aux_is_in: forall l a, is_inv a = true -> In a l -> In a (isupport_aux l). -intros l a; elim l; simpl; auto. -intros b l1 Rec H [H1 | H1]; subst. -rewrite H; auto with datatypes. -case (is_inv b); auto with datatypes. -Qed. - - -Theorem isupport_aux_not_in: - forall b l, (forall a, (In a support) -> op b a <> e \/ op a b <> e) -> ~ In b (isupport_aux l). -intros b l; elim l; simpl; simpl; auto. -intros a l1 H; case_eq (is_inv a); intros H1; simpl; auto. -intros H2 [H3 | H3]; subst. -contradict H1. -unfold is_inv; rewrite is_inv_aux_false; auto. -case H; auto; apply isupport_aux_is_in; auto. -Qed. - -Theorem isupport_aux_incl: forall l, incl (isupport_aux l) l. -intros l; elim l; simpl; auto with datatypes. -intros a l1 H1; case (is_inv a); auto with datatypes. -Qed. - -Theorem isupport_aux_ulist: forall l, ulist l -> ulist (isupport_aux l). -intros l; elim l; simpl; auto with datatypes. -intros a l1 H1 H2; case_eq (is_inv a); intros H3; auto with datatypes. -apply ulist_cons; auto with datatypes. -intros H4; apply (ulist_app_inv _ (a::nil) l1 a); auto with datatypes. -apply (isupport_aux_incl l1 a); auto. -apply H1; apply ulist_app_inv_r with (a:: nil); auto. -apply H1; apply ulist_app_inv_r with (a:: nil); auto. -Qed. - -(************************************** - isupport is the sublist of inversible element of support - **************************************) - -Definition isupport := isupport_aux support. - -(************************************** - Some properties of isupport - **************************************) - -Theorem isupport_is_inv_true: forall a, In a isupport -> is_inv a = true. -unfold isupport; intros a H; apply isupport_aux_is_inv_true with (1 := H). -Qed. - -Theorem isupport_is_in: forall a, is_inv a = true -> In a support -> In a isupport. -intros a H H1; unfold isupport; apply isupport_aux_is_in; auto. -Qed. - -Theorem isupport_incl: incl isupport support. -unfold isupport; apply isupport_aux_incl. -Qed. - -Theorem isupport_ulist: ulist isupport. -unfold isupport; apply isupport_aux_ulist. -apply support_ulist. -Qed. - -Theorem isupport_length: (length isupport <= length support)%nat. -apply ulist_incl_length. -apply isupport_ulist. -apply isupport_incl. -Qed. - -Theorem isupport_length_strict: - forall b, (In b support) -> (forall a, (In a support) -> op b a <> e \/ op a b <> e) -> - (length isupport < length support)%nat. -intros b H H1; apply ulist_incl_length_strict. -apply isupport_ulist. -apply isupport_incl. -intros H2; case (isupport_aux_not_in b support); auto. -Qed. - -Fixpoint inv_aux (l: list A) (a: A) {struct l}: A := - match l with nil => e | cons b l1 => - if A_dec (op a b) e then if (A_dec (op b a) e) then b else inv_aux l1 a else inv_aux l1 a - end. - -Theorem inv_aux_prop_r: forall l a, is_inv_aux l a = true -> op a (inv_aux l a) = e. -intros l a; elim l; simpl. -intros; discriminate. -intros b l1 H1; case (A_dec (op a b) e); case (A_dec (op b a) e); intros H3 H4; subst; auto. -Qed. - -Theorem inv_aux_prop_l: forall l a, is_inv_aux l a = true -> op (inv_aux l a) a = e. -intros l a; elim l; simpl. -intros; discriminate. -intros b l1 H1; case (A_dec (op a b) e); case (A_dec (op b a) e); intros H3 H4; subst; auto. -Qed. - -Theorem inv_aux_inv: forall l a b, op a b = e -> op b a = e -> (In a l) -> is_inv_aux l b = true. -intros l a b; elim l; simpl. -intros _ _ H; case H. -intros c l1 Rec H H0 H1; case H1; clear H1; intros H1; subst; rewrite H. -case (A_dec (op b a) e); case (A_dec e e); auto. -intros H1 H2; contradict H2; rewrite H0; auto. -case (A_dec (op b c) e); case (A_dec (op c b) e); auto. -Qed. - -Theorem inv_aux_in: forall l a, In (inv_aux l a) l \/ inv_aux l a = e. -intros l a; elim l; simpl; auto. -intros b l1; case (A_dec (op a b) e); case (A_dec (op b a) e); intros _ _ [H1 | H1]; auto. -Qed. - -(************************************** - The inverse function - **************************************) - -Definition inv := inv_aux support. - -(************************************** - Some properties of inv - **************************************) - -Theorem inv_prop_r: forall a, In a isupport -> op a (inv a) = e. -intros a H; unfold inv; apply inv_aux_prop_r with (l := support). -change (is_inv a = true). -apply isupport_is_inv_true; auto. -Qed. - -Theorem inv_prop_l: forall a, In a isupport -> op (inv a) a = e. -intros a H; unfold inv; apply inv_aux_prop_l with (l := support). -change (is_inv a = true). -apply isupport_is_inv_true; auto. -Qed. - -Theorem is_inv_true: forall a b, op b a = e -> op a b = e -> (In a support) -> is_inv b = true. -intros a b H H1 H2; unfold is_inv; apply inv_aux_inv with a; auto. -Qed. - -Theorem is_inv_false: forall b, (forall a, (In a support) -> op b a <> e \/ op a b <> e) -> is_inv b = false. -intros b H; unfold is_inv; apply is_inv_aux_false; auto. -Qed. - -Theorem inv_internal: forall a, In a isupport -> In (inv a) isupport. -intros a H; apply isupport_is_in. -apply is_inv_true with a; auto. -apply inv_prop_l; auto. -apply inv_prop_r; auto. -apply (isupport_incl a); auto. -case (inv_aux_in support a); unfold inv; auto. -intros H1; rewrite H1; apply e_in_support; auto with zarith. -Qed. - -(************************************** - We are now ready to build our group - **************************************) - -Definition IGroup : (FGroup op). -generalize (fun x=> (isupport_incl x)); intros Hx. -apply mkGroup with (s := isupport) (e := e) (i := inv); auto. -apply isupport_ulist. -intros a b H H1. -assert (Haii: In (inv a) isupport); try apply inv_internal; auto. -assert (Hbii: In (inv b) isupport); try apply inv_internal; auto. -apply isupport_is_in; auto. -apply is_inv_true with (op (inv b) (inv a)); auto. -rewrite op_assoc; auto. -rewrite <- (op_assoc a); auto. -rewrite inv_prop_r; auto. -rewrite e_is_zero_r; auto. -apply inv_prop_r; auto. -rewrite <- (op_assoc (inv b)); auto. -rewrite (op_assoc (inv a)); auto. -rewrite inv_prop_l; auto. -rewrite e_is_zero_l; auto. -apply inv_prop_l; auto. -apply isupport_is_in; auto. -apply is_inv_true with e; auto. -intros a H; apply inv_internal; auto. -intros; apply inv_prop_l; auto. -intros; apply inv_prop_r; auto. -Defined. - -End IG. diff --git a/coqprime-8.5/Coqprime/Iterator.v b/coqprime-8.5/Coqprime/Iterator.v deleted file mode 100644 index 96d3e5655..000000000 --- a/coqprime-8.5/Coqprime/Iterator.v +++ /dev/null @@ -1,180 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Require Export List. -Require Export Permutation. -Require Import Arith. - -Section Iterator. -Variables A B : Set. -Variable zero : B. -Variable f : A -> B. -Variable g : B -> B -> B. -Hypothesis g_zero : forall a, g a zero = a. -Hypothesis g_trans : forall a b c, g a (g b c) = g (g a b) c. -Hypothesis g_sym : forall a b, g a b = g b a. - -Definition iter := fold_right (fun a r => g (f a) r) zero. -Hint Unfold iter . - -Theorem iter_app: forall l1 l2, iter (app l1 l2) = g (iter l1) (iter l2). -intros l1; elim l1; simpl; auto. -intros l2; rewrite g_sym; auto. -intros a l H l2; rewrite H. -rewrite g_trans; auto. -Qed. - -Theorem iter_permutation: forall l1 l2, permutation l1 l2 -> iter l1 = iter l2. -intros l1 l2 H; elim H; simpl; auto; clear H l1 l2. -intros a l1 l2 H1 H2; apply f_equal2 with ( f := g ); auto. -intros a b l; (repeat rewrite g_trans). -apply f_equal2 with ( f := g ); auto. -intros l1 l2 l3 H H0 H1 H2; apply trans_equal with ( 1 := H0 ); auto. -Qed. - -Lemma iter_inv: - forall P l, - P zero -> - (forall a b, P a -> P b -> P (g a b)) -> - (forall x, In x l -> P (f x)) -> P (iter l). -intros P l H H0; (elim l; simpl; auto). -Qed. -Variable next : A -> A. - -Fixpoint progression (m : A) (n : nat) {struct n} : list A := - match n with 0 => nil - | S n1 => cons m (progression (next m) n1) end. - -Fixpoint next_n (c : A) (n : nat) {struct n} : A := - match n with 0 => c | S n1 => next_n (next c) n1 end. - -Theorem progression_app: - forall a b n m, - le m n -> - b = next_n a m -> - progression a n = app (progression a m) (progression b (n - m)). -intros a b n m; generalize a b n; clear a b n; elim m; clear m; simpl. -intros a b n H H0; apply f_equal2 with ( f := progression ); auto with arith. -intros m H a b n; case n; simpl; clear n. -intros H1; absurd (0 < 1 + m); auto with arith. -intros n H0 H1; apply f_equal2 with ( f := @cons A ); auto with arith. -Qed. - -Let iter_progression := fun m n => iter (progression m n). - -Theorem iter_progression_app: - forall a b n m, - le m n -> - b = next_n a m -> - iter (progression a n) = - g (iter (progression a m)) (iter (progression b (n - m))). -intros a b n m H H0; unfold iter_progression; rewrite (progression_app a b n m); - (try apply iter_app); auto. -Qed. - -Theorem length_progression: forall z n, length (progression z n) = n. -intros z n; generalize z; elim n; simpl; auto. -Qed. - -End Iterator. -Implicit Arguments iter [A B]. -Implicit Arguments progression [A]. -Implicit Arguments next_n [A]. -Hint Unfold iter . -Hint Unfold progression . -Hint Unfold next_n . - -Theorem iter_ext: - forall (A B : Set) zero (f1 : A -> B) f2 g l, - (forall a, In a l -> f1 a = f2 a) -> iter zero f1 g l = iter zero f2 g l. -intros A B zero f1 f2 g l; elim l; simpl; auto. -intros a l0 H H0; apply f_equal2 with ( f := g ); auto. -Qed. - -Theorem iter_map: - forall (A B C : Set) zero (f : B -> C) g (k : A -> B) l, - iter zero f g (map k l) = iter zero (fun x => f (k x)) g l. -intros A B C zero f g k l; elim l; simpl; auto. -intros; apply f_equal2 with ( f := g ); auto with arith. -Qed. - -Theorem iter_comp: - forall (A B : Set) zero (f1 f2 : A -> B) g l, - (forall a, g a zero = a) -> - (forall a b c, g a (g b c) = g (g a b) c) -> - (forall a b, g a b = g b a) -> - g (iter zero f1 g l) (iter zero f2 g l) = - iter zero (fun x => g (f1 x) (f2 x)) g l. -intros A B zero f1 f2 g l g_zero g_trans g_sym; elim l; simpl; auto. -intros a l0 H; rewrite <- H; (repeat rewrite <- g_trans). -apply f_equal2 with ( f := g ); auto. -(repeat rewrite g_trans); apply f_equal2 with ( f := g ); auto. -Qed. - -Theorem iter_com: - forall (A B : Set) zero (f : A -> A -> B) g l1 l2, - (forall a, g a zero = a) -> - (forall a b c, g a (g b c) = g (g a b) c) -> - (forall a b, g a b = g b a) -> - iter zero (fun x => iter zero (fun y => f x y) g l1) g l2 = - iter zero (fun y => iter zero (fun x => f x y) g l2) g l1. -intros A B zero f g l1 l2 H H0 H1; generalize l2; elim l1; simpl; auto; - clear l1 l2. -intros l2; elim l2; simpl; auto with arith. -intros; rewrite H1; rewrite H; auto with arith. -intros a l1 H2 l2; case l2; clear l2; simpl; auto. -elim l1; simpl; auto with arith. -intros; rewrite H1; rewrite H; auto with arith. -intros b l2. -rewrite <- (iter_comp - _ _ zero (fun x => f x a) - (fun x => iter zero (fun (y : A) => f x y) g l1)); auto with arith. -rewrite <- (iter_comp - _ _ zero (fun y => f b y) - (fun y => iter zero (fun (x : A) => f x y) g l2)); auto with arith. -(repeat rewrite H0); auto. -apply f_equal2 with ( f := g ); auto. -(repeat rewrite <- H0); auto. -apply f_equal2 with ( f := g ); auto. -Qed. - -Theorem iter_comp_const: - forall (A B : Set) zero (f : A -> B) g k l, - k zero = zero -> - (forall a b, k (g a b) = g (k a) (k b)) -> - k (iter zero f g l) = iter zero (fun x => k (f x)) g l. -intros A B zero f g k l H H0; elim l; simpl; auto. -intros a l0 H1; rewrite H0; apply f_equal2 with ( f := g ); auto. -Qed. - -Lemma next_n_S: forall n m, next_n S n m = plus n m. -intros n m; generalize n; elim m; clear n m; simpl; auto with arith. -intros m H n; case n; simpl; auto with arith. -rewrite H; auto with arith. -intros n1; rewrite H; simpl; auto with arith. -Qed. - -Theorem progression_S_le_init: - forall n m p, In p (progression S n m) -> le n p. -intros n m; generalize n; elim m; clear n m; simpl; auto. -intros; contradiction. -intros m H n p [H1|H1]; auto with arith. -subst n; auto. -apply le_S_n; auto with arith. -Qed. - -Theorem progression_S_le_end: - forall n m p, In p (progression S n m) -> lt p (n + m). -intros n m; generalize n; elim m; clear n m; simpl; auto. -intros; contradiction. -intros m H n p [H1|H1]; auto with arith. -subst n; auto with arith. -rewrite <- plus_n_Sm; auto with arith. -rewrite <- plus_n_Sm; auto with arith. -generalize (H (S n) p); auto with arith. -Qed. diff --git a/coqprime-8.5/Coqprime/Lagrange.v b/coqprime-8.5/Coqprime/Lagrange.v deleted file mode 100644 index b35460bad..000000000 --- a/coqprime-8.5/Coqprime/Lagrange.v +++ /dev/null @@ -1,179 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - Lagrange.v - - Proof of Lagrange theorem: - the oder of a subgroup divides the order of a group - - Definition: lagrange - **********************************************************************) -Require Import List. -Require Import UList. -Require Import ListAux. -Require Import ZArith Znumtheory. -Require Import NatAux. -Require Import FGroup. - -Open Scope Z_scope. - -Section Lagrange. - -Variable A: Set. - -Variable A_dec: forall a b: A, {a = b} + {~ a = b}. - -Variable op: A -> A -> A. - -Variable G: (FGroup op). - -Variable H:(FGroup op). - -Hypothesis G_in_H: (incl G.(s) H.(s)). - -(************************************** - A group and a subgroup have the same neutral element - **************************************) - -Theorem same_e_for_H_and_G: H.(e) = G.(e). -apply trans_equal with (op H.(e) H.(e)); sauto. -apply trans_equal with (op H.(e) (op G.(e) (H.(i) G.(e)))); sauto. -eq_tac; sauto. -apply trans_equal with (op G.(e) (op G.(e) (H.(i) G.(e)))); sauto. -repeat rewrite H.(assoc); sauto. -eq_tac; sauto. -apply trans_equal with G.(e); sauto. -apply trans_equal with (op G.(e) H.(e)); sauto. -eq_tac; sauto. -Qed. - -(************************************** - The proof works like this. - If G = {e, g1, g2, g3, .., gn} and {e, h1, h2, h3, ..., hm} - we construct the list mkGH - {e, g1, g2, g3, ...., gn - hi*e, hi * g1, hi * g2, ..., hi * gn if hi does not appear before - .... - hk*e, hk * g1, hk * g2, ..., hk * gn if hk does not appear before - } - that contains all the element of H. - We show that this list does not contain double (ulist). - **************************************) - -Fixpoint mkList (base l: (list A)) { struct l} : (list A) := - match l with - nil => nil - | cons a l1 => let r1 := mkList base l1 in - if (In_dec A_dec a r1) then r1 else - (map (op a) base) ++ r1 - end. - -Definition mkGH := mkList G.(s) H.(s). - -Theorem mkGH_length: divide (length G.(s)) (length mkGH). -unfold mkGH; elim H.(s); simpl. -exists 0%nat; auto with arith. -intros a l1 (c, H1); case (In_dec A_dec a (mkList G.(s) l1)); intros H2. -exists c; auto. -exists (1 + c)%nat; rewrite ListAux.length_app; rewrite ListAux.length_map; rewrite H1; ring. -Qed. - -Theorem mkGH_incl: incl H.(s) mkGH. -assert (H1: forall l, incl l H.(s) -> incl l (mkList G.(s) l)). -intros l; elim l; simpl; auto with datatypes. -intros a l1 H1 H2. -case (In_dec A_dec a (mkList (s G) l1)); auto with datatypes. -intros H3; assert (H4: incl l1 (mkList (s G) l1)). -apply H1; auto with datatypes. -intros b H4; apply H2; auto with datatypes. -intros b; simpl; intros [H5 | H5]; subst; auto. -intros _ b; simpl; intros [H3 | H3]; subst; auto. -apply in_or_app; left. -cut (In H.(e) G.(s)). -elim (s G); simpl; auto. -intros c l2 Hl2 [H3 | H3]; subst; sauto. -assert (In b H.(s)); sauto. -apply (H2 b); auto with datatypes. -rewrite same_e_for_H_and_G; sauto. -apply in_or_app; right. -apply H1; auto with datatypes. -apply incl_tran with (2:= H2); auto with datatypes. -unfold mkGH; apply H1; auto with datatypes. -Qed. - -Theorem incl_mkGH: incl mkGH H.(s). -assert (H1: forall l, incl l H.(s) -> incl (mkList G.(s) l) H.(s)). -intros l; elim l; simpl; auto with datatypes. -intros a l1 H1 H2. -case (In_dec A_dec a (mkList (s G) l1)); intros H3; auto with datatypes. -apply H1; apply incl_tran with (2 := H2); auto with datatypes. -apply incl_app. -intros b H4. -case ListAux.in_map_inv with (1:= H4); auto. -intros c (Hc1, Hc2); subst; sauto. -apply internal; auto with datatypes. -apply H1; apply incl_tran with (2 := H2); auto with datatypes. -unfold mkGH; apply H1; auto with datatypes. -Qed. - -Theorem ulist_mkGH: ulist mkGH. -assert (H1: forall l, incl l H.(s) -> ulist (mkList G.(s) l)). -intros l; elim l; simpl; auto with datatypes. -intros a l1 H1 H2. -case (In_dec A_dec a (mkList (s G) l1)); intros H3; auto with datatypes. -apply H1; apply incl_tran with (2 := H2); auto with datatypes. -apply ulist_app; auto. -apply ulist_map; sauto. -intros x y H4 H5 H6; apply g_cancel_l with (g:= H) (a := a); sauto. -apply H2; auto with datatypes. -apply H1; apply incl_tran with (2 := H2); auto with datatypes. -intros b H4 H5. -case ListAux.in_map_inv with (1:= H4); auto. -intros c (Hc, Hc1); subst. -assert (H6: forall l a b, In b G.(s) -> incl l H.(s) -> In a (mkList G.(s) l) -> In (op a b) (mkList G.(s) l)). -intros ll u v; elim ll; simpl; auto with datatypes. -intros w ll1 T0 T1 T2. -case (In_dec A_dec w (mkList (s G) ll1)); intros T3 T4; auto with datatypes. -apply T0; auto; apply incl_tran with (2:= T2); auto with datatypes. -case in_app_or with (1 := T4); intros T5; auto with datatypes. -apply in_or_app; left. -case ListAux.in_map_inv with (1:= T5); auto. -intros z (Hz1, Hz2); subst. -replace (op (op w z) v) with (op w (op z v)); sauto. -apply in_map; sauto. -apply assoc with H; auto with datatypes. -apply in_or_app; right; auto with datatypes. -apply T0; try apply incl_tran with (2 := T2); auto with datatypes. -case H3; replace a with (op (op a c) (G.(i) c)); auto with datatypes. -apply H6; sauto. -apply incl_tran with (2 := H2); auto with datatypes. -apply trans_equal with (op a (op c (G.(i) c))); sauto. -apply sym_equal; apply assoc with H; auto with datatypes. -replace (op c (G.(i) c)) with (G.(e)); sauto. -rewrite <- same_e_for_H_and_G. -assert (In a H.(s)); sauto; apply (H2 a); auto with datatypes. -unfold mkGH; apply H1; auto with datatypes. -Qed. - -(************************************** - Lagrange theorem - **************************************) - -Theorem lagrange: (g_order G | (g_order H)). -unfold g_order. -rewrite Permutation.permutation_length with (l := H.(s)) (m:= mkGH). -case mkGH_length; intros x H1; exists (Z_of_nat x). -rewrite H1; rewrite Zmult_comm; apply inj_mult. -apply ulist_incl2_permutation; auto. -apply ulist_mkGH. -apply mkGH_incl. -apply incl_mkGH. -Qed. - -End Lagrange. diff --git a/coqprime-8.5/Coqprime/ListAux.v b/coqprime-8.5/Coqprime/ListAux.v deleted file mode 100644 index c3c9602bd..000000000 --- a/coqprime-8.5/Coqprime/ListAux.v +++ /dev/null @@ -1,271 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - Aux.v - - Auxillary functions & Theorems - **********************************************************************) -Require Export List. -Require Export Arith. -Require Export Tactic. -Require Import Inverse_Image. -Require Import Wf_nat. - -(************************************** - Some properties on list operators: app, map,... -**************************************) - -Section List. -Variables (A : Set) (B : Set) (C : Set). -Variable f : A -> B. - -(************************************** - An induction theorem for list based on length -**************************************) - -Theorem list_length_ind: - forall (P : list A -> Prop), - (forall (l1 : list A), - (forall (l2 : list A), length l2 < length l1 -> P l2) -> P l1) -> - forall (l : list A), P l. -intros P H l; - apply well_founded_ind with ( R := fun (x y : list A) => length x < length y ); - auto. -apply wf_inverse_image with ( R := lt ); auto. -apply lt_wf. -Qed. - -Definition list_length_induction: - forall (P : list A -> Set), - (forall (l1 : list A), - (forall (l2 : list A), length l2 < length l1 -> P l2) -> P l1) -> - forall (l : list A), P l. -intros P H l; - apply well_founded_induction - with ( R := fun (x y : list A) => length x < length y ); auto. -apply wf_inverse_image with ( R := lt ); auto. -apply lt_wf. -Qed. - -Theorem in_ex_app: - forall (a : A) (l : list A), - In a l -> (exists l1 : list A , exists l2 : list A , l = l1 ++ (a :: l2) ). -intros a l; elim l; clear l; simpl; auto. -intros H; case H. -intros a1 l H [H1|H1]; auto. -exists (nil (A:=A)); exists l; simpl; auto. -rewrite H1; auto. -case H; auto; intros l1 [l2 Hl2]; exists (a1 :: l1); exists l2; simpl; auto. -rewrite Hl2; auto. -Qed. - -(************************************** - Properties on app -**************************************) - -Theorem length_app: - forall (l1 l2 : list A), length (l1 ++ l2) = length l1 + length l2. -intros l1; elim l1; simpl; auto. -Qed. - -Theorem app_inv_head: - forall (l1 l2 l3 : list A), l1 ++ l2 = l1 ++ l3 -> l2 = l3. -intros l1; elim l1; simpl; auto. -intros a l H l2 l3 H0; apply H; injection H0; auto. -Qed. - -Theorem app_inv_tail: - forall (l1 l2 l3 : list A), l2 ++ l1 = l3 ++ l1 -> l2 = l3. -intros l1 l2; generalize l1; elim l2; clear l1 l2; simpl; auto. -intros l1 l3; case l3; auto. -intros b l H; absurd (length ((b :: l) ++ l1) <= length l1). -simpl; rewrite length_app; auto with arith. -rewrite <- H; auto with arith. -intros a l H l1 l3; case l3. -simpl; intros H1; absurd (length (a :: (l ++ l1)) <= length l1). -simpl; rewrite length_app; auto with arith. -rewrite H1; auto with arith. -simpl; intros b l0 H0; injection H0. -intros H1 H2; rewrite H2, (H _ _ H1); auto. -Qed. - -Theorem app_inv_app: - forall l1 l2 l3 l4 a, - l1 ++ l2 = l3 ++ (a :: l4) -> - (exists l5 : list A , l1 = l3 ++ (a :: l5) ) \/ - (exists l5 , l2 = l5 ++ (a :: l4) ). -intros l1; elim l1; simpl; auto. -intros l2 l3 l4 a H; right; exists l3; auto. -intros a l H l2 l3 l4 a0; case l3; simpl. -intros H0; left; exists l; injection H0; intros; subst; auto. -intros b l0 H0; case (H l2 l0 l4 a0); auto. -injection H0; auto. -intros [l5 H1]. -left; exists l5; injection H0; intros; subst; auto. -Qed. - -Theorem app_inv_app2: - forall l1 l2 l3 l4 a b, - l1 ++ l2 = l3 ++ (a :: (b :: l4)) -> - (exists l5 : list A , l1 = l3 ++ (a :: (b :: l5)) ) \/ - ((exists l5 , l2 = l5 ++ (a :: (b :: l4)) ) \/ - l1 = l3 ++ (a :: nil) /\ l2 = b :: l4). -intros l1; elim l1; simpl; auto. -intros l2 l3 l4 a b H; right; left; exists l3; auto. -intros a l H l2 l3 l4 a0 b; case l3; simpl. -case l; simpl. -intros H0; right; right; injection H0; split; auto. -rewrite H2; auto. -intros b0 l0 H0; left; exists l0; injection H0; intros; subst; auto. -intros b0 l0 H0; case (H l2 l0 l4 a0 b); auto. -injection H0; auto. -intros [l5 HH1]; left; exists l5; injection H0; intros; subst; auto. -intros [H1|[H1 H2]]; auto. -right; right; split; auto; injection H0; intros; subst; auto. -Qed. - -Theorem same_length_ex: - forall (a : A) l1 l2 l3, - length (l1 ++ (a :: l2)) = length l3 -> - (exists l4 , - exists l5 , - exists b : B , - length l1 = length l4 /\ (length l2 = length l5 /\ l3 = l4 ++ (b :: l5)) ). -intros a l1; elim l1; simpl; auto. -intros l2 l3; case l3; simpl; (try (intros; discriminate)). -intros b l H; exists (nil (A:=B)); exists l; exists b; (repeat (split; auto)). -intros a0 l H l2 l3; case l3; simpl; (try (intros; discriminate)). -intros b l0 H0. -case (H l2 l0); auto. -intros l4 [l5 [b1 [HH1 [HH2 HH3]]]]. -exists (b :: l4); exists l5; exists b1; (repeat (simpl; split; auto)). -rewrite HH3; auto. -Qed. - -(************************************** - Properties on map -**************************************) - -Theorem in_map_inv: - forall (b : B) (l : list A), - In b (map f l) -> (exists a : A , In a l /\ b = f a ). -intros b l; elim l; simpl; auto. -intros tmp; case tmp. -intros a0 l0 H [H1|H1]; auto. -exists a0; auto. -case (H H1); intros a1 [H2 H3]; exists a1; auto. -Qed. - -Theorem in_map_fst_inv: - forall a (l : list (B * C)), - In a (map (fst (B:=_)) l) -> (exists c , In (a, c) l ). -intros a l; elim l; simpl; auto. -intros H; case H. -intros a0 l0 H [H0|H0]; auto. -exists (snd a0); left; rewrite <- H0; case a0; simpl; auto. -case H; auto; intros l1 Hl1; exists l1; auto. -Qed. - -Theorem length_map: forall l, length (map f l) = length l. -intros l; elim l; simpl; auto. -Qed. - -Theorem map_app: forall l1 l2, map f (l1 ++ l2) = map f l1 ++ map f l2. -intros l; elim l; simpl; auto. -intros a l0 H l2; rewrite H; auto. -Qed. - -Theorem map_length_decompose: - forall l1 l2 l3 l4, - length l1 = length l2 -> - map f (app l1 l3) = app l2 l4 -> map f l1 = l2 /\ map f l3 = l4. -intros l1; elim l1; simpl; auto; clear l1. -intros l2; case l2; simpl; auto. -intros; discriminate. -intros a l1 Rec l2; case l2; simpl; clear l2; auto. -intros; discriminate. -intros b l2 l3 l4 H1 H2. -injection H2; clear H2; intros H2 H3. -case (Rec l2 l3 l4); auto. -intros H4 H5; split; auto. -subst; auto. -Qed. - -(************************************** - Properties of flat_map -**************************************) - -Theorem in_flat_map: - forall (l : list B) (f : B -> list C) a b, - In a (f b) -> In b l -> In a (flat_map f l). -intros l g; elim l; simpl; auto. -intros a l0 H a0 b H0 [H1|H1]; apply in_or_app; auto. -left; rewrite H1; auto. -right; apply H with ( b := b ); auto. -Qed. - -Theorem in_flat_map_ex: - forall (l : list B) (f : B -> list C) a, - In a (flat_map f l) -> (exists b , In b l /\ In a (f b) ). -intros l g; elim l; simpl; auto. -intros a H; case H. -intros a l0 H a0 H0; case in_app_or with ( 1 := H0 ); simpl; auto. -intros H1; exists a; auto. -intros H1; case H with ( 1 := H1 ). -intros b [H2 H3]; exists b; simpl; auto. -Qed. - -(************************************** - Properties of fold_left -**************************************) - -Theorem fold_left_invol: - forall (f: A -> B -> A) (P: A -> Prop) l a, - P a -> (forall x y, P x -> P (f x y)) -> P (fold_left f l a). -intros f1 P l; elim l; simpl; auto. -Qed. - -Theorem fold_left_invol_in: - forall (f: A -> B -> A) (P: A -> Prop) l a b, - In b l -> (forall x, P (f x b)) -> (forall x y, P x -> P (f x y)) -> - P (fold_left f l a). -intros f1 P l; elim l; simpl; auto. -intros a1 b HH; case HH. -intros a1 l1 Rec a2 b [V|V] V1 V2; subst; auto. -apply fold_left_invol; auto. -apply Rec with (b := b); auto. -Qed. - -End List. - - -(************************************** - Propertie of list_prod -**************************************) - -Theorem length_list_prod: - forall (A : Set) (l1 l2 : list A), - length (list_prod l1 l2) = length l1 * length l2. -intros A l1 l2; elim l1; simpl; auto. -intros a l H; rewrite length_app; rewrite length_map; rewrite H; auto. -Qed. - -Theorem in_list_prod_inv: - forall (A B : Set) a l1 l2, - In a (list_prod l1 l2) -> - (exists b : A , exists c : B , a = (b, c) /\ (In b l1 /\ In c l2) ). -intros A B a l1 l2; elim l1; simpl; auto; clear l1. -intros H; case H. -intros a1 l1 H1 H2. -case in_app_or with ( 1 := H2 ); intros H3; auto. -case in_map_inv with ( 1 := H3 ); intros b1 [Hb1 Hb2]; auto. -exists a1; exists b1; split; auto. -case H1; auto; intros b1 [c1 [Hb1 [Hb2 Hb3]]]. -exists b1; exists c1; split; auto. -Qed. diff --git a/coqprime-8.5/Coqprime/LucasLehmer.v b/coqprime-8.5/Coqprime/LucasLehmer.v deleted file mode 100644 index a0e3b8e46..000000000 --- a/coqprime-8.5/Coqprime/LucasLehmer.v +++ /dev/null @@ -1,597 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - LucasLehamer.v - - Build the sequence for the primality test of Mersenne numbers - - Definition: LucasLehmer - **********************************************************************) -Require Import ZArith. -Require Import ZCAux. -Require Import Tactic. -Require Import Wf_nat. -Require Import NatAux. -Require Import UList. -Require Import ListAux. -Require Import FGroup. -Require Import EGroup. -Require Import PGroup. -Require Import IGroup. - -Open Scope Z_scope. - -(************************************** - The seeds of the serie - **************************************) - -Definition w := (2, 1). - -Definition v := (2, -1). - -Theorem w_plus_v: pplus w v = (4, 0). -simpl; auto. -Qed. - -Theorem w_mult_v : pmult w v = (1, 0). -simpl; auto. -Qed. - -(************************************** - Definition of the power function for pairs p^n - **************************************) - -Definition ppow p n := match n with Zpos q => iter_pos _ (pmult p) (1, 0) q | _ => (1, 0) end. - -(************************************** - Some properties of ppow - **************************************) - -Theorem ppow_0: forall n, ppow n 0 = (1, 0). -simpl; auto. -Qed. - -Theorem ppow_1: forall n, ppow (1, 0) n = (1, 0). -intros n; case n; simpl; auto. -intros p; apply iter_pos_invariant with (Inv := fun x => x = (1, 0)); auto. -intros x H; rewrite H; auto. -Qed. - -Theorem ppow_op: forall a b p, iter_pos _ (pmult a) b p = pmult (iter_pos _ (pmult a) (1, 0) p) b. -intros a b p; generalize b; elim p; simpl; auto; clear b p. -intros p Rec b. -rewrite (Rec b). -try rewrite (fun x y => Rec (pmult x y)); try rewrite (fun x y => Rec (iter_pos _ x y p)); auto. -repeat rewrite pmult_assoc; auto. -intros p Rec b. -rewrite (Rec b); try rewrite (fun x y => Rec (pmult x y)); try rewrite (fun x y => Rec (iter_pos _ x y p)); auto. -repeat rewrite pmult_assoc; auto. -intros b; rewrite pmult_1_r; auto. -Qed. - -Theorem ppow_add: forall n m p, 0 <= m -> 0 <= p -> ppow n (m + p) = pmult (ppow n m) (ppow n p). -intros n m; case m; clear m. -intros p _ _; rewrite ppow_0; rewrite pmult_1_l; auto. -2: intros p m H; contradict H; auto with zarith. -intros p1 m _; case m. -intros _; rewrite Zplus_0_r; simpl; apply sym_equal; apply pmult_1_r. -2: intros p2 H; contradict H; auto with zarith. -intros p2 _; simpl. -rewrite iter_pos_plus. -rewrite ppow_op; auto. -Qed. - -Theorem ppow_ppow: forall n m p, 0 <= n -> 0 <= m -> ppow p (n * m ) = ppow (ppow p n) m. -intros n m; case n. -intros p _ Hm; rewrite Zmult_0_l. -rewrite ppow_0; apply sym_equal; apply ppow_1. -2: intros p p1 H; contradict H; auto with zarith. -intros p1 p _; case m; simpl; auto. -intros p2 _; pattern p2; apply Pind; simpl; auto. -rewrite Pmult_1_r; rewrite pmult_1_r; auto. -intros p3 Rec; rewrite Pplus_one_succ_r; rewrite Pmult_plus_distr_l. -rewrite Pmult_1_r. -simpl; repeat rewrite iter_pos_plus; simpl. -rewrite pmult_1_r. -rewrite ppow_op; try rewrite Rec; auto. -apply sym_equal; apply ppow_op; auto. -Qed. - - -Theorem ppow_mult: forall n m p, 0 <= n -> ppow (pmult m p) n = pmult (ppow m n) (ppow p n). -intros n m p; case n; simpl; auto. -intros p1 _; pattern p1; apply Pind; simpl; auto. -repeat rewrite pmult_1_r; auto. -intros p3 Rec; rewrite Pplus_one_succ_r. -repeat rewrite iter_pos_plus; simpl. -repeat rewrite (fun x y z => ppow_op x (pmult y z)) ; auto. -rewrite Rec. -repeat rewrite pmult_1_r; auto. -repeat rewrite <- pmult_assoc; try eq_tac; auto. -rewrite (fun x y => pmult_comm (iter_pos _ x y p3) p); auto. -rewrite (pmult_assoc m); try apply pmult_comm; auto. -Qed. - -(************************************** - We can now define our series of pairs s - **************************************) - -Definition s n := pplus (ppow w (2 ^ n)) (ppow v (2 ^ n)). - -(************************************** - Some properties of s - **************************************) - -Theorem s0 : s 0 = (4, 0). -simpl; auto. -Qed. - -Theorem sn_aux: forall n, 0 <= n -> s (n+1) = (pplus (pmult (s n) (s n)) (-2, 0)). -intros n Hn. -assert (Hu: 0 <= 2 ^n); auto with zarith. -set (y := (fst (s n) * fst (s n) - 2, 0)). -unfold s; simpl; rewrite Zpower_exp; auto with zarith. -rewrite Zpower_1_r; rewrite ppow_ppow; auto with zarith. -repeat rewrite pplus_pmult_dist_r || rewrite pplus_pmult_dist_l. -repeat rewrite <- pplus_assoc. -eq_tac; auto. -pattern 2 at 2; replace 2 with (1 + 1); auto with zarith. -rewrite ppow_add; auto with zarith; simpl. -rewrite pmult_1_r; auto. -rewrite Zmult_comm; rewrite ppow_ppow; simpl; auto with zarith. -repeat rewrite <- ppow_mult; auto with zarith. -rewrite (pmult_comm v w); rewrite w_mult_v. -rewrite ppow_1. -repeat rewrite tpower_1. -rewrite pplus_comm; repeat rewrite <- pplus_assoc; -rewrite pplus_comm; repeat rewrite <- pplus_assoc. -simpl; case (ppow (7, -4) (2 ^n)); simpl; intros z1 z2; eq_tac; auto with zarith. -Qed. - -Theorem sn_snd: forall n, snd (s n) = 0. -intros n; case n; simpl; auto. -intros p; pattern p; apply Pind; auto. -intros p1 H; rewrite Zpos_succ_morphism; unfold Zsucc. -rewrite sn_aux; auto with zarith. -generalize H; case (s (Zpos p1)); simpl. -intros x y H1; rewrite H1; auto with zarith. -Qed. - -Theorem sn: forall n, 0 <= n -> s (n+1) = (fst (s n) * fst (s n) -2, 0). -intros n Hn; rewrite sn_aux; generalize (sn_snd n); case (s n); auto. -intros x y H; simpl in H; rewrite H; simpl. -eq_tac; ring. -Qed. - -Theorem sn_w: forall n, 0 <= n -> ppow w (2 ^ (n + 1)) = pplus (pmult (s n) (ppow w (2 ^ n))) (- 1, 0). -intros n H; unfold s; simpl; rewrite Zpower_exp; auto with zarith. -assert (Hu: 0 <= 2 ^n); auto with zarith. -rewrite Zpower_1_r; rewrite ppow_ppow; auto with zarith. -repeat rewrite pplus_pmult_dist_r || rewrite pplus_pmult_dist_l. -pattern 2 at 2; replace 2 with (1 + 1); auto with zarith. -rewrite ppow_add; auto with zarith; simpl. -rewrite pmult_1_r; auto. -repeat rewrite <- ppow_mult; auto with zarith. -rewrite (pmult_comm v w); rewrite w_mult_v. -rewrite ppow_1; simpl. -simpl; case (ppow (7, 4) (2 ^n)); simpl; intros z1 z2; eq_tac; auto with zarith. -Qed. - -Theorem sn_w_next: forall n, 0 <= n -> ppow w (2 ^ (n + 1)) = pplus (pmult (s n) (ppow w (2 ^ n))) (- 1, 0). -intros n H; unfold s; simpl; rewrite Zpower_exp; auto with zarith. -assert (Hu: 0 <= 2 ^n); auto with zarith. -rewrite Zpower_1_r; rewrite ppow_ppow; auto with zarith. -repeat rewrite pplus_pmult_dist_r || rewrite pplus_pmult_dist_l. -pattern 2 at 2; replace 2 with (1 + 1); auto with zarith. -rewrite ppow_add; auto with zarith; simpl. -rewrite pmult_1_r; auto. -repeat rewrite <- ppow_mult; auto with zarith. -rewrite (pmult_comm v w); rewrite w_mult_v. -rewrite ppow_1; simpl. -simpl; case (ppow (7, 4) (2 ^n)); simpl; intros z1 z2; eq_tac; auto with zarith. -Qed. - -Section Lucas. - -Variable p: Z. - -(************************************** - Definition of the mersenne number - **************************************) - -Definition Mp := 2^p -1. - -Theorem mersenne_pos: 1 < p -> 1 < Mp. -intros H; unfold Mp; assert (2 < 2 ^p); auto with zarith. -apply Zlt_le_trans with (2^2); auto with zarith. -refine (refl_equal _). -apply Zpower_le_monotone; auto with zarith. -Qed. - -Hypothesis p_pos2: 2 < p. - -(************************************** - We suppose that the mersenne number divides s - **************************************) - -Hypothesis Mp_divide_sn: (Mp | fst (s (p - 2))). - -Variable q: Z. - -(************************************** - We take a divisor of Mp and shows that Mp <= q^2, hence Mp is prime - **************************************) - -Hypothesis q_divide_Mp: (q | Mp). - -Hypothesis q_pos2: 2 < q. - -Theorem q_pos: 1 < q. -apply Zlt_trans with (2 := q_pos2); auto with zarith. -Qed. - -(************************************** - The definition of the groups of inversible pairs - **************************************) - -Definition pgroup := PGroup q q_pos. - -Theorem w_in_pgroup: (In w pgroup.(FGroup.s)). -generalize q_pos; intros HM. -generalize q_pos2; intros HM2. -assert (H0: 0 < q); auto with zarith. -simpl; apply isupport_is_in; auto. -assert (zpmult q w (2, q - 1) = (1, 0)). -unfold zpmult, w, pmult, base; repeat (rewrite Zmult_1_r || rewrite Zmult_1_l). -eq_tac. -apply trans_equal with ((3 * q + 1) mod q). -eq_tac; auto with zarith. -rewrite Zplus_mod; auto. -rewrite Zmult_mod; auto. -rewrite Z_mod_same; auto with zarith. -rewrite Zmult_0_r; repeat rewrite Zmod_small; auto with zarith. -apply trans_equal with (2 * q mod q). -eq_tac; auto with zarith. -apply Zdivide_mod; auto with zarith; exists 2; auto with zarith. -apply is_inv_true with (2, q - 1); auto. -apply mL_in; auto with zarith. -intros; apply zpmult_1_l; auto with zarith. -intros; apply zpmult_1_r; auto with zarith. -rewrite zpmult_comm; auto. -apply mL_in; auto with zarith. -unfold w; apply mL_in; auto with zarith. -Qed. - -Theorem e_order_divide_order: (e_order P_dec w pgroup | g_order pgroup). -apply e_order_divide_g_order. -apply w_in_pgroup. -Qed. - -Theorem order_lt: g_order pgroup < q * q. -unfold g_order, pgroup, PGroup; simpl. -rewrite <- (Zabs_eq (q * q)); auto with zarith. -rewrite <- (inj_Zabs_nat (q * q)); auto with zarith. -rewrite <- mL_length; auto with zarith. -apply inj_lt; apply isupport_length_strict with (0, 0). -apply mL_ulist. -apply mL_in; auto with zarith. -intros a _; left; rewrite zpmult_0_l; auto with zarith. -intros; discriminate. -Qed. - -(************************************** - The power function zpow: a^n - **************************************) - -Definition zpow a := gpow a pgroup. - -(************************************** - Some properties of zpow - **************************************) - -Theorem zpow_def: - forall a b, In a pgroup.(FGroup.s) -> 0 <= b -> - zpow a b = ((fst (ppow a b)) mod q, (snd (ppow a b)) mod q). -generalize q_pos; intros HM. -generalize q_pos2; intros HM2. -assert (H0: 0 < q); auto with zarith. -intros a b Ha Hb; generalize Hb; pattern b; apply natlike_ind; auto. -intros _; repeat rewrite Zmod_small; auto with zarith. -rewrite ppow_0; simpl; auto with zarith. -unfold zpow; intros n1 H Rec _; unfold Zsucc. -rewrite gpow_add; auto with zarith. -rewrite ppow_add; simpl; try rewrite pmult_1_r; auto with zarith. -rewrite Rec; unfold zpmult; auto with zarith. -case (ppow a n1); case a; unfold pmult, fst, snd. -intros x y z t. -repeat (rewrite Zmult_1_r || rewrite Zmult_0_r || rewrite Zplus_0_r || rewrite Zplus_0_l); eq_tac. -repeat rewrite (fun u v => Zplus_mod (u * v)); auto. -eq_tac; try eq_tac; auto. -repeat rewrite (Zmult_mod z); auto with zarith. -repeat rewrite (fun u v => Zmult_mod (u * v)); auto. -eq_tac; try eq_tac; auto with zarith. -repeat rewrite (Zmult_mod base); auto with zarith. -eq_tac; try eq_tac; auto with zarith. -apply Zmod_mod; auto. -apply Zmod_mod; auto. -repeat rewrite (fun u v => Zplus_mod (u * v)); auto. -eq_tac; try eq_tac; auto. -repeat rewrite (Zmult_mod z); auto with zarith. -repeat rewrite (Zmult_mod t); auto with zarith. -Qed. - -Theorem zpow_w_n_minus_1: zpow w (2 ^ (p - 1)) = (-1 mod q, 0). -generalize q_pos; intros HM. -generalize q_pos2; intros HM2. -assert (H0: 0 < q); auto with zarith. -rewrite zpow_def. -replace (p - 1) with ((p - 2) + 1); auto with zarith. -rewrite sn_w; auto with zarith. -generalize Mp_divide_sn (sn_snd (p - 2)); case (s (p -2)); case (ppow w (2 ^ (p -2))). -unfold fst, snd; intros x y z t H1 H2; unfold pmult, pplus; subst. -repeat (rewrite Zmult_0_l || rewrite Zmult_0_r || rewrite Zplus_0_l || rewrite Zplus_0_r). -assert (H2: z mod q = 0). -case H1; intros q1 Hq1; rewrite Hq1. -case q_divide_Mp; intros q2 Hq2; rewrite Hq2. -rewrite Zmult_mod; auto. -rewrite (Zmult_mod q2); auto. -rewrite Z_mod_same; auto with zarith. -repeat (rewrite Zmult_0_r; rewrite (Zmod_small 0)); auto with zarith. -assert (H3: forall x, (z * x) mod q = 0). -intros y1; rewrite Zmult_mod; try rewrite H2; auto. -assert (H4: forall x y, (z * x + y) mod q = y mod q). -intros x1 y1; rewrite Zplus_mod; try rewrite H3; auto. -rewrite Zplus_0_l; apply Zmod_mod; auto. -eq_tac; auto. -apply w_in_pgroup. -apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. -Qed. - -Theorem zpow_w_n: zpow w (2 ^ p) = (1, 0). -generalize q_pos; intros HM. -generalize q_pos2; intros HM2. -assert (H0: 0 < q); auto with zarith. -replace p with ((p - 1) + 1); auto with zarith. -rewrite Zpower_exp; try rewrite Zpower_exp_1; auto with zarith. -unfold zpow; rewrite gpow_gpow; auto with zarith. -generalize zpow_w_n_minus_1; unfold zpow; intros H1; rewrite H1; clear H1. -simpl; unfold zpmult, pmult. -repeat (rewrite Zmult_0_l || rewrite Zmult_0_r || rewrite Zplus_0_l || - rewrite Zplus_0_r || rewrite Zmult_1_r). -eq_tac; auto. -pattern (-1 mod q) at 1; rewrite <- (Zmod_mod (-1) q); auto with zarith. -repeat rewrite <- Zmult_mod; auto. -rewrite Zmod_small; auto with zarith. -apply w_in_pgroup. -Qed. - -(************************************** - As e = (1, 0), the previous equation implies that the order of the group divide 2^p - **************************************) - -Theorem e_order_divide_pow: (e_order P_dec w pgroup | 2 ^ p). -generalize q_pos; intros HM. -generalize q_pos2; intros HM2. -assert (H0: 0 < q); auto with zarith. -apply e_order_divide_gpow. -apply w_in_pgroup. -apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. -exact zpow_w_n. -Qed. - -(************************************** - So it is less than equal - **************************************) - -Theorem e_order_le_pow : e_order P_dec w pgroup <= 2 ^ p. -apply Zdivide_le. -apply Zlt_le_weak; apply e_order_pos. -apply Zpower_gt_0; auto with zarith. -apply e_order_divide_pow. -Qed. - -(************************************** - So order(w) must be 2^q - **************************************) - -Theorem e_order_eq_pow: exists q, (e_order P_dec w pgroup) = 2 ^ q. -case (Zdivide_power_2 (e_order P_dec w pgroup) 2 p); auto with zarith. -apply Zlt_le_weak; apply e_order_pos. -apply prime_2. -apply e_order_divide_pow; auto. -intros x H; exists x; auto with zarith. -Qed. - -(************************************** - Buth this q can only be p otherwise it would contradict w^2^(p -1) = (-1, 0) - **************************************) - -Theorem e_order_eq_p: e_order P_dec w pgroup = 2 ^ p. -case (Zdivide_power_2 (e_order P_dec w pgroup) 2 p); auto with zarith. -apply Zlt_le_weak; apply e_order_pos. -apply prime_2. -apply e_order_divide_pow; auto. -intros p1 Hp1. -case (Zle_lt_or_eq p1 p); try (intro H1; subst; auto; fail). -case (Zle_or_lt p1 p); auto; intros H1. -absurd (2 ^ p1 <= 2 ^ p); auto with zarith. -apply Zlt_not_le; apply Zpower_lt_monotone; auto with zarith. -apply Zdivide_le. -apply Zlt_le_weak; apply Zpower_gt_0; auto with zarith. -apply Zpower_gt_0; auto with zarith. -rewrite <- Hp1; apply e_order_divide_pow. -intros H1. -assert (Hu: 0 <= p1). -generalize Hp1; case p1; simpl; auto with zarith. -intros p2 Hu; absurd (0 < e_order P_dec w pgroup). -rewrite Hu; auto with zarith. -apply e_order_pos. -absurd (zpow w (2 ^ (p - 1)) = (1, 0)). -rewrite zpow_w_n_minus_1. -intros H2; injection H2; clear H2; intros H2. -assert (H0: 0 < q); auto with zarith. -absurd (0 mod q = 0). -pattern 0 at 1; replace 0 with (-1 + 1); auto with zarith. -rewrite Zplus_mod; auto with zarith. -rewrite H2; rewrite (Zmod_small 1); auto with zarith. -rewrite Zmod_small; auto with zarith. -rewrite Zmod_small; auto with zarith. -unfold zpow; apply (gpow_pow _ _ w pgroup) with p1; auto with zarith. -apply w_in_pgroup. -rewrite <- Hp1. -apply (gpow_e_order_is_e _ P_dec _ w pgroup). -apply w_in_pgroup. -Qed. - -(************************************** - We have then the expected conclusion - **************************************) - -Theorem q_more_than_square: Mp < q * q. -unfold Mp. -assert (2 ^ p <= q * q); auto with zarith. -rewrite <- e_order_eq_p. -apply Zle_trans with (g_order pgroup). -apply Zdivide_le; auto with zarith. -apply Zlt_le_weak; apply e_order_pos; auto with zarith. -2: apply e_order_divide_order. -2: apply Zlt_le_weak; apply order_lt. -apply Zlt_le_trans with 2; auto with zarith. -replace 2 with (Z_of_nat (length ((1, 0)::w::nil))); auto. -unfold g_order; apply inj_le. -apply ulist_incl_length. -apply ulist_cons; simpl; auto. -unfold w; intros [H2 | H2]; try (case H2; fail); discriminate. -intro a; simpl; intros [H1 | [H1 | H1]]; subst. -assert (In (1, 0) (mL q)). -apply mL_in; auto with zarith. -apply isupport_is_in; auto. -apply is_inv_true with (1, 0); simpl; auto. -intros; apply zpmult_1_l; auto with zarith. -intros; apply zpmult_1_r; auto with zarith. -rewrite zpmult_1_r; auto with zarith. -rewrite zpmult_1_r; auto with zarith. -exact w_in_pgroup. -case H1. -Qed. - -End Lucas. - -(************************************** - We build the sequence in Z - **************************************) - -Definition SS p := - let n := Mp p in - match p - 2 with - Zpos p1 => iter_pos _ (fun x => Zmodd (Zsquare x - 2) n) (Zmodd 4 n) p1 - | _ => (Zmodd 4 n) - end. - -Theorem SS_aux_correct: - forall p z1 z2 n, 0 <= n -> 0 < z1 -> z2 = fst (s n) mod z1 -> - iter_pos _ (fun x => Zmodd (Zsquare x - 2) z1) z2 p = fst (s (n + Zpos p)) mod z1. -intros p; pattern p; apply Pind. -simpl. -intros z1 z2 n Hn H H1; rewrite sn; auto; rewrite H1; rewrite Zmodd_correct; rewrite Zsquare_correct; simpl. -unfold Zminus; rewrite Zplus_mod; auto. -rewrite (Zplus_mod (fst (s n) * fst (s n))); auto with zarith. -eq_tac; auto. -eq_tac; auto. -apply sym_equal; apply Zmult_mod; auto. -intros n Rec z1 z2 n1 Hn1 H1 H2. -rewrite Pplus_one_succ_l; rewrite iter_pos_plus. -rewrite Rec with (n0 := n1); auto. -replace (n1 + Zpos (1 + n)) with ((n1 + Zpos n) + 1); auto with zarith. -rewrite sn; simpl; try rewrite Zmodd_correct; try rewrite Zsquare_correct; simpl; auto with zarith. -unfold Zminus; rewrite Zplus_mod; auto. -unfold Zmodd. -rewrite (Zplus_mod (fst (s (n1 + Zpos n)) * fst (s (n1 + Zpos n)))); auto with zarith. -eq_tac; auto. -eq_tac; auto. -apply sym_equal; apply Zmult_mod; auto. -rewrite Zpos_plus_distr; auto with zarith. -Qed. - -Theorem SS_prop: forall n, 1 < n -> SS n = fst(s (n -2)) mod (Mp n). -intros n Hn; unfold SS. -cut (0 <= n - 2); auto with zarith. -case (n - 2). -intros _; rewrite Zmodd_correct; rewrite s0; auto. -intros p1 H2; rewrite SS_aux_correct with (n := 0); auto with zarith. -apply Zle_lt_trans with 1; try apply mersenne_pos; auto with zarith. -rewrite Zmodd_correct; rewrite s0; auto. -intros p1 H2; case H2; auto. -Qed. - -Theorem SS_prop_cor: forall p, 1 < p -> SS p = 0 -> (Mp p | fst(s (p -2))). -intros p H H1. -apply Zmod_divide. -generalize (mersenne_pos _ H); auto with zarith. -apply trans_equal with (2:= H1); apply sym_equal; apply SS_prop; auto. -Qed. - -Theorem LucasLehmer: forall p, 2 < p -> SS p = 0 -> prime (Mp p). -intros p H H1; case (prime_dec (Mp p)); auto; intros H2. -case Zdivide_div_prime_le_square with (2 := H2). -apply mersenne_pos; apply Zlt_trans with 2; auto with zarith. -intros q (H3, (H4, H5)). -contradict H5; apply Zlt_not_le. -apply q_more_than_square; auto. -apply SS_prop_cor; auto. -apply Zlt_trans with 2; auto with zarith. -case (Zle_lt_or_eq 2 q); auto. -apply prime_ge_2; auto. -intros H5; subst. -absurd (2 <= 1); auto with arith. -apply Zdivide_le; auto with zarith. -case H4; intros x Hx. -exists (2 ^ (p -1) - x). -rewrite Zmult_minus_distr_r; rewrite <- Hx; unfold Mp. -pattern 2 at 2; rewrite <- Zpower_1_r; rewrite <- Zpower_exp; auto with zarith. -replace (p - 1 + 1) with p; auto with zarith. -Qed. - -(************************************** - The test - **************************************) - -Definition lucas_test n := - if Z_lt_dec 2 n then if Z_eq_dec (SS n) 0 then true else false else false. - -Theorem LucasTest: forall n, lucas_test n = true -> prime (Mp n). -intros n; unfold lucas_test; case (Z_lt_dec 2 n); intros H1; try (intros; discriminate). -case (Z_eq_dec (SS n) 0); intros H2; try (intros; discriminate). -intros _; apply LucasLehmer; auto. -Qed. - -Theorem prime7: prime 7. -exact (LucasTest 3 (refl_equal _)). -Qed. - -Theorem prime31: prime 31. -exact (LucasTest 5 (refl_equal _)). -Qed. - -Theorem prime127: prime 127. -exact (LucasTest 7 (refl_equal _)). -Qed. - -Theorem prime8191: prime 8191. -exact (LucasTest 13 (refl_equal _)). -Qed. - -Theorem prime131071: prime 131071. -exact (LucasTest 17 (refl_equal _)). -Qed. - -Theorem prime524287: prime 524287. -exact (LucasTest 19 (refl_equal _)). -Qed. - diff --git a/coqprime-8.5/Coqprime/NatAux.v b/coqprime-8.5/Coqprime/NatAux.v deleted file mode 100644 index eab09150c..000000000 --- a/coqprime-8.5/Coqprime/NatAux.v +++ /dev/null @@ -1,72 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - Aux.v - - Auxillary functions & Theorems - **********************************************************************) -Require Export Arith. - -(************************************** - Some properties of minus -**************************************) - -Theorem minus_O : forall a b : nat, a <= b -> a - b = 0. -intros a; elim a; simpl in |- *; auto with arith. -intros a1 Rec b; case b; elim b; auto with arith. -Qed. - - -(************************************** - Definitions and properties of the power for nat -**************************************) - -Fixpoint pow (n m: nat) {struct m} : nat := match m with O => 1%nat | (S m1) => (n * pow n m1)%nat end. - -Theorem pow_add: forall n m p, pow n (m + p) = (pow n m * pow n p)%nat. -intros n m; elim m; simpl. -intros p; rewrite plus_0_r; auto. -intros m1 Rec p; rewrite Rec; auto with arith. -Qed. - - -Theorem pow_pos: forall p n, (0 < p)%nat -> (0 < pow p n)%nat. -intros p1 n H; elim n; simpl; auto with arith. -intros n1 H1; replace 0%nat with (p1 * 0)%nat; auto with arith. -repeat rewrite (mult_comm p1); apply mult_lt_compat_r; auto with arith. -Qed. - - -Theorem pow_monotone: forall n p q, (1 < n)%nat -> (p < q)%nat -> (pow n p < pow n q)%nat. -intros n p1 q1 H H1; elim H1; simpl. -pattern (pow n p1) at 1; rewrite <- (mult_1_l (pow n p1)). -apply mult_lt_compat_r; auto. -apply pow_pos; auto with arith. -intros n1 H2 H3. -apply lt_trans with (1 := H3). -pattern (pow n n1) at 1; rewrite <- (mult_1_l (pow n n1)). -apply mult_lt_compat_r; auto. -apply pow_pos; auto with arith. -Qed. - -(************************************ - Definition of the divisibility for nat -**************************************) - -Definition divide a b := exists c, b = a * c. - - -Theorem divide_le: forall p q, (1 < q)%nat -> divide p q -> (p <= q)%nat. -intros p1 q1 H (x, H1); subst. -apply le_trans with (p1 * 1)%nat; auto with arith. -rewrite mult_1_r; auto with arith. -apply mult_le_compat_l. -case (le_lt_or_eq 0 x); auto with arith. -intros H2; subst; contradict H; rewrite mult_0_r; auto with arith. -Qed. diff --git a/coqprime-8.5/Coqprime/PGroup.v b/coqprime-8.5/Coqprime/PGroup.v deleted file mode 100644 index e9c1b2f47..000000000 --- a/coqprime-8.5/Coqprime/PGroup.v +++ /dev/null @@ -1,347 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - PGroup.v - - Build the group of pairs modulo needed for the theorem of - lucas lehmer - - Definition: PGroup - **********************************************************************) -Require Import ZArith. -Require Import Znumtheory. -Require Import Tactic. -Require Import Wf_nat. -Require Import ListAux. -Require Import UList. -Require Import FGroup. -Require Import EGroup. -Require Import IGroup. - -Open Scope Z_scope. - -Definition base := 3. - - -(************************************** - Equality is decidable on pairs - **************************************) - -Definition P_dec: forall p q: Z * Z, {p = q} + {p <> q}. -intros p1 q1; case p1; case q1; intros z t x y; case (Z_eq_dec x z); intros H1. -case (Z_eq_dec y t); intros H2. -left; eq_tac; auto. -right; contradict H2; injection H2; auto. -right; contradict H1; injection H1; auto. -Defined. - - -(************************************** - Addition of two pairs - **************************************) - -Definition pplus (p q: Z * Z) := let (x ,y) := p in let (z,t) := q in (x + z, y + t). - -(************************************** - Properties of addition - **************************************) - -Theorem pplus_assoc: forall p q r, (pplus p (pplus q r)) = (pplus (pplus p q) r). -intros p q r; case p; case q; case r; intros r1 r2 q1 q2 p1 p2; unfold pplus. -eq_tac; ring. -Qed. - -Theorem pplus_comm: forall p q, (pplus p q) = (pplus q p). -intros p q; case p; case q; intros q1 q2 p1 p2; unfold pplus. -eq_tac; ring. -Qed. - -(************************************** - Multiplication of two pairs - **************************************) - -Definition pmult (p q: Z * Z) := let (x ,y) := p in let (z,t) := q in (x * z + base * y * t, x * t + y * z). - -(************************************** - Properties of multiplication - **************************************) - -Theorem pmult_assoc: forall p q r, (pmult p (pmult q r)) = (pmult (pmult p q) r). -intros p q r; case p; case q; case r; intros r1 r2 q1 q2 p1 p2; unfold pmult. -eq_tac; ring. -Qed. - -Theorem pmult_0_l: forall p, (pmult (0, 0) p) = (0, 0). -intros p; case p; intros x y; unfold pmult; eq_tac; ring. -Qed. - -Theorem pmult_0_r: forall p, (pmult p (0, 0)) = (0, 0). -intros p; case p; intros x y; unfold pmult; eq_tac; ring. -Qed. - -Theorem pmult_1_l: forall p, (pmult (1, 0) p) = p. -intros p; case p; intros x y; unfold pmult; eq_tac; ring. -Qed. - -Theorem pmult_1_r: forall p, (pmult p (1, 0)) = p. -intros p; case p; intros x y; unfold pmult; eq_tac; ring. -Qed. - -Theorem pmult_comm: forall p q, (pmult p q) = (pmult q p). -intros p q; case p; case q; intros q1 q2 p1 p2; unfold pmult. -eq_tac; ring. -Qed. - -Theorem pplus_pmult_dist_l: forall p q r, (pmult p (pplus q r)) = (pplus (pmult p q) (pmult p r)). -intros p q r; case p; case q; case r; intros r1 r2 q1 q2 p1 p2; unfold pplus, pmult. -eq_tac; ring. -Qed. - - -Theorem pplus_pmult_dist_r: forall p q r, (pmult (pplus q r) p) = (pplus (pmult q p) (pmult r p)). -intros p q r; case p; case q; case r; intros r1 r2 q1 q2 p1 p2; unfold pplus, pmult. -eq_tac; ring. -Qed. - -(************************************** - In this section we create the group PGroup of inversible elements {(p, q) | 0 <= p < m /\ 0 <= q < m} - **************************************) -Section Mod. - -Variable m : Z. - -Hypothesis m_pos: 1 < m. - -(************************************** - mkLine creates {(a, p) | 0 <= p < n} - **************************************) - -Fixpoint mkLine (a: Z) (n: nat) {struct n} : list (Z * Z) := - (a, Z_of_nat n) :: match n with O => nil | (S n1) => mkLine a n1 end. - -(************************************** - Some properties of mkLine - **************************************) - -Theorem mkLine_length: forall a n, length (mkLine a n) = (n + 1)%nat. -intros a n; elim n; simpl; auto. -Qed. - -Theorem mkLine_in: forall a n p, 0 <= p <= Z_of_nat n -> (In (a, p) (mkLine a n)). -intros a n; elim n. -simpl; auto with zarith. -intros p (H1, H2); replace p with 0; auto with zarith. -intros n1 Rec p (H1, H2). -case (Zle_lt_or_eq p (Z_of_nat (S n1))); auto with zarith. -rewrite inj_S in H2; auto with zarith. -rewrite inj_S; auto with zarith. -intros H3; right; apply Rec; auto with zarith. -intros H3; subst; simpl; auto. -Qed. - -Theorem in_mkLine: forall a n p, In p (mkLine a n) -> exists q, 0 <= q <= Z_of_nat n /\ p = (a, q). -intros a n p; elim n; clear n. -simpl; intros [H1 | H1]; exists 0; auto with zarith; case H1. -simpl; intros n Rec [H1 | H1]; auto. -exists (Z_of_nat (S n)); auto with zarith. -case Rec; auto; intros q ((H2, H3), H4); exists q; repeat split; auto with zarith. -change (q <= Z_of_nat (S n)). -rewrite inj_S; auto with zarith. -Qed. - -Theorem mkLine_ulist: forall a n, ulist (mkLine a n). -intros a n; elim n; simpl; auto. -intros n1 H; apply ulist_cons; auto. -change (~ In (a, Z_of_nat (S n1)) (mkLine a n1)). -rewrite inj_S; intros H1. -case in_mkLine with (1 := H1); auto with zarith. -intros x ((H2, H3), H4); injection H4. -intros H5; subst; auto with zarith. -Qed. - -(************************************** - mkRect creates the list {(p, q) | 0 <= p < n /\ 0 <= q < m} - **************************************) - -Fixpoint mkRect (n m: nat) {struct n} : list (Z * Z) := - (mkLine (Z_of_nat n) m) ++ match n with O => nil | (S n1) => mkRect n1 m end. - -(************************************** - Some properties of mkRect - **************************************) - -Theorem mkRect_length: forall n m, length (mkRect n m) = ((n + 1) * (m + 1))%nat. -intros n; elim n; simpl; auto. -intros n1; rewrite <- app_nil_end; rewrite mkLine_length; rewrite plus_0_r; auto. -intros n1 Rec m1; rewrite length_app; rewrite Rec; rewrite mkLine_length; auto. -Qed. - -Theorem mkRect_in: forall n m p q, 0 <= p <= Z_of_nat n -> 0 <= q <= Z_of_nat m -> (In (p, q) (mkRect n m)). -intros n m1; elim n; simpl. -intros p q (H1, H2) (H3, H4); replace p with 0; auto with zarith. -rewrite <- app_nil_end; apply mkLine_in; auto. -intros n1 Rec p q (H1, H2) (H3, H4). -case (Zle_lt_or_eq p (Z_of_nat (S n1))); auto with zarith; intros H5. -rewrite inj_S in H5; apply in_or_app; auto with zarith. -apply in_or_app; left; subst; apply mkLine_in; auto with zarith. -Qed. - -Theorem in_mkRect: forall n m p, In p (mkRect n m) -> exists p1, exists p2, 0 <= p1 <= Z_of_nat n /\ 0 <= p2 <= Z_of_nat m /\ p = (p1, p2). -intros n m1 p; elim n; clear n; simpl. -rewrite <- app_nil_end; intros H1. -case in_mkLine with (1 := H1). -intros p2 (H2, H3); exists 0; exists p2; auto with zarith. -intros n Rec H1. -case in_app_or with (1 := H1); intros H2. -case in_mkLine with (1 := H2). -intros p2 (H3, H4); exists (Z_of_nat (S n)); exists p2; subst; simpl; auto with zarith. -case Rec with (1 := H2); auto. -intros p1 (p2, (H3, (H4, H5))); exists p1; exists p2; repeat split; auto with zarith. -change (p1 <= Z_of_nat (S n)). -rewrite inj_S; auto with zarith. -Qed. - -Theorem mkRect_ulist: forall n m, ulist (mkRect n m). -intros n; elim n; simpl; auto. -intros n1; rewrite <- app_nil_end; apply mkLine_ulist; auto. -intros n1 Rec m1; apply ulist_app; auto. -apply mkLine_ulist. -intros a H1 H2. -case in_mkLine with (1 := H1); intros p1 ((H3, H4), H5). -case in_mkRect with (1 := H2); intros p2 (p3, ((H6, H7), ((H8, H9), H10))). -subst; injection H10; clear H10; intros; subst. -contradict H7. -change (~ Z_of_nat (S n1) <= Z_of_nat n1). -rewrite inj_S; auto with zarith. -Qed. - -(************************************** - mL is the list {(p, q) | 0 <= p < m-1 /\ 0 <= q < m - 1} - **************************************) -Definition mL := mkRect (Zabs_nat (m - 1)) (Zabs_nat (m -1)). - -(************************************** - Some properties of mL - **************************************) - -Theorem mL_length : length mL = Zabs_nat (m * m). -unfold mL; rewrite mkRect_length; simpl; apply inj_eq_rev. -repeat (rewrite inj_mult || rewrite inj_plus || rewrite inj_Zabs_nat || rewrite Zabs_eq); simpl; auto with zarith. -eq_tac; auto with zarith. -Qed. - -Theorem mL_in: forall p q, 0 <= p < m -> 0 <= q < m -> (In (p, q) mL). -intros p q (H1, H2) (H3, H4); unfold mL; apply mkRect_in; rewrite inj_Zabs_nat; - rewrite Zabs_eq; auto with zarith. -Qed. - -Theorem in_mL: forall p, In p mL-> exists p1, exists p2, 0 <= p1 < m /\ 0 <= p2 < m /\ p = (p1, p2). -unfold mL; intros p H1; case in_mkRect with (1 := H1). -repeat (rewrite inj_Zabs_nat || rewrite Zabs_eq); auto with zarith. -intros p1 (p2, ((H2, H3), ((H4, H5), H6))); exists p1; exists p2; repeat split; auto with zarith. -Qed. - -Theorem mL_ulist: ulist mL. -unfold mL; apply mkRect_ulist; auto. -Qed. - -(************************************** - We define zpmult the multiplication of pairs module m - **************************************) - -Definition zpmult (p q: Z * Z) := let (x ,y) := pmult p q in (Zmod x m, Zmod y m). - -(************************************** - Some properties of zpmult - **************************************) - -Theorem zpmult_internal: forall p q, (In (zpmult p q) mL). -intros p q; unfold zpmult; case (pmult p q); intros z y; apply mL_in; auto with zarith. -apply Z_mod_lt; auto with zarith. -apply Z_mod_lt; auto with zarith. -Qed. - -Theorem zpmult_assoc: forall p q r, (zpmult p (zpmult q r)) = (zpmult (zpmult p q) r). -assert (U: 0 < m); auto with zarith. -intros p q r; unfold zpmult. -generalize (pmult_assoc p q r). -case (pmult p q); intros x1 x2. -case (pmult q r); intros y1 y2. -case p; case r; unfold pmult. -intros z1 z2 t1 t2 H. -match goal with - H: (?X, ?Y) = (?Z, ?T) |- _ => - assert (H1: X = Z); assert (H2: Y = T); try (injection H; simpl; auto; fail); clear H -end. -eq_tac. -generalize (f_equal (fun x => x mod m) H1). -repeat rewrite <- Zmult_assoc. -repeat (rewrite (fun x => Zplus_mod (t1 * x))); auto. -repeat (rewrite (fun x => Zplus_mod (x1 * x))); auto. -repeat (rewrite (fun x => Zplus_mod (x1 mod m * x))); auto. -repeat (rewrite (Zmult_mod t1)); auto. -repeat (rewrite (Zmult_mod x1)); auto. -repeat (rewrite (Zmult_mod base)); auto. -repeat (rewrite (Zmult_mod t2)); auto. -repeat (rewrite (Zmult_mod x2)); auto. -repeat (rewrite (Zmult_mod (t2 mod m))); auto. -repeat (rewrite (Zmult_mod (x1 mod m))); auto. -repeat (rewrite (Zmult_mod (x2 mod m))); auto. -repeat (rewrite Zmod_mod); auto. -generalize (f_equal (fun x => x mod m) H2). -repeat (rewrite (fun x => Zplus_mod (t1 * x))); auto. -repeat (rewrite (fun x => Zplus_mod (x1 * x))); auto. -repeat (rewrite (fun x => Zplus_mod (x1 mod m * x))); auto. -repeat (rewrite (Zmult_mod t1)); auto. -repeat (rewrite (Zmult_mod x1)); auto. -repeat (rewrite (Zmult_mod t2)); auto. -repeat (rewrite (Zmult_mod x2)); auto. -repeat (rewrite (Zmult_mod (t2 mod m))); auto. -repeat (rewrite (Zmult_mod (x1 mod m))); auto. -repeat (rewrite (Zmult_mod (x2 mod m))); auto. -repeat (rewrite Zmod_mod); auto. -Qed. - -Theorem zpmult_0_l: forall p, (zpmult (0, 0) p) = (0, 0). -intros p; case p; intros x y; unfold zpmult, pmult; simpl. -rewrite Zmod_small; auto with zarith. -Qed. - -Theorem zpmult_1_l: forall p, In p mL -> zpmult (1, 0) p = p. -intros p H; case in_mL with (1 := H); clear H; intros p1 (p2, ((H1, H2), (H3, H4))); subst. -unfold zpmult; rewrite pmult_1_l. -repeat rewrite Zmod_small; auto with zarith. -Qed. - -Theorem zpmult_1_r: forall p, In p mL -> zpmult p (1, 0) = p. -intros p H; case in_mL with (1 := H); clear H; intros p1 (p2, ((H1, H2), (H3, H4))); subst. -unfold zpmult; rewrite pmult_1_r. -repeat rewrite Zmod_small; auto with zarith. -Qed. - -Theorem zpmult_comm: forall p q, zpmult p q = zpmult q p. -intros p q; unfold zpmult; rewrite pmult_comm; auto. -Qed. - -(************************************** - We are now ready to build our group - **************************************) - -Definition PGroup : (FGroup zpmult). -apply IGroup with (support := mL) (e:= (1, 0)). -exact P_dec. -apply mL_ulist. -apply mL_in; auto with zarith. -intros; apply zpmult_internal. -intros; apply zpmult_assoc. -exact zpmult_1_l. -exact zpmult_1_r. -Defined. - -End Mod. diff --git a/coqprime-8.5/Coqprime/Permutation.v b/coqprime-8.5/Coqprime/Permutation.v deleted file mode 100644 index a06693f89..000000000 --- a/coqprime-8.5/Coqprime/Permutation.v +++ /dev/null @@ -1,506 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - Permutation.v - - Defintion and properties of permutations - **********************************************************************) -Require Export List. -Require Export ListAux. - -Section permutation. -Variable A : Set. - -(************************************** - Definition of permutations as sequences of adjacent transpositions - **************************************) - -Inductive permutation : list A -> list A -> Prop := - | permutation_nil : permutation nil nil - | permutation_skip : - forall (a : A) (l1 l2 : list A), - permutation l2 l1 -> permutation (a :: l2) (a :: l1) - | permutation_swap : - forall (a b : A) (l : list A), permutation (a :: b :: l) (b :: a :: l) - | permutation_trans : - forall l1 l2 l3 : list A, - permutation l1 l2 -> permutation l2 l3 -> permutation l1 l3. -Hint Constructors permutation. - -(************************************** - Reflexivity - **************************************) - -Theorem permutation_refl : forall l : list A, permutation l l. -simple induction l. -apply permutation_nil. -intros a l1 H. -apply permutation_skip with (1 := H). -Qed. -Hint Resolve permutation_refl. - -(************************************** - Symmetry - **************************************) - -Theorem permutation_sym : - forall l m : list A, permutation l m -> permutation m l. -intros l1 l2 H'; elim H'. -apply permutation_nil. -intros a l1' l2' H1 H2. -apply permutation_skip with (1 := H2). -intros a b l1'. -apply permutation_swap. -intros l1' l2' l3' H1 H2 H3 H4. -apply permutation_trans with (1 := H4) (2 := H2). -Qed. - -(************************************** - Compatibility with list length - **************************************) - -Theorem permutation_length : - forall l m : list A, permutation l m -> length l = length m. -intros l m H'; elim H'; simpl in |- *; auto. -intros l1 l2 l3 H'0 H'1 H'2 H'3. -rewrite <- H'3; auto. -Qed. - -(************************************** - A permutation of the nil list is the nil list - **************************************) - -Theorem permutation_nil_inv : forall l : list A, permutation l nil -> l = nil. -intros l H; generalize (permutation_length _ _ H); case l; simpl in |- *; - auto. -intros; discriminate. -Qed. - -(************************************** - A permutation of the singleton list is the singleton list - **************************************) - -Let permutation_one_inv_aux : - forall l1 l2 : list A, - permutation l1 l2 -> forall a : A, l1 = a :: nil -> l2 = a :: nil. -intros l1 l2 H; elim H; clear H l1 l2; auto. -intros a l3 l4 H0 H1 b H2. -injection H2; intros; subst; auto. -rewrite (permutation_nil_inv _ (permutation_sym _ _ H0)); auto. -intros; discriminate. -Qed. - -Theorem permutation_one_inv : - forall (a : A) (l : list A), permutation (a :: nil) l -> l = a :: nil. -intros a l H; apply permutation_one_inv_aux with (l1 := a :: nil); auto. -Qed. - -(************************************** - Compatibility with the belonging - **************************************) - -Theorem permutation_in : - forall (a : A) (l m : list A), permutation l m -> In a l -> In a m. -intros a l m H; elim H; simpl in |- *; auto; intuition. -Qed. - -(************************************** - Compatibility with the append function - **************************************) - -Theorem permutation_app_comp : - forall l1 l2 l3 l4, - permutation l1 l2 -> permutation l3 l4 -> permutation (l1 ++ l3) (l2 ++ l4). -intros l1 l2 l3 l4 H1; generalize l3 l4; elim H1; clear H1 l1 l2 l3 l4; - simpl in |- *; auto. -intros a b l l3 l4 H. -cut (permutation (l ++ l3) (l ++ l4)); auto. -intros; apply permutation_trans with (a :: b :: l ++ l4); auto. -elim l; simpl in |- *; auto. -intros l1 l2 l3 H H0 H1 H2 l4 l5 H3. -apply permutation_trans with (l2 ++ l4); auto. -Qed. -Hint Resolve permutation_app_comp. - -(************************************** - Swap two sublists - **************************************) - -Theorem permutation_app_swap : - forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1). -intros l1; elim l1; auto. -intros; rewrite <- app_nil_end; auto. -intros a l H l2. -replace (l2 ++ a :: l) with ((l2 ++ a :: nil) ++ l). -apply permutation_trans with (l ++ l2 ++ a :: nil); auto. -apply permutation_trans with (((a :: nil) ++ l2) ++ l); auto. -simpl in |- *; auto. -apply permutation_trans with (l ++ (a :: nil) ++ l2); auto. -apply permutation_sym; auto. -replace (l2 ++ a :: l) with ((l2 ++ a :: nil) ++ l). -apply permutation_app_comp; auto. -elim l2; simpl in |- *; auto. -intros a0 l0 H0. -apply permutation_trans with (a0 :: a :: l0); auto. -apply (app_ass l2 (a :: nil) l). -apply (app_ass l2 (a :: nil) l). -Qed. - -(************************************** - A transposition is a permutation - **************************************) - -Theorem permutation_transposition : - forall a b l1 l2 l3, - permutation (l1 ++ a :: l2 ++ b :: l3) (l1 ++ b :: l2 ++ a :: l3). -intros a b l1 l2 l3. -apply permutation_app_comp; auto. -change - (permutation ((a :: nil) ++ l2 ++ (b :: nil) ++ l3) - ((b :: nil) ++ l2 ++ (a :: nil) ++ l3)) in |- *. -repeat rewrite <- app_ass. -apply permutation_app_comp; auto. -apply permutation_trans with ((b :: nil) ++ (a :: nil) ++ l2); auto. -apply permutation_app_swap; auto. -repeat rewrite app_ass. -apply permutation_app_comp; auto. -apply permutation_app_swap; auto. -Qed. - -(************************************** - An element of a list can be put on top of the list to get a permutation - **************************************) - -Theorem in_permutation_ex : - forall a l, In a l -> exists l1 : list A, permutation (a :: l1) l. -intros a l; elim l; simpl in |- *; auto. -intros H; case H; auto. -intros a0 l0 H [H0| H0]. -exists l0; rewrite H0; auto. -case H; auto; intros l1 Hl1; exists (a0 :: l1). -apply permutation_trans with (a0 :: a :: l1); auto. -Qed. - -(************************************** - A permutation of a cons can be inverted - **************************************) - -Let permutation_cons_ex_aux : - forall (a : A) (l1 l2 : list A), - permutation l1 l2 -> - forall l11 l12 : list A, - l1 = l11 ++ a :: l12 -> - exists l3 : list A, - (exists l4 : list A, - l2 = l3 ++ a :: l4 /\ permutation (l11 ++ l12) (l3 ++ l4)). -intros a l1 l2 H; elim H; clear H l1 l2. -intros l11 l12; case l11; simpl in |- *; intros; discriminate. -intros a0 l1 l2 H H0 l11 l12; case l11; simpl in |- *. -exists (nil (A:=A)); exists l1; simpl in |- *; split; auto. -injection H1; intros; subst; auto. -injection H1; intros H2 H3; rewrite <- H2; auto. -intros a1 l111 H1. -case (H0 l111 l12); auto. -injection H1; auto. -intros l3 (l4, (Hl1, Hl2)). -exists (a0 :: l3); exists l4; split; simpl in |- *; auto. -injection H1; intros; subst; auto. -injection H1; intros H2 H3; rewrite H3; auto. -intros a0 b l l11 l12; case l11; simpl in |- *. -case l12; try (intros; discriminate). -intros a1 l0 H; exists (b :: nil); exists l0; simpl in |- *; split; auto. -injection H; intros; subst; auto. -injection H; intros H1 H2 H3; rewrite H2; auto. -intros a1 l111; case l111; simpl in |- *. -intros H; exists (nil (A:=A)); exists (a0 :: l12); simpl in |- *; split; auto. -injection H; intros; subst; auto. -injection H; intros H1 H2 H3; rewrite H3; auto. -intros a2 H1111 H; exists (a2 :: a1 :: H1111); exists l12; simpl in |- *; - split; auto. -injection H; intros; subst; auto. -intros l1 l2 l3 H H0 H1 H2 l11 l12 H3. -case H0 with (1 := H3). -intros l4 (l5, (Hl1, Hl2)). -case H2 with (1 := Hl1). -intros l6 (l7, (Hl3, Hl4)). -exists l6; exists l7; split; auto. -apply permutation_trans with (1 := Hl2); auto. -Qed. - -Theorem permutation_cons_ex : - forall (a : A) (l1 l2 : list A), - permutation (a :: l1) l2 -> - exists l3 : list A, - (exists l4 : list A, l2 = l3 ++ a :: l4 /\ permutation l1 (l3 ++ l4)). -intros a l1 l2 H. -apply (permutation_cons_ex_aux a (a :: l1) l2 H nil l1); simpl in |- *; auto. -Qed. - -(************************************** - A permutation can be simply inverted if the two list starts with a cons - **************************************) - -Theorem permutation_inv : - forall (a : A) (l1 l2 : list A), - permutation (a :: l1) (a :: l2) -> permutation l1 l2. -intros a l1 l2 H; case permutation_cons_ex with (1 := H). -intros l3 (l4, (Hl1, Hl2)). -apply permutation_trans with (1 := Hl2). -generalize Hl1; case l3; simpl in |- *; auto. -intros H1; injection H1; intros H2; rewrite H2; auto. -intros a0 l5 H1; injection H1; intros H2 H3; rewrite H2; rewrite H3; auto. -apply permutation_trans with (a0 :: l4 ++ l5); auto. -apply permutation_skip; apply permutation_app_swap. -apply (permutation_app_swap (a0 :: l4) l5). -Qed. - -(************************************** - Take a list and return tle list of all pairs of an element of the - list and the remaining list - **************************************) - -Fixpoint split_one (l : list A) : list (A * list A) := - match l with - | nil => nil (A:=A * list A) - | a :: l1 => - (a, l1) - :: map (fun p : A * list A => (fst p, a :: snd p)) (split_one l1) - end. - -(************************************** - The pairs of the list are a permutation - **************************************) - -Theorem split_one_permutation : - forall (a : A) (l1 l2 : list A), - In (a, l1) (split_one l2) -> permutation (a :: l1) l2. -intros a l1 l2; generalize a l1; elim l2; clear a l1 l2; simpl in |- *; auto. -intros a l1 H1; case H1. -intros a l H a0 l1 [H0| H0]. -injection H0; intros H1 H2; rewrite H2; rewrite H1; auto. -generalize H H0; elim (split_one l); simpl in |- *; auto. -intros H1 H2; case H2. -intros a1 l0 H1 H2 [H3| H3]; auto. -injection H3; intros H4 H5; (rewrite <- H4; rewrite <- H5). -apply permutation_trans with (a :: fst a1 :: snd a1); auto. -apply permutation_skip. -apply H2; auto. -case a1; simpl in |- *; auto. -Qed. - -(************************************** - All elements of the list are there - **************************************) - -Theorem split_one_in_ex : - forall (a : A) (l1 : list A), - In a l1 -> exists l2 : list A, In (a, l2) (split_one l1). -intros a l1; elim l1; simpl in |- *; auto. -intros H; case H. -intros a0 l H [H0| H0]; auto. -exists l; left; subst; auto. -case H; auto. -intros x H1; exists (a0 :: x); right; auto. -apply - (in_map (fun p : A * list A => (fst p, a0 :: snd p)) (split_one l) (a, x)); - auto. -Qed. - -(************************************** - An auxillary function to generate all permutations - **************************************) - -Fixpoint all_permutations_aux (l : list A) (n : nat) {struct n} : - list (list A) := - match n with - | O => nil :: nil - | S n1 => - flat_map - (fun p : A * list A => - map (cons (fst p)) (all_permutations_aux (snd p) n1)) ( - split_one l) - end. -(************************************** - Generate all the permutations - **************************************) - -Definition all_permutations (l : list A) := all_permutations_aux l (length l). - -(************************************** - All the elements of the list are permutations - **************************************) - -Let all_permutations_aux_permutation : - forall (n : nat) (l1 l2 : list A), - n = length l2 -> In l1 (all_permutations_aux l2 n) -> permutation l1 l2. -intros n; elim n; simpl in |- *; auto. -intros l1 l2; case l2. -simpl in |- *; intros H0 [H1| H1]. -rewrite <- H1; auto. -case H1. -simpl in |- *; intros; discriminate. -intros n0 H l1 l2 H0 H1. -case in_flat_map_ex with (1 := H1). -clear H1; intros x; case x; clear x; intros a1 l3 (H1, H2). -case in_map_inv with (1 := H2). -simpl in |- *; intros y (H3, H4). -rewrite H4; auto. -apply permutation_trans with (a1 :: l3); auto. -apply permutation_skip; auto. -apply H with (2 := H3). -apply eq_add_S. -apply trans_equal with (1 := H0). -change (length l2 = length (a1 :: l3)) in |- *. -apply permutation_length; auto. -apply permutation_sym; apply split_one_permutation; auto. -apply split_one_permutation; auto. -Qed. - -Theorem all_permutations_permutation : - forall l1 l2 : list A, In l1 (all_permutations l2) -> permutation l1 l2. -intros l1 l2 H; apply all_permutations_aux_permutation with (n := length l2); - auto. -Qed. - -(************************************** - A permutation is in the list - **************************************) - -Let permutation_all_permutations_aux : - forall (n : nat) (l1 l2 : list A), - n = length l2 -> permutation l1 l2 -> In l1 (all_permutations_aux l2 n). -intros n; elim n; simpl in |- *; auto. -intros l1 l2; case l2. -intros H H0; rewrite permutation_nil_inv with (1 := H0); auto with datatypes. -simpl in |- *; intros; discriminate. -intros n0 H l1; case l1. -intros l2 H0 H1; - rewrite permutation_nil_inv with (1 := permutation_sym _ _ H1) in H0; - discriminate. -clear l1; intros a1 l1 l2 H1 H2. -case (split_one_in_ex a1 l2); auto. -apply permutation_in with (1 := H2); auto with datatypes. -intros x H0. -apply in_flat_map with (b := (a1, x)); auto. -apply in_map; simpl in |- *. -apply H; auto. -apply eq_add_S. -apply trans_equal with (1 := H1). -change (length l2 = length (a1 :: x)) in |- *. -apply permutation_length; auto. -apply permutation_sym; apply split_one_permutation; auto. -apply permutation_inv with (a := a1). -apply permutation_trans with (1 := H2). -apply permutation_sym; apply split_one_permutation; auto. -Qed. - -Theorem permutation_all_permutations : - forall l1 l2 : list A, permutation l1 l2 -> In l1 (all_permutations l2). -intros l1 l2 H; unfold all_permutations in |- *; - apply permutation_all_permutations_aux; auto. -Qed. - -(************************************** - Permutation is decidable - **************************************) - -Definition permutation_dec : - (forall a b : A, {a = b} + {a <> b}) -> - forall l1 l2 : list A, {permutation l1 l2} + {~ permutation l1 l2}. -intros H l1 l2. -case (In_dec (list_eq_dec H) l1 (all_permutations l2)). -intros i; left; apply all_permutations_permutation; auto. -intros i; right; contradict i; apply permutation_all_permutations; auto. -Defined. - -End permutation. - -(************************************** - Hints - **************************************) - -Hint Constructors permutation. -Hint Resolve permutation_refl. -Hint Resolve permutation_app_comp. -Hint Resolve permutation_app_swap. - -(************************************** - Implicits - **************************************) - -Implicit Arguments permutation [A]. -Implicit Arguments split_one [A]. -Implicit Arguments all_permutations [A]. -Implicit Arguments permutation_dec [A]. - -(************************************** - Permutation is compatible with map - **************************************) - -Theorem permutation_map : - forall (A B : Set) (f : A -> B) l1 l2, - permutation l1 l2 -> permutation (map f l1) (map f l2). -intros A B f l1 l2 H; elim H; simpl in |- *; auto. -intros l0 l3 l4 H0 H1 H2 H3; apply permutation_trans with (2 := H3); auto. -Qed. -Hint Resolve permutation_map. - -(************************************** - Permutation of a map can be inverted - *************************************) - -Let permutation_map_ex_aux : - forall (A B : Set) (f : A -> B) l1 l2 l3, - permutation l1 l2 -> - l1 = map f l3 -> exists l4, permutation l4 l3 /\ l2 = map f l4. -intros A1 B1 f l1 l2 l3 H; generalize l3; elim H; clear H l1 l2 l3. -intros l3; case l3; simpl in |- *; auto. -intros H; exists (nil (A:=A1)); auto. -intros; discriminate. -intros a0 l1 l2 H H0 l3; case l3; simpl in |- *; auto. -intros; discriminate. -intros a1 l H1; case (H0 l); auto. -injection H1; auto. -intros l5 (H2, H3); exists (a1 :: l5); split; simpl in |- *; auto. -injection H1; intros; subst; auto. -intros a0 b l l3; case l3. -intros; discriminate. -intros a1 l0; case l0; simpl in |- *. -intros; discriminate. -intros a2 l1 H; exists (a2 :: a1 :: l1); split; simpl in |- *; auto. -injection H; intros; subst; auto. -intros l1 l2 l3 H H0 H1 H2 l0 H3. -case H0 with (1 := H3); auto. -intros l4 (HH1, HH2). -case H2 with (1 := HH2); auto. -intros l5 (HH3, HH4); exists l5; split; auto. -apply permutation_trans with (1 := HH3); auto. -Qed. - -Theorem permutation_map_ex : - forall (A B : Set) (f : A -> B) l1 l2, - permutation (map f l1) l2 -> - exists l3, permutation l3 l1 /\ l2 = map f l3. -intros A0 B f l1 l2 H; apply permutation_map_ex_aux with (l1 := map f l1); - auto. -Qed. - -(************************************** - Permutation is compatible with flat_map - **************************************) - -Theorem permutation_flat_map : - forall (A B : Set) (f : A -> list B) l1 l2, - permutation l1 l2 -> permutation (flat_map f l1) (flat_map f l2). -intros A B f l1 l2 H; elim H; simpl in |- *; auto. -intros a b l; auto. -repeat rewrite <- app_ass. -apply permutation_app_comp; auto. -intros k3 l4 l5 H0 H1 H2 H3; apply permutation_trans with (1 := H1); auto. -Qed. diff --git a/coqprime-8.5/Coqprime/Pmod.v b/coqprime-8.5/Coqprime/Pmod.v deleted file mode 100644 index f64af48e3..000000000 --- a/coqprime-8.5/Coqprime/Pmod.v +++ /dev/null @@ -1,617 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Require Export ZArith. -Require Export ZCmisc. - -Open Local Scope positive_scope. - -Open Local Scope P_scope. - -(* [div_eucl a b] return [(q,r)] such that a = q*b + r *) -Fixpoint div_eucl (a b : positive) {struct a} : N * N := - match a with - | xH => if 1 ?< b then (0%N, 1%N) else (1%N, 0%N) - | xO a' => - let (q, r) := div_eucl a' b in - match q, r with - | N0, N0 => (0%N, 0%N) (* n'arrive jamais *) - | N0, Npos r => - if (xO r) ?< b then (0%N, Npos (xO r)) - else (1%N,PminusN (xO r) b) - | Npos q, N0 => (Npos (xO q), 0%N) - | Npos q, Npos r => - if (xO r) ?< b then (Npos (xO q), Npos (xO r)) - else (Npos (xI q),PminusN (xO r) b) - end - | xI a' => - let (q, r) := div_eucl a' b in - match q, r with - | N0, N0 => (0%N, 0%N) (* Impossible *) - | N0, Npos r => - if (xI r) ?< b then (0%N, Npos (xI r)) - else (1%N,PminusN (xI r) b) - | Npos q, N0 => if 1 ?< b then (Npos (xO q), 1%N) else (Npos (xI q), 0%N) - | Npos q, Npos r => - if (xI r) ?< b then (Npos (xO q), Npos (xI r)) - else (Npos (xI q),PminusN (xI r) b) - end - end. -Infix "/" := div_eucl : P_scope. - -Open Scope Z_scope. -Opaque Zmult. -Lemma div_eucl_spec : forall a b, - Zpos a = fst (a/b)%P * b + snd (a/b)%P - /\ snd (a/b)%P < b. -Proof with zsimpl;try apply Zlt_0_pos;try ((ring;fail) || omega). - intros a b;generalize a;clear a;induction a;simpl;zsimpl. - case IHa; destruct (a/b)%P as [q r]. - case q; case r; simpl fst; simpl snd. - rewrite Zmult_0_l; rewrite Zplus_0_r; intros HH; discriminate HH. - intros p H; rewrite H; - match goal with - | [|- context [ ?xx ?< b ]] => - generalize (is_lt_spec xx b);destruct (xx ?< b) - | _ => idtac - end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto. - rewrite PminusN_le... - generalize H1; zsimpl; auto. - rewrite PminusN_le... - generalize H1; zsimpl; auto. - intros p H; rewrite H; - match goal with - | [|- context [ ?xx ?< b ]] => - generalize (is_lt_spec xx b);destruct (xx ?< b) - | _ => idtac - end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto; try ring. - ring_simplify. - case (Zle_lt_or_eq _ _ H1); auto with zarith. - intros p p1 H; rewrite H. - match goal with - | [|- context [ ?xx ?< b ]] => - generalize (is_lt_spec xx b);destruct (xx ?< b) - | _ => idtac - end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto; try ring. - rewrite PminusN_le... - generalize H1; zsimpl; auto. - rewrite PminusN_le... - generalize H1; zsimpl; auto. - case IHa; destruct (a/b)%P as [q r]. - case q; case r; simpl fst; simpl snd. - rewrite Zmult_0_l; rewrite Zplus_0_r; intros HH; discriminate HH. - intros p H; rewrite H; - match goal with - | [|- context [ ?xx ?< b ]] => - generalize (is_lt_spec xx b);destruct (xx ?< b) - | _ => idtac - end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto. - rewrite PminusN_le... - generalize H1; zsimpl; auto. - rewrite PminusN_le... - generalize H1; zsimpl; auto. - intros p H; rewrite H; simpl; intros H1; split; auto. - zsimpl; ring. - intros p p1 H; rewrite H. - match goal with - | [|- context [ ?xx ?< b ]] => - generalize (is_lt_spec xx b);destruct (xx ?< b) - | _ => idtac - end; zsimpl; simpl; intros H1 H2; split; zsimpl; auto; try ring. - rewrite PminusN_le... - generalize H1; zsimpl; auto. - rewrite PminusN_le... - generalize H1; zsimpl; auto. - match goal with - | [|- context [ ?xx ?< b ]] => - generalize (is_lt_spec xx b);destruct (xx ?< b) - | _ => idtac - end; zsimpl; simpl. - split; auto. - case (Zle_lt_or_eq 1 b); auto with zarith. - generalize (Zlt_0_pos b); auto with zarith. -Qed. -Transparent Zmult. - -(******** Definition du modulo ************) - -(* [mod a b] return [a] modulo [b] *) -Fixpoint Pmod (a b : positive) {struct a} : N := - match a with - | xH => if 1 ?< b then 1%N else 0%N - | xO a' => - let r := Pmod a' b in - match r with - | N0 => 0%N - | Npos r' => - if (xO r') ?< b then Npos (xO r') - else PminusN (xO r') b - end - | xI a' => - let r := Pmod a' b in - match r with - | N0 => if 1 ?< b then 1%N else 0%N - | Npos r' => - if (xI r') ?< b then Npos (xI r') - else PminusN (xI r') b - end - end. - -Infix "mod" := Pmod (at level 40, no associativity) : P_scope. -Open Local Scope P_scope. - -Lemma Pmod_div_eucl : forall a b, a mod b = snd (a/b). -Proof with auto. - intros a b;generalize a;clear a;induction a;simpl; - try (rewrite IHa; - assert (H1 := div_eucl_spec a b); destruct (a/b) as [q r]; - destruct q as [|q];destruct r as [|r];simpl in *; - match goal with - | [|- context [ ?xx ?< b ]] => - assert (H2 := is_lt_spec xx b);destruct (xx ?< b) - | _ => idtac - end;simpl) ... - destruct H1 as [H3 H4];discriminate H3. - destruct (1 ?< b);simpl ... -Qed. - -Lemma mod1: forall a, a mod 1 = 0%N. -Proof. induction a;simpl;try rewrite IHa;trivial. Qed. - -Lemma mod_a_a_0 : forall a, a mod a = N0. -Proof. - intros a;generalize (div_eucl_spec a a);rewrite <- Pmod_div_eucl. - destruct (fst (a / a));unfold Z_of_N at 1. - rewrite Zmult_0_l;intros (H1,H2);elimtype False;omega. - assert (a<=p*a). - pattern (Zpos a) at 1;rewrite <- (Zmult_1_l a). - assert (H1:= Zlt_0_pos p);assert (H2:= Zle_0_pos a); - apply Zmult_le_compat;trivial;try omega. - destruct (a mod a)%P;auto with zarith. - unfold Z_of_N;assert (H1:= Zlt_0_pos p0);intros (H2,H3);elimtype False;omega. -Qed. - -Lemma mod_le_2r : forall (a b r: positive) (q:N), - Zpos a = b*q + r -> b <= a -> r < b -> 2*r <= a. -Proof. - intros a b r q H0 H1 H2. - assert (H3:=Zlt_0_pos a). assert (H4:=Zlt_0_pos b). assert (H5:=Zlt_0_pos r). - destruct q as [|q]. rewrite Zmult_0_r in H0. elimtype False;omega. - assert (H6:=Zlt_0_pos q). unfold Z_of_N in H0. - assert (Zpos r = a - b*q). omega. - simpl;zsimpl. pattern r at 2;rewrite H. - assert (b <= b * q). - pattern (Zpos b) at 1;rewrite <- (Zmult_1_r b). - apply Zmult_le_compat;try omega. - apply Zle_trans with (a - b * q + b). omega. - apply Zle_trans with (a - b + b);omega. -Qed. - -Lemma mod_lt : forall a b r, a mod b = Npos r -> r < b. -Proof. - intros a b r H;generalize (div_eucl_spec a b);rewrite <- Pmod_div_eucl; - rewrite H;simpl;intros (H1,H2);omega. -Qed. - -Lemma mod_le : forall a b r, a mod b = Npos r -> r <= b. -Proof. intros a b r H;assert (H1:= mod_lt _ _ _ H);omega. Qed. - -Lemma mod_le_a : forall a b r, a mod b = r -> r <= a. -Proof. - intros a b r H;generalize (div_eucl_spec a b);rewrite <- Pmod_div_eucl; - rewrite H;simpl;intros (H1,H2). - assert (0 <= fst (a / b) * b). - destruct (fst (a / b));simpl;auto with zarith. - auto with zarith. -Qed. - -Lemma lt_mod : forall a b, Zpos a < Zpos b -> (a mod b)%P = Npos a. -Proof. - intros a b H; rewrite Pmod_div_eucl. case (div_eucl_spec a b). - assert (0 <= snd(a/b)). destruct (snd(a/b));simpl;auto with zarith. - destruct (fst (a/b)). - unfold Z_of_N at 1;rewrite Zmult_0_l;rewrite Zplus_0_l. - destruct (snd (a/b));simpl; intros H1 H2;inversion H1;trivial. - unfold Z_of_N at 1;assert (b <= p*b). - pattern (Zpos b) at 1; rewrite <- (Zmult_1_l (Zpos b)). - assert (H1 := Zlt_0_pos p);apply Zmult_le_compat;try omega. - apply Zle_0_pos. - intros;elimtype False;omega. -Qed. - -Fixpoint gcd_log2 (a b c:positive) {struct c}: option positive := - match a mod b with - | N0 => Some b - | Npos r => - match b mod r, c with - | N0, _ => Some r - | Npos r', xH => None - | Npos r', xO c' => gcd_log2 r r' c' - | Npos r', xI c' => gcd_log2 r r' c' - end - end. - -Fixpoint egcd_log2 (a b c:positive) {struct c}: - option (Z * Z * positive) := - match a/b with - | (_, N0) => Some (0, 1, b) - | (q, Npos r) => - match b/r, c with - | (_, N0), _ => Some (1, -q, r) - | (q', Npos r'), xH => None - | (q', Npos r'), xO c' => - match egcd_log2 r r' c' with - None => None - | Some (u', v', w') => - let u := u' - v' * q' in - Some (u, v' - q * u, w') - end - | (q', Npos r'), xI c' => - match egcd_log2 r r' c' with - None => None - | Some (u', v', w') => - let u := u' - v' * q' in - Some (u, v' - q * u, w') - end - end - end. - -Lemma egcd_gcd_log2: forall c a b, - match egcd_log2 a b c, gcd_log2 a b c with - None, None => True - | Some (u,v,r), Some r' => r = r' - | _, _ => False - end. -induction c; simpl; auto; try - (intros a b; generalize (Pmod_div_eucl a b); case (a/b); simpl; - intros q r1 H; subst; case (a mod b); auto; - intros r; generalize (Pmod_div_eucl b r); case (b/r); simpl; - intros q' r1 H; subst; case (b mod r); auto; - intros r'; generalize (IHc r r'); case egcd_log2; auto; - intros ((p1,p2),p3); case gcd_log2; auto). -Qed. - -Ltac rw l := - match l with - | (?r, ?r1) => - match type of r with - True => rewrite <- r1 - | _ => rw r; rw r1 - end - | ?r => rewrite r - end. - -Lemma egcd_log2_ok: forall c a b, - match egcd_log2 a b c with - None => True - | Some (u,v,r) => u * a + v * b = r - end. -induction c; simpl; auto; - intros a b; generalize (div_eucl_spec a b); case (a/b); - simpl fst; simpl snd; intros q r1; case r1; try (intros; ring); - simpl; intros r (Hr1, Hr2); clear r1; - generalize (div_eucl_spec b r); case (b/r); - simpl fst; simpl snd; intros q' r1; case r1; - try (intros; rewrite Hr1; ring); - simpl; intros r' (Hr'1, Hr'2); clear r1; auto; - generalize (IHc r r'); case egcd_log2; auto; - intros ((u',v'),w'); case gcd_log2; auto; intros; - rw ((I, H), Hr1, Hr'1); ring. -Qed. - - -Fixpoint log2 (a:positive) : positive := - match a with - | xH => xH - | xO a => Psucc (log2 a) - | xI a => Psucc (log2 a) - end. - -Lemma gcd_log2_1: forall a c, gcd_log2 a xH c = Some xH. -Proof. destruct c;simpl;try rewrite mod1;trivial. Qed. - -Lemma log2_Zle :forall a b, Zpos a <= Zpos b -> log2 a <= log2 b. -Proof with zsimpl;try omega. - induction a;destruct b;zsimpl;intros;simpl ... - assert (log2 a <= log2 b) ... apply IHa ... - assert (log2 a <= log2 b) ... apply IHa ... - assert (H1 := Zlt_0_pos a);elimtype False;omega. - assert (log2 a <= log2 b) ... apply IHa ... - assert (log2 a <= log2 b) ... apply IHa ... - assert (H1 := Zlt_0_pos a);elimtype False;omega. - assert (H1 := Zlt_0_pos (log2 b)) ... - assert (H1 := Zlt_0_pos (log2 b)) ... -Qed. - -Lemma log2_1_inv : forall a, Zpos (log2 a) = 1 -> a = xH. -Proof. - destruct a;simpl;zsimpl;intros;trivial. - assert (H1:= Zlt_0_pos (log2 a));elimtype False;omega. - assert (H1:= Zlt_0_pos (log2 a));elimtype False;omega. -Qed. - -Lemma mod_log2 : - forall a b r:positive, a mod b = Npos r -> b <= a -> log2 r + 1 <= log2 a. -Proof. - intros; cut (log2 (xO r) <= log2 a). simpl;zsimpl;trivial. - apply log2_Zle. - replace (Zpos (xO r)) with (2 * r)%Z;trivial. - generalize (div_eucl_spec a b);rewrite <- Pmod_div_eucl;rewrite H. - rewrite Zmult_comm;intros [H1 H2];apply mod_le_2r with b (fst (a/b));trivial. -Qed. - -Lemma gcd_log2_None_aux : - forall c a b, Zpos b <= Zpos a -> log2 b <= log2 c -> - gcd_log2 a b c <> None. -Proof. - induction c;simpl;intros; - (CaseEq (a mod b);[intros Heq|intros r Heq];try (intro;discriminate)); - (CaseEq (b mod r);[intros Heq'|intros r' Heq'];try (intro;discriminate)). - apply IHc. apply mod_le with b;trivial. - generalize H0 (mod_log2 _ _ _ Heq' (mod_le _ _ _ Heq));zsimpl;intros;omega. - apply IHc. apply mod_le with b;trivial. - generalize H0 (mod_log2 _ _ _ Heq' (mod_le _ _ _ Heq));zsimpl;intros;omega. - assert (Zpos (log2 b) = 1). - assert (H1 := Zlt_0_pos (log2 b));omega. - rewrite (log2_1_inv _ H1) in Heq;rewrite mod1 in Heq;discriminate Heq. -Qed. - -Lemma gcd_log2_None : forall a b, Zpos b <= Zpos a -> gcd_log2 a b b <> None. -Proof. intros;apply gcd_log2_None_aux;auto with zarith. Qed. - -Lemma gcd_log2_Zle : - forall c1 c2 a b, log2 c1 <= log2 c2 -> - gcd_log2 a b c1 <> None -> gcd_log2 a b c2 = gcd_log2 a b c1. -Proof with zsimpl;trivial;try omega. - induction c1;destruct c2;simpl;intros; - (destruct (a mod b) as [|r];[idtac | destruct (b mod r)]) ... - apply IHc1;trivial. generalize H;zsimpl;intros;omega. - apply IHc1;trivial. generalize H;zsimpl;intros;omega. - elim H;destruct (log2 c1);trivial. - apply IHc1;trivial. generalize H;zsimpl;intros;omega. - apply IHc1;trivial. generalize H;zsimpl;intros;omega. - elim H;destruct (log2 c1);trivial. - elim H0;trivial. elim H0;trivial. -Qed. - -Lemma gcd_log2_Zle_log : - forall a b c, log2 b <= log2 c -> Zpos b <= Zpos a -> - gcd_log2 a b c = gcd_log2 a b b. -Proof. - intros a b c H1 H2; apply gcd_log2_Zle; trivial. - apply gcd_log2_None; trivial. -Qed. - -Lemma gcd_log2_mod0 : - forall a b c, a mod b = N0 -> gcd_log2 a b c = Some b. -Proof. intros a b c H;destruct c;simpl;rewrite H;trivial. Qed. - - -Require Import Zwf. - -Lemma Zwf_pos : well_founded (fun x y => Zpos x < Zpos y). -Proof. - unfold well_founded. - assert (forall x a ,x = Zpos a -> Acc (fun x y : positive => x < y) a). - intros x;assert (Hacc := Zwf_well_founded 0 x);induction Hacc;intros;subst x. - constructor;intros. apply H0 with (Zpos y);trivial. - split;auto with zarith. - intros a;apply H with (Zpos a);trivial. -Qed. - -Opaque Pmod. -Lemma gcd_log2_mod : forall a b, Zpos b <= Zpos a -> - forall r, a mod b = Npos r -> gcd_log2 a b b = gcd_log2 b r r. -Proof. - intros a b;generalize a;clear a; assert (Hacc := Zwf_pos b). - induction Hacc; intros a Hle r Hmod. - rename x into b. destruct b;simpl;rewrite Hmod. - CaseEq (xI b mod r)%P;intros. rewrite gcd_log2_mod0;trivial. - assert (H2 := mod_le _ _ _ H1);assert (H3 := mod_lt _ _ _ Hmod); - assert (H4 := mod_le _ _ _ Hmod). - rewrite (gcd_log2_Zle_log r p b);trivial. - symmetry;apply H0;trivial. - generalize (mod_log2 _ _ _ H1 H4);simpl;zsimpl;intros;omega. - CaseEq (xO b mod r)%P;intros. rewrite gcd_log2_mod0;trivial. - assert (H2 := mod_le _ _ _ H1);assert (H3 := mod_lt _ _ _ Hmod); - assert (H4 := mod_le _ _ _ Hmod). - rewrite (gcd_log2_Zle_log r p b);trivial. - symmetry;apply H0;trivial. - generalize (mod_log2 _ _ _ H1 H4);simpl;zsimpl;intros;omega. - rewrite mod1 in Hmod;discriminate Hmod. -Qed. - -Lemma gcd_log2_xO_Zle : - forall a b, Zpos b <= Zpos a -> gcd_log2 a b (xO b) = gcd_log2 a b b. -Proof. - intros a b Hle;apply gcd_log2_Zle. - simpl;zsimpl;auto with zarith. - apply gcd_log2_None_aux;auto with zarith. -Qed. - -Lemma gcd_log2_xO_Zlt : - forall a b, Zpos a < Zpos b -> gcd_log2 a b (xO b) = gcd_log2 b a a. -Proof. - intros a b H;simpl. assert (Hlt := Zlt_0_pos a). - assert (H0 := lt_mod _ _ H). - rewrite H0;simpl. - CaseEq (b mod a)%P;intros;simpl. - symmetry;apply gcd_log2_mod0;trivial. - assert (H2 := mod_lt _ _ _ H1). - rewrite (gcd_log2_Zle_log a p b);auto with zarith. - symmetry;apply gcd_log2_mod;auto with zarith. - apply log2_Zle. - replace (Zpos p) with (Z_of_N (Npos p));trivial. - apply mod_le_a with a;trivial. -Qed. - -Lemma gcd_log2_x0 : forall a b, gcd_log2 a b (xO b) <> None. -Proof. - intros;simpl;CaseEq (a mod b)%P;intros. intro;discriminate. - CaseEq (b mod p)%P;intros. intro;discriminate. - assert (H1 := mod_le_a _ _ _ H0). unfold Z_of_N in H1. - assert (H2 := mod_le _ _ _ H0). - apply gcd_log2_None_aux. trivial. - apply log2_Zle. trivial. -Qed. - -Lemma egcd_log2_x0 : forall a b, egcd_log2 a b (xO b) <> None. -Proof. -intros a b H; generalize (egcd_gcd_log2 (xO b) a b) (gcd_log2_x0 a b); - rw H; case gcd_log2; auto. -Qed. - -Definition gcd a b := - match gcd_log2 a b (xO b) with - | Some p => p - | None => (* can not appear *) 1%positive - end. - -Definition egcd a b := - match egcd_log2 a b (xO b) with - | Some p => p - | None => (* can not appear *) (1,1,1%positive) - end. - - -Lemma gcd_mod0 : forall a b, (a mod b)%P = N0 -> gcd a b = b. -Proof. - intros a b H;unfold gcd. - pattern (gcd_log2 a b (xO b)) at 1; - rewrite (gcd_log2_mod0 _ _ (xO b) H);trivial. -Qed. - -Lemma gcd1 : forall a, gcd a xH = xH. -Proof. intros a;rewrite gcd_mod0;[trivial|apply mod1]. Qed. - -Lemma gcd_mod : forall a b r, (a mod b)%P = Npos r -> - gcd a b = gcd b r. -Proof. - intros a b r H;unfold gcd. - assert (log2 r <= log2 (xO r)). simpl;zsimpl;omega. - assert (H1 := mod_lt _ _ _ H). - pattern (gcd_log2 b r (xO r)) at 1; rewrite gcd_log2_Zle_log;auto with zarith. - destruct (Z_lt_le_dec a b) as [z|z]. - pattern (gcd_log2 a b (xO b)) at 1; rewrite gcd_log2_xO_Zlt;trivial. - rewrite (lt_mod _ _ z) in H;inversion H. - assert (r <= b). omega. - generalize (gcd_log2_None _ _ H2). - destruct (gcd_log2 b r r);intros;trivial. - assert (log2 b <= log2 (xO b)). simpl;zsimpl;omega. - pattern (gcd_log2 a b (xO b)) at 1; rewrite gcd_log2_Zle_log;auto with zarith. - pattern (gcd_log2 a b b) at 1;rewrite (gcd_log2_mod _ _ z _ H). - assert (r <= b). omega. - generalize (gcd_log2_None _ _ H3). - destruct (gcd_log2 b r r);intros;trivial. -Qed. - -Require Import ZArith. -Require Import Znumtheory. - -Hint Rewrite Zpos_mult times_Zmult square_Zmult Psucc_Zplus: zmisc. - -Ltac mauto := - trivial;autorewrite with zmisc;trivial;auto with zarith. - -Lemma gcd_Zis_gcd : forall a b:positive, (Zis_gcd b a (gcd b a)%P). -Proof with mauto. - intros a;assert (Hacc := Zwf_pos a);induction Hacc;rename x into a;intros. - generalize (div_eucl_spec b a)... - rewrite <- (Pmod_div_eucl b a). - CaseEq (b mod a)%P;[intros Heq|intros r Heq]; intros (H1,H2). - simpl in H1;rewrite Zplus_0_r in H1. - rewrite (gcd_mod0 _ _ Heq). - constructor;mauto. - apply Zdivide_intro with (fst (b/a)%P);trivial. - rewrite (gcd_mod _ _ _ Heq). - rewrite H1;apply Zis_gcd_sym. - rewrite Zmult_comm;apply Zis_gcd_for_euclid2;simpl in *. - apply Zis_gcd_sym;auto. -Qed. - -Lemma egcd_Zis_gcd : forall a b:positive, - let (uv,w) := egcd a b in - let (u,v) := uv in - u * a + v * b = w /\ (Zis_gcd b a w). -Proof with mauto. - intros a b; unfold egcd. - generalize (egcd_log2_ok (xO b) a b) (egcd_gcd_log2 (xO b) a b) - (egcd_log2_x0 a b) (gcd_Zis_gcd b a); unfold egcd, gcd. - case egcd_log2; try (intros ((u,v),w)); case gcd_log2; - try (intros; match goal with H: False |- _ => case H end); - try (intros _ _ H1; case H1; auto; fail). - intros; subst; split; try apply Zis_gcd_sym; auto. -Qed. - -Definition Zgcd a b := - match a, b with - | Z0, _ => b - | _, Z0 => a - | Zpos a, Zneg b => Zpos (gcd a b) - | Zneg a, Zpos b => Zpos (gcd a b) - | Zpos a, Zpos b => Zpos (gcd a b) - | Zneg a, Zneg b => Zpos (gcd a b) - end. - - -Lemma Zgcd_is_gcd : forall x y, Zis_gcd x y (Zgcd x y). -Proof. - destruct x;destruct y;simpl. - apply Zis_gcd_0. - apply Zis_gcd_sym;apply Zis_gcd_0. - apply Zis_gcd_sym;apply Zis_gcd_0. - apply Zis_gcd_0. - apply gcd_Zis_gcd. - apply Zis_gcd_sym;apply Zis_gcd_minus;simpl;apply gcd_Zis_gcd. - apply Zis_gcd_0. - apply Zis_gcd_minus;simpl;apply Zis_gcd_sym;apply gcd_Zis_gcd. - apply Zis_gcd_minus;apply Zis_gcd_minus;simpl;apply gcd_Zis_gcd. -Qed. - -Definition Zegcd a b := - match a, b with - | Z0, Z0 => (0,0,0) - | Zpos _, Z0 => (1,0,a) - | Zneg _, Z0 => (-1,0,-a) - | Z0, Zpos _ => (0,1,b) - | Z0, Zneg _ => (0,-1,-b) - | Zpos a, Zneg b => - match egcd a b with (u,v,w) => (u,-v, Zpos w) end - | Zneg a, Zpos b => - match egcd a b with (u,v,w) => (-u,v, Zpos w) end - | Zpos a, Zpos b => - match egcd a b with (u,v,w) => (u,v, Zpos w) end - | Zneg a, Zneg b => - match egcd a b with (u,v,w) => (-u,-v, Zpos w) end - end. - -Lemma Zegcd_is_egcd : forall x y, - match Zegcd x y with - (u,v,w) => u * x + v * y = w /\ Zis_gcd x y w /\ 0 <= w - end. -Proof. - assert (zx0: forall x, Zneg x = -x). - simpl; auto. - assert (zx1: forall x, -(-x) = x). - intro x; case x; simpl; auto. - destruct x;destruct y;simpl; try (split; [idtac|split]); - auto; try (red; simpl; intros; discriminate); - try (rewrite zx0; apply Zis_gcd_minus; try rewrite zx1; auto; - apply Zis_gcd_minus; try rewrite zx1; simpl; auto); - try apply Zis_gcd_0; try (apply Zis_gcd_sym;apply Zis_gcd_0); - generalize (egcd_Zis_gcd p p0); case egcd; intros (u,v) w (H1, H2); - split; repeat rewrite zx0; try (rewrite <- H1; ring); auto; - (split; [idtac | red; intros; discriminate]). - apply Zis_gcd_sym; auto. - apply Zis_gcd_sym; apply Zis_gcd_minus; rw zx1; - apply Zis_gcd_sym; auto. - apply Zis_gcd_minus; rw zx1; auto. - apply Zis_gcd_minus; rw zx1; auto. - apply Zis_gcd_minus; rw zx1; auto. - apply Zis_gcd_sym; auto. -Qed. diff --git a/coqprime-8.5/Coqprime/Pocklington.v b/coqprime-8.5/Coqprime/Pocklington.v deleted file mode 100644 index 9871cd3e6..000000000 --- a/coqprime-8.5/Coqprime/Pocklington.v +++ /dev/null @@ -1,261 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Require Import ZArith. -Require Export Znumtheory. -Require Import Tactic. -Require Import ZCAux. -Require Import Zp. -Require Import FGroup. -Require Import EGroup. -Require Import Euler. - -Open Scope Z_scope. - -Theorem Pocklington: -forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> - (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> - forall n, prime n -> (n | N) -> n mod F1 = 1. -intros N F1 R1 HF1 HR1 Neq Rec n Hn H. -assert (HN: 1 < N). -assert (0 < N - 1); auto with zarith. -rewrite Neq; auto with zarith. -apply Zlt_le_trans with (1* R1); auto with zarith. -assert (Hn1: 1 < n); auto with zarith. -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -assert (H1: (F1 | n - 1)). -2: rewrite <- (Zmod_small 1 F1); auto with zarith. -2: case H1; intros k H1'. -2: replace n with (1 + (n - 1)); auto with zarith. -2: rewrite H1'; apply Z_mod_plus; auto with zarith. -apply Zdivide_Zpower; auto with zarith. -intros p i Hp Hi HiF1. -case (Rec p); auto. -apply Zdivide_trans with (2 := HiF1). -apply Zpower_divide; auto with zarith. -intros a (Ha1, (Ha2, Ha3)). -assert (HNn: a ^ (N - 1) mod n = 1). -apply Zdivide_mod_minus; auto with zarith. -apply Zdivide_trans with (1 := H). -apply Zmod_divide_minus; auto with zarith. -assert (~(n | a)). -intros H1; absurd (0 = 1); auto with zarith. -rewrite <- HNn; auto. -apply sym_equal; apply Zdivide_mod; auto with zarith. -apply Zdivide_trans with (1 := H1); apply Zpower_divide; auto with zarith. -assert (Hr: rel_prime a n). -apply rel_prime_sym; apply prime_rel_prime; auto. -assert (Hz: 0 < Zorder a n). -apply Zorder_power_pos; auto. -apply Zdivide_trans with (Zorder a n). -apply prime_divide_Zpower_Zdiv with (N - 1); auto with zarith. -apply Zorder_div_power; auto with zarith. -intros H1; absurd (1 < n); auto; apply Zle_not_lt; apply Zdivide_le; auto with zarith. -rewrite <- Ha3; apply Zdivide_Zgcd; auto with zarith. -apply Zmod_divide_minus; auto with zarith. -case H1; intros t Ht; rewrite Ht. -assert (Ht1: 0 <= t). -apply Zmult_le_reg_r with (Zorder a n); auto with zarith. -rewrite Zmult_0_l; rewrite <- Ht. -apply Zge_le; apply Z_div_ge0; auto with zarith. -apply Zlt_gt; apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -rewrite Zmult_comm; rewrite Zpower_mult; auto with zarith. -rewrite Zpower_mod; auto with zarith. -rewrite Zorder_power_is_1; auto with zarith. -rewrite Zpower_1_l; auto with zarith. -apply Zmod_small; auto with zarith. -apply Zdivide_trans with (1:= HiF1); rewrite Neq; apply Zdivide_factor_r. -apply Zorder_div; auto. -Qed. - -Theorem PocklingtonCorollary1: -forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> N < F1 * F1 -> - (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> - prime N. -intros N F1 R1 H H1 H2 H3 H4; case (prime_dec N); intros H5; auto. -assert (HN: 1 < N). -assert (0 < N - 1); auto with zarith. -rewrite H2; auto with zarith. -apply Zlt_le_trans with (1* R1); auto with zarith. -case Zdivide_div_prime_le_square with (2:= H5); auto with zarith. -intros n (Hn, (Hn1, Hn2)). -assert (Hn3: 0 <= n). -apply Zle_trans with 2; try apply prime_ge_2; auto with zarith. -absurd (n = 1). -intros H6; contradict Hn; subst; apply not_prime_1. -rewrite <- (Zmod_small n F1); try split; auto. -apply Pocklington with (R1 := R1) (4 := H4); auto. -apply Zlt_square_mult_inv; auto with zarith. -Qed. - -Theorem PocklingtonCorollary2: -forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> - (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> - forall n, 0 <= n -> (n | N) -> n mod F1 = 1. -intros N F1 R1 H1 H2 H3 H4 n H5; pattern n; apply prime_induction; auto. -assert (HN: 1 < N). -assert (0 < N - 1); auto with zarith. -rewrite H3; auto with zarith. -apply Zlt_le_trans with (1* R1); auto with zarith. -intros (u, Hu); contradict HN; subst; rewrite Zmult_0_r; auto with zarith. -intro H6; rewrite Zmod_small; auto with zarith. -intros p q Hp Hp1 Hp2; rewrite Zmult_mod; auto with zarith. -rewrite Pocklington with (n := p) (R1 := R1) (4 := H4); auto. -rewrite Hp1. -rewrite Zmult_1_r; rewrite Zmod_small; auto with zarith. -apply Zdivide_trans with (2 := Hp2); apply Zdivide_factor_l. -apply Zdivide_trans with (2 := Hp2); apply Zdivide_factor_r; auto. -Qed. - -Definition isSquare x := exists y, x = y * y. - -Theorem PocklingtonExtra: -forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> Zeven F1 -> Zodd R1 -> - (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> - forall m, 1 <= m -> (forall l, 1 <= l < m -> ~((l * F1 + 1) | N)) -> - let s := (R1 / (2 * F1)) in - let r := (R1 mod (2 * F1)) in - N < (m * F1 + 1) * (2 * F1 * F1 + (r - m) * F1 + 1) -> - (s = 0 \/ ~ isSquare (r * r - 8 * s)) -> prime N. -intros N F1 R1 H1 H2 H3 OF1 ER1 H4 m H5 H6 s r H7 H8. -case (prime_dec N); auto; intros H9. -assert (HN: 1 < N). -assert (0 < N - 1); auto with zarith. -rewrite H3; auto with zarith. -apply Zlt_le_trans with (1* R1); auto with zarith. -case Zdivide_div_prime_le_square with N; auto. -intros X (Hx1, (Hx2, Hx3)). -assert (Hx0: 1 < X). -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -pose (c := (X / F1)). -assert(Hc1: 0 <= c); auto with zarith. -apply Zge_le; unfold c; apply Z_div_ge0; auto with zarith. -assert (Hc2: X = c * F1 + 1). -rewrite (Z_div_mod_eq X F1); auto with zarith. -eq_tac; auto. -rewrite (Zmult_comm F1); auto. -apply PocklingtonCorollary2 with (R1 := R1) (4 := H4); auto with zarith. -case Zle_lt_or_eq with (1 := Hc1); clear Hc1; intros Hc1. -2: contradict Hx0; rewrite Hc2; try rewrite <- Hc1; auto with zarith. -case (Zle_or_lt m c); intros Hc3. -2: case Zle_lt_or_eq with (1 := H5); clear H5; intros H5; auto with zarith. -2: case (H6 c); auto with zarith; rewrite <- Hc2; auto. -2: contradict Hc3; rewrite <- H5; auto with zarith. -pose (d := ((N / X) / F1)). -assert(Hd0: 0 <= N / X); try apply Z_div_pos; auto with zarith. -(* -apply Zge_le; unfold d; repeat apply Z_div_ge0; auto with zarith. -*) -assert(Hd1: 0 <= d); auto with zarith. -apply Zge_le; unfold d; repeat apply Z_div_ge0; auto with zarith. -assert (Hd2: N / X = d * F1 + 1). -rewrite (Z_div_mod_eq (N / X) F1); auto with zarith. -eq_tac; auto. -rewrite (Zmult_comm F1); auto. -apply PocklingtonCorollary2 with (R1 := R1) (4 := H4); auto with zarith. -exists X; auto with zarith. -apply Zdivide_Zdiv_eq; auto with zarith. -case Zle_lt_or_eq with (1 := Hd0); clear Hd0; intros Hd0. -2: contradict HN; rewrite (Zdivide_Zdiv_eq X N); auto with zarith. -2: rewrite <- Hd0; auto with zarith. -case (Zle_lt_or_eq 1 (N / X)); auto with zarith; clear Hd0; intros Hd0. -2: contradict H9; rewrite (Zdivide_Zdiv_eq X N); auto with zarith. -2: rewrite <- Hd0; rewrite Zmult_1_r; auto with zarith. -case Zle_lt_or_eq with (1 := Hd1); clear Hd1; intros Hd1. -2: contradict Hd0; rewrite Hd2; try rewrite <- Hd1; auto with zarith. -case (Zle_or_lt m d); intros Hd3. -2: case Zle_lt_or_eq with (1 := H5); clear H5; intros H5; auto with zarith. -2: case (H6 d); auto with zarith; rewrite <- Hd2; auto. -2: exists X; auto with zarith. -2: apply Zdivide_Zdiv_eq; auto with zarith. -2: contradict Hd3; rewrite <- H5; auto with zarith. -assert (L5: N = (c * F1 + 1) * (d * F1 + 1)). -rewrite <- Hc2; rewrite <- Hd2; apply Zdivide_Zdiv_eq; auto with zarith. -assert (L6: R1 = c * d * F1 + c + d). -apply trans_equal with ((N - 1) / F1). -rewrite H3; rewrite Zmult_comm; apply sym_equal; apply Z_div_mult; auto with zarith. -rewrite L5. -match goal with |- (?X / ?Y = ?Z) => replace X with (Z * Y) end; try ring; apply Z_div_mult; auto with zarith. -assert (L6_1: Zodd (c + d)). -case (Zeven_odd_dec (c + d)); auto; intros O1. -contradict ER1; apply Zeven_not_Zodd; rewrite L6; rewrite <- Zplus_assoc; apply Zeven_plus_Zeven; auto. -apply Zeven_mult_Zeven_r; auto. -assert (L6_2: Zeven (c * d)). -case (Zeven_odd_dec c); intros HH1. -apply Zeven_mult_Zeven_l; auto. -case (Zeven_odd_dec d); intros HH2. -apply Zeven_mult_Zeven_r; auto. -contradict L6_1; apply Zeven_not_Zodd; apply Zodd_plus_Zodd; auto. -assert ((c + d) mod (2 * F1) = r). -rewrite <- Z_mod_plus with (b := Zdiv2 (c * d)); auto with zarith. -match goal with |- ?X mod _ = _ => replace X with R1 end; auto. -rewrite L6; pattern (c * d) at 1. -rewrite Zeven_div2 with (1 := L6_2); ring. -assert (L9: c + d - r < 2 * F1). -apply Zplus_lt_reg_r with (r - m). -apply Zmult_lt_reg_r with (F1); auto with zarith. -apply Zplus_lt_reg_r with 1. -match goal with |- ?X < ?Y => - replace Y with (2 * F1 * F1 + (r - m) * F1 + 1); try ring; - replace X with ((((c + d) - m) * F1) + 1); try ring -end. -apply Zmult_lt_reg_r with (m * F1 + 1); auto with zarith. -apply Zlt_trans with (m * F1 + 0); auto with zarith. -rewrite Zplus_0_r; apply Zmult_lt_O_compat; auto with zarith. -repeat rewrite (fun x => Zmult_comm x (m * F1 + 1)). -apply Zle_lt_trans with (2 := H7). -rewrite L5. -match goal with |- ?X <= ?Y => - replace X with ((m * (c + d) - m * m ) * F1 * F1 + (c + d) * F1 + 1); try ring; - replace Y with ((c * d) * F1 * F1 + (c + d) * F1 + 1); try ring -end. -repeat apply Zplus_le_compat_r. -repeat apply Zmult_le_compat_r; auto with zarith. -assert (tmp: forall p q, 0 <= p - q -> q <= p); auto with zarith; try apply tmp. -match goal with |- _ <= ?X => - replace X with ((c - m) * (d - m)); try ring; auto with zarith -end. -assert (L10: c + d = r). -apply Zmod_closeby_eq with (2 * F1); auto with zarith. -unfold r; apply Z_mod_lt; auto with zarith. -assert (L11: 2 * s = c * d). -apply Zmult_reg_r with F1; auto with zarith. -apply trans_equal with (R1 - (c + d)). -rewrite L10; rewrite (Z_div_mod_eq R1 (2 * F1)); auto with zarith. -unfold s, r; ring. -rewrite L6; ring. -case H8; intro H10. -absurd (0 < c * d); auto with zarith. -apply Zmult_lt_O_compat; auto with zarith. -case H10; exists (c - d); auto with zarith. -rewrite <- L10. -replace (8 * s) with (4 * (2 * s)); auto with zarith; try rewrite L11; ring. -Qed. - -Theorem PocklingtonExtraCorollary: -forall N F1 R1, 1 < F1 -> 0 < R1 -> N - 1 = F1 * R1 -> Zeven F1 -> Zodd R1 -> - (forall p, prime p -> (p | F1) -> exists a, 1 < a /\ a^(N - 1) mod N = 1 /\ Zgcd (a ^ ((N - 1)/ p) - 1) N = 1) -> - let s := (R1 / (2 * F1)) in - let r := (R1 mod (2 * F1)) in - N < 2 * F1 * F1 * F1 -> (s = 0 \/ ~ isSquare (r * r - 8 * s)) -> prime N. -intros N F1 R1 H1 H2 H3 OF1 ER1 H4 s r H5 H6. -apply PocklingtonExtra with (6 := H4) (R1 := R1) (m := 1); auto with zarith. -apply Zlt_le_trans with (1 := H5). -match goal with |- ?X <= ?K * ((?Y + ?Z) + ?T) => - rewrite <- (Zplus_0_l X); - replace (K * ((Y + Z) + T)) with ((F1 * (Z + T) + Y + Z + T) + X);[idtac | ring] -end. -apply Zplus_le_compat_r. -case (Zle_lt_or_eq 0 r); unfold r; auto with zarith. -case (Z_mod_lt R1 (2 * F1)); auto with zarith. -intros HH; repeat ((rewrite <- (Zplus_0_r 0); apply Zplus_le_compat)); auto with zarith. -intros HH; contradict ER1; apply Zeven_not_Zodd. -rewrite (Z_div_mod_eq R1 (2 * F1)); auto with zarith. -rewrite <- HH; rewrite Zplus_0_r. -rewrite <- Zmult_assoc; apply Zeven_2p. -Qed. diff --git a/coqprime-8.5/Coqprime/PocklingtonCertificat.v b/coqprime-8.5/Coqprime/PocklingtonCertificat.v deleted file mode 100644 index ecf4462ed..000000000 --- a/coqprime-8.5/Coqprime/PocklingtonCertificat.v +++ /dev/null @@ -1,756 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Require Import List. -Require Import ZArith. -Require Import Zorder. -Require Import ZCAux. -Require Import LucasLehmer. -Require Import Pocklington. -Require Import ZCmisc. -Require Import Pmod. - -Definition dec_prime := list (positive * positive). - -Inductive singleCertif : Set := - | Proof_certif : forall N:positive, prime N -> singleCertif - | Lucas_certif : forall (n:positive) (p: Z), singleCertif - | Pock_certif : forall N a : positive, dec_prime -> positive -> singleCertif - | SPock_certif : forall N a : positive, dec_prime -> singleCertif - | Ell_certif: forall (N S: positive) (l: list (positive * positive)) - (A B x y: Z), singleCertif. - -Definition Certif := list singleCertif. - -Definition nprim sc := - match sc with - | Proof_certif n _ => n - | Lucas_certif n _ => n - | Pock_certif n _ _ _ => n - | SPock_certif n _ _ => n - | Ell_certif n _ _ _ _ _ _ => n - - end. - -Open Scope positive_scope. -Open Scope P_scope. - -Fixpoint pow (a p:positive) {struct p} : positive := - match p with - | xH => a - | xO p' =>let z := pow a p' in square z - | xI p' => let z := pow a p' in square z * a - end. - -Definition mkProd' (l:dec_prime) := - fold_right (fun (k:positive*positive) r => times (fst k) r) 1%positive l. - -Definition mkProd_pred (l:dec_prime) := - fold_right (fun (k:positive*positive) r => - if ((snd k) ?= 1)%P then r else times (pow (fst k) (Ppred (snd k))) r) - 1%positive l. - -Definition mkProd (l:dec_prime) := - fold_right (fun (k:positive*positive) r => times (pow (fst k) (snd k)) r) 1%positive l. - -(* [pow_mod a m n] return [a^m mod n] *) -Fixpoint pow_mod (a m n : positive) {struct m} : N := - match m with - | xH => (a mod n)%P - | xO m' => - let z := pow_mod a m' n in - match z with - | N0 => 0%N - | Npos z' => ((square z') mod n)%P - end - | xI m' => - let z := pow_mod a m' n in - match z with - | N0 => 0%N - | Npos z' => (((square z') * a)%P mod n)%P - end - end. - -Definition Npow_mod a m n := - match a with - | N0 => 0%N - | Npos a => pow_mod a m n - end. - -(* [fold_pow_mod a [q1,_;...;qn,_]] b = a ^(q1*...*qn) mod b *) -(* invariant a mod N = a *) -Definition fold_pow_mod a l n := - fold_left - (fun a' (qp:positive*positive) => Npow_mod a' (fst qp) n) - l a. - -Definition times_mod x y n := - match x, y with - | N0, _ => N0 - | _, N0 => N0 - | Npos x, Npos y => ((x * y)%P mod n) - end. - -Definition Npred_mod p n := - match p with - | N0 => Npos (Ppred n) - | Npos p => - if (p ?= 1) then N0 - else Npos (Ppred p) - end. - -Fixpoint all_pow_mod (prod a : N) (l:dec_prime) (n:positive) {struct l}: N*N := - match l with - | nil => (prod,a) - | (q,_) :: l => - let m := Npred_mod (fold_pow_mod a l n) n in - all_pow_mod (times_mod prod m n) (Npow_mod a q n) l n - end. - -Fixpoint pow_mod_pred (a:N) (l:dec_prime) (n:positive) {struct l} : N := - match l with - | nil => a - | (q,p)::l => - if (p ?= 1) then pow_mod_pred a l n - else - let a' := iter_pos _ (fun x => Npow_mod x q n) a (Ppred p) in - pow_mod_pred a' l n - end. - -Definition is_odd p := - match p with - | xO _ => false - | _ => true - end. - -Definition is_even p := - match p with - | xO _ => true - | _ => false - end. - -Definition check_s_r s r sqrt := - match s with - | N0 => true - | Npos p => - match (Zminus (square r) (xO (xO (xO p)))) with - | Zpos x => - let sqrt2 := square sqrt in - let sqrt12 := square (Psucc sqrt) in - if sqrt2 ?< x then x ?< sqrt12 - else false - | Zneg _ => true - | Z0 => false - end - end. - -Definition test_pock N a dec sqrt := - if (2 ?< N) then - let Nm1 := Ppred N in - let F1 := mkProd dec in - match Nm1 / F1 with - | (Npos R1, N0) => - if is_odd R1 then - if is_even F1 then - if (1 ?< a) then - let (s,r') := (R1 / (xO F1))in - match r' with - | Npos r => - let A := pow_mod_pred (pow_mod a R1 N) dec N in - match all_pow_mod 1%N A dec N with - | (Npos p, Npos aNm1) => - if (aNm1 ?= 1) then - if gcd p N ?= 1 then - if check_s_r s r sqrt then - (N ?< (times ((times ((xO F1)+r+1) F1) + r) F1) + 1) - else false - else false - else false - | _ => false - end - | _ => false - end - else false - else false - else false - | _=> false - end - else false. - -Fixpoint is_in (p : positive) (lc : Certif) {struct lc} : bool := - match lc with - | nil => false - | c :: l => if p ?= (nprim c) then true else is_in p l - end. - -Fixpoint all_in (lc : Certif) (lp : dec_prime) {struct lp} : bool := - match lp with - | nil => true - | (p,_) :: lp => - if all_in lc lp - then is_in p lc - else false - end. - -Definition gt2 n := - match n with - | Zpos p => (2 ?< p)%positive - | _ => false - end. - -Fixpoint test_Certif (lc : Certif) : bool := - match lc with - | nil => true - | (Proof_certif _ _) :: lc => test_Certif lc - | (Lucas_certif n p) :: lc => - if test_Certif lc then - if gt2 p then - match Mp p with - | Zpos n' => - if (n ?= n') then - match SS p with - | Z0 => true - | _ => false - end - else false - | _ => false - end - else false - else false - | (Pock_certif n a dec sqrt) :: lc => - if test_pock n a dec sqrt then - if all_in lc dec then test_Certif lc else false - else false -(* Shoudl be done later to do it with Z *) - | (SPock_certif n a dec) :: lc => false - | (Ell_certif _ _ _ _ _ _ _):: lc => false - end. - -Lemma pos_eq_1_spec : - forall p, - if (p ?= 1)%P then p = xH - else (1 < p). -Proof. - unfold Zlt;destruct p;simpl; auto; red;reflexivity. -Qed. - -Open Scope Z_scope. -Lemma mod_unique : forall b q1 r1 q2 r2, - 0 <= r1 < b -> - 0 <= r2 < b -> - b * q1 + r1 = b * q2 + r2 -> - q1 = q2 /\ r1 = r2. -Proof with auto with zarith. - intros b q1 r1 q2 r2 H1 H2 H3. - assert (r2 = (b * q1 + r1) -b*q2). rewrite H3;ring. - assert (b*(q2 - q1) = r1 - r2 ). rewrite H;ring. - assert (-b < r1 - r2 < b). omega. - destruct (Ztrichotomy q1 q2) as [H5 | [H5 | H5]]. - assert (q2 - q1 >= 1). omega. - assert (r1- r2 >= b). - rewrite <- H0. - pattern b at 2; replace b with (b*1). - apply Zmult_ge_compat_l; omega. ring. - elimtype False; omega. - split;trivial. rewrite H;rewrite H5;ring. - assert (r1- r2 <= -b). - rewrite <- H0. - replace (-b) with (b*(-1)); try (ring;fail). - apply Zmult_le_compat_l; omega. - elimtype False; omega. -Qed. - -Lemma Zge_0_pos : forall p:positive, p>= 0. -Proof. - intros;unfold Zge;simpl;intro;discriminate. -Qed. - -Lemma Zge_0_pos_add : forall p:positive, p+p>= 0. -Proof. - intros;simpl;apply Zge_0_pos. -Qed. - -Hint Resolve Zpower_gt_0 Zlt_0_pos Zge_0_pos Zlt_le_weak Zge_0_pos_add: zmisc. - -Hint Rewrite Zpos_mult Zpower_mult Zpower_1_r Zmod_mod Zpower_exp - times_Zmult square_Zmult Psucc_Zplus: zmisc. - -Ltac mauto := - trivial;autorewrite with zmisc;trivial;auto with zmisc zarith. - -Lemma mod_lt : forall a (b:positive), a mod b < b. -Proof. - intros a b;destruct (Z_mod_lt a b);mauto. -Qed. -Hint Resolve mod_lt : zmisc. - -Lemma Zmult_mod_l : forall (n:positive) a b, (a mod n * b) mod n = (a * b) mod n. -Proof with mauto. - intros;rewrite Zmult_mod ... rewrite (Zmult_mod a) ... -Qed. - -Lemma Zmult_mod_r : forall (n:positive) a b, (a * (b mod n)) mod n = (a * b) mod n. -Proof with mauto. - intros;rewrite Zmult_mod ... rewrite (Zmult_mod a) ... -Qed. - -Lemma Zminus_mod_l : forall (n:positive) a b, (a mod n - b) mod n = (a - b) mod n. -Proof with mauto. - intros;rewrite Zminus_mod ... rewrite (Zminus_mod a) ... -Qed. - -Lemma Zminus_mod_r : forall (n:positive) a b, (a - (b mod n)) mod n = (a - b) mod n. -Proof with mauto. - intros;rewrite Zminus_mod ... rewrite (Zminus_mod a) ... -Qed. - -Hint Rewrite Zmult_mod_l Zmult_mod_r Zminus_mod_l Zminus_mod_r : zmisc. -Hint Rewrite <- Zpower_mod : zmisc. - -Lemma Pmod_Zmod : forall a b, Z_of_N (a mod b)%P = a mod b. -Proof. - intros a b; rewrite Pmod_div_eucl. - assert (b>0). mauto. - unfold Zmod; assert (H1 := Z_div_mod a b H). - destruct (Zdiv_eucl a b) as (q2, r2). - assert (H2 := div_eucl_spec a b). - assert (Z_of_N (fst (a / b)%P) = q2 /\ Z_of_N (snd (a/b)%P) = r2). - destruct H1;destruct H2. - apply mod_unique with b;mauto. - split;mauto. - unfold Zle;destruct (snd (a / b)%P);intro;discriminate. - rewrite <- H0;symmetry;rewrite Zmult_comm;trivial. - destruct H0;auto. -Qed. -Hint Rewrite Pmod_Zmod : zmisc. - -Lemma Zpower_0 : forall p : positive, 0^p = 0. -Proof. - intros;simpl;destruct p;unfold Zpower_pos;simpl;trivial. - generalize (iter_pos Z (Z.mul 0) 1 p). - induction p;simpl;trivial. -Qed. - -Lemma pow_Zpower : forall a p, Zpos (pow a p) = a ^ p. -Proof. - induction p; mauto; simpl; mauto; rewrite IHp; mauto. -Qed. -Hint Rewrite pow_Zpower : zmisc. - -Lemma pow_mod_spec : forall n a m, Z_of_N (pow_mod a m n) = a^m mod n. -Proof. - induction m; mauto; simpl; intros; mauto. - rewrite Zmult_mod; auto with zmisc. - rewrite (Zmult_mod (a^m)(a^m)); auto with zmisc. - rewrite <- IHm; mauto. - destruct (pow_mod a m n); mauto. - rewrite (Zmult_mod (a^m)(a^m)); auto with zmisc. - rewrite <- IHm. destruct (pow_mod a m n);simpl; mauto. -Qed. -Hint Rewrite pow_mod_spec Zpower_0 : zmisc. - -Lemma Npow_mod_spec : forall a p n, Z_of_N (Npow_mod a p n) = a^p mod n. -Proof. - intros a p n;destruct a; mauto; simpl; mauto. -Qed. -Hint Rewrite Npow_mod_spec : zmisc. - -Lemma iter_Npow_mod_spec : forall n q p a, - Z_of_N (iter_pos N (fun x : N => Npow_mod x q n) a p) = a^q^p mod n. -Proof. - induction p; mauto; intros; simpl Pos.iter; mauto; repeat rewrite IHp. - rewrite (Zpower_mod ((a ^ q ^ p) ^ q ^ p));auto with zmisc. - rewrite (Zpower_mod (a ^ q ^ p)); mauto. - mauto. -Qed. -Hint Rewrite iter_Npow_mod_spec : zmisc. - -Lemma fold_pow_mod_spec : forall (n:positive) l (a:N), - Z_of_N a = a mod n -> - Z_of_N (fold_pow_mod a l n) = a^(mkProd' l) mod n. -Proof. - unfold fold_pow_mod;induction l; simpl fold_left; simpl mkProd'; - intros; mauto. - rewrite IHl; mauto. -Qed. -Hint Rewrite fold_pow_mod_spec : zmisc. - -Lemma pow_mod_pred_spec : forall (n:positive) l (a:N), - Z_of_N a = a mod n -> - Z_of_N (pow_mod_pred a l n) = a^(mkProd_pred l) mod n. -Proof. - unfold pow_mod_pred;induction l;simpl mkProd;intros; mauto. - destruct a as (q,p). - simpl mkProd_pred. - destruct (p ?= 1)%P; rewrite IHl; mauto; simpl. -Qed. -Hint Rewrite pow_mod_pred_spec : zmisc. - -Lemma mkProd_pred_mkProd : forall l, - (mkProd_pred l)*(mkProd' l) = mkProd l. -Proof. - induction l;simpl;intros; mauto. - generalize (pos_eq_1_spec (snd a)); destruct (snd a ?= 1)%P;intros. - rewrite H; mauto. - replace (mkProd_pred l * (fst a * mkProd' l)) with - (fst a *(mkProd_pred l * mkProd' l));try ring. - rewrite IHl; mauto. - rewrite Zmult_assoc. rewrite times_Zmult. - rewrite (Zmult_comm (pow (fst a) (Ppred (snd a)) * mkProd_pred l)). - rewrite Zmult_assoc. rewrite pow_Zpower. rewrite <-Ppred_Zminus;trivial. - rewrite <- Zpower_Zsucc; try omega. - replace (Zsucc (snd a - 1)) with ((snd a - 1)+1). - replace ((snd a - 1)+1) with (Zpos (snd a)); mauto. - rewrite <- IHl;repeat rewrite Zmult_assoc; mauto. - destruct (snd a - 1);trivial. - assert (1 < snd a); auto with zarith. -Qed. -Hint Rewrite mkProd_pred_mkProd : zmisc. - -Lemma lt_Zmod : forall p n, 0 <= p < n -> p mod n = p. -Proof. - intros a b H. - assert ( 0 <= a mod b < b). - apply Z_mod_lt; mauto. - destruct (mod_unique b (a/b) (a mod b) 0 a H0 H); mauto. - rewrite <- Z_div_mod_eq; mauto. -Qed. - -Lemma Npred_mod_spec : forall p n, Z_of_N p < Zpos n -> - 1 < Zpos n -> Z_of_N (Npred_mod p n) = (p - 1) mod n. -Proof. - destruct p;intros;simpl. - rewrite <- Ppred_Zminus; auto. - apply Zmod_unique with (q := -1); mauto. - assert (H1 := pos_eq_1_spec p);destruct (p?=1)%P. - rewrite H1; mauto. - unfold Z_of_N;rewrite <- Ppred_Zminus; auto. - simpl in H;symmetry; apply (lt_Zmod (p-1) n). - assert (1 < p); auto with zarith. -Qed. -Hint Rewrite Npred_mod_spec : zmisc. - -Lemma times_mod_spec : forall x y n, Z_of_N (times_mod x y n) = (x * y) mod n. -Proof. - intros; destruct x; mauto. - destruct y;simpl; mauto. -Qed. -Hint Rewrite times_mod_spec : zmisc. - -Lemma snd_all_pow_mod : - forall n l (prod a :N), - a mod (Zpos n) = a -> - Z_of_N (snd (all_pow_mod prod a l n)) = (a^(mkProd' l)) mod n. -Proof. - induction l; simpl all_pow_mod; simpl mkProd';intros; mauto. - destruct a as (q,p). - rewrite IHl; mauto. -Qed. - -Lemma fold_aux : forall a N (n:positive) l prod, - fold_left - (fun (r : Z) (k : positive * positive) => - r * (a ^(N / fst k) - 1) mod n) l (prod mod n) mod n = - fold_left - (fun (r : Z) (k : positive * positive) => - r * (a^(N / fst k) - 1)) l prod mod n. -Proof. - induction l;simpl;intros; mauto. -Qed. - -Lemma fst_all_pow_mod : - forall (n a:positive) l (R:positive) (prod A :N), - 1 < n -> - Z_of_N prod = prod mod n -> - Z_of_N A = a^R mod n -> - Z_of_N (fst (all_pow_mod prod A l n)) = - (fold_left - (fun r (k:positive*positive) => - (r * (a ^ (R* mkProd' l / (fst k)) - 1))) l prod) mod n. -Proof. - induction l;simpl;intros; mauto. - destruct a0 as (q,p);simpl. - assert (Z_of_N A = A mod n). - rewrite H1; mauto. - rewrite (IHl (R * q)%positive); mauto; mauto. - pattern (q * mkProd' l) at 2;rewrite (Zmult_comm q). - repeat rewrite Zmult_assoc. - rewrite Z_div_mult;auto with zmisc zarith. - rewrite <- fold_aux. - rewrite <- (fold_aux a (R * q * mkProd' l) n l (prod * (a ^ (R * mkProd' l) - 1)))... - assert ( ((prod * (A ^ mkProd' l - 1)) mod n) = - ((prod * ((a ^ R) ^ mkProd' l - 1)) mod n)). - repeat rewrite (Zmult_mod prod);auto with zmisc. - rewrite Zminus_mod;auto with zmisc. - rewrite (Zminus_mod ((a ^ R) ^ mkProd' l));auto with zmisc. - rewrite (Zpower_mod (a^R));auto with zmisc. rewrite H1; mauto. - rewrite H3; mauto. - rewrite H1; mauto. -Qed. - -Lemma is_odd_Zodd : forall p, is_odd p = true -> Zodd p. -Proof. - destruct p;intros;simpl;trivial;discriminate. -Qed. - -Lemma is_even_Zeven : forall p, is_even p = true -> Zeven p. -Proof. - destruct p;intros;simpl;trivial;discriminate. -Qed. - -Lemma lt_square : forall x y, 0 < x -> x < y -> x*x < y*y. -Proof. - intros; apply Zlt_trans with (x*y). - apply Zmult_lt_compat_l;trivial. - apply Zmult_lt_compat_r;trivial. omega. -Qed. - -Lemma le_square : forall x y, 0 <= x -> x <= y -> x*x <= y*y. -Proof. - intros; apply Zle_trans with (x*y). - apply Zmult_le_compat_l;trivial. - apply Zmult_le_compat_r;trivial. omega. -Qed. - -Lemma borned_square : forall x y, 0 <= x -> 0 <= y -> - x*x < y*y < (x+1)*(x+1) -> False. -Proof. - intros;destruct (Z_lt_ge_dec x y) as [z|z]. - assert (x + 1 <= y). omega. - assert (0 <= x+1). omega. - assert (H4 := le_square _ _ H3 H2). omega. - assert (H4 := le_square _ _ H0 (Zge_le _ _ z)). omega. -Qed. - -Lemma not_square : forall (sqrt:positive) n, sqrt * sqrt < n < (sqrt+1)*(sqrt + 1) -> ~(isSquare n). -Proof. - intros sqrt n H (y,H0). - destruct (Z_lt_ge_dec 0 y). - apply (borned_square sqrt y);mauto. - assert (y*y = (-y)*(-y)). ring. rewrite H1 in H0;clear H1. - apply (borned_square sqrt (-y));mauto. -Qed. - -Ltac spec_dec := - repeat match goal with - | [H:(?x ?= ?y)%P = _ |- _] => - generalize (is_eq_spec x y); - rewrite H;clear H; autorewrite with zmisc; - intro - | [H:(?x ?< ?y)%P = _ |- _] => - generalize (is_lt_spec x y); - rewrite H; clear H; autorewrite with zmisc; - intro - end. - -Ltac elimif := - match goal with - | [H: (if ?b then _ else _) = _ |- _] => - let H1 := fresh "H" in - (CaseEq b;intros H1; rewrite H1 in H; - try discriminate H); elimif - | _ => spec_dec - end. - -Lemma check_s_r_correct : forall s r sqrt, check_s_r s r sqrt = true -> - Z_of_N s = 0 \/ ~ isSquare (r * r - 8 * s). -Proof. - unfold check_s_r;intros. - destruct s as [|s]; trivial;auto. - right;CaseEq (square r - xO (xO (xO s)));[intros H1|intros p1 H1| intros p1 H1]; - rewrite H1 in H;try discriminate H. - elimif. - assert (Zpos (xO (xO (xO s))) = 8 * s). repeat rewrite Zpos_xO_add;ring. - generalizeclear H1; rewrite H2;mauto;intros. - apply (not_square sqrt). - simpl Z.of_N; rewrite H1;auto. - intros (y,Heq). - generalize H1 Heq;mauto. - unfold Z_of_N. - match goal with |- ?x = _ -> ?y = _ -> _ => - replace x with y; try ring - end. - intros Heq1;rewrite Heq1;intros Heq2. - destruct y;discriminate Heq2. -Qed. - -Lemma in_mkProd_prime_div_in : - forall p:positive, prime p -> - forall (l:dec_prime), - (forall k, In k l -> prime (fst k)) -> - Zdivide p (mkProd l) -> exists n,In (p, n) l. -Proof. - induction l;simpl mkProd; simpl In; mauto. - intros _ H1; absurd (p <= 1). - apply Zlt_not_le; apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. - apply Zdivide_le; auto with zarith. - intros. - case prime_mult with (2 := H1); auto with zarith; intros H2. - exists (snd a);left. - destruct a;simpl in *. - assert (Zpos p = Zpos p0). - rewrite (prime_div_Zpower_prime p1 p p0); mauto. - apply (H0 (p0,p1));auto. - inversion H3; auto. - destruct IHl as (n,H3); mauto. - exists n; auto. -Qed. - -Lemma gcd_Zis_gcd : forall a b:positive, (Zis_gcd b a (gcd b a)%P). -Proof. - intros a;assert (Hacc := Zwf_pos a);induction Hacc;rename x into a;intros. - generalize (div_eucl_spec b a); mauto. - rewrite <- (Pmod_div_eucl b a). - CaseEq (b mod a)%P;[intros Heq|intros r Heq]; intros (H1,H2). - simpl in H1;rewrite Zplus_0_r in H1. - rewrite (gcd_mod0 _ _ Heq). - constructor;mauto. - apply Zdivide_intro with (fst (b/a)%P);trivial. - rewrite (gcd_mod _ _ _ Heq). - rewrite H1;apply Zis_gcd_sym. - rewrite Zmult_comm;apply Zis_gcd_for_euclid2;simpl in *. - apply Zis_gcd_sym;auto. -Qed. - -Lemma test_pock_correct : forall N a dec sqrt, - (forall k, In k dec -> prime (Zpos (fst k))) -> - test_pock N a dec sqrt = true -> - prime N. -Proof. - unfold test_pock;intros. - elimif. - generalize (div_eucl_spec (Ppred N) (mkProd dec)); - destruct ((Ppred N) / (mkProd dec))%P as (R1,n); mauto;intros (H2,H3). - destruct R1 as [|R1];try discriminate H0. - destruct n;try discriminate H0. - elimif. - generalize (div_eucl_spec R1 (xO (mkProd dec))); - destruct ((R1 / xO (mkProd dec))%P) as (s,r'); mauto;intros (H7,H8). - destruct r' as [|r];try discriminate H0. - generalize (fst_all_pow_mod N a dec (R1*mkProd_pred dec) 1 - (pow_mod_pred (pow_mod a R1 N) dec N)). - generalize (snd_all_pow_mod N dec 1 (pow_mod_pred (pow_mod a R1 N) dec N)). - destruct (all_pow_mod 1 (pow_mod_pred (pow_mod a R1 N) dec N) dec N) as - (prod,aNm1); mauto; simpl Z_of_N. - destruct prod as [|prod];try discriminate H0. - destruct aNm1 as [|aNm1];try discriminate H0;elimif. - simpl in H3; simpl in H2. - rewrite <- Ppred_Zminus in H2;try omega. - rewrite <- Zmult_assoc;rewrite mkProd_pred_mkProd. - intros H12;assert (a^(N-1) mod N = 1). - pattern 1 at 2;rewrite <- H9;symmetry. - simpl Z.of_N in H12. - rewrite H2; rewrite H12; mauto. - rewrite <- Zpower_mult; mauto. - clear H12. - intros H14. - match type of H14 with _ -> _ -> _ -> ?X => - assert (H12:X); try apply H14; clear H14 - end; mauto. - rewrite Zmod_small; mauto. - assert (1 < mkProd dec). - assert (H14 := Zlt_0_pos (mkProd dec)). - assert (1 <= mkProd dec); mauto. - destruct (Zle_lt_or_eq _ _ H15); mauto. - inversion H16. rewrite <- H18 in H5;discriminate H5. - simpl in H8. - assert (Z_of_N s = R1 / (2 * mkProd dec) /\ Zpos r = R1 mod (2 * mkProd dec)). - apply mod_unique with (2 * mkProd dec);auto with zarith. - revert H8; mauto. - apply Z_mod_lt; mauto. - rewrite <- Z_div_mod_eq; mauto; rewrite H7. - simpl fst; simpl snd; simpl Z_of_N. - ring. - destruct H15 as (H15,Heqr). - apply PocklingtonExtra with (F1:=mkProd dec) (R1:=R1) (m:=1); - auto with zmisc zarith. - rewrite H2; mauto. - apply is_even_Zeven; auto. - apply is_odd_Zodd; auto. - intros p; case p; clear p. - intros HH; contradict HH. - apply not_prime_0. - 2: intros p (V1, _); contradict V1; apply Zle_not_lt; red; simpl; intros; - discriminate. - intros p Hprime Hdec; exists (Zpos a);repeat split; auto with zarith. - apply Zis_gcd_gcd; auto with zarith. - change (rel_prime (a ^ ((N - 1) / p) - 1) N). - match type of H12 with _ = ?X mod _ => - apply rel_prime_div with (p := X); auto with zarith - end. - apply rel_prime_mod_rev; auto with zarith. - red. - pattern 1 at 3; rewrite <- H10; rewrite <- H12. - apply Pmod.gcd_Zis_gcd. - destruct (in_mkProd_prime_div_in _ Hprime _ H Hdec) as (q,Hin). - revert H2; mauto; intro H2. - rewrite <- H2. - match goal with |- context [fold_left ?f _ _] => - apply (ListAux.fold_left_invol_in _ _ f (fun k => Zdivide (a ^ ((N - 1) / p) - 1) k)) - with (b := (p, q)); auto with zarith - end. - rewrite <- Heqr. - generalizeclear H0; ring_simplify - (((mkProd dec + mkProd dec + r + 1) * mkProd dec + r) * mkProd dec + 1) - ((1 * mkProd dec + 1) * (2 * mkProd dec * mkProd dec + (r - 1) * mkProd dec + 1)); mauto. - rewrite <- H15;rewrite <- Heqr. - apply check_s_r_correct with sqrt; mauto. -Qed. - -Lemma is_in_In : - forall p lc, is_in p lc = true -> exists c, In c lc /\ p = nprim c. -Proof. - induction lc;simpl;try (intros;discriminate). - intros;elimif. - exists a;split;auto. inversion H0;trivial. - destruct (IHlc H) as [c [H1 H2]];exists c;auto. -Qed. - -Lemma all_in_In : - forall lc lp, all_in lc lp = true -> - forall pq, In pq lp -> exists c, In c lc /\ fst pq = nprim c. -Proof. - induction lp;simpl. intros H pq HF;elim HF. - intros;destruct a;elimif. - destruct H0;auto. - rewrite <- H0;simpl;apply is_in_In;trivial. -Qed. - -Lemma test_Certif_In_Prime : - forall lc, test_Certif lc = true -> - forall c, In c lc -> prime (nprim c). -Proof with mauto. - induction lc;simpl;intros. elim H0. - destruct H0. - subst c;destruct a;simpl... - elimif. - CaseEq (Mp p);[intros Heq|intros N' Heq|intros N' Heq];rewrite Heq in H; - try discriminate H. elimif. - CaseEq (SS p);[intros Heq'|intros N'' Heq'|intros N'' Heq'];rewrite Heq' in H; - try discriminate H. - rewrite H2;rewrite <- Heq. -apply LucasLehmer;trivial. -(destruct p; try discriminate H1). -simpl in H1; generalize (is_lt_spec 2 p); rewrite H1; auto. -elimif. -apply (test_pock_correct N a d p); mauto. - intros k Hin;destruct (all_in_In _ _ H1 _ Hin) as (c,(H2,H3)). - rewrite H3;auto. -discriminate. -discriminate. - destruct a;elimif;auto. -discriminate. -discriminate. -Qed. - -Lemma Pocklington_refl : - forall c lc, test_Certif (c::lc) = true -> prime (nprim c). -Proof. - intros c lc Heq;apply test_Certif_In_Prime with (c::lc);trivial;simpl;auto. -Qed. - diff --git a/coqprime-8.5/Coqprime/Root.v b/coqprime-8.5/Coqprime/Root.v deleted file mode 100644 index 2f65790d6..000000000 --- a/coqprime-8.5/Coqprime/Root.v +++ /dev/null @@ -1,239 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(*********************************************************************** - Root.v - - Proof that a polynomial has at most n roots -************************************************************************) -Require Import ZArith. -Require Import List. -Require Import UList. -Require Import Tactic. -Require Import Permutation. - -Open Scope Z_scope. - -Section Root. - -Variable A: Set. -Variable P: A -> Prop. -Variable plus mult: A -> A -> A. -Variable op: A -> A. -Variable zero one: A. - - -Let pol := list A. - -Definition toA z := -match z with - Z0 => zero -| Zpos p => iter_pos _ (plus one) zero p -| Zneg p => op (iter_pos _ (plus one) zero p) -end. - -Fixpoint eval (p: pol) (x: A) {struct p} : A := -match p with - nil => zero -| a::p1 => plus a (mult x (eval p1 x)) -end. - -Fixpoint div (p: pol) (x: A) {struct p} : pol * A := -match p with - nil => (nil, zero) -| a::nil => (nil, a) -| a::p1 => - (snd (div p1 x)::fst (div p1 x), - (plus a (mult x (snd (div p1 x))))) -end. - -Hypothesis Pzero: P zero. -Hypothesis Pplus: forall x y, P x -> P y -> P (plus x y). -Hypothesis Pmult: forall x y, P x -> P y -> P (mult x y). -Hypothesis Pop: forall x, P x -> P (op x). -Hypothesis plus_zero: forall a, P a -> plus zero a = a. -Hypothesis plus_comm: forall a b, P a -> P b -> plus a b = plus b a. -Hypothesis plus_assoc: forall a b c, P a -> P b -> P c -> plus a (plus b c) = plus (plus a b) c. -Hypothesis mult_zero: forall a, P a -> mult zero a = zero. -Hypothesis mult_comm: forall a b, P a -> P b -> mult a b = mult b a. -Hypothesis mult_assoc: forall a b c, P a -> P b -> P c -> mult a (mult b c) = mult (mult a b) c. -Hypothesis mult_plus_distr: forall a b c, P a -> P b -> P c -> mult a (plus b c) = plus (mult a b) (mult a c). -Hypothesis plus_op_zero: forall a, P a -> plus a (op a) = zero. -Hypothesis mult_integral: forall a b, P a -> P b -> mult a b = zero -> a = zero \/ b = zero. -(* Not necessary in Set just handy *) -Hypothesis A_dec: forall a b: A, {a = b} + {a <> b}. - -Theorem eval_P: forall p a, P a -> (forall i, In i p -> P i) -> P (eval p a). -intros p a Pa; elim p; simpl; auto with datatypes. -intros a1 l1 Rec H; apply Pplus; auto. -Qed. - -Hint Resolve eval_P. - -Theorem div_P: forall p a, P a -> (forall i, In i p -> P i) -> (forall i, In i (fst (div p a)) -> P i) /\ P (snd (div p a)). -intros p a Pa; elim p; auto with datatypes. -intros a1 l1; case l1. -simpl; intuition. -intros a2 p2 Rec Hi; split. -case Rec; auto with datatypes. -intros H H1 i. -replace (In i (fst (div (a1 :: a2 :: p2) a))) with - (snd (div (a2::p2) a) = i \/ In i (fst (div (a2::p2) a))); auto. -intros [Hi1 | Hi1]; auto. -rewrite <- Hi1; auto. -change ( P (plus a1 (mult a (snd (div (a2::p2) a))))); auto with datatypes. -apply Pplus; auto with datatypes. -apply Pmult; auto with datatypes. -case Rec; auto with datatypes. -Qed. - - -Theorem div_correct: - forall p x y, P x -> P y -> (forall i, In i p -> P i) -> eval p y = plus (mult (eval (fst (div p x)) y) (plus y (op x))) (snd (div p x)). -intros p x y; elim p; simpl. -intros; rewrite mult_zero; try rewrite plus_zero; auto. -intros a l; case l; simpl; auto. -intros _ px py pa; rewrite (fun x => mult_comm x zero); repeat rewrite mult_zero; try apply plus_comm; auto. -intros a1 l1. -generalize (div_P (a1::l1) x); simpl. -match goal with |- context[fst ?A] => case A end; simpl. -intros q r Hd Rec px py pi. -assert (pr: P r). -case Hd; auto. -assert (pa1: P a1). -case Hd; auto. -assert (pey: P (eval q y)). -apply eval_P; auto. -case Hd; auto. -rewrite Rec; auto with datatypes. -rewrite (fun x y => plus_comm x (plus a y)); try rewrite <- plus_assoc; auto. -apply f_equal2 with (f := plus); auto. -repeat rewrite mult_plus_distr; auto. -repeat (rewrite (fun x y => (mult_comm (plus x y))) || rewrite mult_plus_distr); auto. -rewrite (fun x => (plus_comm x (mult y r))); auto. -repeat rewrite plus_assoc; try apply f_equal2 with (f := plus); auto. -2: repeat rewrite mult_assoc; try rewrite (fun y => mult_comm y (op x)); - repeat rewrite mult_assoc; auto. -rewrite (fun z => (plus_comm z (mult (op x) r))); auto. -repeat rewrite plus_assoc; try apply f_equal2 with (f := plus); auto. -2: apply f_equal2 with (f := mult); auto. -repeat rewrite (fun x => mult_comm x r); try rewrite <- mult_plus_distr; auto. -rewrite (plus_comm (op x)); try rewrite plus_op_zero; auto. -rewrite (fun x => mult_comm x zero); try rewrite mult_zero; try rewrite plus_zero; auto. -Qed. - -Theorem div_correct_factor: - forall p a, (forall i, In i p -> P i) -> P a -> - eval p a = zero -> forall x, P x -> eval p x = (mult (eval (fst (div p a)) x) (plus x (op a))). -intros p a Hp Ha H x px. -case (div_P p a); auto; intros Hd1 Hd2. -rewrite (div_correct p a x); auto. -generalize (div_correct p a a). -rewrite plus_op_zero; try rewrite (fun x => mult_comm x zero); try rewrite mult_zero; try rewrite plus_zero; try rewrite H; auto. -intros H1; rewrite <- H1; auto. -rewrite (fun x => plus_comm x zero); auto. -Qed. - -Theorem length_decrease: forall p x, p <> nil -> (length (fst (div p x)) < length p)%nat. -intros p x; elim p; simpl; auto. -intros H1; case H1; auto. -intros a l; case l; simpl; auto. -intros a1 l1. -match goal with |- context[fst ?A] => case A end; simpl; auto with zarith. -intros p1 _ H H1. -apply lt_n_S; apply H; intros; discriminate. -Qed. - -Theorem root_max: -forall p l, ulist l -> (forall i, In i p -> P i) -> (forall i, In i l -> P i) -> - (forall x, In x l -> eval p x = zero) -> (length p <= length l)%nat -> forall x, P x -> eval p x = zero. -intros p l; generalize p; elim l; clear l p; simpl; auto. -intros p; case p; simpl; auto. -intros a p1 _ _ _ _ H; contradict H; auto with arith. -intros a p1 Rec p; case p. -simpl; auto. -intros a1 p2 H H1 H2 H3 H4 x px. -assert (Hu: eval (a1 :: p2) a = zero); auto with datatypes. -rewrite (div_correct_factor (a1 :: p2) a); auto with datatypes. -match goal with |- mult ?X _ = _ => replace X with zero end; try apply mult_zero; auto. -apply sym_equal; apply Rec; auto with datatypes. -apply ulist_inv with (1 := H). -intros i Hi; case (div_P (a1 :: p2) a); auto. -intros x1 H5; case (mult_integral (eval (fst (div (a1 :: p2) a)) x1) (plus x1 (op a))); auto. -apply eval_P; auto. -intros i Hi; case (div_P (a1 :: p2) a); auto. -rewrite <- div_correct_factor; auto. -intros H6; case (ulist_app_inv _ (a::nil) p1 x1); simpl; auto. -left. -apply trans_equal with (plus zero x1); auto. -rewrite <- (plus_op_zero a); try rewrite <- plus_assoc; auto. -rewrite (fun x => plus_comm (op x)); try rewrite H6; try rewrite plus_comm; auto. -apply sym_equal; apply plus_zero; auto. -apply lt_n_Sm_le;apply lt_le_trans with (length (a1 :: p2)); auto with zarith. -apply length_decrease; auto with datatypes. -Qed. - -Theorem root_max_is_zero: -forall p l, ulist l -> (forall i, In i p -> P i) -> (forall i, In i l -> P i) -> - (forall x, In x l -> eval p x = zero) -> (length p <= length l)%nat -> forall x, (In x p) -> x = zero. -intros p l; generalize p; elim l; clear l p; simpl; auto. -intros p; case p; simpl; auto. -intros _ _ _ _ _ x H; case H. -intros a p1 _ _ _ _ H; contradict H; auto with arith. -intros a p1 Rec p; case p. -simpl; auto. -intros _ _ _ _ _ x H; case H. -simpl; intros a1 p2 H H1 H2 H3 H4 x H5. -assert (Ha1: a1 = zero). -assert (Hu: (eval (a1::p2) zero = zero)). -apply root_max with (l := a :: p1); auto. -rewrite <- Hu; simpl; rewrite mult_zero; try rewrite plus_comm; sauto. -case H5; clear H5; intros H5; subst; auto. -apply Rec with p2; auto with arith. -apply ulist_inv with (1 := H). -intros x1 Hx1. -case (In_dec A_dec zero p1); intros Hz. -case (in_permutation_ex _ zero p1); auto; intros p3 Hp3. -apply root_max with (l := a::p3); auto. -apply ulist_inv with zero. -apply ulist_perm with (a::p1); auto. -apply permutation_trans with (a:: (zero:: p3)); auto. -apply permutation_skip; auto. -apply permutation_sym; auto. -simpl; intros x2 [Hx2 | Hx2]; subst; auto. -apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. -simpl; intros x2 [Hx2 | Hx2]; subst. -case (mult_integral x2 (eval p2 x2)); auto. -rewrite <- H3 with x2; sauto. -rewrite plus_zero; auto. -intros H6; case (ulist_app_inv _ (x2::nil) p1 x2) ; auto with datatypes. -rewrite H6; apply permutation_in with (1 := Hp3); auto with datatypes. -case (mult_integral x2 (eval p2 x2)); auto. -apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. -apply eval_P; auto. -apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. -rewrite <- H3 with x2; sauto; try right. -apply sym_equal; apply plus_zero; auto. -apply Pmult; auto. -apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. -apply eval_P; auto. -apply H2; right; apply permutation_in with (1 := Hp3); auto with datatypes. -apply permutation_in with (1 := Hp3); auto with datatypes. -intros H6; case (ulist_app_inv _ (zero::nil) p3 x2) ; auto with datatypes. -simpl; apply ulist_perm with (1:= (permutation_sym _ _ _ Hp3)). -apply ulist_inv with (1 := H). -rewrite H6; auto with datatypes. -replace (length (a :: p3)) with (length (zero::p3)); auto. -rewrite permutation_length with (1 := Hp3); auto with arith. -case (mult_integral x1 (eval p2 x1)); auto. -rewrite <- H3 with x1; sauto; try right. -apply sym_equal; apply plus_zero; auto. -intros HH; case Hz; rewrite <- HH; auto. -Qed. - -End Root. \ No newline at end of file diff --git a/coqprime-8.5/Coqprime/Tactic.v b/coqprime-8.5/Coqprime/Tactic.v deleted file mode 100644 index 93a244149..000000000 --- a/coqprime-8.5/Coqprime/Tactic.v +++ /dev/null @@ -1,84 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - - -(********************************************************************** - Tactic.v - Useful tactics - **********************************************************************) - -(************************************** - A simple tactic to end a proof -**************************************) -Ltac finish := intros; auto; trivial; discriminate. - - -(************************************** - A tactic for proof by contradiction - with contradict H - H: ~A |- B gives |- A - H: ~A |- ~ B gives H: B |- A - H: A |- B gives |- ~ A - H: A |- B gives |- ~ A - H: A |- ~ B gives H: A |- ~ A -**************************************) - -Ltac contradict name := - let term := type of name in ( - match term with - (~_) => - match goal with - |- ~ _ => let x := fresh in - (intros x; case name; - generalize x; clear x name; - intro name) - | |- _ => case name; clear name - end - | _ => - match goal with - |- ~ _ => let x := fresh in - (intros x; absurd term; - [idtac | exact name]; generalize x; clear x name; - intros name) - | |- _ => generalize name; absurd term; - [idtac | exact name]; clear name - end - end). - - -(************************************** - A tactic to do case analysis keeping the equality -**************************************) - -Ltac case_eq name := - generalize (refl_equal name); pattern name at -1 in |- *; case name. - - -(************************************** - A tactic to use f_equal? theorems -**************************************) - -Ltac eq_tac := - match goal with - |- (?g _ = ?g _) => apply f_equal with (f := g) - | |- (?g ?X _ = ?g ?X _) => apply f_equal with (f := g X) - | |- (?g _ _ = ?g _ _) => apply f_equal2 with (f := g) - | |- (?g ?X ?Y _ = ?g ?X ?Y _) => apply f_equal with (f := g X Y) - | |- (?g ?X _ _ = ?g ?X _ _) => apply f_equal2 with (f := g X) - | |- (?g _ _ _ = ?g _ _ _) => apply f_equal3 with (f := g) - | |- (?g ?X ?Y ?Z _ = ?g ?X ?Y ?Z _) => apply f_equal with (f := g X Y Z) - | |- (?g ?X ?Y _ _ = ?g ?X ?Y _ _) => apply f_equal2 with (f := g X Y) - | |- (?g ?X _ _ _ = ?g ?X _ _ _) => apply f_equal3 with (f := g X) - | |- (?g _ _ _ _ _ = ?g _ _ _ _) => apply f_equal4 with (f := g) - end. - -(************************************** - A stupid tactic that tries auto also after applying sym_equal -**************************************) - -Ltac sauto := (intros; apply sym_equal; auto; fail) || auto. diff --git a/coqprime-8.5/Coqprime/UList.v b/coqprime-8.5/Coqprime/UList.v deleted file mode 100644 index 7b9d982ea..000000000 --- a/coqprime-8.5/Coqprime/UList.v +++ /dev/null @@ -1,286 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(*********************************************************************** - UList.v - - Definition of list with distinct elements - - Definition: ulist -************************************************************************) -Require Import List. -Require Import Arith. -Require Import Permutation. -Require Import ListSet. - -Section UniqueList. -Variable A : Set. -Variable eqA_dec : forall (a b : A), ({ a = b }) + ({ a <> b }). -(* A list is unique if there is not twice the same element in the list *) - -Inductive ulist : list A -> Prop := - ulist_nil: ulist nil - | ulist_cons: forall a l, ~ In a l -> ulist l -> ulist (a :: l) . -Hint Constructors ulist . -(* Inversion theorem *) - -Theorem ulist_inv: forall a l, ulist (a :: l) -> ulist l. -intros a l H; inversion H; auto. -Qed. -(* The append of two unique list is unique if the list are distinct *) - -Theorem ulist_app: - forall l1 l2, - ulist l1 -> - ulist l2 -> (forall (a : A), In a l1 -> In a l2 -> False) -> ulist (l1 ++ l2). -intros L1; elim L1; simpl; auto. -intros a l H l2 H0 H1 H2; apply ulist_cons; simpl; auto. -red; intros H3; case in_app_or with ( 1 := H3 ); auto; intros H4. -inversion H0; auto. -apply H2 with a; auto. -apply H; auto. -apply ulist_inv with ( 1 := H0 ); auto. -intros a0 H3 H4; apply (H2 a0); auto. -Qed. -(* Iinversion theorem the appended list *) - -Theorem ulist_app_inv: - forall l1 l2 (a : A), ulist (l1 ++ l2) -> In a l1 -> In a l2 -> False. -intros l1; elim l1; simpl; auto. -intros a l H l2 a0 H0 [H1|H1] H2. -inversion H0 as [|a1 l0 H3 H4 H5]; auto. -case H3; rewrite H1; auto with datatypes. -apply (H l2 a0); auto. -apply ulist_inv with ( 1 := H0 ); auto. -Qed. -(* Iinversion theorem the appended list *) - -Theorem ulist_app_inv_l: forall (l1 l2 : list A), ulist (l1 ++ l2) -> ulist l1. -intros l1; elim l1; simpl; auto. -intros a l H l2 H0. -inversion H0 as [|il1 iH1 iH2 il2 [iH4 iH5]]; apply ulist_cons; auto. -intros H5; case iH2; auto with datatypes. -apply H with l2; auto. -Qed. -(* Iinversion theorem the appended list *) - -Theorem ulist_app_inv_r: forall (l1 l2 : list A), ulist (l1 ++ l2) -> ulist l2. -intros l1; elim l1; simpl; auto. -intros a l H l2 H0; inversion H0; auto. -Qed. -(* Uniqueness is decidable *) - -Definition ulist_dec: forall l, ({ ulist l }) + ({ ~ ulist l }). -intros l; elim l; auto. -intros a l1 [H|H]; auto. -case (In_dec eqA_dec a l1); intros H2; auto. -right; red; intros H1; inversion H1; auto. -right; intros H1; case H; apply ulist_inv with ( 1 := H1 ). -Defined. -(* Uniqueness is compatible with permutation *) - -Theorem ulist_perm: - forall (l1 l2 : list A), permutation l1 l2 -> ulist l1 -> ulist l2. -intros l1 l2 H; elim H; clear H l1 l2; simpl; auto. -intros a l1 l2 H0 H1 H2; apply ulist_cons; auto. -inversion_clear H2 as [|ia il iH1 iH2 [iH3 iH4]]; auto. -intros H3; case iH1; - apply permutation_in with ( 1 := permutation_sym _ _ _ H0 ); auto. -inversion H2; auto. -intros a b L H0; apply ulist_cons; auto. -inversion_clear H0 as [|ia il iH1 iH2]; auto. -inversion_clear iH2 as [|ia il iH3 iH4]; auto. -intros H; case H; auto. -intros H1; case iH1; rewrite H1; simpl; auto. -apply ulist_cons; auto. -inversion_clear H0 as [|ia il iH1 iH2]; auto. -intros H; case iH1; simpl; auto. -inversion_clear H0 as [|ia il iH1 iH2]; auto. -inversion iH2; auto. -Qed. - -Theorem ulist_def: - forall l a, - In a l -> ulist l -> ~ (exists l1 , permutation l (a :: (a :: l1)) ). -intros l a H H0 [l1 H1]. -absurd (ulist (a :: (a :: l1))); auto. -intros H2; inversion_clear H2; simpl; auto with datatypes. -apply ulist_perm with ( 1 := H1 ); auto. -Qed. - -Theorem ulist_incl_permutation: - forall (l1 l2 : list A), - ulist l1 -> incl l1 l2 -> (exists l3 , permutation l2 (l1 ++ l3) ). -intros l1; elim l1; simpl; auto. -intros l2 H H0; exists l2; simpl; auto. -intros a l H l2 H0 H1; auto. -case (in_permutation_ex _ a l2); auto with datatypes. -intros l3 Hl3. -case (H l3); auto. -apply ulist_inv with ( 1 := H0 ); auto. -intros b Hb. -assert (H2: In b (a :: l3)). -apply permutation_in with ( 1 := permutation_sym _ _ _ Hl3 ); - auto with datatypes. -simpl in H2 |-; case H2; intros H3; simpl; auto. -inversion_clear H0 as [|c lc Hk1]; auto. -case Hk1; subst a; auto. -intros l4 H4; exists l4. -apply permutation_trans with (a :: l3); auto. -apply permutation_sym; auto. -Qed. - -Theorem ulist_eq_permutation: - forall (l1 l2 : list A), - ulist l1 -> incl l1 l2 -> length l1 = length l2 -> permutation l1 l2. -intros l1 l2 H1 H2 H3. -case (ulist_incl_permutation l1 l2); auto. -intros l3 H4. -assert (H5: l3 = @nil A). -generalize (permutation_length _ _ _ H4); rewrite length_app; rewrite H3. -rewrite plus_comm; case l3; simpl; auto. -intros a l H5; absurd (lt (length l2) (length l2)); auto with arith. -pattern (length l2) at 2; rewrite H5; auto with arith. -replace l1 with (app l1 l3); auto. -apply permutation_sym; auto. -rewrite H5; rewrite app_nil_end; auto. -Qed. - - -Theorem ulist_incl_length: - forall (l1 l2 : list A), ulist l1 -> incl l1 l2 -> le (length l1) (length l2). -intros l1 l2 H1 Hi; case ulist_incl_permutation with ( 2 := Hi ); auto. -intros l3 Hl3; rewrite permutation_length with ( 1 := Hl3 ); auto. -rewrite length_app; simpl; auto with arith. -Qed. - -Theorem ulist_incl2_permutation: - forall (l1 l2 : list A), - ulist l1 -> ulist l2 -> incl l1 l2 -> incl l2 l1 -> permutation l1 l2. -intros l1 l2 H1 H2 H3 H4. -apply ulist_eq_permutation; auto. -apply le_antisym; apply ulist_incl_length; auto. -Qed. - - -Theorem ulist_incl_length_strict: - forall (l1 l2 : list A), - ulist l1 -> incl l1 l2 -> ~ incl l2 l1 -> lt (length l1) (length l2). -intros l1 l2 H1 Hi Hi0; case ulist_incl_permutation with ( 2 := Hi ); auto. -intros l3 Hl3; rewrite permutation_length with ( 1 := Hl3 ); auto. -rewrite length_app; simpl; auto with arith. -generalize Hl3; case l3; simpl; auto with arith. -rewrite <- app_nil_end; auto. -intros H2; case Hi0; auto. -intros a HH; apply permutation_in with ( 1 := H2 ); auto. -intros a l Hl0; (rewrite plus_comm; simpl; rewrite plus_comm; auto with arith). -Qed. - -Theorem in_inv_dec: - forall (a b : A) l, In a (cons b l) -> a = b \/ ~ a = b /\ In a l. -intros a b l H; case (eqA_dec a b); auto; intros H1. -right; split; auto; inversion H; auto. -case H1; auto. -Qed. - -Theorem in_ex_app_first: - forall (a : A) (l : list A), - In a l -> - (exists l1 : list A , exists l2 : list A , l = l1 ++ (a :: l2) /\ ~ In a l1 ). -intros a l; elim l; clear l; auto. -intros H; case H. -intros a1 l H H1; auto. -generalize (in_inv_dec _ _ _ H1); intros [H2|[H2 H3]]. -exists (nil (A:=A)); exists l; simpl; split; auto. -subst; auto. -case H; auto; intros l1 [l2 [Hl2 Hl3]]; exists (a1 :: l1); exists l2; simpl; - split; auto. -subst; auto. -intros H4; case H4; auto. -Qed. - -Theorem ulist_inv_ulist: - forall (l : list A), - ~ ulist l -> - (exists a , - exists l1 , - exists l2 , - exists l3 , l = l1 ++ ((a :: l2) ++ (a :: l3)) /\ ulist (l1 ++ (a :: l2)) ). -intros l; elim l using list_length_ind; clear l. -intros l; case l; simpl; auto; clear l. -intros Rec H0; case H0; auto. -intros a l H H0. -case (In_dec eqA_dec a l); intros H1; auto. -case in_ex_app_first with ( 1 := H1 ); intros l1 [l2 [Hl1 Hl2]]; subst l. -case (ulist_dec l1); intros H2. -exists a; exists (@nil A); exists l1; exists l2; split; auto. -simpl; apply ulist_cons; auto. -case (H l1); auto. -rewrite length_app; auto with arith. -intros b [l3 [l4 [l5 [Hl3 Hl4]]]]; subst l1. -exists b; exists (a :: l3); exists l4; exists (l5 ++ (a :: l2)); split; simpl; - auto. -(repeat (rewrite <- ass_app; simpl)); auto. -apply ulist_cons; auto. -contradict Hl2; auto. -replace (l3 ++ (b :: (l4 ++ (b :: l5)))) with ((l3 ++ (b :: l4)) ++ (b :: l5)); - auto with datatypes. -(repeat (rewrite <- ass_app; simpl)); auto. -case (H l); auto; intros a1 [l1 [l2 [l3 [Hl3 Hl4]]]]; subst l. -exists a1; exists (a :: l1); exists l2; exists l3; split; auto. -simpl; apply ulist_cons; auto. -contradict H1. -replace (l1 ++ (a1 :: (l2 ++ (a1 :: l3)))) - with ((l1 ++ (a1 :: l2)) ++ (a1 :: l3)); auto with datatypes. -(repeat (rewrite <- ass_app; simpl)); auto. -Qed. - -Theorem incl_length_repetition: - forall (l1 l2 : list A), - incl l1 l2 -> - lt (length l2) (length l1) -> - (exists a , - exists ll1 , - exists ll2 , - exists ll3 , - l1 = ll1 ++ ((a :: ll2) ++ (a :: ll3)) /\ ulist (ll1 ++ (a :: ll2)) ). -intros l1 l2 H H0; apply ulist_inv_ulist. -intros H1; absurd (le (length l1) (length l2)); auto with arith. -apply ulist_incl_length; auto. -Qed. - -End UniqueList. -Implicit Arguments ulist [A]. -Hint Constructors ulist . - -Theorem ulist_map: - forall (A B : Set) (f : A -> B) l, - (forall x y, (In x l) -> (In y l) -> f x = f y -> x = y) -> ulist l -> ulist (map f l). -intros a b f l Hf Hl; generalize Hf; elim Hl; clear Hf; auto. -simpl; auto. -intros a1 l1 H1 H2 H3 Hf; simpl. -apply ulist_cons; auto with datatypes. -contradict H1. -case in_map_inv with ( 1 := H1 ); auto with datatypes. -intros b1 [Hb1 Hb2]. -replace a1 with b1; auto with datatypes. -Qed. - -Theorem ulist_list_prod: - forall (A : Set) (l1 l2 : list A), - ulist l1 -> ulist l2 -> ulist (list_prod l1 l2). -intros A l1 l2 Hl1 Hl2; elim Hl1; simpl; auto. -intros a l H1 H2 H3; apply ulist_app; auto. -apply ulist_map; auto. -intros x y _ _ H; inversion H; auto. -intros p Hp1 Hp2; case H1. -case in_map_inv with ( 1 := Hp1 ); intros a1 [Ha1 Ha2]; auto. -case in_list_prod_inv with ( 1 := Hp2 ); intros b1 [c1 [Hb1 [Hb2 Hb3]]]; auto. -replace a with b1; auto. -rewrite Ha2 in Hb1; injection Hb1; auto. -Qed. diff --git a/coqprime-8.5/Coqprime/ZCAux.v b/coqprime-8.5/Coqprime/ZCAux.v deleted file mode 100644 index de03a2fe2..000000000 --- a/coqprime-8.5/Coqprime/ZCAux.v +++ /dev/null @@ -1,295 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - ZCAux.v - - Auxillary functions & Theorems - **********************************************************************) - -Require Import ArithRing. -Require Export ZArith Zpow_facts. -Require Export Znumtheory. -Require Export Tactic. - -Theorem Zdivide_div_prime_le_square: forall x, 1 < x -> ~prime x -> exists p, prime p /\ (p | x) /\ p * p <= x. -intros x Hx; generalize Hx; pattern x; apply Z_lt_induction; auto with zarith. -clear x Hx; intros x Rec H H1. -case (not_prime_divide x); auto. -intros x1 ((H2, H3), H4); case (prime_dec x1); intros H5. -case (Zle_or_lt (x1 * x1) x); intros H6. -exists x1; auto. -case H4; clear H4; intros x2 H4; subst. -assert (Hx2: x2 <= x1). -case (Zle_or_lt x2 x1); auto; intros H8; contradict H6; apply Zle_not_lt. -apply Zmult_le_compat_r; auto with zarith. -case (prime_dec x2); intros H7. -exists x2; repeat (split; auto with zarith). -apply Zmult_le_compat_l; auto with zarith. -apply Zle_trans with 2%Z; try apply prime_ge_2; auto with zarith. -case (Zle_or_lt 0 x2); intros H8. -case Zle_lt_or_eq with (1 := H8); auto with zarith; clear H8; intros H8; subst; auto with zarith. -case (Zle_lt_or_eq 1 x2); auto with zarith; clear H8; intros H8; subst; auto with zarith. -case (Rec x2); try split; auto with zarith. -intros x3 (H9, (H10, H11)). -exists x3; repeat (split; auto with zarith). -contradict H; apply Zle_not_lt; auto with zarith. -apply Zle_trans with (0 * x1); auto with zarith. -case (Rec x1); try split; auto with zarith. -intros x3 (H9, (H10, H11)). -exists x3; repeat (split; auto with zarith). -apply Zdivide_trans with x1; auto with zarith. -Qed. - - -Theorem Zmult_interval: forall p q, 0 < p * q -> 1 < p -> 0 < q < p * q. -intros p q H1 H2; assert (0 < q). -case (Zle_or_lt q 0); auto; intros H3; contradict H1; apply Zle_not_lt. -rewrite <- (Zmult_0_r p). -apply Zmult_le_compat_l; auto with zarith. -split; auto. -pattern q at 1; rewrite <- (Zmult_1_l q). -apply Zmult_lt_compat_r; auto with zarith. -Qed. - -Theorem prime_induction: forall (P: Z -> Prop), P 0 -> P 1 -> (forall p q, prime p -> P q -> P (p * q)) -> forall p, 0 <= p -> P p. -intros P H H1 H2 p Hp. -generalize Hp; pattern p; apply Z_lt_induction; auto; clear p Hp. -intros p Rec Hp. -case Zle_lt_or_eq with (1 := Hp); clear Hp; intros Hp; subst; auto. -case (Zle_lt_or_eq 1 p); auto with zarith; clear Hp; intros Hp; subst; auto. -case (prime_dec p); intros H3. -rewrite <- (Zmult_1_r p); apply H2; auto. - case (Zdivide_div_prime_le_square p); auto. -intros q (Hq1, ((q2, Hq2), Hq3)); subst. -case (Zmult_interval q q2). -rewrite Zmult_comm; apply Zlt_trans with 1; auto with zarith. -apply Zlt_le_trans with 2; auto with zarith; apply prime_ge_2; auto. -intros H4 H5; rewrite Zmult_comm; apply H2; auto. -apply Rec; try split; auto with zarith. -rewrite Zmult_comm; auto. -Qed. - -Theorem div_power_max: forall p q, 1 < p -> 0 < q -> exists n, 0 <= n /\ (p ^n | q) /\ ~(p ^(1 + n) | q). -intros p q H1 H2; generalize H2; pattern q; apply Z_lt_induction; auto with zarith; clear q H2. -intros q Rec H2. -case (Zdivide_dec p q); intros H3. -case (Zdivide_Zdiv_lt_pos p q); auto with zarith; intros H4 H5. -case (Rec (Zdiv q p)); auto with zarith. -intros n (Ha1, (Ha2, Ha3)); exists (n + 1); split; auto with zarith; split. -case Ha2; intros q1 Hq; exists q1. -rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith. -rewrite Zmult_assoc; rewrite <- Hq. -rewrite Zmult_comm; apply Zdivide_Zdiv_eq; auto with zarith. -intros (q1, Hu); case Ha3; exists q1. -apply Zmult_reg_r with p; auto with zarith. -rewrite (Zmult_comm (q / p)); rewrite <- Zdivide_Zdiv_eq; auto with zarith. -apply trans_equal with (1 := Hu); repeat rewrite Zpower_exp; try rewrite Zpower_exp_1; auto with zarith. -ring. -exists 0; repeat split; try rewrite Zpower_1_r; try rewrite Zpower_exp_0; auto with zarith. -Qed. - -Theorem prime_div_induction: - forall (P: Z -> Prop) n, - 0 < n -> - (P 1) -> - (forall p i, prime p -> 0 <= i -> (p^i | n) -> P (p^i)) -> - (forall p q, rel_prime p q -> P p -> P q -> P (p * q)) -> - forall m, 0 <= m -> (m | n) -> P m. -intros P n P1 Hn H H1 m Hm. -generalize Hm; pattern m; apply Z_lt_induction; auto; clear m Hm. -intros m Rec Hm H2. -case (prime_dec m); intros Hm1. -rewrite <- Zpower_1_r; apply H; auto with zarith. -rewrite Zpower_1_r; auto. -case Zle_lt_or_eq with (1 := Hm); clear Hm; intros Hm; subst. -2: contradict P1; case H2; intros; subst; auto with zarith. -case (Zle_lt_or_eq 1 m); auto with zarith; clear Hm; intros Hm; subst; auto. -case Zdivide_div_prime_le_square with m; auto. -intros p (Hp1, (Hp2, Hp3)). -case (div_power_max p m); auto with zarith. -generalize (prime_ge_2 p Hp1); auto with zarith. -intros i (Hi, (Hi1, Hi2)). -case Zle_lt_or_eq with (1 := Hi); clear Hi; intros Hi. -assert (Hpi: 0 < p ^ i). -apply Zpower_gt_0; auto with zarith. -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -rewrite (Z_div_exact_2 m (p ^ i)); auto with zarith. -apply H1; auto with zarith. -apply rel_prime_sym; apply rel_prime_Zpower_r; auto with zarith. -apply rel_prime_sym. -apply prime_rel_prime; auto. -contradict Hi2. -case Hi1; intros; subst. -rewrite Z_div_mult in Hi2; auto with zarith. -case Hi2; intros q0 Hq0; subst. -exists q0; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith. -apply H; auto with zarith. -apply Zdivide_trans with (1 := Hi1); auto. -apply Rec; auto with zarith. -split; auto with zarith. -apply Z_div_pos; auto with zarith. -apply Z_div_lt; auto with zarith. -apply Zle_ge; apply Zle_trans with p. -apply prime_ge_2; auto. -pattern p at 1; rewrite <- Zpower_1_r; apply Zpower_le_monotone; auto with zarith. -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -apply Z_div_pos; auto with zarith. -apply Zdivide_trans with (2 := H2); auto. -exists (p ^ i); apply Z_div_exact_2; auto with zarith. -apply Zdivide_mod; auto with zarith. -apply Zdivide_mod; auto with zarith. -case Hi2; rewrite <- Hi; rewrite Zplus_0_r; rewrite Zpower_1_r; auto. -Qed. - -Theorem prime_div_Zpower_prime: forall n p q, 0 <= n -> prime p -> prime q -> (p | q ^ n) -> p = q. -intros n p q Hp Hq; generalize p q Hq; pattern n; apply natlike_ind; auto; clear n p q Hp Hq. -intros p q Hp Hq; rewrite Zpower_0_r. -intros (r, H); subst. -case (Zmult_interval p r); auto; try rewrite Zmult_comm. -rewrite <- H; auto with zarith. -apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. -rewrite <- H; intros H1 H2; contradict H2; auto with zarith. -intros n1 H Rec p q Hp Hq; try rewrite Zpower_Zsucc; auto with zarith; intros H1. -case prime_mult with (2 := H1); auto. -intros H2; apply prime_div_prime; auto. -Qed. - -Definition Zmodd a b := -match a with -| Z0 => 0 -| Zpos a' => - match b with - | Z0 => 0 - | Zpos _ => Zmod_POS a' b - | Zneg b' => - let r := Zmod_POS a' (Zpos b') in - match r with Z0 => 0 | _ => b + r end - end -| Zneg a' => - match b with - | Z0 => 0 - | Zpos _ => - let r := Zmod_POS a' b in - match r with Z0 => 0 | _ => b - r end - | Zneg b' => - (Zmod_POS a' (Zpos b')) - end -end. - -Theorem Zmodd_correct: forall a b, Zmodd a b = Zmod a b. -intros a b; unfold Zmod; case a; simpl; auto. -intros p; case b; simpl; auto. -intros p1; refine (Zmod_POS_correct _ _); auto. -intros p1; rewrite Zmod_POS_correct; auto. -case (Zdiv_eucl_POS p (Zpos p1)); simpl; intros z1 z2; case z2; auto. -intros p; case b; simpl; auto. -intros p1; rewrite Zmod_POS_correct; auto. -case (Zdiv_eucl_POS p (Zpos p1)); simpl; intros z1 z2; case z2; auto. -intros p1; rewrite Zmod_POS_correct; simpl; auto. -case (Zdiv_eucl_POS p (Zpos p1)); auto. -Qed. - -Theorem prime_divide_prime_eq: - forall p1 p2, prime p1 -> prime p2 -> Zdivide p1 p2 -> p1 = p2. -intros p1 p2 Hp1 Hp2 Hp3. -assert (Ha: 1 < p1). -inversion Hp1; auto. -assert (Ha1: 1 < p2). -inversion Hp2; auto. -case (Zle_lt_or_eq p1 p2); auto with zarith. -apply Zdivide_le; auto with zarith. -intros Hp4. -case (prime_div_prime p1 p2); auto with zarith. -Qed. - -Theorem Zdivide_Zpower: forall n m, 0 < n -> (forall p i, prime p -> 0 < i -> (p^i | n) -> (p^i | m)) -> (n | m). -intros n m Hn; generalize m Hn; pattern n; apply prime_induction; auto with zarith; clear n m Hn. -intros m H1; contradict H1; auto with zarith. -intros p q H Rec m H1 H2. -assert (H3: (p | m)). -rewrite <- (Zpower_1_r p); apply H2; auto with zarith; rewrite Zpower_1_r; apply Zdivide_factor_r. -case (Zmult_interval p q); auto. -apply Zlt_le_trans with 2; auto with zarith; apply prime_ge_2; auto. -case H3; intros k Hk; subst. -intros Hq Hq1. -rewrite (Zmult_comm k); apply Zmult_divide_compat_l. -apply Rec; auto. -intros p1 i Hp1 Hp2 Hp3. -case (Z_eq_dec p p1); intros Hpp1; subst. -case (H2 p1 (Zsucc i)); auto with zarith. -rewrite Zpower_Zsucc; try apply Zmult_divide_compat_l; auto with zarith. -intros q2 Hq2; exists q2. -apply Zmult_reg_r with p1. -contradict H; subst; apply not_prime_0. -rewrite Hq2; rewrite Zpower_Zsucc; try ring; auto with zarith. -apply Gauss with p. -rewrite Zmult_comm; apply H2; auto. -apply Zdivide_trans with (1:= Hp3). -apply Zdivide_factor_l. -apply rel_prime_sym; apply rel_prime_Zpower_r; auto with zarith. -apply prime_rel_prime; auto. -contradict Hpp1; apply prime_divide_prime_eq; auto. -Qed. - -Theorem prime_divide_Zpower_Zdiv: forall m a p i, 0 <= i -> prime p -> (m | a) -> ~(m | (a/p)) -> (p^i | a) -> (p^i | m). -intros m a p i Hi Hp (k, Hk) H (l, Hl); subst. -case (Zle_lt_or_eq 0 i); auto with arith; intros Hi1; subst. -assert (Hp0: 0 < p). -apply Zlt_le_trans with 2; auto with zarith; apply prime_ge_2; auto. -case (Zdivide_dec p k); intros H1. -case H1; intros k' H2; subst. -case H; replace (k' * p * m) with ((k' * m) * p); try ring; rewrite Z_div_mult; auto with zarith. -apply Gauss with k. -exists l; rewrite Hl; ring. -apply rel_prime_sym; apply rel_prime_Zpower_r; auto. -apply rel_prime_sym; apply prime_rel_prime; auto. -rewrite Zpower_0_r; apply Zone_divide. -Qed. - -Theorem Zle_square_mult: forall a b, 0 <= a <= b -> a * a <= b * b. -intros a b (H1, H2); apply Zle_trans with (a * b); auto with zarith. -Qed. - -Theorem Zlt_square_mult_inv: forall a b, 0 <= a -> 0 <= b -> a * a < b * b -> a < b. -intros a b H1 H2 H3; case (Zle_or_lt b a); auto; intros H4; apply Zmult_lt_reg_r with a; - contradict H3; apply Zle_not_lt; apply Zle_square_mult; auto. -Qed. - - -Theorem Zmod_closeby_eq: forall a b n, 0 <= a -> 0 <= b < n -> a - b < n -> a mod n = b -> a = b. -intros a b n H H1 H2 H3. -case (Zle_or_lt 0 (a - b)); intros H4. -case Zle_lt_or_eq with (1 := H4); clear H4; intros H4; auto with zarith. -contradict H2; apply Zle_not_lt; apply Zdivide_le; auto with zarith. -apply Zmod_divide_minus; auto with zarith. -rewrite <- (Zmod_small a n); try split; auto with zarith. -Qed. - - -Theorem Zpow_mod_pos_Zpower_pos_correct: forall a m n, 0 < n -> Zpow_mod_pos a m n = (Zpower_pos a m) mod n. -intros a m; elim m; simpl; auto. -intros p Rec n H1; rewrite xI_succ_xO; rewrite Pplus_one_succ_r; rewrite <- Pplus_diag; auto. -repeat rewrite Zpower_pos_is_exp; auto. -repeat rewrite Rec; auto. -replace (Zpower_pos a 1) with a; auto. -2: unfold Zpower_pos; simpl; auto with zarith. -repeat rewrite (fun x => (Zmult_mod x a)); auto. -rewrite (Zmult_mod (Zpower_pos a p)); auto. -case (Zpower_pos a p mod n); auto. -intros p Rec n H1; rewrite <- Pplus_diag; auto. -repeat rewrite Zpower_pos_is_exp; auto. -repeat rewrite Rec; auto. -rewrite (Zmult_mod (Zpower_pos a p)); auto. -case (Zpower_pos a p mod n); auto. -unfold Zpower_pos; simpl; rewrite Zmult_1_r; auto with zarith. -Qed. - -Theorem Zpow_mod_Zpower_correct: forall a m n, 1 < n -> 0 <= m -> Zpow_mod a m n = (a ^ m) mod n. -intros a m n; case m; simpl; auto. -intros; apply Zpow_mod_pos_Zpower_pos_correct; auto with zarith. -Qed. diff --git a/coqprime-8.5/Coqprime/ZCmisc.v b/coqprime-8.5/Coqprime/ZCmisc.v deleted file mode 100644 index c1bdacc63..000000000 --- a/coqprime-8.5/Coqprime/ZCmisc.v +++ /dev/null @@ -1,186 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Require Export ZArith. -Open Local Scope Z_scope. - -Coercion Zpos : positive >-> Z. -Coercion Z_of_N : N >-> Z. - -Lemma Zpos_plus : forall p q, Zpos (p + q) = p + q. -Proof. intros;trivial. Qed. - -Lemma Zpos_mult : forall p q, Zpos (p * q) = p * q. -Proof. intros;trivial. Qed. - -Lemma Zpos_xI_add : forall p, Zpos (xI p) = Zpos p + Zpos p + Zpos 1. -Proof. intros p;rewrite Zpos_xI;ring. Qed. - -Lemma Zpos_xO_add : forall p, Zpos (xO p) = Zpos p + Zpos p. -Proof. intros p;rewrite Zpos_xO;ring. Qed. - -Lemma Psucc_Zplus : forall p, Zpos (Psucc p) = p + 1. -Proof. intros p;rewrite Zpos_succ_morphism;unfold Zsucc;trivial. Qed. - -Hint Rewrite Zpos_xI_add Zpos_xO_add Pplus_carry_spec - Psucc_Zplus Zpos_plus : zmisc. - -Lemma Zlt_0_pos : forall p, 0 < Zpos p. -Proof. unfold Zlt;trivial. Qed. - - -Lemma Pminus_mask_carry_spec : forall p q, - Pminus_mask_carry p q = Pminus_mask p (Psucc q). -Proof. - intros p q;generalize q p;clear q p. - induction q;destruct p;simpl;try rewrite IHq;trivial. - destruct p;trivial. destruct p;trivial. -Qed. - -Hint Rewrite Pminus_mask_carry_spec : zmisc. - -Ltac zsimpl := autorewrite with zmisc. -Ltac CaseEq t := generalize (refl_equal t);pattern t at -1;case t. -Ltac generalizeclear H := generalize H;clear H. - -Lemma Pminus_mask_spec : - forall p q, - match Pminus_mask p q with - | IsNul => Zpos p = Zpos q - | IsPos k => Zpos p = q + k - | IsNeq => p < q - end. -Proof with zsimpl;auto with zarith. - induction p;destruct q;simpl;zsimpl; - match goal with - | [|- context [(Pminus_mask ?p1 ?q1)]] => - assert (H1 := IHp q1);destruct (Pminus_mask p1 q1) - | _ => idtac - end;simpl ... - inversion H1 ... inversion H1 ... - rewrite Psucc_Zplus in H1 ... - clear IHp;induction p;simpl ... - rewrite IHp;destruct (Pdouble_minus_one p) ... - assert (H:= Zlt_0_pos q) ... assert (H:= Zlt_0_pos q) ... -Qed. - -Definition PminusN x y := - match Pminus_mask x y with - | IsPos k => Npos k - | _ => N0 - end. - -Lemma PminusN_le : forall x y:positive, x <= y -> Z_of_N (PminusN y x) = y - x. -Proof. - intros x y Hle;unfold PminusN. - assert (H := Pminus_mask_spec y x);destruct (Pminus_mask y x). - rewrite H;unfold Z_of_N;auto with zarith. - rewrite H;unfold Z_of_N;auto with zarith. - elimtype False;omega. -Qed. - -Lemma Ppred_Zminus : forall p, 1< Zpos p -> (p-1)%Z = Ppred p. -Proof. destruct p;simpl;trivial. intros;elimtype False;omega. Qed. - - -Open Local Scope positive_scope. - -Delimit Scope P_scope with P. -Open Local Scope P_scope. - -Definition is_lt (n m : positive) := - match (n ?= m) with - | Lt => true - | _ => false - end. -Infix "?<" := is_lt (at level 70, no associativity) : P_scope. - -Lemma is_lt_spec : forall n m, if n ?< m then (n < m)%Z else (m <= n)%Z. -Proof. -intros n m; unfold is_lt, Zlt, Zle, Zcompare. -rewrite Pos.compare_antisym. -case (m ?= n); simpl; auto; intros HH; discriminate HH. -Qed. - -Definition is_eq a b := - match (a ?= b) with - | Eq => true - | _ => false - end. -Infix "?=" := is_eq (at level 70, no associativity) : P_scope. - -Lemma is_eq_refl : forall n, n ?= n = true. -Proof. intros n;unfold is_eq;rewrite Pos.compare_refl;trivial. Qed. - -Lemma is_eq_eq : forall n m, n ?= m = true -> n = m. -Proof. - unfold is_eq;intros n m H; apply Pos.compare_eq. -destruct (n ?= m)%positive;trivial;try discriminate. -Qed. - -Lemma is_eq_spec_pos : forall n m, if n ?= m then n = m else m <> n. -Proof. - intros n m; CaseEq (n ?= m);intro H. - rewrite (is_eq_eq _ _ H);trivial. - intro H1;rewrite H1 in H;rewrite is_eq_refl in H;discriminate H. -Qed. - -Lemma is_eq_spec : forall n m, if n ?= m then Zpos n = m else Zpos m <> n. -Proof. - intros n m; CaseEq (n ?= m);intro H. - rewrite (is_eq_eq _ _ H);trivial. - intro H1;inversion H1. - rewrite H2 in H;rewrite is_eq_refl in H;discriminate H. -Qed. - -Definition is_Eq a b := - match a, b with - | N0, N0 => true - | Npos a', Npos b' => a' ?= b' - | _, _ => false - end. - -Lemma is_Eq_spec : - forall n m, if is_Eq n m then Z_of_N n = m else Z_of_N m <> n. -Proof. - destruct n;destruct m;simpl;trivial;try (intro;discriminate). - apply is_eq_spec. -Qed. - -(* [times x y] return [x * y], a litle bit more efficiant *) -Fixpoint times (x y : positive) {struct y} : positive := - match x, y with - | xH, _ => y - | _, xH => x - | xO x', xO y' => xO (xO (times x' y')) - | xO x', xI y' => xO (x' + xO (times x' y')) - | xI x', xO y' => xO (y' + xO (times x' y')) - | xI x', xI y' => xI (x' + y' + xO (times x' y')) - end. - -Infix "*" := times : P_scope. - -Lemma times_Zmult : forall p q, Zpos (p * q)%P = (p * q)%Z. -Proof. - intros p q;generalize q p;clear p q. - induction q;destruct p; unfold times; try fold (times p q); - autorewrite with zmisc; try rewrite IHq; ring. -Qed. - -Fixpoint square (x:positive) : positive := - match x with - | xH => xH - | xO x => xO (xO (square x)) - | xI x => xI (xO (square x + x)) - end. - -Lemma square_Zmult : forall x, Zpos (square x) = (x * x) %Z. -Proof. - induction x as [x IHx|x IHx |];unfold square;try (fold (square x)); - autorewrite with zmisc; try rewrite IHx; ring. -Qed. diff --git a/coqprime-8.5/Coqprime/ZProgression.v b/coqprime-8.5/Coqprime/ZProgression.v deleted file mode 100644 index 51ce91cdc..000000000 --- a/coqprime-8.5/Coqprime/ZProgression.v +++ /dev/null @@ -1,104 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -Require Export Iterator. -Require Import ZArith. -Require Export UList. -Open Scope Z_scope. - -Theorem next_n_Z: forall n m, next_n Zsucc n m = n + Z_of_nat m. -intros n m; generalize n; elim m; clear n m. -intros n; simpl; auto with zarith. -intros m H n. -replace (n + Z_of_nat (S m)) with (Zsucc n + Z_of_nat m); auto with zarith. -rewrite <- H; auto with zarith. -rewrite inj_S; auto with zarith. -Qed. - -Theorem Zprogression_end: - forall n m, - progression Zsucc n (S m) = - app (progression Zsucc n m) (cons (n + Z_of_nat m) nil). -intros n m; generalize n; elim m; clear n m. -simpl; intros; apply f_equal2 with ( f := @cons Z ); auto with zarith. -intros m1 Hm1 n1. -apply trans_equal with (cons n1 (progression Zsucc (Zsucc n1) (S m1))); auto. -rewrite Hm1. -replace (Zsucc n1 + Z_of_nat m1) with (n1 + Z_of_nat (S m1)); auto with zarith. -replace (Z_of_nat (S m1)) with (1 + Z_of_nat m1); auto with zarith. -rewrite inj_S; auto with zarith. -Qed. - -Theorem Zprogression_pred_end: - forall n m, - progression Zpred n (S m) = - app (progression Zpred n m) (cons (n - Z_of_nat m) nil). -intros n m; generalize n; elim m; clear n m. -simpl; intros; apply f_equal2 with ( f := @cons Z ); auto with zarith. -intros m1 Hm1 n1. -apply trans_equal with (cons n1 (progression Zpred (Zpred n1) (S m1))); auto. -rewrite Hm1. -replace (Zpred n1 - Z_of_nat m1) with (n1 - Z_of_nat (S m1)); auto with zarith. -replace (Z_of_nat (S m1)) with (1 + Z_of_nat m1); auto with zarith. -rewrite inj_S; auto with zarith. -Qed. - -Theorem Zprogression_opp: - forall n m, - rev (progression Zsucc n m) = progression Zpred (n + Z_of_nat (pred m)) m. -intros n m; generalize n; elim m; clear n m. -simpl; auto. -intros m Hm n. -rewrite (Zprogression_end n); auto. -rewrite distr_rev. -rewrite Hm; simpl; auto. -case m. -simpl; auto. -intros m1; - replace (n + Z_of_nat (pred (S m1))) with (Zpred (n + Z_of_nat (S m1))); auto. -rewrite inj_S; simpl; (unfold Zpred; unfold Zsucc); auto with zarith. -Qed. - -Theorem Zprogression_le_init: - forall n m p, In p (progression Zsucc n m) -> (n <= p). -intros n m; generalize n; elim m; clear n m; simpl; auto. -intros; contradiction. -intros m H n p [H1|H1]; auto with zarith. -generalize (H _ _ H1); auto with zarith. -Qed. - -Theorem Zprogression_le_end: - forall n m p, In p (progression Zsucc n m) -> (p < n + Z_of_nat m). -intros n m; generalize n; elim m; clear n m; auto. -intros; contradiction. -intros m H n p H1; simpl in H1 |-; case H1; clear H1; intros H1; - auto with zarith. -subst n; auto with zarith. -apply Zle_lt_trans with (p + 0); auto with zarith. -apply Zplus_lt_compat_l; red; simpl; auto with zarith. -apply Zlt_le_trans with (Zsucc n + Z_of_nat m); auto with zarith. -rewrite inj_S; rewrite Zplus_succ_comm; auto with zarith. -Qed. - -Theorem ulist_Zprogression: forall a n, ulist (progression Zsucc a n). -intros a n; generalize a; elim n; clear a n; simpl; auto with zarith. -intros n H1 a; apply ulist_cons; auto. -intros H2; absurd (Zsucc a <= a); auto with zarith. -apply Zprogression_le_init with ( 1 := H2 ). -Qed. - -Theorem in_Zprogression: - forall a b n, ( a <= b < a + Z_of_nat n ) -> In b (progression Zsucc a n). -intros a b n; generalize a b; elim n; clear a b n; auto with zarith. -simpl; auto with zarith. -intros n H a b. -replace (a + Z_of_nat (S n)) with (Zsucc a + Z_of_nat n); auto with zarith. -intros [H1 H2]; simpl; auto with zarith. -case (Zle_lt_or_eq _ _ H1); auto with zarith. -rewrite inj_S; auto with zarith. -Qed. diff --git a/coqprime-8.5/Coqprime/ZSum.v b/coqprime-8.5/Coqprime/ZSum.v deleted file mode 100644 index 3a7f14065..000000000 --- a/coqprime-8.5/Coqprime/ZSum.v +++ /dev/null @@ -1,335 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(*********************************************************************** - Summation.v from Z to Z - *********************************************************************) -Require Import Arith. -Require Import ArithRing. -Require Import ListAux. -Require Import ZArith. -Require Import Iterator. -Require Import ZProgression. - - -Open Scope Z_scope. -(* Iterated Sum *) - -Definition Zsum := - fun n m f => - if Zle_bool n m - then iter 0 f Zplus (progression Zsucc n (Zabs_nat ((1 + m) - n))) - else iter 0 f Zplus (progression Zpred n (Zabs_nat ((1 + n) - m))). -Hint Unfold Zsum . - -Lemma Zsum_nn: forall n f, Zsum n n f = f n. -intros n f; unfold Zsum; rewrite Zle_bool_refl. -replace ((1 + n) - n) with 1; auto with zarith. -simpl; ring. -Qed. - -Theorem permutation_rev: forall (A:Set) (l : list A), permutation (rev l) l. -intros a l; elim l; simpl; auto. -intros a1 l1 Hl1. -apply permutation_trans with (cons a1 (rev l1)); auto. -change (permutation (rev l1 ++ (a1 :: nil)) (app (cons a1 nil) (rev l1))); auto. -Qed. - -Lemma Zsum_swap: forall (n m : Z) (f : Z -> Z), Zsum n m f = Zsum m n f. -intros n m f; unfold Zsum. -generalize (Zle_cases n m) (Zle_cases m n); case (Zle_bool n m); - case (Zle_bool m n); auto with arith. -intros; replace n with m; auto with zarith. -3:intros H1 H2; contradict H2; auto with zarith. -intros H1 H2; apply iter_permutation; auto with zarith. -apply permutation_trans - with (rev (progression Zsucc n (Zabs_nat ((1 + m) - n)))). -apply permutation_sym; apply permutation_rev. -rewrite Zprogression_opp; auto with zarith. -replace (n + Z_of_nat (pred (Zabs_nat ((1 + m) - n)))) with m; auto. -replace (Zabs_nat ((1 + m) - n)) with (S (Zabs_nat (m - n))); auto with zarith. -simpl. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -replace ((1 + m) - n) with (1 + (m - n)); auto with zarith. -cut (0 <= m - n); auto with zarith; unfold Zabs_nat. -case (m - n); auto with zarith. -intros p; case p; simpl; auto with zarith. -intros p1 Hp1; rewrite nat_of_P_xO; rewrite nat_of_P_xI; - rewrite nat_of_P_succ_morphism. -simpl; repeat rewrite plus_0_r. -repeat rewrite <- plus_n_Sm; simpl; auto. -intros p H3; contradict H3; auto with zarith. -intros H1 H2; apply iter_permutation; auto with zarith. -apply permutation_trans - with (rev (progression Zsucc m (Zabs_nat ((1 + n) - m)))). -rewrite Zprogression_opp; auto with zarith. -replace (m + Z_of_nat (pred (Zabs_nat ((1 + n) - m)))) with n; auto. -replace (Zabs_nat ((1 + n) - m)) with (S (Zabs_nat (n - m))); auto with zarith. -simpl. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -replace ((1 + n) - m) with (1 + (n - m)); auto with zarith. -cut (0 <= n - m); auto with zarith; unfold Zabs_nat. -case (n - m); auto with zarith. -intros p; case p; simpl; auto with zarith. -intros p1 Hp1; rewrite nat_of_P_xO; rewrite nat_of_P_xI; - rewrite nat_of_P_succ_morphism. -simpl; repeat rewrite plus_0_r. -repeat rewrite <- plus_n_Sm; simpl; auto. -intros p H3; contradict H3; auto with zarith. -apply permutation_rev. -Qed. - -Lemma Zsum_split_up: - forall (n m p : Z) (f : Z -> Z), - ( n <= m < p ) -> Zsum n p f = Zsum n m f + Zsum (m + 1) p f. -intros n m p f [H H0]. -case (Zle_lt_or_eq _ _ H); clear H; intros H. -unfold Zsum; (repeat rewrite Zle_imp_le_bool); auto with zarith. -assert (H1: n < p). -apply Zlt_trans with ( 1 := H ); auto with zarith. -assert (H2: m < 1 + p). -apply Zlt_trans with ( 1 := H0 ); auto with zarith. -assert (H3: n < 1 + m). -apply Zlt_trans with ( 1 := H ); auto with zarith. -assert (H4: n < 1 + p). -apply Zlt_trans with ( 1 := H1 ); auto with zarith. -replace (Zabs_nat ((1 + p) - (m + 1))) - with (minus (Zabs_nat ((1 + p) - n)) (Zabs_nat ((1 + m) - n))). -apply iter_progression_app; auto with zarith. -apply inj_le_rev. -(repeat rewrite inj_Zabs_nat); auto with zarith. -(repeat rewrite Zabs_eq); auto with zarith. -rewrite next_n_Z; auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -apply inj_eq_rev; auto with zarith. -rewrite inj_minus1; auto with zarith. -(repeat rewrite inj_Zabs_nat); auto with zarith. -(repeat rewrite Zabs_eq); auto with zarith. -apply inj_le_rev. -(repeat rewrite inj_Zabs_nat); auto with zarith. -(repeat rewrite Zabs_eq); auto with zarith. -subst m. -rewrite Zsum_nn; auto with zarith. -unfold Zsum; generalize (Zle_cases n p); generalize (Zle_cases (n + 1) p); - case (Zle_bool n p); case (Zle_bool (n + 1) p); auto with zarith. -intros H1 H2. -replace (Zabs_nat ((1 + p) - n)) with (S (Zabs_nat (p - n))); auto with zarith. -replace (n + 1) with (Zsucc n); auto with zarith. -replace ((1 + p) - Zsucc n) with (p - n); auto with zarith. -apply inj_eq_rev; auto with zarith. -rewrite inj_S; (repeat rewrite inj_Zabs_nat); auto with zarith. -(repeat rewrite Zabs_eq); auto with zarith. -Qed. - -Lemma Zsum_S_left: - forall (n m : Z) (f : Z -> Z), n < m -> Zsum n m f = f n + Zsum (n + 1) m f. -intros n m f H; rewrite (Zsum_split_up n n m f); auto with zarith. -rewrite Zsum_nn; auto with zarith. -Qed. - -Lemma Zsum_S_right: - forall (n m : Z) (f : Z -> Z), - n <= m -> Zsum n (m + 1) f = Zsum n m f + f (m + 1). -intros n m f H; rewrite (Zsum_split_up n m (m + 1) f); auto with zarith. -rewrite Zsum_nn; auto with zarith. -Qed. - -Lemma Zsum_split_down: - forall (n m p : Z) (f : Z -> Z), - ( p < m <= n ) -> Zsum n p f = Zsum n m f + Zsum (m - 1) p f. -intros n m p f [H H0]. -case (Zle_lt_or_eq p (m - 1)); auto with zarith; intros H1. -pattern m at 1; replace m with ((m - 1) + 1); auto with zarith. -repeat rewrite (Zsum_swap n). -rewrite (Zsum_swap (m - 1)). -rewrite Zplus_comm. -apply Zsum_split_up; auto with zarith. -subst p. -repeat rewrite (Zsum_swap n). -rewrite Zsum_nn. -unfold Zsum; (repeat rewrite Zle_imp_le_bool); auto with zarith. -replace (Zabs_nat ((1 + n) - (m - 1))) with (S (Zabs_nat (n - (m - 1)))). -rewrite Zplus_comm. -replace (Zabs_nat ((1 + n) - m)) with (Zabs_nat (n - (m - 1))); auto with zarith. -pattern m at 4; replace m with (Zsucc (m - 1)); auto with zarith. -apply f_equal with ( f := Zabs_nat ); auto with zarith. -apply inj_eq_rev; auto with zarith. -rewrite inj_S. -(repeat rewrite inj_Zabs_nat); auto with zarith. -(repeat rewrite Zabs_eq); auto with zarith. -Qed. - - -Lemma Zsum_ext: - forall (n m : Z) (f g : Z -> Z), - n <= m -> - (forall (x : Z), ( n <= x <= m ) -> f x = g x) -> Zsum n m f = Zsum n m g. -intros n m f g HH H. -unfold Zsum; auto. -unfold Zsum; (repeat rewrite Zle_imp_le_bool); auto with zarith. -apply iter_ext; auto with zarith. -intros a H1; apply H; auto; split. -apply Zprogression_le_init with ( 1 := H1 ). -cut (a < Zsucc m); auto with zarith. -replace (Zsucc m) with (n + Z_of_nat (Zabs_nat ((1 + m) - n))); auto with zarith. -apply Zprogression_le_end; auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -(repeat rewrite Zabs_eq); auto with zarith. -Qed. - -Lemma Zsum_add: - forall (n m : Z) (f g : Z -> Z), - Zsum n m f + Zsum n m g = Zsum n m (fun (i : Z) => f i + g i). -intros n m f g; unfold Zsum; case (Zle_bool n m); apply iter_comp; - auto with zarith. -Qed. - -Lemma Zsum_times: - forall n m x f, x * Zsum n m f = Zsum n m (fun i=> x * f i). -intros n m x f. -unfold Zsum. case (Zle_bool n m); intros; apply iter_comp_const with (k := (fun y : Z => x * y)); auto with zarith. -Qed. - -Lemma inv_Zsum: - forall (P : Z -> Prop) (n m : Z) (f : Z -> Z), - n <= m -> - P 0 -> - (forall (a b : Z), P a -> P b -> P (a + b)) -> - (forall (x : Z), ( n <= x <= m ) -> P (f x)) -> P (Zsum n m f). -intros P n m f HH H H0 H1. -unfold Zsum; rewrite Zle_imp_le_bool; auto with zarith; apply iter_inv; auto. -intros x H3; apply H1; auto; split. -apply Zprogression_le_init with ( 1 := H3 ). -cut (x < Zsucc m); auto with zarith. -replace (Zsucc m) with (n + Z_of_nat (Zabs_nat ((1 + m) - n))); auto with zarith. -apply Zprogression_le_end; auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -(repeat rewrite Zabs_eq); auto with zarith. -Qed. - - -Lemma Zsum_pred: - forall (n m : Z) (f : Z -> Z), - Zsum n m f = Zsum (n + 1) (m + 1) (fun (i : Z) => f (Zpred i)). -intros n m f. -unfold Zsum. -generalize (Zle_cases n m); generalize (Zle_cases (n + 1) (m + 1)); - case (Zle_bool n m); case (Zle_bool (n + 1) (m + 1)); auto with zarith. -replace ((1 + (m + 1)) - (n + 1)) with ((1 + m) - n); auto with zarith. -intros H1 H2; cut (exists c , c = Zabs_nat ((1 + m) - n) ). -intros [c H3]; rewrite <- H3. -generalize n; elim c; auto with zarith; clear H1 H2 H3 c n. -intros c H n; simpl; eq_tac; auto with zarith. -eq_tac; unfold Zpred; auto with zarith. -replace (Zsucc (n + 1)) with (Zsucc n + 1); auto with zarith. -exists (Zabs_nat ((1 + m) - n)); auto. -replace ((1 + (n + 1)) - (m + 1)) with ((1 + n) - m); auto with zarith. -intros H1 H2; cut (exists c , c = Zabs_nat ((1 + n) - m) ). -intros [c H3]; rewrite <- H3. -generalize n; elim c; auto with zarith; clear H1 H2 H3 c n. -intros c H n; simpl; (eq_tac; auto with zarith). -eq_tac; unfold Zpred; auto with zarith. -replace (Zpred (n + 1)) with (Zpred n + 1); auto with zarith. -unfold Zpred; auto with zarith. -exists (Zabs_nat ((1 + n) - m)); auto. -Qed. - -Theorem Zsum_c: - forall (c p q : Z), p <= q -> Zsum p q (fun x => c) = ((1 + q) - p) * c. -intros c p q Hq; unfold Zsum. -rewrite Zle_imp_le_bool; auto with zarith. -pattern ((1 + q) - p) at 2. - rewrite <- Zabs_eq; auto with zarith. - rewrite <- inj_Zabs_nat; auto with zarith. -cut (exists r , r = Zabs_nat ((1 + q) - p) ); - [intros [r H1]; rewrite <- H1 | exists (Zabs_nat ((1 + q) - p))]; auto. -generalize p; elim r; auto with zarith. -intros n H p0; replace (Z_of_nat (S n)) with (Z_of_nat n + 1); auto with zarith. -simpl; rewrite H; ring. -rewrite inj_S; auto with zarith. -Qed. - -Theorem Zsum_Zsum_f: - forall (i j k l : Z) (f : Z -> Z -> Z), - i <= j -> - k < l -> - Zsum i j (fun x => Zsum k (l + 1) (fun y => f x y)) = - Zsum i j (fun x => Zsum k l (fun y => f x y) + f x (l + 1)). -intros; apply Zsum_ext; intros; auto with zarith. -rewrite Zsum_S_right; auto with zarith. -Qed. - -Theorem Zsum_com: - forall (i j k l : Z) (f : Z -> Z -> Z), - Zsum i j (fun x => Zsum k l (fun y => f x y)) = - Zsum k l (fun y => Zsum i j (fun x => f x y)). -intros; unfold Zsum; case (Zle_bool i j); case (Zle_bool k l); apply iter_com; - auto with zarith. -Qed. - -Theorem Zsum_le: - forall (n m : Z) (f g : Z -> Z), - n <= m -> - (forall (x : Z), ( n <= x <= m ) -> (f x <= g x )) -> - (Zsum n m f <= Zsum n m g ). -intros n m f g Hl H. -unfold Zsum; rewrite Zle_imp_le_bool; auto with zarith. -unfold Zsum; - cut - (forall x, - In x (progression Zsucc n (Zabs_nat ((1 + m) - n))) -> ( f x <= g x )). -elim (progression Zsucc n (Zabs_nat ((1 + m) - n))); simpl; auto with zarith. -intros x H1; apply H; split. -apply Zprogression_le_init with ( 1 := H1 ); auto. -cut (x < m + 1); auto with zarith. -replace (m + 1) with (n + Z_of_nat (Zabs_nat ((1 + m) - n))); auto with zarith. -apply Zprogression_le_end; auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -Qed. - -Theorem iter_le: -forall (f g: Z -> Z) l, (forall a, In a l -> f a <= g a) -> - iter 0 f Zplus l <= iter 0 g Zplus l. -intros f g l; elim l; simpl; auto with zarith. -Qed. - -Theorem Zsum_lt: - forall n m f g, - (forall x, n <= x -> x <= m -> f x <= g x) -> - (exists x, n <= x /\ x <= m /\ f x < g x) -> - Zsum n m f < Zsum n m g. -intros n m f g H (d, (Hd1, (Hd2, Hd3))); unfold Zsum; rewrite Zle_imp_le_bool; auto with zarith. -cut (In d (progression Zsucc n (Zabs_nat (1 + m - n)))). -cut (forall x, In x (progression Zsucc n (Zabs_nat (1 + m - n)))-> f x <= g x). -elim (progression Zsucc n (Zabs_nat (1 + m - n))); simpl; auto with zarith. -intros a l Rec H0 [H1 | H1]; subst; auto. -apply Zle_lt_trans with (f d + iter 0 g Zplus l); auto with zarith. -apply Zplus_le_compat_l. -apply iter_le; auto. -apply Zlt_le_trans with (f a + iter 0 g Zplus l); auto with zarith. -intros x H1; apply H. -apply Zprogression_le_init with ( 1 := H1 ); auto. -cut (x < m + 1); auto with zarith. -replace (m + 1) with (n + Z_of_nat (Zabs_nat ((1 + m) - n))); auto with zarith. -apply Zprogression_le_end with ( 1 := H1 ); auto with arith. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -apply in_Zprogression. -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -Qed. - -Theorem Zsum_minus: - forall n m f g, Zsum n m f - Zsum n m g = Zsum n m (fun x => f x - g x). -intros n m f g; apply trans_equal with (Zsum n m f + (-1) * Zsum n m g); auto with zarith. -rewrite Zsum_times; rewrite Zsum_add; auto with zarith. -Qed. diff --git a/coqprime-8.5/Coqprime/Zp.v b/coqprime-8.5/Coqprime/Zp.v deleted file mode 100644 index 1e5295191..000000000 --- a/coqprime-8.5/Coqprime/Zp.v +++ /dev/null @@ -1,411 +0,0 @@ - -(*************************************************************) -(* This file is distributed under the terms of the *) -(* GNU Lesser General Public License Version 2.1 *) -(*************************************************************) -(* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) -(*************************************************************) - -(********************************************************************** - Zp.v - - Build the group of the inversible element on {1, 2, .., n-1} - for the multiplication modulo n - - Definition: ZpGroup - **********************************************************************) -Require Import ZArith Znumtheory Zpow_facts. -Require Import Tactic. -Require Import Wf_nat. -Require Import UList. -Require Import FGroup. -Require Import EGroup. -Require Import IGroup. -Require Import Cyclic. -Require Import Euler. -Require Import ZProgression. - -Open Scope Z_scope. - -Section Zp. - -Variable n: Z. - -Hypothesis n_pos: 1 < n. - - -(************************************** - mkZp m creates {m, m - 1, ..., 0} - **************************************) - -Fixpoint mkZp_aux (m: nat): list Z:= - Z_of_nat m :: match m with O => nil | (S m1) => mkZp_aux m1 end. - -(************************************** - Some properties of mkZp_aux - **************************************) - -Theorem mkZp_aux_length: forall m, length (mkZp_aux m) = (m + 1)%nat. -intros m; elim m; simpl; auto. -Qed. - -Theorem mkZp_aux_in: forall m p, 0 <= p <= Z_of_nat m -> In p (mkZp_aux m). -intros m; elim m. -simpl; auto with zarith. -intros n1 Rec p (H1, H2); case Zle_lt_or_eq with (1 := H2); clear H2; intro H2. -rewrite inj_S in H2. -simpl; right; apply Rec; split; auto with zarith. -rewrite H2; simpl; auto. -Qed. - -Theorem in_mkZp_aux: forall m p, In p (mkZp_aux m) -> 0 <= p <= Z_of_nat m. -intros m; elim m; clear m. -simpl; intros p H1; case H1; clear H1; intros H1; subst; auto with zarith. -intros m1; generalize (inj_S m1); simpl. -intros H Rec p [H1 | H1]. -rewrite <- H1; rewrite H; auto with zarith. -rewrite H; case (Rec p); auto with zarith. -Qed. - -Theorem mkZp_aux_ulist: forall m, ulist (mkZp_aux m). -intros m; elim m; simpl; auto. -intros m1 H; apply ulist_cons; auto. -change (~ In (Z_of_nat (S m1)) (mkZp_aux m1)). -rewrite inj_S; intros H1. -case in_mkZp_aux with (1 := H1); auto with zarith. -Qed. - -(************************************** - mkZp creates {n - 1, ..., 1, 0} - **************************************) - -Definition mkZp := mkZp_aux (Zabs_nat (n - 1)). - -(************************************** - Some properties of mkZp - **************************************) - -Theorem mkZp_length: length mkZp = Zabs_nat n. -unfold mkZp; rewrite mkZp_aux_length. -apply inj_eq_rev. -rewrite inj_plus. -simpl; repeat rewrite inj_Zabs_nat; auto with zarith. -repeat rewrite Zabs_eq; auto with zarith. -Qed. - -Theorem mkZp_in: forall p, 0 <= p < n -> In p mkZp. -intros p (H1, H2); unfold mkZp; apply mkZp_aux_in. -rewrite inj_Zabs_nat; auto with zarith. -repeat rewrite Zabs_eq; auto with zarith. -Qed. - -Theorem in_mkZp: forall p, In p mkZp -> 0 <= p < n. -intros p H; case (in_mkZp_aux (Zabs_nat (n - 1)) p); auto with zarith. -rewrite inj_Zabs_nat; auto with zarith. -repeat rewrite Zabs_eq; auto with zarith. -Qed. - -Theorem mkZp_ulist: ulist mkZp. -unfold mkZp; apply mkZp_aux_ulist; auto. -Qed. - -(************************************** - Multiplication of two pairs - **************************************) - -Definition pmult (p q: Z) := (p * q) mod n. - -(************************************** - Properties of multiplication - **************************************) - -Theorem pmult_assoc: forall p q r, (pmult p (pmult q r)) = (pmult (pmult p q) r). -assert (Hu: 0 < n); try apply Zlt_trans with 1; auto with zarith. -generalize Zmod_mod; intros H. -intros p q r; unfold pmult. -rewrite (Zmult_mod p); auto. -repeat rewrite Zmod_mod; auto. -rewrite (Zmult_mod q); auto. -rewrite <- Zmult_mod; auto. -rewrite Zmult_assoc. -rewrite (Zmult_mod (p * (q mod n))); auto. -rewrite (Zmult_mod ((p * q) mod n)); auto. -eq_tac; auto. -eq_tac; auto. -rewrite (Zmult_mod p); sauto. -rewrite Zmod_mod; auto. -rewrite <- Zmult_mod; sauto. -Qed. - -Theorem pmult_1_l: forall p, In p mkZp -> pmult 1 p = p. -intros p H; unfold pmult; rewrite Zmult_1_l. -apply Zmod_small. -case (in_mkZp p); auto with zarith. -Qed. - -Theorem pmult_1_r: forall p, In p mkZp -> pmult p 1 = p. -intros p H; unfold pmult; rewrite Zmult_1_r. -apply Zmod_small. -case (in_mkZp p); auto with zarith. -Qed. - -Theorem pmult_comm: forall p q, pmult p q = pmult q p. -intros p q; unfold pmult; rewrite Zmult_comm; auto. -Qed. - -Definition Lrel := isupport_aux _ pmult mkZp 1 Z_eq_dec (progression Zsucc 0 (Zabs_nat n)). - -Theorem rel_prime_is_inv: - forall a, is_inv Z pmult mkZp 1 Z_eq_dec a = if (rel_prime_dec a n) then true else false. -assert (Hu: 0 < n); try apply Zlt_trans with 1; auto with zarith. -intros a; case (rel_prime_dec a n); intros H. -assert (H1: Bezout a n 1); try apply rel_prime_bezout; auto. -inversion H1 as [c d Hcd]; clear H1. -assert (pmult (c mod n) a = 1). -unfold pmult; rewrite Zmult_mod; try rewrite Zmod_mod; auto. -rewrite <- Zmult_mod; auto. -replace (c * a) with (1 + (-d) * n). -rewrite Z_mod_plus; auto with zarith. -rewrite Zmod_small; auto with zarith. -rewrite <- Hcd; ring. -apply is_inv_true with (a := (c mod n)); auto. -apply mkZp_in; auto with zarith. -exact pmult_1_l. -exact pmult_1_r. -rewrite pmult_comm; auto. -apply mkZp_in; auto with zarith. -apply Z_mod_lt; auto with zarith. -apply is_inv_false. -intros c H1; left; intros H2; contradict H. -apply bezout_rel_prime. -apply Bezout_intro with c (- (Zdiv (c * a) n)). -pattern (c * a) at 1; rewrite (Z_div_mod_eq (c * a) n); auto with zarith. -unfold pmult in H2; rewrite (Zmult_comm c); try rewrite H2. -ring. -Qed. - -(************************************** - We are now ready to build our group - **************************************) - -Definition ZPGroup : (FGroup pmult). -apply IGroup with (support := mkZp) (e:= 1). -exact Z_eq_dec. -apply mkZp_ulist. -apply mkZp_in; auto with zarith. -intros a b H1 H2; apply mkZp_in. -unfold pmult; apply Z_mod_lt; auto with zarith. -intros; apply pmult_assoc. -exact pmult_1_l. -exact pmult_1_r. -Defined. - -Theorem in_ZPGroup: forall p, rel_prime p n -> 0 <= p < n -> In p ZPGroup.(s). -intros p H (H1, H2); unfold ZPGroup; simpl. -apply isupport_is_in. -generalize (rel_prime_is_inv p); case (rel_prime_dec p); auto. -apply mkZp_in; auto with zarith. -Qed. - - -Theorem phi_is_length: phi n = Z_of_nat (length Lrel). -assert (Hu: 0 < n); try apply Zlt_trans with 1; auto with zarith. -rewrite phi_def_with_0; auto. -unfold Zsum, Lrel; rewrite Zle_imp_le_bool; auto with zarith. -replace (1 + (n - 1) - 0) with n; auto with zarith. -elim (progression Zsucc 0 (Zabs_nat n)); simpl; auto. -intros a l1 Rec. -rewrite Rec. -rewrite rel_prime_is_inv. -case (rel_prime_dec a n); auto with zarith. -simpl length; rewrite inj_S; auto with zarith. -Qed. - -Theorem phi_is_order: phi n = g_order ZPGroup. -unfold g_order; rewrite phi_is_length. -eq_tac; apply permutation_length. -apply ulist_incl2_permutation. -unfold Lrel; apply isupport_aux_ulist. -apply ulist_Zprogression; auto. -apply ZPGroup.(unique_s). -intros a H; unfold ZPGroup; simpl. -apply isupport_is_in. -unfold Lrel in H; apply isupport_aux_is_inv_true with (1 := H). -apply mkZp_in; auto. -assert (In a (progression Zsucc 0 (Zabs_nat n))). -apply (isupport_aux_incl _ pmult mkZp 1 Z_eq_dec); auto. -split. -apply Zprogression_le_init with (1 := H0). -replace n with (0 + Z_of_nat (Zabs_nat n)). -apply Zprogression_le_end with (1 := H0). -rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -intros a H; unfold Lrel; simpl. -apply isupport_aux_is_in. -simpl in H; apply isupport_is_inv_true with (1 := H). -apply in_Zprogression. -rewrite Zplus_0_l; rewrite inj_Zabs_nat; auto with zarith. -rewrite Zabs_eq; auto with zarith. -assert (In a mkZp). -apply (isupport_aux_incl _ pmult mkZp 1 Z_eq_dec); auto. -apply in_mkZp; auto. -Qed. - -Theorem Zp_cyclic: prime n -> cyclic Z_eq_dec ZPGroup. -intros H1. -unfold ZPGroup, pmult; -generalize (cyclic_field _ (fun x y => (x + y) mod n) (fun x y => (x * y) mod n) (fun x => (-x) mod n) 0); -unfold IA; intros tmp; apply tmp; clear tmp; auto. -intros; discriminate. -apply mkZp_in; auto with zarith. -intros; apply mkZp_in; auto with zarith. -apply Z_mod_lt; auto with zarith. -intros; rewrite Zplus_0_l; auto. -apply Zmod_small; auto. -apply in_mkZp; auto. -intros; rewrite Zplus_comm; auto. -intros a b c Ha Hb Hc. -pattern a at 1; rewrite <- (Zmod_small a n); auto with zarith. -pattern c at 2; rewrite <- (Zmod_small c n); auto with zarith. -repeat rewrite <- Zplus_mod; auto with zarith. -eq_tac; auto with zarith. -apply in_mkZp; auto. -apply in_mkZp; auto. -intros; eq_tac; auto with zarith. -intros a b c Ha Hb Hc. -pattern a at 1; rewrite <- (Zmod_small a n); auto with zarith. -repeat rewrite <- Zmult_mod; auto with zarith. -repeat rewrite <- Zplus_mod; auto with zarith. -eq_tac; auto with zarith. -apply in_mkZp; auto. -intros; apply mkZp_in; apply Z_mod_lt; auto with zarith. -intros a Ha. -pattern a at 1; rewrite <- (Zmod_small a n); auto with zarith. -repeat rewrite <- Zplus_mod; auto with zarith. -rewrite <- (Zmod_small 0 n); auto with zarith. -eq_tac; auto with zarith. -apply in_mkZp; auto. -intros a b Ha Hb H; case (prime_mult n H1 a b). -apply Zmod_divide; auto with zarith. -intros H2; left. -case (Zle_lt_or_eq 0 a); auto. -case (in_mkZp a); auto. -intros H3; absurd (n <= a). -apply Zlt_not_le. -case (in_mkZp a); auto. -apply Zdivide_le; auto with zarith. -intros H2; right. -case (Zle_lt_or_eq 0 b); auto. -case (in_mkZp b); auto. -intros H3; absurd (n <= b). -apply Zlt_not_le. -case (in_mkZp b); auto. -apply Zdivide_le; auto with zarith. -Qed. - -End Zp. - -(* Definition of the order (0 for q < 1) *) - -Definition Zorder: Z -> Z -> Z. -intros p q; case (Z_le_dec q 1); intros H. -exact 0. -refine (e_order Z_eq_dec (p mod q) (ZPGroup q _)); auto with zarith. -Defined. - -Theorem Zorder_pos: forall p n, 0 <= Zorder p n. -intros p n; unfold Zorder. -case (Z_le_dec n 1); auto with zarith. -intros n1. -apply Zlt_le_weak; apply e_order_pos. -Qed. - -Theorem in_mod_ZPGroup - : forall (n : Z) (n_pos : 1 < n) (p : Z), - rel_prime p n -> In (p mod n) (s (ZPGroup n n_pos)). -intros n H p H1. -apply in_ZPGroup; auto. -apply rel_prime_mod; auto with zarith. -apply Z_mod_lt; auto with zarith. -Qed. - - -Theorem Zpower_mod_is_gpow: - forall p q n (Hn: 1 < n), rel_prime p n -> 0 <= q -> p ^ q mod n = gpow (p mod n) (ZPGroup n Hn) q. -intros p q n H Hp H1; generalize H1; pattern q; apply natlike_ind; simpl; auto. -intros _; apply Zmod_small; auto with zarith. -intros n1 Hn1 Rec _; simpl. -generalize (in_mod_ZPGroup _ H _ Hp); intros Hu. -unfold Zsucc; rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith. -rewrite gpow_add; auto with zarith. -rewrite gpow_1; auto; rewrite <- Rec; auto. -rewrite Zmult_mod; auto. -Qed. - - -Theorem Zorder_div_power: forall p q n, 1 < n -> rel_prime p n -> p ^ q mod n = 1 -> (Zorder p n | q). -intros p q n H H1 H2. -assert (Hq: 0 <= q). -generalize H2; case q; simpl; auto with zarith. -intros p1 H3; contradict H3; rewrite Zmod_small; auto with zarith. -unfold Zorder; case (Z_le_dec n 1). -intros H3; contradict H; auto with zarith. -intros H3; apply e_order_divide_gpow; auto. -apply in_mod_ZPGroup; auto. -rewrite <- Zpower_mod_is_gpow; auto with zarith. -Qed. - -Theorem Zorder_div: forall p n, prime n -> ~(n | p) -> (Zorder p n | n - 1). -intros p n H; unfold Zorder. -case (Z_le_dec n 1); intros H1 H2. -contradict H1; generalize (prime_ge_2 n H); auto with zarith. -rewrite <- prime_phi_n_minus_1; auto. -match goal with |- context[ZPGroup _ ?H2] => rewrite phi_is_order with (n_pos := H2) end. -apply e_order_divide_g_order; auto. -apply in_mod_ZPGroup; auto. -apply rel_prime_sym; apply prime_rel_prime; auto. -Qed. - - -Theorem Zorder_power_is_1: forall p n, 1 < n -> rel_prime p n -> p ^ (Zorder p n) mod n = 1. -intros p n H H1; unfold Zorder. -case (Z_le_dec n 1); intros H2. -contradict H; auto with zarith. -let x := match goal with |- context[ZPGroup _ ?X] => X end in rewrite Zpower_mod_is_gpow with (Hn := x); auto with zarith. -rewrite gpow_e_order_is_e. -reflexivity. -apply in_mod_ZPGroup; auto. -apply Zlt_le_weak; apply e_order_pos. -Qed. - -Theorem Zorder_power_pos: forall p n, 1 < n -> rel_prime p n -> 0 < Zorder p n. -intros p n H H1; unfold Zorder. -case (Z_le_dec n 1); intros H2. -contradict H; auto with zarith. -apply e_order_pos. -Qed. - -Theorem phi_power_is_1: forall p n, 1 < n -> rel_prime p n -> p ^ (phi n) mod n = 1. -intros p n H H1. -assert (V1:= Zorder_power_pos p n H H1). -assert (H2: (Zorder p n | phi n)). -unfold Zorder. -case (Z_le_dec n 1); intros H2. -contradict H; auto with zarith. -match goal with |- context[ZPGroup n ?H] => -rewrite phi_is_order with (n_pos := H) -end. -apply e_order_divide_g_order. -apply in_mod_ZPGroup; auto. -case H2; clear H2; intros q H2; rewrite H2. -rewrite Zmult_comm. -assert (V2 := (phi_pos _ H)). -assert (V3: 0 <= q). -rewrite H2 in V2. -apply Zlt_le_weak; apply Zmult_lt_0_reg_r with (2 := V2); auto with zarith. -rewrite Zpower_mult; auto with zarith. -rewrite Zpower_mod; auto with zarith. -rewrite Zorder_power_is_1; auto. -rewrite Zpower_1_l; auto with zarith. -apply Zmod_small; auto with zarith. -Qed. diff --git a/coqprime-8.5/Makefile b/coqprime-8.5/Makefile deleted file mode 100644 index c8e44a658..000000000 --- a/coqprime-8.5/Makefile +++ /dev/null @@ -1,319 +0,0 @@ -############################################################################# -## v # The Coq Proof Assistant ## -## $@ - printf 'cd "$${DSTROOT}"$(COQLIBINSTALL)/Coqprime && rm -f $(NATIVEFILES1) $(GLOBFILES1) $(VFILES1) $(VOFILES1) && find . -type d -and -empty -delete\ncd "$${DSTROOT}"$(COQLIBINSTALL) && find "Coqprime" -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n' >> "$@" - printf 'cd "$${DSTROOT}"$(COQDOCINSTALL)/Coqprime \\\n' >> "$@" - printf '&& rm -f $(shell find "html" -maxdepth 1 -and -type f -print)\n' >> "$@" - printf 'cd "$${DSTROOT}"$(COQDOCINSTALL) && find Coqprime/html -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n' >> "$@" - chmod +x $@ - -uninstall: uninstall_me.sh - sh $< - -.merlin: - @echo 'FLG -rectypes' > .merlin - @echo "B $(COQLIB) kernel" >> .merlin - @echo "B $(COQLIB) lib" >> .merlin - @echo "B $(COQLIB) library" >> .merlin - @echo "B $(COQLIB) parsing" >> .merlin - @echo "B $(COQLIB) pretyping" >> .merlin - @echo "B $(COQLIB) interp" >> .merlin - @echo "B $(COQLIB) printing" >> .merlin - @echo "B $(COQLIB) intf" >> .merlin - @echo "B $(COQLIB) proofs" >> .merlin - @echo "B $(COQLIB) tactics" >> .merlin - @echo "B $(COQLIB) tools" >> .merlin - @echo "B $(COQLIB) toplevel" >> .merlin - @echo "B $(COQLIB) stm" >> .merlin - @echo "B $(COQLIB) grammar" >> .merlin - @echo "B $(COQLIB) config" >> .merlin - -clean:: - rm -f $(OBJFILES) $(OBJFILES:.o=.native) $(NATIVEFILES) - find . -name .coq-native -type d -empty -delete - rm -f $(VOFILES) $(VOFILES:.vo=.vio) $(GFILES) $(VFILES:.v=.v.d) $(VFILES:=.beautified) $(VFILES:=.old) - rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob $(VFILES:.v=.glob) $(VFILES:.v=.tex) $(VFILES:.v=.g.tex) all-mli.tex - - rm -rf html mlihtml uninstall_me.sh - -cleanall:: clean - rm -f $(patsubst %.v,.%.aux,$(VFILES)) - -archclean:: - rm -f *.cmx *.o - -printenv: - @"$(COQBIN)coqtop" -config - @echo 'CAMLC = $(CAMLC)' - @echo 'CAMLOPTC = $(CAMLOPTC)' - @echo 'PP = $(PP)' - @echo 'COQFLAGS = $(COQFLAGS)' - @echo 'COQLIBINSTALL = $(COQLIBINSTALL)' - @echo 'COQDOCINSTALL = $(COQDOCINSTALL)' - -Makefile: _CoqProject - mv -f $@ $@.bak - "$(COQBIN)coq_makefile" -f $< -o $@ - - -################### -# # -# Implicit rules. # -# # -################### - -$(VOFILES): %.vo: %.v - $(COQC) $(COQDEBUG) $(COQFLAGS) $* - -$(GLOBFILES): %.glob: %.v - $(COQC) $(COQDEBUG) $(COQFLAGS) $* - -$(VFILES:.v=.vio): %.vio: %.v - $(COQC) -quick $(COQDEBUG) $(COQFLAGS) $* - -$(GFILES): %.g: %.v - $(GALLINA) $< - -$(VFILES:.v=.tex): %.tex: %.v - $(COQDOC) $(COQDOCFLAGS) -latex $< -o $@ - -$(HTMLFILES): %.html: %.v %.glob - $(COQDOC) $(COQDOCFLAGS) -html $< -o $@ - -$(VFILES:.v=.g.tex): %.g.tex: %.v - $(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@ - -$(GHTMLFILES): %.g.html: %.v %.glob - $(COQDOC) $(COQDOCFLAGS) -html -g $< -o $@ - -$(addsuffix .d,$(VFILES)): %.v.d: %.v - $(COQDEP) $(COQLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) - -$(addsuffix .beautified,$(VFILES)): %.v.beautified: - $(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $* - -# WARNING -# -# This Makefile has been automagically generated -# Edit at your own risks ! -# -# END OF WARNING - diff --git a/coqprime-8.5/README.md b/coqprime-8.5/README.md deleted file mode 100644 index 9c317fb00..000000000 --- a/coqprime-8.5/README.md +++ /dev/null @@ -1,9 +0,0 @@ -# Coqprime (LGPL subset) - -This is a mirror of the LGPL-licensed and autogenerated files from [Coqprime](http://coqprime.gforge.inria.fr/) for Coq 8.5. It was generated from [coqprime_8.5b.zip](https://gforge.inria.fr/frs/download.php/file/35520/coqprime_8.5b.zip). Due to the removal of files that are missing license headers in the upstream source, `make` no longer completes successfully. However, a large part of the codebase does build and contains theorems useful to us. Fixing the build system would be nice, but is not a priority for us. - -## Usage - - make PrimalityTest/Zp.vo PrimalityTest/PocklingtonCertificat.vo - cd .. - coqide -R coqprime/Tactic Coqprime -R coqprime/N Coqprime -R coqprime/Z Coqprime -R coqprime/List Coqprime -R coqprime/PrimalityTest Coqprime YOUR_FILE.v # these are the dependencies for PrimalityTest/Zp, other modules can be added in a similar fashion diff --git a/coqprime-8.5/_CoqProject b/coqprime-8.5/_CoqProject deleted file mode 100644 index 95b224864..000000000 --- a/coqprime-8.5/_CoqProject +++ /dev/null @@ -1,24 +0,0 @@ --R Coqprime Coqprime -Coqprime/Cyclic.v -Coqprime/EGroup.v -Coqprime/Euler.v -Coqprime/FGroup.v -Coqprime/IGroup.v -Coqprime/Iterator.v -Coqprime/Lagrange.v -Coqprime/ListAux.v -Coqprime/LucasLehmer.v -Coqprime/NatAux.v -Coqprime/PGroup.v -Coqprime/Permutation.v -Coqprime/Pmod.v -Coqprime/Pocklington.v -Coqprime/PocklingtonCertificat.v -Coqprime/Root.v -Coqprime/Tactic.v -Coqprime/UList.v -Coqprime/ZCAux.v -Coqprime/ZCmisc.v -Coqprime/ZProgression.v -Coqprime/ZSum.v -Coqprime/Zp.v diff --git a/coqprime/Coqprime/Cyclic.v b/coqprime/Coqprime/Cyclic.v index e2daa4d67..c25f683ca 100644 --- a/coqprime/Coqprime/Cyclic.v +++ b/coqprime/Coqprime/Cyclic.v @@ -11,13 +11,13 @@ Proof that an abelien ring is cyclic ************************************************************************) -Require Import Coqprime.ZCAux. -Require Import Coq.Lists.List. -Require Import Coqprime.Root. -Require Import Coqprime.UList. -Require Import Coqprime.IGroup. -Require Import Coqprime.EGroup. -Require Import Coqprime.FGroup. +Require Import ZCAux. +Require Import List. +Require Import Root. +Require Import UList. +Require Import IGroup. +Require Import EGroup. +Require Import FGroup. Open Scope Z_scope. diff --git a/coqprime/Coqprime/EGroup.v b/coqprime/Coqprime/EGroup.v index 553cb746c..933176abd 100644 --- a/coqprime/Coqprime/EGroup.v +++ b/coqprime/Coqprime/EGroup.v @@ -11,15 +11,15 @@ Given an element a, create the group {e, a, a^2, ..., a^n} **********************************************************************) -Require Import Coq.ZArith.ZArith. -Require Import Coqprime.Tactic. -Require Import Coq.Lists.List. -Require Import Coqprime.ZCAux. -Require Import Coq.ZArith.ZArith Coq.ZArith.Znumtheory. -Require Import Coq.Arith.Wf_nat. -Require Import Coqprime.UList. -Require Import Coqprime.FGroup. -Require Import Coqprime.Lagrange. +Require Import ZArith. +Require Import Tactic. +Require Import List. +Require Import ZCAux. +Require Import ZArith Znumtheory. +Require Import Wf_nat. +Require Import UList. +Require Import FGroup. +Require Import Lagrange. Open Scope Z_scope. @@ -43,7 +43,7 @@ Hypothesis a_in_G: In a G.(s). **************************************) Set Implicit Arguments. -Definition gpow n := match n with Zpos p => iter_pos p _ (op a) G.(e) | _ => G.(e) end. +Definition gpow n := match n with Zpos p => iter_pos _ (op a) G.(e) p | _ => G.(e) end. Unset Implicit Arguments. Theorem gpow_0: gpow 0 = G.(e). @@ -63,17 +63,17 @@ intros n; case n; simpl; auto. intros p; apply iter_pos_invariant with (Inv := fun x => In x G.(s)); auto. Qed. -Theorem gpow_op: forall b p, In b G.(s) -> iter_pos p _ (op a) b = op (iter_pos p _ (op a) G.(e)) b. +Theorem gpow_op: forall b p, In b G.(s) -> iter_pos _ (op a) b p = op (iter_pos _ (op a) G.(e) p) b. intros b p; generalize b; elim p; simpl; auto; clear b p. intros p Rec b Hb. assert (H: In (gpow (Zpos p)) G.(s)). apply gpow_in. -rewrite (Rec b); try rewrite (fun x y => Rec (op x y)); try rewrite (fun x y => Rec (iter_pos p A x y)); auto. +rewrite (Rec b); try rewrite (fun x y => Rec (op x y)); try rewrite (fun x y => Rec (iter_pos A x y p)); auto. repeat rewrite G.(assoc); auto. intros p Rec b Hb. assert (H: In (gpow (Zpos p)) G.(s)). apply gpow_in. -rewrite (Rec b); try rewrite (fun x y => Rec (op x y)); try rewrite (fun x y => Rec (iter_pos p A x y)); auto. +rewrite (Rec b); try rewrite (fun x y => Rec (op x y)); try rewrite (fun x y => Rec (iter_pos A x y p)); auto. repeat rewrite G.(assoc); auto. intros b H; rewrite e_is_zero_r; auto. Qed. @@ -87,7 +87,7 @@ intros _ _; simpl; apply sym_equal; apply e_is_zero_r. exact (gpow_in (Zpos p1)). 2: intros p2 _ H; contradict H; auto with zarith. intros p2 _ _; simpl. -rewrite iter_pos_plus; rewrite (fun x y => gpow_op (iter_pos p2 A x y)); auto. +rewrite iter_pos_plus; rewrite (fun x y => gpow_op (iter_pos A x y p2)); auto. exact (gpow_in (Zpos p2)). Qed. @@ -445,7 +445,7 @@ intros x H2 Rec _; unfold Zsucc; rewrite gpow_add; simpl; auto with zarith. repeat rewrite G.(e_is_zero_r); auto with zarith. apply gpow_in; sauto. intros p1 _; case m; simpl; auto. -assert(H1: In (iter_pos p1 A (op a) (e G)) (s G)). +assert(H1: In (iter_pos A (op a) (e G) p1) (s G)). refine (gpow_in _ _ _ _ _ (Zpos p1)); auto. intros p2 _; pattern p2; apply Pind; simpl; auto. rewrite Pmult_1_r; rewrite G.(e_is_zero_r); try rewrite G.(e_is_zero_r); auto. @@ -486,12 +486,12 @@ repeat rewrite iter_pos_plus; simpl. repeat rewrite (fun x y H z => gpow_op A op x G H (op y z)) ; auto. rewrite Rec. repeat rewrite G.(e_is_zero_r); auto. -assert(H1: In (iter_pos p3 A (op a) (e G)) (s G)). +assert(H1: In (iter_pos A (op a) (e G) p3) (s G)). refine (gpow_in _ _ _ _ _ (Zpos p3)); auto. -assert(H2: In (iter_pos p3 A (op b) (e G)) (s G)). +assert(H2: In (iter_pos A (op b) (e G) p3) (s G)). refine (gpow_in _ _ _ _ _ (Zpos p3)); auto. repeat rewrite <- G.(assoc); try eq_tac; auto. -rewrite (fun x y => comm (iter_pos p3 A x y) b); auto. +rewrite (fun x y => comm (iter_pos A x y p3) b); auto. rewrite (G.(assoc) a); try apply comm; auto. Qed. diff --git a/coqprime/Coqprime/Euler.v b/coqprime/Coqprime/Euler.v index e571d8e3c..06d92ce57 100644 --- a/coqprime/Coqprime/Euler.v +++ b/coqprime/Coqprime/Euler.v @@ -11,10 +11,10 @@ Definition of the Euler Totient function *************************************************************************) -Require Import Coq.ZArith.ZArith. -Require Export Coq.ZArith.Znumtheory. -Require Import Coqprime.Tactic. -Require Export Coqprime.ZSum. +Require Import ZArith. +Require Export Znumtheory. +Require Import Tactic. +Require Export ZSum. Open Scope Z_scope. diff --git a/coqprime/Coqprime/FGroup.v b/coqprime/Coqprime/FGroup.v index 0bcc9ebf1..a55710e7c 100644 --- a/coqprime/Coqprime/FGroup.v +++ b/coqprime/Coqprime/FGroup.v @@ -13,10 +13,10 @@ Definition: FGroup **********************************************************************) -Require Import Coq.Lists.List. -Require Import Coqprime.UList. -Require Import Coqprime.Tactic. -Require Import Coq.ZArith.ZArith. +Require Import List. +Require Import UList. +Require Import Tactic. +Require Import ZArith. Open Scope Z_scope. diff --git a/coqprime/Coqprime/IGroup.v b/coqprime/Coqprime/IGroup.v index 04219be5a..11a73d414 100644 --- a/coqprime/Coqprime/IGroup.v +++ b/coqprime/Coqprime/IGroup.v @@ -13,12 +13,12 @@ Definition: ZpGroup **********************************************************************) -Require Import Coq.ZArith.ZArith. -Require Import Coqprime.Tactic. -Require Import Coq.Arith.Wf_nat. -Require Import Coqprime.UList. -Require Import Coqprime.ListAux. -Require Import Coqprime.FGroup. +Require Import ZArith. +Require Import Tactic. +Require Import Wf_nat. +Require Import UList. +Require Import ListAux. +Require Import FGroup. Open Scope Z_scope. diff --git a/coqprime/Coqprime/Iterator.v b/coqprime/Coqprime/Iterator.v index e84687cd4..96d3e5655 100644 --- a/coqprime/Coqprime/Iterator.v +++ b/coqprime/Coqprime/Iterator.v @@ -6,9 +6,9 @@ (* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) (*************************************************************) -Require Export Coq.Lists.List. -Require Export Coqprime.Permutation. -Require Import Coq.Arith.Arith. +Require Export List. +Require Export Permutation. +Require Import Arith. Section Iterator. Variables A B : Set. diff --git a/coqprime/Coqprime/Lagrange.v b/coqprime/Coqprime/Lagrange.v index b890c5621..b35460bad 100644 --- a/coqprime/Coqprime/Lagrange.v +++ b/coqprime/Coqprime/Lagrange.v @@ -14,12 +14,12 @@ Definition: lagrange **********************************************************************) -Require Import Coq.Lists.List. -Require Import Coqprime.UList. -Require Import Coqprime.ListAux. -Require Import Coq.ZArith.ZArith Coq.ZArith.Znumtheory. -Require Import Coqprime.NatAux. -Require Import Coqprime.FGroup. +Require Import List. +Require Import UList. +Require Import ListAux. +Require Import ZArith Znumtheory. +Require Import NatAux. +Require Import FGroup. Open Scope Z_scope. diff --git a/coqprime/Coqprime/ListAux.v b/coqprime/Coqprime/ListAux.v index 4ed154685..c3c9602bd 100644 --- a/coqprime/Coqprime/ListAux.v +++ b/coqprime/Coqprime/ListAux.v @@ -11,11 +11,11 @@ Auxillary functions & Theorems **********************************************************************) -Require Export Coq.Lists.List. -Require Export Coq.Arith.Arith. -Require Export Coqprime.Tactic. -Require Import Coq.Wellfounded.Inverse_Image. -Require Import Coq.Arith.Wf_nat. +Require Export List. +Require Export Arith. +Require Export Tactic. +Require Import Inverse_Image. +Require Import Wf_nat. (************************************** Some properties on list operators: app, map,... diff --git a/coqprime/Coqprime/LucasLehmer.v b/coqprime/Coqprime/LucasLehmer.v index c459195a8..a0e3b8e46 100644 --- a/coqprime/Coqprime/LucasLehmer.v +++ b/coqprime/Coqprime/LucasLehmer.v @@ -13,17 +13,17 @@ Definition: LucasLehmer **********************************************************************) -Require Import Coq.ZArith.ZArith. -Require Import Coqprime.ZCAux. -Require Import Coqprime.Tactic. -Require Import Coq.Arith.Wf_nat. -Require Import Coqprime.NatAux. -Require Import Coqprime.UList. -Require Import Coqprime.ListAux. -Require Import Coqprime.FGroup. -Require Import Coqprime.EGroup. -Require Import Coqprime.PGroup. -Require Import Coqprime.IGroup. +Require Import ZArith. +Require Import ZCAux. +Require Import Tactic. +Require Import Wf_nat. +Require Import NatAux. +Require Import UList. +Require Import ListAux. +Require Import FGroup. +Require Import EGroup. +Require Import PGroup. +Require Import IGroup. Open Scope Z_scope. @@ -47,7 +47,7 @@ Qed. Definition of the power function for pairs p^n **************************************) -Definition ppow p n := match n with Zpos q => iter_pos q _ (pmult p) (1, 0) | _ => (1, 0) end. +Definition ppow p n := match n with Zpos q => iter_pos _ (pmult p) (1, 0) q | _ => (1, 0) end. (************************************** Some properties of ppow @@ -63,14 +63,14 @@ intros p; apply iter_pos_invariant with (Inv := fun x => x = (1, 0)); auto. intros x H; rewrite H; auto. Qed. -Theorem ppow_op: forall a b p, iter_pos p _ (pmult a) b = pmult (iter_pos p _ (pmult a) (1, 0)) b. +Theorem ppow_op: forall a b p, iter_pos _ (pmult a) b p = pmult (iter_pos _ (pmult a) (1, 0) p) b. intros a b p; generalize b; elim p; simpl; auto; clear b p. intros p Rec b. rewrite (Rec b). -try rewrite (fun x y => Rec (pmult x y)); try rewrite (fun x y => Rec (iter_pos p _ x y)); auto. +try rewrite (fun x y => Rec (pmult x y)); try rewrite (fun x y => Rec (iter_pos _ x y p)); auto. repeat rewrite pmult_assoc; auto. intros p Rec b. -rewrite (Rec b); try rewrite (fun x y => Rec (pmult x y)); try rewrite (fun x y => Rec (iter_pos p _ x y)); auto. +rewrite (Rec b); try rewrite (fun x y => Rec (pmult x y)); try rewrite (fun x y => Rec (iter_pos _ x y p)); auto. repeat rewrite pmult_assoc; auto. intros b; rewrite pmult_1_r; auto. Qed. @@ -114,7 +114,7 @@ repeat rewrite (fun x y z => ppow_op x (pmult y z)) ; auto. rewrite Rec. repeat rewrite pmult_1_r; auto. repeat rewrite <- pmult_assoc; try eq_tac; auto. -rewrite (fun x y => pmult_comm (iter_pos p3 _ x y) p); auto. +rewrite (fun x y => pmult_comm (iter_pos _ x y p3) p); auto. rewrite (pmult_assoc m); try apply pmult_comm; auto. Qed. @@ -490,13 +490,13 @@ End Lucas. Definition SS p := let n := Mp p in match p - 2 with - Zpos p1 => iter_pos p1 _ (fun x => Zmodd (Zsquare x - 2) n) (Zmodd 4 n) + Zpos p1 => iter_pos _ (fun x => Zmodd (Zsquare x - 2) n) (Zmodd 4 n) p1 | _ => (Zmodd 4 n) end. Theorem SS_aux_correct: forall p z1 z2 n, 0 <= n -> 0 < z1 -> z2 = fst (s n) mod z1 -> - iter_pos p _ (fun x => Zmodd (Zsquare x - 2) z1) z2 = fst (s (n + Zpos p)) mod z1. + iter_pos _ (fun x => Zmodd (Zsquare x - 2) z1) z2 p = fst (s (n + Zpos p)) mod z1. intros p; pattern p; apply Pind. simpl. intros z1 z2 n Hn H H1; rewrite sn; auto; rewrite H1; rewrite Zmodd_correct; rewrite Zsquare_correct; simpl. diff --git a/coqprime/Coqprime/Makefile.bak b/coqprime/Coqprime/Makefile.bak deleted file mode 100644 index fe49dbf29..000000000 --- a/coqprime/Coqprime/Makefile.bak +++ /dev/null @@ -1,203 +0,0 @@ -############################################################################## -## The Calculus of Inductive Constructions ## -## ## -## Projet Coq ## -## ## -## INRIA ENS-CNRS ## -## Rocquencourt Lyon ## -## ## -## Coq V7 ## -## ## -## ## -############################################################################## - -# WARNING -# -# This Makefile has been automagically generated by coq_makefile -# Edit at your own risks ! -# -# END OF WARNING - -# -# This Makefile was generated by the command line : -# coq_makefile -f Make -o Makefile -# - -########################## -# # -# Variables definitions. # -# # -########################## - -CAMLP4LIB=`camlp4 -where` -COQSRC=-I $(COQTOP)/kernel -I $(COQTOP)/lib \ - -I $(COQTOP)/library -I $(COQTOP)/parsing \ - -I $(COQTOP)/pretyping -I $(COQTOP)/interp \ - -I $(COQTOP)/proofs -I $(COQTOP)/syntax -I $(COQTOP)/tactics \ - -I $(COQTOP)/toplevel -I $(COQTOP)/contrib/correctness \ - -I $(COQTOP)/contrib/extraction -I $(COQTOP)/contrib/field \ - -I $(COQTOP)/contrib/fourier -I $(COQTOP)/contrib/graphs \ - -I $(COQTOP)/contrib/interface -I $(COQTOP)/contrib/jprover \ - -I $(COQTOP)/contrib/omega -I $(COQTOP)/contrib/romega \ - -I $(COQTOP)/contrib/ring -I $(COQTOP)/contrib/xml \ - -I $(CAMLP4LIB) -ZFLAGS=$(OCAMLLIBS) $(COQSRC) -OPT= -COQFLAGS=-q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML) -COQC=$(COQBIN)coqc -GALLINA=gallina -COQDOC=coqdoc -CAMLC=ocamlc -c -CAMLOPTC=ocamlopt -c -CAMLLINK=ocamlc -CAMLOPTLINK=ocamlopt -COQDEP=$(COQBIN)coqdep -c -GRAMMARS=grammar.cma -CAMLP4EXTEND=pa_extend.cmo pa_ifdef.cmo q_MLast.cmo -PP=-pp "camlp4o -I . -I $(COQTOP)/parsing $(CAMLP4EXTEND) $(GRAMMARS) -impl" - -######################### -# # -# Libraries definition. # -# # -######################### - -OCAMLLIBS=-I .\ - -I ../Tactic\ - -I ../N\ - -I ../Z\ - -I ../List -COQLIBS=-I .\ - -I ../Tactic\ - -I ../N\ - -I ../Z\ - -I ../List - -################################### -# # -# Definition of the "all" target. # -# # -################################### - -VFILES=Cyclic.v\ - EGroup.v\ - Euler.v\ - FGroup.v\ - IGroup.v\ - Lagrange.v\ - LucasLehmer.v\ - Pepin.v\ - PGroup.v\ - PocklingtonCertificat.v\ - PocklingtonRefl.v\ - Pocklington.v\ - Proth.v\ - Root.v\ - Zp.v -VOFILES=$(VFILES:.v=.vo) -VIFILES=$(VFILES:.v=.vi) -GFILES=$(VFILES:.v=.g) -HTMLFILES=$(VFILES:.v=.html) -GHTMLFILES=$(VFILES:.v=.g.html) - -all: Cyclic.vo\ - EGroup.vo\ - Euler.vo\ - FGroup.vo\ - IGroup.vo\ - Lagrange.vo\ - LucasLehmer.vo\ - Pepin.vo\ - PGroup.vo\ - PocklingtonCertificat.vo\ - PocklingtonRefl.vo\ - Pocklington.vo\ - Proth.vo\ - Root.vo\ - Zp.vo - -spec: $(VIFILES) - -gallina: $(GFILES) - -html: $(HTMLFILES) - -gallinahtml: $(GHTMLFILES) - -all.ps: $(VFILES) - $(COQDOC) -ps -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` - -all-gal.ps: $(VFILES) - $(COQDOC) -ps -g -o $@ `$(COQDEP) -sort -suffix .v $(VFILES)` - - - -#################### -# # -# Special targets. # -# # -#################### - -.PHONY: all opt byte archclean clean install depend html - -.SUFFIXES: .v .vo .vi .g .html .tex .g.tex .g.html - -.v.vo: - $(COQC) $(COQDEBUG) $(COQFLAGS) $* - -.v.vi: - $(COQC) -i $(COQDEBUG) $(COQFLAGS) $* - -.v.g: - $(GALLINA) $< - -.v.tex: - $(COQDOC) -latex $< -o $@ - -.v.html: - $(COQDOC) -html $< -o $@ - -.v.g.tex: - $(COQDOC) -latex -g $< -o $@ - -.v.g.html: - $(COQDOC) -html -g $< -o $@ - -byte: - $(MAKE) all "OPT=" - -opt: - $(MAKE) all "OPT=-opt" - -include .depend - -.depend depend: - rm -f .depend - $(COQDEP) -i $(COQLIBS) $(VFILES) *.ml *.mli >.depend - $(COQDEP) $(COQLIBS) -suffix .html $(VFILES) >>.depend - -install: - mkdir -p `$(COQC) -where`/user-contrib - cp -f $(VOFILES) `$(COQC) -where`/user-contrib - -Makefile: Make - mv -f Makefile Makefile.bak - $(COQBIN)coq_makefile -f Make -o Makefile - - -clean: - rm -f *.cmo *.cmi *.cmx *.o $(VOFILES) $(VIFILES) $(GFILES) *~ - rm -f all.ps all-gal.ps $(HTMLFILES) $(GHTMLFILES) - -archclean: - rm -f *.cmx *.o - -html: - -# WARNING -# -# This Makefile has been automagically generated by coq_makefile -# Edit at your own risks ! -# -# END OF WARNING - diff --git a/coqprime/Coqprime/NatAux.v b/coqprime/Coqprime/NatAux.v index 6df511eed..eab09150c 100644 --- a/coqprime/Coqprime/NatAux.v +++ b/coqprime/Coqprime/NatAux.v @@ -11,7 +11,7 @@ Auxillary functions & Theorems **********************************************************************) -Require Export Coq.Arith.Arith. +Require Export Arith. (************************************** Some properties of minus diff --git a/coqprime/Coqprime/Note.pdf b/coqprime/Coqprime/Note.pdf deleted file mode 100644 index 239a38772..000000000 Binary files a/coqprime/Coqprime/Note.pdf and /dev/null differ diff --git a/coqprime/Coqprime/PGroup.v b/coqprime/Coqprime/PGroup.v index 19eff5850..e9c1b2f47 100644 --- a/coqprime/Coqprime/PGroup.v +++ b/coqprime/Coqprime/PGroup.v @@ -14,15 +14,15 @@ Definition: PGroup **********************************************************************) -Require Import Coq.ZArith.ZArith. -Require Import Coq.ZArith.Znumtheory. -Require Import Coqprime.Tactic. -Require Import Coq.Arith.Wf_nat. -Require Import Coqprime.ListAux. -Require Import Coqprime.UList. -Require Import Coqprime.FGroup. -Require Import Coqprime.EGroup. -Require Import Coqprime.IGroup. +Require Import ZArith. +Require Import Znumtheory. +Require Import Tactic. +Require Import Wf_nat. +Require Import ListAux. +Require Import UList. +Require Import FGroup. +Require Import EGroup. +Require Import IGroup. Open Scope Z_scope. diff --git a/coqprime/Coqprime/Permutation.v b/coqprime/Coqprime/Permutation.v index 7cb6f629d..a06693f89 100644 --- a/coqprime/Coqprime/Permutation.v +++ b/coqprime/Coqprime/Permutation.v @@ -11,8 +11,8 @@ Defintion and properties of permutations **********************************************************************) -Require Export Coq.Lists.List. -Require Export Coqprime.ListAux. +Require Export List. +Require Export ListAux. Section permutation. Variable A : Set. diff --git a/coqprime/Coqprime/Pmod.v b/coqprime/Coqprime/Pmod.v index 45961896e..f64af48e3 100644 --- a/coqprime/Coqprime/Pmod.v +++ b/coqprime/Coqprime/Pmod.v @@ -6,8 +6,8 @@ (* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) (*************************************************************) -Require Export Coq.ZArith.ZArith. -Require Export Coqprime.ZCmisc. +Require Export ZArith. +Require Export ZCmisc. Open Local Scope positive_scope. @@ -392,7 +392,7 @@ Lemma gcd_log2_mod0 : Proof. intros a b c H;destruct c;simpl;rewrite H;trivial. Qed. -Require Import Coq.ZArith.Zwf. +Require Import Zwf. Lemma Zwf_pos : well_founded (fun x y => Zpos x < Zpos y). Proof. @@ -510,8 +510,8 @@ Proof. destruct (gcd_log2 b r r);intros;trivial. Qed. -Require Import Coq.ZArith.ZArith. -Require Import Coq.ZArith.Znumtheory. +Require Import ZArith. +Require Import Znumtheory. Hint Rewrite Zpos_mult times_Zmult square_Zmult Psucc_Zplus: zmisc. diff --git a/coqprime/Coqprime/Pocklington.v b/coqprime/Coqprime/Pocklington.v index 79e7dc616..9871cd3e6 100644 --- a/coqprime/Coqprime/Pocklington.v +++ b/coqprime/Coqprime/Pocklington.v @@ -6,14 +6,14 @@ (* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) (*************************************************************) -Require Import Coq.ZArith.ZArith. -Require Export Coq.ZArith.Znumtheory. -Require Import Coqprime.Tactic. -Require Import Coqprime.ZCAux. -Require Import Coqprime.Zp. -Require Import Coqprime.FGroup. -Require Import Coqprime.EGroup. -Require Import Coqprime.Euler. +Require Import ZArith. +Require Export Znumtheory. +Require Import Tactic. +Require Import ZCAux. +Require Import Zp. +Require Import FGroup. +Require Import EGroup. +Require Import Euler. Open Scope Z_scope. diff --git a/coqprime/Coqprime/PocklingtonCertificat.v b/coqprime/Coqprime/PocklingtonCertificat.v index fccea30b6..ecf4462ed 100644 --- a/coqprime/Coqprime/PocklingtonCertificat.v +++ b/coqprime/Coqprime/PocklingtonCertificat.v @@ -6,14 +6,14 @@ (* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) (*************************************************************) -Require Import Coq.Lists.List. -Require Import Coq.ZArith.ZArith. -Require Import Coq.ZArith.Zorder. -Require Import Coqprime.ZCAux. -Require Import Coqprime.LucasLehmer. -Require Import Coqprime.Pocklington. -Require Import Coqprime.ZCmisc. -Require Import Coqprime.Pmod. +Require Import List. +Require Import ZArith. +Require Import Zorder. +Require Import ZCAux. +Require Import LucasLehmer. +Require Import Pocklington. +Require Import ZCmisc. +Require Import Pmod. Definition dec_prime := list (positive * positive). @@ -61,18 +61,18 @@ Definition mkProd (l:dec_prime) := (* [pow_mod a m n] return [a^m mod n] *) Fixpoint pow_mod (a m n : positive) {struct m} : N := match m with - | xH => (a mod n) + | xH => (a mod n)%P | xO m' => let z := pow_mod a m' n in match z with | N0 => 0%N - | Npos z' => ((square z') mod n) + | Npos z' => ((square z') mod n)%P end | xI m' => let z := pow_mod a m' n in match z with | N0 => 0%N - | Npos z' => ((square z') * a)%P mod n + | Npos z' => (((square z') * a)%P mod n)%P end end. @@ -118,7 +118,7 @@ Fixpoint pow_mod_pred (a:N) (l:dec_prime) (n:positive) {struct l} : N := | (q,p)::l => if (p ?= 1) then pow_mod_pred a l n else - let a' := iter_pos (Ppred p) _ (fun x => Npow_mod x q n) a in + let a' := iter_pos _ (fun x => Npow_mod x q n) a (Ppred p) in pow_mod_pred a' l n end. @@ -332,120 +332,113 @@ Hint Rewrite Pmod_Zmod : zmisc. Lemma Zpower_0 : forall p : positive, 0^p = 0. Proof. intros;simpl;destruct p;unfold Zpower_pos;simpl;trivial. - generalize (iter_pos p Z (Z.mul 0) 1). + generalize (iter_pos Z (Z.mul 0) 1 p). induction p;simpl;trivial. Qed. -Opaque Zpower. -Opaque Zmult. - Lemma pow_Zpower : forall a p, Zpos (pow a p) = a ^ p. -Proof with mauto. - induction p;simpl... rewrite IHp... rewrite IHp... +Proof. + induction p; mauto; simpl; mauto; rewrite IHp; mauto. Qed. Hint Rewrite pow_Zpower : zmisc. Lemma pow_mod_spec : forall n a m, Z_of_N (pow_mod a m n) = a^m mod n. -Proof with mauto. - induction m;simpl;intros... +Proof. + induction m; mauto; simpl; intros; mauto. rewrite Zmult_mod; auto with zmisc. - rewrite (Zmult_mod (a^m)); auto with zmisc. rewrite <- IHm. - destruct (pow_mod a m n);simpl... - rewrite Zmult_mod; auto with zmisc. - rewrite <- IHm. destruct (pow_mod a m n);simpl... + rewrite (Zmult_mod (a^m)(a^m)); auto with zmisc. + rewrite <- IHm; mauto. + destruct (pow_mod a m n); mauto. + rewrite (Zmult_mod (a^m)(a^m)); auto with zmisc. + rewrite <- IHm. destruct (pow_mod a m n);simpl; mauto. Qed. Hint Rewrite pow_mod_spec Zpower_0 : zmisc. Lemma Npow_mod_spec : forall a p n, Z_of_N (Npow_mod a p n) = a^p mod n. -Proof with mauto. - intros a p n;destruct a;simpl ... +Proof. + intros a p n;destruct a; mauto; simpl; mauto. Qed. Hint Rewrite Npow_mod_spec : zmisc. Lemma iter_Npow_mod_spec : forall n q p a, - Z_of_N (iter_pos p N (fun x : N => Npow_mod x q n) a) = a^q^p mod n. -Proof with mauto. - induction p;simpl;intros ... - repeat rewrite IHp. + Z_of_N (iter_pos N (fun x : N => Npow_mod x q n) a p) = a^q^p mod n. +Proof. + induction p; mauto; intros; simpl Pos.iter; mauto; repeat rewrite IHp. rewrite (Zpower_mod ((a ^ q ^ p) ^ q ^ p));auto with zmisc. - rewrite (Zpower_mod (a ^ q ^ p))... - repeat rewrite IHp... + rewrite (Zpower_mod (a ^ q ^ p)); mauto. + mauto. Qed. -Hint Rewrite iter_Npow_mod_spec : zmisc. - +Hint Rewrite iter_Npow_mod_spec : zmisc. Lemma fold_pow_mod_spec : forall (n:positive) l (a:N), Z_of_N a = a mod n -> Z_of_N (fold_pow_mod a l n) = a^(mkProd' l) mod n. -Proof with mauto. - unfold fold_pow_mod;induction l;simpl;intros ... - rewrite IHl... +Proof. + unfold fold_pow_mod;induction l; simpl fold_left; simpl mkProd'; + intros; mauto. + rewrite IHl; mauto. Qed. Hint Rewrite fold_pow_mod_spec : zmisc. Lemma pow_mod_pred_spec : forall (n:positive) l (a:N), Z_of_N a = a mod n -> Z_of_N (pow_mod_pred a l n) = a^(mkProd_pred l) mod n. -Proof with mauto. - unfold pow_mod_pred;induction l;simpl;intros ... - destruct a as (q,p);simpl. - destruct (p ?= 1)%P; rewrite IHl... +Proof. + unfold pow_mod_pred;induction l;simpl mkProd;intros; mauto. + destruct a as (q,p). + simpl mkProd_pred. + destruct (p ?= 1)%P; rewrite IHl; mauto; simpl. Qed. Hint Rewrite pow_mod_pred_spec : zmisc. Lemma mkProd_pred_mkProd : forall l, (mkProd_pred l)*(mkProd' l) = mkProd l. -Proof with mauto. - induction l;simpl;intros ... +Proof. + induction l;simpl;intros; mauto. generalize (pos_eq_1_spec (snd a)); destruct (snd a ?= 1)%P;intros. - rewrite H... + rewrite H; mauto. replace (mkProd_pred l * (fst a * mkProd' l)) with (fst a *(mkProd_pred l * mkProd' l));try ring. - rewrite IHl... + rewrite IHl; mauto. rewrite Zmult_assoc. rewrite times_Zmult. rewrite (Zmult_comm (pow (fst a) (Ppred (snd a)) * mkProd_pred l)). rewrite Zmult_assoc. rewrite pow_Zpower. rewrite <-Ppred_Zminus;trivial. rewrite <- Zpower_Zsucc; try omega. replace (Zsucc (snd a - 1)) with ((snd a - 1)+1). - replace ((snd a - 1)+1) with (Zpos (snd a)) ... - rewrite <- IHl;repeat rewrite Zmult_assoc ... + replace ((snd a - 1)+1) with (Zpos (snd a)); mauto. + rewrite <- IHl;repeat rewrite Zmult_assoc; mauto. destruct (snd a - 1);trivial. assert (1 < snd a); auto with zarith. Qed. -Hint Rewrite mkProd_pred_mkProd : zmisc. +Hint Rewrite mkProd_pred_mkProd : zmisc. Lemma lt_Zmod : forall p n, 0 <= p < n -> p mod n = p. -Proof with mauto. +Proof. intros a b H. assert ( 0 <= a mod b < b). - apply Z_mod_lt... - destruct (mod_unique b (a/b) (a mod b) 0 a H0 H)... - rewrite <- Z_div_mod_eq... + apply Z_mod_lt; mauto. + destruct (mod_unique b (a/b) (a mod b) 0 a H0 H); mauto. + rewrite <- Z_div_mod_eq; mauto. Qed. -Opaque Zminus. Lemma Npred_mod_spec : forall p n, Z_of_N p < Zpos n -> 1 < Zpos n -> Z_of_N (Npred_mod p n) = (p - 1) mod n. -Proof with mauto. +Proof. destruct p;intros;simpl. - rewrite <- Ppred_Zminus... - change (-1) with (0 -1). rewrite <- (Z_mod_same n) ... - pattern 1 at 2;rewrite <- (lt_Zmod 1 n) ... - symmetry;apply lt_Zmod. -Transparent Zminus. - omega. + rewrite <- Ppred_Zminus; auto. + apply Zmod_unique with (q := -1); mauto. assert (H1 := pos_eq_1_spec p);destruct (p?=1)%P. - rewrite H1 ... - unfold Z_of_N;rewrite <- Ppred_Zminus... - simpl in H;symmetry; apply (lt_Zmod (p-1) n)... + rewrite H1; mauto. + unfold Z_of_N;rewrite <- Ppred_Zminus; auto. + simpl in H;symmetry; apply (lt_Zmod (p-1) n). assert (1 < p); auto with zarith. Qed. Hint Rewrite Npred_mod_spec : zmisc. Lemma times_mod_spec : forall x y n, Z_of_N (times_mod x y n) = (x * y) mod n. -Proof with mauto. - intros; destruct x ... - destruct y;simpl ... +Proof. + intros; destruct x; mauto. + destruct y;simpl; mauto. Qed. Hint Rewrite times_mod_spec : zmisc. @@ -453,10 +446,10 @@ Lemma snd_all_pow_mod : forall n l (prod a :N), a mod (Zpos n) = a -> Z_of_N (snd (all_pow_mod prod a l n)) = (a^(mkProd' l)) mod n. -Proof with mauto. - induction l;simpl;intros... - destruct a as (q,p);simpl. - rewrite IHl... +Proof. + induction l; simpl all_pow_mod; simpl mkProd';intros; mauto. + destruct a as (q,p). + rewrite IHl; mauto. Qed. Lemma fold_aux : forall a N (n:positive) l prod, @@ -466,8 +459,8 @@ Lemma fold_aux : forall a N (n:positive) l prod, fold_left (fun (r : Z) (k : positive * positive) => r * (a^(N / fst k) - 1)) l prod mod n. -Proof with mauto. - induction l;simpl;intros ... +Proof. + induction l;simpl;intros; mauto. Qed. Lemma fst_all_pow_mod : @@ -479,12 +472,12 @@ Lemma fst_all_pow_mod : (fold_left (fun r (k:positive*positive) => (r * (a ^ (R* mkProd' l / (fst k)) - 1))) l prod) mod n. -Proof with mauto. - induction l;simpl;intros... +Proof. + induction l;simpl;intros; mauto. destruct a0 as (q,p);simpl. assert (Z_of_N A = A mod n). - rewrite H1 ... - rewrite (IHl (R * q)%positive)... + rewrite H1; mauto. + rewrite (IHl (R * q)%positive); mauto; mauto. pattern (q * mkProd' l) at 2;rewrite (Zmult_comm q). repeat rewrite Zmult_assoc. rewrite Z_div_mult;auto with zmisc zarith. @@ -495,12 +488,11 @@ Proof with mauto. repeat rewrite (Zmult_mod prod);auto with zmisc. rewrite Zminus_mod;auto with zmisc. rewrite (Zminus_mod ((a ^ R) ^ mkProd' l));auto with zmisc. - rewrite (Zpower_mod (a^R));auto with zmisc. rewrite H1... - rewrite H3... - rewrite H1 ... + rewrite (Zpower_mod (a^R));auto with zmisc. rewrite H1; mauto. + rewrite H3; mauto. + rewrite H1; mauto. Qed. - Lemma is_odd_Zodd : forall p, is_odd p = true -> Zodd p. Proof. destruct p;intros;simpl;trivial;discriminate. @@ -548,11 +540,11 @@ Ltac spec_dec := repeat match goal with | [H:(?x ?= ?y)%P = _ |- _] => generalize (is_eq_spec x y); - rewrite H;clear H;simpl; autorewrite with zmisc; + rewrite H;clear H; autorewrite with zmisc; intro | [H:(?x ?< ?y)%P = _ |- _] => generalize (is_lt_spec x y); - rewrite H; clear H;simpl; autorewrite with zmisc; + rewrite H; clear H; autorewrite with zmisc; intro end. @@ -576,7 +568,7 @@ Proof. assert (Zpos (xO (xO (xO s))) = 8 * s). repeat rewrite Zpos_xO_add;ring. generalizeclear H1; rewrite H2;mauto;intros. apply (not_square sqrt). - rewrite H1;auto. + simpl Z.of_N; rewrite H1;auto. intros (y,Heq). generalize H1 Heq;mauto. unfold Z_of_N. @@ -587,32 +579,32 @@ Proof. destruct y;discriminate Heq2. Qed. -Opaque Zplus Pplus. Lemma in_mkProd_prime_div_in : forall p:positive, prime p -> forall (l:dec_prime), (forall k, In k l -> prime (fst k)) -> Zdivide p (mkProd l) -> exists n,In (p, n) l. -Proof with mauto. - induction l;simpl ... +Proof. + induction l;simpl mkProd; simpl In; mauto. intros _ H1; absurd (p <= 1). apply Zlt_not_le; apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. apply Zdivide_le; auto with zarith. - intros; case prime_mult with (2 := H1); auto with zarith; intros H2. + intros. + case prime_mult with (2 := H1); auto with zarith; intros H2. exists (snd a);left. destruct a;simpl in *. assert (Zpos p = Zpos p0). - rewrite (prime_div_Zpower_prime p1 p p0)... + rewrite (prime_div_Zpower_prime p1 p p0); mauto. apply (H0 (p0,p1));auto. - inversion H3... - destruct IHl as (n,H3)... - exists n... + inversion H3; auto. + destruct IHl as (n,H3); mauto. + exists n; auto. Qed. Lemma gcd_Zis_gcd : forall a b:positive, (Zis_gcd b a (gcd b a)%P). -Proof with mauto. +Proof. intros a;assert (Hacc := Zwf_pos a);induction Hacc;rename x into a;intros. - generalize (div_eucl_spec b a)... + generalize (div_eucl_spec b a); mauto. rewrite <- (Pmod_div_eucl b a). CaseEq (b mod a)%P;[intros Heq|intros r Heq]; intros (H1,H2). simpl in H1;rewrite Zplus_0_r in H1. @@ -629,53 +621,57 @@ Lemma test_pock_correct : forall N a dec sqrt, (forall k, In k dec -> prime (Zpos (fst k))) -> test_pock N a dec sqrt = true -> prime N. -Proof with mauto. +Proof. unfold test_pock;intros. elimif. generalize (div_eucl_spec (Ppred N) (mkProd dec)); - destruct ((Ppred N) / (mkProd dec))%P as (R1,n);simpl;mauto;intros (H2,H3). + destruct ((Ppred N) / (mkProd dec))%P as (R1,n); mauto;intros (H2,H3). destruct R1 as [|R1];try discriminate H0. destruct n;try discriminate H0. elimif. generalize (div_eucl_spec R1 (xO (mkProd dec))); - destruct ((R1 / xO (mkProd dec))%P) as (s,r');simpl;mauto;intros (H7,H8). + destruct ((R1 / xO (mkProd dec))%P) as (s,r'); mauto;intros (H7,H8). destruct r' as [|r];try discriminate H0. generalize (fst_all_pow_mod N a dec (R1*mkProd_pred dec) 1 (pow_mod_pred (pow_mod a R1 N) dec N)). generalize (snd_all_pow_mod N dec 1 (pow_mod_pred (pow_mod a R1 N) dec N)). destruct (all_pow_mod 1 (pow_mod_pred (pow_mod a R1 N) dec N) dec N) as - (prod,aNm1);simpl... + (prod,aNm1); mauto; simpl Z_of_N. destruct prod as [|prod];try discriminate H0. destruct aNm1 as [|aNm1];try discriminate H0;elimif. - simpl in H2;rewrite Zplus_0_r in H2. + simpl in H3; simpl in H2. rewrite <- Ppred_Zminus in H2;try omega. rewrite <- Zmult_assoc;rewrite mkProd_pred_mkProd. intros H12;assert (a^(N-1) mod N = 1). pattern 1 at 2;rewrite <- H9;symmetry. - rewrite H2;rewrite H12 ... - rewrite <- Zpower_mult... + simpl Z.of_N in H12. + rewrite H2; rewrite H12; mauto. + rewrite <- Zpower_mult; mauto. clear H12. intros H14. match type of H14 with _ -> _ -> _ -> ?X => assert (H12:X); try apply H14; clear H14 - end... - rewrite Zmod_small... + end; mauto. + rewrite Zmod_small; mauto. assert (1 < mkProd dec). assert (H14 := Zlt_0_pos (mkProd dec)). - assert (1 <= mkProd dec)... - destruct (Zle_lt_or_eq _ _ H15)... + assert (1 <= mkProd dec); mauto. + destruct (Zle_lt_or_eq _ _ H15); mauto. inversion H16. rewrite <- H18 in H5;discriminate H5. simpl in H8. assert (Z_of_N s = R1 / (2 * mkProd dec) /\ Zpos r = R1 mod (2 * mkProd dec)). apply mod_unique with (2 * mkProd dec);auto with zarith. - apply Z_mod_lt ... - rewrite <- Z_div_mod_eq... rewrite H7. simpl;ring. + revert H8; mauto. + apply Z_mod_lt; mauto. + rewrite <- Z_div_mod_eq; mauto; rewrite H7. + simpl fst; simpl snd; simpl Z_of_N. + ring. destruct H15 as (H15,Heqr). apply PocklingtonExtra with (F1:=mkProd dec) (R1:=R1) (m:=1); auto with zmisc zarith. - rewrite H2;ring. - apply is_even_Zeven... - apply is_odd_Zodd... + rewrite H2; mauto. + apply is_even_Zeven; auto. + apply is_odd_Zodd; auto. intros p; case p; clear p. intros HH; contradict HH. apply not_prime_0. @@ -692,6 +688,7 @@ Proof with mauto. pattern 1 at 3; rewrite <- H10; rewrite <- H12. apply Pmod.gcd_Zis_gcd. destruct (in_mkProd_prime_div_in _ Hprime _ H Hdec) as (q,Hin). + revert H2; mauto; intro H2. rewrite <- H2. match goal with |- context [fold_left ?f _ _] => apply (ListAux.fold_left_invol_in _ _ f (fun k => Zdivide (a ^ ((N - 1) / p) - 1) k)) @@ -700,9 +697,9 @@ Proof with mauto. rewrite <- Heqr. generalizeclear H0; ring_simplify (((mkProd dec + mkProd dec + r + 1) * mkProd dec + r) * mkProd dec + 1) - ((1 * mkProd dec + 1) * (2 * mkProd dec * mkProd dec + (r - 1) * mkProd dec + 1))... + ((1 * mkProd dec + 1) * (2 * mkProd dec * mkProd dec + (r - 1) * mkProd dec + 1)); mauto. rewrite <- H15;rewrite <- Heqr. - apply check_s_r_correct with sqrt ... + apply check_s_r_correct with sqrt; mauto. Qed. Lemma is_in_In : diff --git a/coqprime/Coqprime/Root.v b/coqprime/Coqprime/Root.v index 4e74a4d2f..2f65790d6 100644 --- a/coqprime/Coqprime/Root.v +++ b/coqprime/Coqprime/Root.v @@ -11,11 +11,11 @@ Proof that a polynomial has at most n roots ************************************************************************) -Require Import Coq.ZArith.ZArith. -Require Import Coq.Lists.List. -Require Import Coqprime.UList. -Require Import Coqprime.Tactic. -Require Import Coqprime.Permutation. +Require Import ZArith. +Require Import List. +Require Import UList. +Require Import Tactic. +Require Import Permutation. Open Scope Z_scope. @@ -33,8 +33,8 @@ Let pol := list A. Definition toA z := match z with Z0 => zero -| Zpos p => iter_pos p _ (plus one) zero -| Zneg p => op (iter_pos p _ (plus one) zero) +| Zpos p => iter_pos _ (plus one) zero p +| Zneg p => op (iter_pos _ (plus one) zero p) end. Fixpoint eval (p: pol) (x: A) {struct p} : A := diff --git a/coqprime/Coqprime/UList.v b/coqprime/Coqprime/UList.v index 32ca6b2a0..7b9d982ea 100644 --- a/coqprime/Coqprime/UList.v +++ b/coqprime/Coqprime/UList.v @@ -7,33 +7,33 @@ (*************************************************************) (*********************************************************************** - UList.v - - Definition of list with distinct elements - - Definition: ulist + UList.v + + Definition of list with distinct elements + + Definition: ulist ************************************************************************) -Require Import Coq.Lists.List. -Require Import Coq.Arith.Arith. -Require Import Coqprime.Permutation. -Require Import Coq.Lists.ListSet. - +Require Import List. +Require Import Arith. +Require Import Permutation. +Require Import ListSet. + Section UniqueList. Variable A : Set. Variable eqA_dec : forall (a b : A), ({ a = b }) + ({ a <> b }). (* A list is unique if there is not twice the same element in the list *) - + Inductive ulist : list A -> Prop := ulist_nil: ulist nil | ulist_cons: forall a l, ~ In a l -> ulist l -> ulist (a :: l) . Hint Constructors ulist . (* Inversion theorem *) - + Theorem ulist_inv: forall a l, ulist (a :: l) -> ulist l. intros a l H; inversion H; auto. Qed. (* The append of two unique list is unique if the list are distinct *) - + Theorem ulist_app: forall l1 l2, ulist l1 -> @@ -48,16 +48,18 @@ apply ulist_inv with ( 1 := H0 ); auto. intros a0 H3 H4; apply (H2 a0); auto. Qed. (* Iinversion theorem the appended list *) - + Theorem ulist_app_inv: forall l1 l2 (a : A), ulist (l1 ++ l2) -> In a l1 -> In a l2 -> False. intros l1; elim l1; simpl; auto. -intros a l H l2 a0 H0 [H1|H1] H2; -inversion H0 as [|a1 l0 H3 H4 H5]; clear H0; auto; - subst; eauto using ulist_inv with datatypes. +intros a l H l2 a0 H0 [H1|H1] H2. +inversion H0 as [|a1 l0 H3 H4 H5]; auto. +case H3; rewrite H1; auto with datatypes. +apply (H l2 a0); auto. +apply ulist_inv with ( 1 := H0 ); auto. Qed. (* Iinversion theorem the appended list *) - + Theorem ulist_app_inv_l: forall (l1 l2 : list A), ulist (l1 ++ l2) -> ulist l1. intros l1; elim l1; simpl; auto. intros a l H l2 H0. @@ -66,13 +68,13 @@ intros H5; case iH2; auto with datatypes. apply H with l2; auto. Qed. (* Iinversion theorem the appended list *) - + Theorem ulist_app_inv_r: forall (l1 l2 : list A), ulist (l1 ++ l2) -> ulist l2. intros l1; elim l1; simpl; auto. intros a l H l2 H0; inversion H0; auto. Qed. (* Uniqueness is decidable *) - + Definition ulist_dec: forall l, ({ ulist l }) + ({ ~ ulist l }). intros l; elim l; auto. intros a l1 [H|H]; auto. @@ -81,7 +83,7 @@ right; red; intros H1; inversion H1; auto. right; intros H1; case H; apply ulist_inv with ( 1 := H1 ). Defined. (* Uniqueness is compatible with permutation *) - + Theorem ulist_perm: forall (l1 l2 : list A), permutation l1 l2 -> ulist l1 -> ulist l2. intros l1 l2 H; elim H; clear H l1 l2; simpl; auto. @@ -101,7 +103,7 @@ intros H; case iH1; simpl; auto. inversion_clear H0 as [|ia il iH1 iH2]; auto. inversion iH2; auto. Qed. - + Theorem ulist_def: forall l a, In a l -> ulist l -> ~ (exists l1 , permutation l (a :: (a :: l1)) ). @@ -110,7 +112,7 @@ absurd (ulist (a :: (a :: l1))); auto. intros H2; inversion_clear H2; simpl; auto with datatypes. apply ulist_perm with ( 1 := H1 ); auto. Qed. - + Theorem ulist_incl_permutation: forall (l1 l2 : list A), ulist l1 -> incl l1 l2 -> (exists l3 , permutation l2 (l1 ++ l3) ). @@ -132,7 +134,7 @@ intros l4 H4; exists l4. apply permutation_trans with (a :: l3); auto. apply permutation_sym; auto. Qed. - + Theorem ulist_eq_permutation: forall (l1 l2 : list A), ulist l1 -> incl l1 l2 -> length l1 = length l2 -> permutation l1 l2. @@ -148,7 +150,7 @@ replace l1 with (app l1 l3); auto. apply permutation_sym; auto. rewrite H5; rewrite app_nil_end; auto. Qed. - + Theorem ulist_incl_length: forall (l1 l2 : list A), ulist l1 -> incl l1 l2 -> le (length l1) (length l2). @@ -164,8 +166,8 @@ intros l1 l2 H1 H2 H3 H4. apply ulist_eq_permutation; auto. apply le_antisym; apply ulist_incl_length; auto. Qed. - - + + Theorem ulist_incl_length_strict: forall (l1 l2 : list A), ulist l1 -> incl l1 l2 -> ~ incl l2 l1 -> lt (length l1) (length l2). @@ -178,14 +180,14 @@ intros H2; case Hi0; auto. intros a HH; apply permutation_in with ( 1 := H2 ); auto. intros a l Hl0; (rewrite plus_comm; simpl; rewrite plus_comm; auto with arith). Qed. - + Theorem in_inv_dec: forall (a b : A) l, In a (cons b l) -> a = b \/ ~ a = b /\ In a l. intros a b l H; case (eqA_dec a b); auto; intros H1. right; split; auto; inversion H; auto. case H1; auto. Qed. - + Theorem in_ex_app_first: forall (a : A) (l : list A), In a l -> @@ -201,7 +203,7 @@ case H; auto; intros l1 [l2 [Hl2 Hl3]]; exists (a1 :: l1); exists l2; simpl; subst; auto. intros H4; case H4; auto. Qed. - + Theorem ulist_inv_ulist: forall (l : list A), ~ ulist l -> @@ -237,7 +239,7 @@ replace (l1 ++ (a1 :: (l2 ++ (a1 :: l3)))) with ((l1 ++ (a1 :: l2)) ++ (a1 :: l3)); auto with datatypes. (repeat (rewrite <- ass_app; simpl)); auto. Qed. - + Theorem incl_length_repetition: forall (l1 l2 : list A), incl l1 l2 -> @@ -251,11 +253,11 @@ intros l1 l2 H H0; apply ulist_inv_ulist. intros H1; absurd (le (length l1) (length l2)); auto with arith. apply ulist_incl_length; auto. Qed. - + End UniqueList. Implicit Arguments ulist [A]. Hint Constructors ulist . - + Theorem ulist_map: forall (A B : Set) (f : A -> B) l, (forall x y, (In x l) -> (In y l) -> f x = f y -> x = y) -> ulist l -> ulist (map f l). @@ -268,7 +270,7 @@ case in_map_inv with ( 1 := H1 ); auto with datatypes. intros b1 [Hb1 Hb2]. replace a1 with b1; auto with datatypes. Qed. - + Theorem ulist_list_prod: forall (A : Set) (l1 l2 : list A), ulist l1 -> ulist l2 -> ulist (list_prod l1 l2). diff --git a/coqprime/Coqprime/ZCAux.v b/coqprime/Coqprime/ZCAux.v index aa47fb655..de03a2fe2 100644 --- a/coqprime/Coqprime/ZCAux.v +++ b/coqprime/Coqprime/ZCAux.v @@ -12,10 +12,10 @@ Auxillary functions & Theorems **********************************************************************) -Require Import Coq.setoid_ring.ArithRing. -Require Export Coq.ZArith.ZArith Coq.ZArith.Zpow_facts. -Require Export Coq.ZArith.Znumtheory. -Require Export Coqprime.Tactic. +Require Import ArithRing. +Require Export ZArith Zpow_facts. +Require Export Znumtheory. +Require Export Tactic. Theorem Zdivide_div_prime_le_square: forall x, 1 < x -> ~prime x -> exists p, prime p /\ (p | x) /\ p * p <= x. intros x Hx; generalize Hx; pattern x; apply Z_lt_induction; auto with zarith. diff --git a/coqprime/Coqprime/ZCmisc.v b/coqprime/Coqprime/ZCmisc.v index e2ec66ba1..c1bdacc63 100644 --- a/coqprime/Coqprime/ZCmisc.v +++ b/coqprime/Coqprime/ZCmisc.v @@ -6,7 +6,7 @@ (* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) (*************************************************************) -Require Export Coq.ZArith.ZArith. +Require Export ZArith. Open Local Scope Z_scope. Coercion Zpos : positive >-> Z. diff --git a/coqprime/Coqprime/ZProgression.v b/coqprime/Coqprime/ZProgression.v index 4cf30d692..51ce91cdc 100644 --- a/coqprime/Coqprime/ZProgression.v +++ b/coqprime/Coqprime/ZProgression.v @@ -6,9 +6,9 @@ (* Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr *) (*************************************************************) -Require Export Coqprime.Iterator. -Require Import Coq.ZArith.ZArith. -Require Export Coqprime.UList. +Require Export Iterator. +Require Import ZArith. +Require Export UList. Open Scope Z_scope. Theorem next_n_Z: forall n m, next_n Zsucc n m = n + Z_of_nat m. diff --git a/coqprime/Coqprime/ZSum.v b/coqprime/Coqprime/ZSum.v index 907720f7c..3a7f14065 100644 --- a/coqprime/Coqprime/ZSum.v +++ b/coqprime/Coqprime/ZSum.v @@ -9,12 +9,12 @@ (*********************************************************************** Summation.v from Z to Z *********************************************************************) -Require Import Coq.Arith.Arith. -Require Import Coq.setoid_ring.ArithRing. -Require Import Coqprime.ListAux. -Require Import Coq.ZArith.ZArith. -Require Import Coqprime.Iterator. -Require Import Coqprime.ZProgression. +Require Import Arith. +Require Import ArithRing. +Require Import ListAux. +Require Import ZArith. +Require Import Iterator. +Require Import ZProgression. Open Scope Z_scope. diff --git a/coqprime/Coqprime/Zp.v b/coqprime/Coqprime/Zp.v index 2f7d28d69..1e5295191 100644 --- a/coqprime/Coqprime/Zp.v +++ b/coqprime/Coqprime/Zp.v @@ -14,16 +14,16 @@ Definition: ZpGroup **********************************************************************) -Require Import Coq.ZArith.ZArith Coq.ZArith.Znumtheory Coq.ZArith.Zpow_facts. -Require Import Coqprime.Tactic. -Require Import Coq.Arith.Wf_nat. -Require Import Coqprime.UList. -Require Import Coqprime.FGroup. -Require Import Coqprime.EGroup. -Require Import Coqprime.IGroup. -Require Import Coqprime.Cyclic. -Require Import Coqprime.Euler. -Require Import Coqprime.ZProgression. +Require Import ZArith Znumtheory Zpow_facts. +Require Import Tactic. +Require Import Wf_nat. +Require Import UList. +Require Import FGroup. +Require Import EGroup. +Require Import IGroup. +Require Import Cyclic. +Require Import Euler. +Require Import ZProgression. Open Scope Z_scope. diff --git a/coqprime/Makefile b/coqprime/Makefile index 8fa838a1e..c8e44a658 100644 --- a/coqprime/Makefile +++ b/coqprime/Makefile @@ -2,7 +2,7 @@ ## v # The Coq Proof Assistant ## ## $@ + printf 'cd "$${DSTROOT}"$(COQLIBINSTALL)/Coqprime && rm -f $(NATIVEFILES1) $(GLOBFILES1) $(VFILES1) $(VOFILES1) && find . -type d -and -empty -delete\ncd "$${DSTROOT}"$(COQLIBINSTALL) && find "Coqprime" -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n' >> "$@" + printf 'cd "$${DSTROOT}"$(COQDOCINSTALL)/Coqprime \\\n' >> "$@" + printf '&& rm -f $(shell find "html" -maxdepth 1 -and -type f -print)\n' >> "$@" + printf 'cd "$${DSTROOT}"$(COQDOCINSTALL) && find Coqprime/html -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n' >> "$@" + chmod +x $@ + +uninstall: uninstall_me.sh + sh $< + +.merlin: + @echo 'FLG -rectypes' > .merlin + @echo "B $(COQLIB) kernel" >> .merlin + @echo "B $(COQLIB) lib" >> .merlin + @echo "B $(COQLIB) library" >> .merlin + @echo "B $(COQLIB) parsing" >> .merlin + @echo "B $(COQLIB) pretyping" >> .merlin + @echo "B $(COQLIB) interp" >> .merlin + @echo "B $(COQLIB) printing" >> .merlin + @echo "B $(COQLIB) intf" >> .merlin + @echo "B $(COQLIB) proofs" >> .merlin + @echo "B $(COQLIB) tactics" >> .merlin + @echo "B $(COQLIB) tools" >> .merlin + @echo "B $(COQLIB) toplevel" >> .merlin + @echo "B $(COQLIB) stm" >> .merlin + @echo "B $(COQLIB) grammar" >> .merlin + @echo "B $(COQLIB) config" >> .merlin + +clean:: + rm -f $(OBJFILES) $(OBJFILES:.o=.native) $(NATIVEFILES) + find . -name .coq-native -type d -empty -delete + rm -f $(VOFILES) $(VOFILES:.vo=.vio) $(GFILES) $(VFILES:.v=.v.d) $(VFILES:=.beautified) $(VFILES:=.old) rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob $(VFILES:.v=.glob) $(VFILES:.v=.tex) $(VFILES:.v=.g.tex) all-mli.tex - - rm -rf html mlihtml + - rm -rf html mlihtml uninstall_me.sh -archclean: +cleanall:: clean + rm -f $(patsubst %.v,.%.aux,$(VFILES)) + +archclean:: rm -f *.cmx *.o printenv: @@ -217,31 +280,34 @@ Makefile: _CoqProject # # ################### -%.vo %.glob: %.v +$(VOFILES): %.vo: %.v + $(COQC) $(COQDEBUG) $(COQFLAGS) $* + +$(GLOBFILES): %.glob: %.v $(COQC) $(COQDEBUG) $(COQFLAGS) $* -%.vi: %.v - $(COQC) -i $(COQDEBUG) $(COQFLAGS) $* +$(VFILES:.v=.vio): %.vio: %.v + $(COQC) -quick $(COQDEBUG) $(COQFLAGS) $* -%.g: %.v +$(GFILES): %.g: %.v $(GALLINA) $< -%.tex: %.v +$(VFILES:.v=.tex): %.tex: %.v $(COQDOC) $(COQDOCFLAGS) -latex $< -o $@ -%.html: %.v %.glob +$(HTMLFILES): %.html: %.v %.glob $(COQDOC) $(COQDOCFLAGS) -html $< -o $@ -%.g.tex: %.v +$(VFILES:.v=.g.tex): %.g.tex: %.v $(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@ -%.g.html: %.v %.glob +$(GHTMLFILES): %.g.html: %.v %.glob $(COQDOC) $(COQDOCFLAGS) -html -g $< -o $@ -%.v.d: %.v - $(COQDEP) -slash $(COQLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) +$(addsuffix .d,$(VFILES)): %.v.d: %.v + $(COQDEP) $(COQLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) -%.v.beautified: +$(addsuffix .beautified,$(VFILES)): %.v.beautified: $(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $* # WARNING diff --git a/coqprime/README.md b/coqprime/README.md index 8f1b93b12..9c317fb00 100644 --- a/coqprime/README.md +++ b/coqprime/README.md @@ -1,6 +1,6 @@ # Coqprime (LGPL subset) -This is a mirror of the LGPL-licensed and autogenerated files from [Coqprime](http://coqprime.gforge.inria.fr/) for Coq 8.4. It was generated from [coqprime_par.zip](https://gforge.inria.fr/frs/download.php/file/35201/coqprime_par.zip). Due to the removal of files that are missing license headers in the upstream source, `make` no longer completes successfully. However, a large part of the codebase does build and contains theorems useful to us. Fixing the build system would be nice, but is not a priority for us. +This is a mirror of the LGPL-licensed and autogenerated files from [Coqprime](http://coqprime.gforge.inria.fr/) for Coq 8.5. It was generated from [coqprime_8.5b.zip](https://gforge.inria.fr/frs/download.php/file/35520/coqprime_8.5b.zip). Due to the removal of files that are missing license headers in the upstream source, `make` no longer completes successfully. However, a large part of the codebase does build and contains theorems useful to us. Fixing the build system would be nice, but is not a priority for us. ## Usage -- cgit v1.2.3