diff options
Diffstat (limited to 'contrib/micromega/ZCoeff.v')
-rw-r--r-- | contrib/micromega/ZCoeff.v | 173 |
1 files changed, 0 insertions, 173 deletions
diff --git a/contrib/micromega/ZCoeff.v b/contrib/micromega/ZCoeff.v deleted file mode 100644 index ced67e39..00000000 --- a/contrib/micromega/ZCoeff.v +++ /dev/null @@ -1,173 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) -(* Evgeny Makarov, INRIA, 2007 *) -(************************************************************************) - -Require Import OrderedRing. -Require Import RingMicromega. -Require Import ZArith. -Require Import InitialRing. -Require Import Setoid. - -Import OrderedRingSyntax. - -Set Implicit Arguments. - -Section InitialMorphism. - -Variable R : Type. -Variables rO rI : R. -Variables rplus rtimes rminus: R -> R -> R. -Variable ropp : R -> R. -Variables req rle rlt : R -> R -> Prop. - -Variable sor : SOR rO rI rplus rtimes rminus ropp req rle rlt. - -Notation "0" := rO. -Notation "1" := rI. -Notation "x + y" := (rplus x y). -Notation "x * y " := (rtimes x y). -Notation "x - y " := (rminus x y). -Notation "- x" := (ropp x). -Notation "x == y" := (req x y). -Notation "x ~= y" := (~ req x y). -Notation "x <= y" := (rle x y). -Notation "x < y" := (rlt x y). - -Lemma req_refl : forall x, req x x. -Proof. - destruct sor.(SORsetoid). - apply Equivalence_Reflexive. -Qed. - -Lemma req_sym : forall x y, req x y -> req y x. -Proof. - destruct sor.(SORsetoid). - apply Equivalence_Symmetric. -Qed. - -Lemma req_trans : forall x y z, req x y -> req y z -> req x z. -Proof. - destruct sor.(SORsetoid). - apply Equivalence_Transitive. -Qed. - - -Add Relation R req - reflexivity proved by sor.(SORsetoid).(@Equivalence_Reflexive _ _) - symmetry proved by sor.(SORsetoid).(@Equivalence_Symmetric _ _) - transitivity proved by sor.(SORsetoid).(@Equivalence_Transitive _ _) -as sor_setoid. - -Add Morphism rplus with signature req ==> req ==> req as rplus_morph. -Proof. -exact sor.(SORplus_wd). -Qed. -Add Morphism rtimes with signature req ==> req ==> req as rtimes_morph. -Proof. -exact sor.(SORtimes_wd). -Qed. -Add Morphism ropp with signature req ==> req as ropp_morph. -Proof. -exact sor.(SORopp_wd). -Qed. -Add Morphism rle with signature req ==> req ==> iff as rle_morph. -Proof. -exact sor.(SORle_wd). -Qed. -Add Morphism rlt with signature req ==> req ==> iff as rlt_morph. -Proof. -exact sor.(SORlt_wd). -Qed. -Add Morphism rminus with signature req ==> req ==> req as rminus_morph. -Proof. - exact (rminus_morph sor). -Qed. - -Ltac le_less := rewrite (Rle_lt_eq sor); left; try assumption. -Ltac le_equal := rewrite (Rle_lt_eq sor); right; try reflexivity; try assumption. - -Definition gen_order_phi_Z : Z -> R := gen_phiZ 0 1 rplus rtimes ropp. - -Notation phi_pos := (gen_phiPOS 1 rplus rtimes). -Notation phi_pos1 := (gen_phiPOS1 1 rplus rtimes). - -Notation "[ x ]" := (gen_order_phi_Z x). - -Lemma ring_ops_wd : ring_eq_ext rplus rtimes ropp req. -Proof. -constructor. -exact rplus_morph. -exact rtimes_morph. -exact ropp_morph. -Qed. - -Lemma Zring_morph : - ring_morph 0 1 rplus rtimes rminus ropp req - 0%Z 1%Z Zplus Zmult Zminus Zopp - Zeq_bool gen_order_phi_Z. -Proof. -exact (gen_phiZ_morph sor.(SORsetoid) ring_ops_wd sor.(SORrt)). -Qed. - -Lemma phi_pos1_pos : forall x : positive, 0 < phi_pos1 x. -Proof. -induction x as [x IH | x IH |]; simpl; -try apply (Rplus_pos_pos sor); try apply (Rtimes_pos_pos sor); try apply (Rplus_pos_pos sor); -try apply (Rlt_0_1 sor); assumption. -Qed. - -Lemma phi_pos1_succ : forall x : positive, phi_pos1 (Psucc x) == 1 + phi_pos1 x. -Proof. -exact (ARgen_phiPOS_Psucc sor.(SORsetoid) ring_ops_wd - (Rth_ARth sor.(SORsetoid) ring_ops_wd sor.(SORrt))). -Qed. - -Lemma clt_pos_morph : forall x y : positive, (x < y)%positive -> phi_pos1 x < phi_pos1 y. -Proof. -intros x y H. pattern y; apply Plt_ind with x. -rewrite phi_pos1_succ; apply (Rlt_succ_r sor). -clear y H; intros y _ H. rewrite phi_pos1_succ. now apply (Rlt_lt_succ sor). -assumption. -Qed. - -Lemma clt_morph : forall x y : Z, (x < y)%Z -> [x] < [y]. -Proof. -unfold Zlt; intros x y H; -do 2 rewrite (same_genZ sor.(SORsetoid) ring_ops_wd sor.(SORrt)); -destruct x; destruct y; simpl in *; try discriminate. -apply phi_pos1_pos. -now apply clt_pos_morph. -apply <- (Ropp_neg_pos sor); apply phi_pos1_pos. -apply (Rlt_trans sor) with 0. apply <- (Ropp_neg_pos sor); apply phi_pos1_pos. -apply phi_pos1_pos. -rewrite Pcompare_antisym in H; simpl in H. apply -> (Ropp_lt_mono sor). -now apply clt_pos_morph. -Qed. - -Lemma Zcleb_morph : forall x y : Z, Zle_bool x y = true -> [x] <= [y]. -Proof. -unfold Zle_bool; intros x y H. -case_eq (x ?= y)%Z; intro H1; rewrite H1 in H. -le_equal. apply Zring_morph.(morph_eq). unfold Zeq_bool; now rewrite H1. -le_less. now apply clt_morph. -discriminate. -Qed. - -Lemma Zcneqb_morph : forall x y : Z, Zeq_bool x y = false -> [x] ~= [y]. -Proof. -intros x y H. unfold Zeq_bool in H. -case_eq (Zcompare x y); intro H1; rewrite H1 in *; (discriminate || clear H). -apply (Rlt_neq sor). now apply clt_morph. -fold (x > y)%Z in H1. rewrite Zgt_iff_lt in H1. -apply (Rneq_symm sor). apply (Rlt_neq sor). now apply clt_morph. -Qed. - -End InitialMorphism. - - |