diff options
| author |  Stephane Glondu <steph@glondu.net> | 2008-08-08 13:18:42 +0200 |
|---|---|---|
| committer | Stephane Glondu <steph@glondu.net> | 2008-08-08 13:18:42 +0200 |
| commit | 870075f34dd9fa5792bfbf413afd3b96f17e76a0 (patch) | |
| tree | 0c647056de1832cf1dba5ba58758b9121418e4be /theories | |
| parent | a0cfa4f118023d35b767a999d5a2ac4b082857b4 (diff) | |
Imported Upstream version 8.2~beta4+dfsgupstream/8.2.beta4+dfsg
Diffstat (limited to 'theories')
46 files changed, 2084 insertions, 5923 deletions
diff --git a/theories/Classes/EquivDec.v b/theories/Classes/EquivDec.v index debe953a..1e58d05d 100644 --- a/theories/Classes/EquivDec.v +++ b/theories/Classes/EquivDec.v @@ -13,7 +13,7 @@ * Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud * 91405 Orsay, France *) -(* $Id: EquivDec.v 10919 2008-05-11 22:04:26Z msozeau $ *) +(* $Id: EquivDec.v 11282 2008-07-28 11:51:53Z msozeau $ *) Set Implicit Arguments. Unset Strict Implicit. @@ -40,7 +40,7 @@ Class [ equiv : Equivalence A ] => EqDec := (** We define the [==] overloaded notation for deciding equality. It does not take precedence of [==] defined in the type scope, hence we can have both at the same time. *) -Notation " x == y " := (equiv_dec (x :>) (y :>)) (no associativity, at level 70). +Notation " x == y " := (equiv_dec (x :>) (y :>)) (no associativity, at level 70) : equiv_scope. Definition swap_sumbool {A B} (x : { A } + { B }) : { B } + { A } := match x with @@ -58,7 +58,7 @@ Program Definition nequiv_dec [ EqDec A ] (x y : A) : { x =/= y } + { x === y } (** Overloaded notation for inequality. *) -Infix "=/=" := nequiv_dec (no associativity, at level 70). +Infix "<>" := nequiv_dec (no associativity, at level 70) : equiv_scope. (** Define boolean versions, losing the logical information. *) @@ -155,4 +155,4 @@ Program Instance list_eqdec [ eqa : EqDec A eq ] : ! EqDec (list A) eq := Next Obligation. Proof. clear aux. red in H0. subst. destruct y; intuition (discriminate || eauto). - Defined.
\ No newline at end of file + Defined. diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v index 70bf3483..d52eed47 100644 --- a/theories/Classes/Equivalence.v +++ b/theories/Classes/Equivalence.v @@ -13,7 +13,7 @@ Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud 91405 Orsay, France *) -(* $Id: Equivalence.v 10919 2008-05-11 22:04:26Z msozeau $ *) +(* $Id: Equivalence.v 11282 2008-07-28 11:51:53Z msozeau $ *) Require Export Coq.Program.Basics. Require Import Coq.Program.Tactics. @@ -116,7 +116,7 @@ Section Respecting. Definition respecting [ Equivalence A (R : relation A), Equivalence B (R' : relation B) ] : Type := { morph : A -> B | respectful R R' morph morph }. - Program Instance respecting_equiv [ Equivalence A R, Equivalence B R' ] : + Program Instance respecting_equiv [ eqa : Equivalence A R, eqb : Equivalence B R' ] : Equivalence respecting (fun (f g : respecting) => forall (x y : A), R x y -> R' (proj1_sig f x) (proj1_sig g y)). @@ -124,18 +124,17 @@ Section Respecting. Next Obligation. Proof. - unfold respecting in *. program_simpl. red in H2,H3,H4. - transitivity (y x0) ; auto. - transitivity (y y0) ; auto. - symmetry. auto. + unfold respecting in *. program_simpl. transitivity (y y0); auto. apply H0. reflexivity. Qed. End Respecting. (** The default equivalence on function spaces, with higher-priority than [eq]. *) -Program Instance pointwise_equivalence [ Equivalence A eqA ] : - Equivalence (B -> A) (pointwise_relation eqA) | 9. +Program Instance pointwise_equivalence [ eqb : Equivalence B eqB ] : + Equivalence (A -> B) (pointwise_relation eqB) | 9. + + Solve Obligations using simpl_relation ; first [ reflexivity | (symmetry ; auto) ]. Next Obligation. Proof. diff --git a/theories/Classes/Functions.v b/theories/Classes/Functions.v index 49fc4f89..4c844911 100644 --- a/theories/Classes/Functions.v +++ b/theories/Classes/Functions.v @@ -13,7 +13,7 @@ Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud 91405 Orsay, France *) -(* $Id: Functions.v 10739 2008-04-01 14:45:20Z herbelin $ *) +(* $Id: Functions.v 11282 2008-07-28 11:51:53Z msozeau $ *) Require Import Coq.Classes.RelationClasses. Require Import Coq.Classes.Morphisms. @@ -21,22 +21,22 @@ Require Import Coq.Classes.Morphisms. Set Implicit Arguments. Unset Strict Implicit. -Class [ m : Morphism (A -> B) (RA ++> RB) f ] => Injective : Prop := +Class Injective ((m : Morphism (A -> B) (RA ++> RB) f)) : Prop := injective : forall x y : A, RB (f x) (f y) -> RA x y. -Class [ m : Morphism (A -> B) (RA ++> RB) f ] => Surjective : Prop := +Class ((m : Morphism (A -> B) (RA ++> RB) f)) => Surjective : Prop := surjective : forall y, exists x : A, RB y (f x). -Definition Bijective [ m : Morphism (A -> B) (RA ++> RB) (f : A -> B) ] := +Definition Bijective ((m : Morphism (A -> B) (RA ++> RB) (f : A -> B))) := Injective m /\ Surjective m. -Class [ m : Morphism (A -> B) (eqA ++> eqB) ] => MonoMorphism := +Class MonoMorphism (( m : Morphism (A -> B) (eqA ++> eqB) )) := monic :> Injective m. -Class [ m : Morphism (A -> B) (eqA ++> eqB) ] => EpiMorphism := +Class EpiMorphism ((m : Morphism (A -> B) (eqA ++> eqB))) := epic :> Surjective m. -Class [ m : Morphism (A -> B) (eqA ++> eqB) ] => IsoMorphism := +Class IsoMorphism ((m : Morphism (A -> B) (eqA ++> eqB))) := monomorphism :> MonoMorphism m ; epimorphism :> EpiMorphism m. -Class [ m : Morphism (A -> A) (eqA ++> eqA), ! IsoMorphism m ] => AutoMorphism. +Class ((m : Morphism (A -> A) (eqA ++> eqA))) [ ! IsoMorphism m ] => AutoMorphism. diff --git a/theories/Classes/Init.v b/theories/Classes/Init.v index 6ba0c61e..e5f951d0 100644 --- a/theories/Classes/Init.v +++ b/theories/Classes/Init.v @@ -13,9 +13,22 @@ Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud 91405 Orsay, France *) -(* $Id: Init.v 10739 2008-04-01 14:45:20Z herbelin $ *) +(* $Id: Init.v 11282 2008-07-28 11:51:53Z msozeau $ *) (* Ltac typeclass_instantiation := typeclasses eauto || eauto. *) Tactic Notation "clapply" ident(c) := eapply @c ; eauto with typeclass_instances. + +(** The unconvertible typeclass, to test that two objects of the same type are + actually different. *) + +Class Unconvertible (A : Type) (a b : A). + +Ltac unconvertible := + match goal with + | |- @Unconvertible _ ?x ?y => conv x y ; fail 1 "Convertible" + | |- _ => apply Build_Unconvertible + end. + +Hint Extern 0 (@Unconvertible _ _ _) => unconvertible : typeclass_instances.
\ No newline at end of file diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v index f21c68a6..c2ae026d 100644 --- a/theories/Classes/Morphisms.v +++ b/theories/Classes/Morphisms.v @@ -1,4 +1,4 @@ -(* -*- coq-prog-args: ("-emacs-U" "-top" "Coq.Classes.Morphisms"); compile-command: "make -C ../.. TIME='time'" -*- *) +(* -*- coq-prog-name: "~/research/coq/trunk/bin/coqtop.byte"; coq-prog-args: ("-emacs-U" "-top" "Coq.Classes.Morphisms"); compile-command: "make -C ../.. TIME='time'" -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) @@ -13,7 +13,7 @@ Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud 91405 Orsay, France *) -(* $Id: Morphisms.v 11092 2008-06-10 18:28:26Z msozeau $ *) +(* $Id: Morphisms.v 11282 2008-07-28 11:51:53Z msozeau $ *) Require Import Coq.Program.Basics. Require Import Coq.Program.Tactics. @@ -39,10 +39,6 @@ Class Morphism A (R : relation A) (m : A) : Prop := Implicit Arguments Morphism [A]. -(** We allow to unfold the [relation] definition while doing morphism search. *) - -Typeclasses unfold relation. - (** Respectful morphisms. *) (** The fully dependent version, not used yet. *) @@ -79,9 +75,22 @@ Arguments Scope respectful [type_scope type_scope signature_scope signature_scop Open Local Scope signature_scope. +(** Pointwise lifting is just respect with leibniz equality on the left. *) + +Definition pointwise_relation {A B : Type} (R : relation B) : relation (A -> B) := + fun f g => forall x : A, R (f x) (g x). + +Lemma pointwise_pointwise A B (R : relation B) : + relation_equivalence (pointwise_relation R) (@eq A ==> R). +Proof. intros. split. simpl_relation. firstorder. Qed. + (** We can build a PER on the Coq function space if we have PERs on the domain and codomain. *) +Hint Unfold Reflexive : core. +Hint Unfold Symmetric : core. +Hint Unfold Transitive : core. + Program Instance respectful_per [ PER A (R : relation A), PER B (R' : relation B) ] : PER (A -> B) (R ==> R'). @@ -92,24 +101,26 @@ Program Instance respectful_per [ PER A (R : relation A), PER B (R' : relation B transitivity (y x0)... Qed. -(** Subrelations induce a morphism on the identity, not used for morphism search yet. *) +(** Subrelations induce a morphism on the identity. *) -Lemma subrelation_id_morphism [ subrelation A Râ Râ ] : Morphism (Râ ==> Râ) id. +Instance subrelation_id_morphism [ subrelation A Râ Râ ] : Morphism (Râ ==> Râ) id. Proof. firstorder. Qed. (** The subrelation property goes through products as usual. *) -Instance morphisms_subrelation [ sub : subrelation A Râ Râ ] : - ! subrelation (B -> A) (R ==> Râ) (R ==> Râ). -Proof. firstorder. Qed. +Instance morphisms_subrelation_respectful [ subl : subrelation A Râ Râ, subr : subrelation B Sâ Sâ ] : + subrelation (Râ ==> Sâ) (Râ ==> Sâ). +Proof. simpl_relation. apply subr. apply H. apply subl. apply H0. Qed. -Instance morphisms_subrelation_left [ sub : subrelation A Râ Râ ] : - ! subrelation (A -> B) (Râ ==> R) (Râ ==> R) | 3. -Proof. firstorder. Qed. +(** And of course it is reflexive. *) + +Instance morphisms_subrelation_refl : ! subrelation A R R | 10. +Proof. simpl_relation. Qed. (** [Morphism] is itself a covariant morphism for [subrelation]. *) -Lemma subrelation_morphism [ sub : subrelation A Râ Râ, mor : Morphism A Râ m ] : Morphism Râ m. +Lemma subrelation_morphism [ mor : Morphism A Râ m, unc : Unconvertible (relation A) Râ Râ, + sub : subrelation A Râ Râ ] : Morphism Râ m. Proof. intros. apply sub. apply mor. Qed. @@ -121,8 +132,9 @@ Proof. reduce. subst. firstorder. Qed. (** We use an external tactic to manage the application of subrelation, which is otherwise always applicable. We allow its use only once per branch. *) -Inductive subrelation_done : Prop := - did_subrelation : subrelation_done. +Inductive subrelation_done : Prop := did_subrelation : subrelation_done. + +Inductive normalization_done : Prop := did_normalization. Ltac subrelation_tac := match goal with @@ -131,7 +143,7 @@ Ltac subrelation_tac := set(H:=did_subrelation) ; eapply @subrelation_morphism end. -Hint Extern 4 (@Morphism _ _ _) => subrelation_tac : typeclass_instances. +Hint Extern 5 (@Morphism _ _ _) => subrelation_tac : typeclass_instances. (** Essential subrelation instances for [iff], [impl] and [pointwise_relation]. *) @@ -181,20 +193,10 @@ Program Instance trans_contra_co_morphism transitivity x0... Qed. -(* (** Dually... *) *) - -(* Program Instance [ Transitive A R ] => *) -(* trans_co_contra_inv_impl_morphism : Morphism (R ++> R --> inverse impl) R. *) - -(* Next Obligation. *) -(* Proof with auto. *) -(* apply* trans_contra_co_morphism ; eauto. eauto. *) -(* Qed. *) - (** Morphism declarations for partial applications. *) Program Instance trans_contra_inv_impl_morphism - [ Transitive A R ] : Morphism (R --> inverse impl) (R x). + [ Transitive A R ] : Morphism (R --> inverse impl) (R x) | 3. Next Obligation. Proof with auto. @@ -202,7 +204,7 @@ Program Instance trans_contra_inv_impl_morphism Qed. Program Instance trans_co_impl_morphism - [ Transitive A R ] : Morphism (R ==> impl) (R x). + [ Transitive A R ] : Morphism (R ==> impl) (R x) | 3. Next Obligation. Proof with auto. @@ -210,23 +212,23 @@ Program Instance trans_co_impl_morphism Qed. Program Instance trans_sym_co_inv_impl_morphism - [ Transitive A R, Symmetric A R ] : Morphism (R ==> inverse impl) (R x). + [ PER A R ] : Morphism (R ==> inverse impl) (R x) | 2. Next Obligation. Proof with auto. - transitivity y... + transitivity y... symmetry... Qed. Program Instance trans_sym_contra_impl_morphism - [ Transitive A R, Symmetric _ R ] : Morphism (R --> impl) (R x). + [ PER A R ] : Morphism (R --> impl) (R x) | 2. Next Obligation. Proof with auto. - transitivity x0... + transitivity x0... symmetry... Qed. -Program Instance equivalence_partial_app_morphism - [ Equivalence A R ] : Morphism (R ==> iff) (R x). +Program Instance per_partial_app_morphism + [ PER A R ] : Morphism (R ==> iff) (R x) | 1. Next Obligation. Proof with auto. @@ -240,36 +242,16 @@ Program Instance equivalence_partial_app_morphism to get an [R y z] goal. *) Program Instance trans_co_eq_inv_impl_morphism - [ Transitive A R ] : Morphism (R ==> (@eq A) ==> inverse impl) R. + [ Transitive A R ] : Morphism (R ==> (@eq A) ==> inverse impl) R | 2. Next Obligation. Proof with auto. transitivity y... Qed. -(* Program Instance [ Transitive A R ] => *) -(* trans_contra_eq_impl_morphism : Morphism (R --> (@eq A) ==> impl) R. *) - -(* Next Obligation. *) -(* Proof with auto. *) -(* transitivity x... *) -(* Qed. *) - (** Every Symmetric and Transitive relation gives rise to an equivariant morphism. *) -Program Instance trans_sym_morphism - [ Transitive A R, Symmetric _ R ] : Morphism (R ==> R ==> iff) R. - - Next Obligation. - Proof with auto. - split ; intros. - transitivity x0... transitivity x... - - transitivity y... transitivity y0... - Qed. - -Program Instance equiv_morphism [ Equivalence A R ] : - Morphism (R ==> R ==> iff) R. +Program Instance PER_morphism [ PER A R ] : Morphism (R ==> R ==> iff) R | 1. Next Obligation. Proof with auto. @@ -279,27 +261,21 @@ Program Instance equiv_morphism [ Equivalence A R ] : transitivity y... transitivity y0... symmetry... Qed. -(** In case the rewrite happens at top level. *) - -Program Instance iff_inverse_impl_id : - Morphism (iff ==> inverse impl) id. - -Program Instance inverse_iff_inverse_impl_id : - Morphism (iff --> inverse impl) id. +Lemma symmetric_equiv_inverse [ Symmetric A R ] : relation_equivalence R (flip R). +Proof. firstorder. Qed. -Program Instance iff_impl_id : - Morphism (iff ==> impl) id. +Program Instance compose_morphism A B C Râ Râ Râ : + Morphism ((Râ ==> Râ) ==> (Râ ==> Râ) ==> (Râ ==> Râ)) (@compose A B C). + + Next Obligation. + Proof. + simpl_relation. + unfold compose. apply H. apply H0. apply H1. + Qed. -Program Instance inverse_iff_impl_id : - Morphism (iff --> impl) id. - (** Coq functions are morphisms for leibniz equality, applied only if really needed. *) -(* Instance (A : Type) [ Reflexive B R ] => *) -(* eq_reflexive_morphism : Morphism (@Logic.eq A ==> R) m | 3. *) -(* Proof. simpl_relation. Qed. *) - Instance reflexive_eq_dom_reflexive (A : Type) [ Reflexive B R' ] : Reflexive (@Logic.eq A ==> R'). Proof. simpl_relation. Qed. @@ -335,49 +311,81 @@ Class MorphismProxy A (R : relation A) (m : A) : Prop := respect_proxy : R m m. Instance reflexive_morphism_proxy - [ Reflexive A R ] (x : A) : MorphismProxy A R x | 1. + [ Reflexive A R ] (x : A) : MorphismProxy R x | 1. Proof. firstorder. Qed. Instance morphism_morphism_proxy - [ Morphism A R x ] : MorphismProxy A R x | 2. + [ Morphism A R x ] : MorphismProxy R x | 2. Proof. firstorder. Qed. -(* Instance (A : Type) [ Reflexive B R ] => *) -(* eq_reflexive_morphism : Morphism (@Logic.eq A ==> R) m | 3. *) -(* Proof. simpl_relation. Qed. *) - (** [R] is Reflexive, hence we can build the needed proof. *) Lemma Reflexive_partial_app_morphism [ Morphism (A -> B) (R ==> R') m, MorphismProxy A R x ] : Morphism R' (m x). Proof. simpl_relation. Qed. +Class Params {A : Type} (of : A) (arity : nat). + +Class PartialApplication. + Ltac partial_application_tactic := - let tac x := - match type of x with - | Type => fail 1 - | _ => eapply @Reflexive_partial_app_morphism + let rec do_partial_apps H m := + match m with + | ?m' ?x => eapply @Reflexive_partial_app_morphism ; [do_partial_apps H m'|clear H] + | _ => idtac end in - let on_morphism m := - match m with - | ?m' ?x => tac x - | ?m' _ ?x => tac x - | ?m' _ _ ?x => tac x - | ?m' _ _ _ ?x => tac x - | ?m' _ _ _ _ ?x => tac x - | ?m' _ _ _ _ _ ?x => tac x - | ?m' _ _ _ _ _ _ ?x => tac x - | ?m' _ _ _ _ _ _ _ ?x => tac x - | ?m' _ _ _ _ _ _ _ _ ?x => tac x + let rec do_partial H ar m := + match ar with + | 0 => do_partial_apps H m + | S ?n' => + match m with + ?m' ?x => do_partial H n' m' + end end in + let on_morphism m := + let m' := fresh in head_of_constr m' m ; + let n := fresh in evar (n:nat) ; + let v := eval compute in n in clear n ; + let H := fresh in + assert(H:Params m' v) by typeclasses eauto ; + let v' := eval compute in v in + do_partial H v' m + in match goal with - | [ |- @Morphism _ _ ?m ] => on_morphism m + | [ _ : subrelation_done |- _ ] => fail 1 + | [ _ : normalization_done |- _ ] => fail 1 + | [ _ : @Params _ _ _ |- _ ] => fail 1 + | [ |- @Morphism ?T _ (?m ?x) ] => + match goal with + | [ _ : PartialApplication |- _ ] => + eapply @Reflexive_partial_app_morphism + | _ => + on_morphism (m x) || + (eapply @Reflexive_partial_app_morphism ; + [ pose Build_PartialApplication | idtac ]) + end end. -(* Program Instance [ Morphism (A -> B) (R ==> R') m, Reflexive A R ] (x : A) => *) -(* reflexive_partial_app_morphism : Morphism R' (m x). *) +Section PartialAppTest. + Instance and_ar : Params and 0. + + Goal Morphism (iff) (and True True). + partial_application_tactic. + Admitted. + + Goal Morphism (iff) (or True True). + partial_application_tactic. + partial_application_tactic. + Admitted. + + Goal Morphism (iff ==> iff) (iff True). + partial_application_tactic. + (*partial_application_tactic. *) + Admitted. + +End PartialAppTest. Hint Extern 4 (@Morphism _ _ _) => partial_application_tactic : typeclass_instances. @@ -395,19 +403,19 @@ Class (A : Type) => Normalizes (m : relation A) (m' : relation A) : Prop := normalizes : relation_equivalence m m'. Instance inverse_respectful_norm : - Normalizes (A -> B) (inverse R ==> inverse R') (inverse (R ==> R')) . + ! Normalizes (A -> B) (inverse R ==> inverse R') (inverse (R ==> R')) . Proof. firstorder. Qed. (* If not an inverse on the left, do a double inverse. *) Instance not_inverse_respectful_norm : - Normalizes (A -> B) (R ==> inverse R') (inverse (inverse R ==> R')) | 4. + ! Normalizes (A -> B) (R ==> inverse R') (inverse (inverse R ==> R')) | 4. Proof. firstorder. Qed. Instance inverse_respectful_rec_norm [ Normalizes B R' (inverse R'') ] : - Normalizes (A -> B) (inverse R ==> R') (inverse (R ==> R'')). -Proof. red ; intros. - pose normalizes as r. + ! Normalizes (A -> B) (inverse R ==> R') (inverse (R ==> R'')). +Proof. red ; intros. + assert(r:=normalizes). setoid_rewrite r. setoid_rewrite inverse_respectful. reflexivity. @@ -415,8 +423,14 @@ Qed. (** Once we have normalized, we will apply this instance to simplify the problem. *) -Program Instance morphism_inverse_morphism - [ Morphism A R m ] : Morphism (inverse R) m | 2. +Definition morphism_inverse_morphism [ mor : Morphism A R m ] : Morphism (inverse R) m := mor. + +Ltac morphism_inverse := + match goal with + [ |- @Morphism _ (flip _) _ ] => eapply @morphism_inverse_morphism + end. + +Hint Extern 2 (@Morphism _ _ _) => morphism_inverse : typeclass_instances. (** Bootstrap !!! *) @@ -434,16 +448,16 @@ Qed. Lemma morphism_releq_morphism [ Normalizes A R R', Morphism _ R' m ] : Morphism R m. Proof. intros. + pose respect as r. pose normalizes as norm. setoid_rewrite norm. assumption. Qed. -Inductive normalization_done : Prop := did_normalization. - Ltac morphism_normalization := match goal with + | [ _ : subrelation_done |- _ ] => fail 1 | [ _ : normalization_done |- _ ] => fail 1 | [ |- @Morphism _ _ _ ] => let H := fresh "H" in set(H:=did_normalization) ; eapply @morphism_releq_morphism @@ -464,4 +478,4 @@ Ltac morphism_reflexive := | [ |- @Morphism _ _ _ ] => eapply @reflexive_morphism end. -Hint Extern 4 (@Morphism _ _ _) => morphism_reflexive : typeclass_instances.
\ No newline at end of file +Hint Extern 7 (@Morphism _ _ _) => morphism_reflexive : typeclass_instances. diff --git a/theories/Classes/Morphisms_Prop.v b/theories/Classes/Morphisms_Prop.v index 7dc1f95e..ec62e12e 100644 --- a/theories/Classes/Morphisms_Prop.v +++ b/theories/Classes/Morphisms_Prop.v @@ -29,7 +29,7 @@ Program Instance not_iff_morphism : (** Logical conjunction. *) -Program Instance and_impl_iff_morphism : +Program Instance and_impl_morphism : Morphism (impl ==> impl ==> impl) and. (* Program Instance and_impl_iff_morphism : *) @@ -49,7 +49,7 @@ Program Instance and_iff_morphism : (** Logical disjunction. *) -Program Instance or_impl_iff_morphism : +Program Instance or_impl_morphism : Morphism (impl ==> impl ==> impl) or. (* Program Instance or_impl_iff_morphism : *) diff --git a/theories/Classes/Morphisms_Relations.v b/theories/Classes/Morphisms_Relations.v index 5018fa01..1b389667 100644 --- a/theories/Classes/Morphisms_Relations.v +++ b/theories/Classes/Morphisms_Relations.v @@ -48,3 +48,11 @@ Proof. intro. apply (predicate_equivalence_pointwise (cons A (cons A nil))). Qed Instance subrelation_pointwise : Morphism (subrelation ==> pointwise_relation (A:=A) (pointwise_relation (A:=A) impl)) id. Proof. intro. apply (predicate_implication_pointwise (cons A (cons A nil))). Qed. + + +Lemma inverse_pointwise_relation A (R : relation A) : + relation_equivalence (pointwise_relation (inverse R)) (inverse (pointwise_relation (A:=A) R)). +Proof. intros. split; firstorder. Qed. + + + diff --git a/theories/Classes/RelationClasses.v b/theories/Classes/RelationClasses.v index a9a53068..9a43a1ba 100644 --- a/theories/Classes/RelationClasses.v +++ b/theories/Classes/RelationClasses.v @@ -1,4 +1,4 @@ -(* -*- coq-prog-args: ("-emacs-U" "-top" "Coq.Classes.RelationClasses") -*- *) +(* -*- coq-prog-name: "coqtop.byte"; coq-prog-args: ("-emacs-U" "-top" "Coq.Classes.RelationClasses") -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) @@ -14,20 +14,21 @@ Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud 91405 Orsay, France *) -(* $Id: RelationClasses.v 11092 2008-06-10 18:28:26Z msozeau $ *) +(* $Id: RelationClasses.v 11282 2008-07-28 11:51:53Z msozeau $ *) Require Export Coq.Classes.Init. Require Import Coq.Program.Basics. Require Import Coq.Program.Tactics. Require Export Coq.Relations.Relation_Definitions. +(** We allow to unfold the [relation] definition while doing morphism search. *) + +Typeclasses unfold relation. + Notation inverse R := (flip (R:relation _) : relation _). Definition complement {A} (R : relation A) : relation A := fun x y => R x y -> False. -Definition pointwise_relation {A B : Type} (R : relation B) : relation (A -> B) := - fun f g => forall x : A, R (f x) (g x). - (** These are convertible. *) Lemma complement_inverse : forall A (R : relation A), complement (inverse R) = inverse (complement R). @@ -42,7 +43,7 @@ Class Reflexive A (R : relation A) := reflexivity : forall x, R x x. Class Irreflexive A (R : relation A) := - irreflexivity :> Reflexive A (complement R). + irreflexivity :> Reflexive (complement R). Class Symmetric A (R : relation A) := symmetry : forall x y, R x y -> R y x. @@ -53,12 +54,6 @@ Class Asymmetric A (R : relation A) := Class Transitive A (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. -Implicit Arguments Reflexive [A]. -Implicit Arguments Irreflexive [A]. -Implicit Arguments Symmetric [A]. -Implicit Arguments Asymmetric [A]. -Implicit Arguments Transitive [A]. - Hint Resolve @irreflexivity : ord. Unset Implicit Arguments. @@ -91,7 +86,7 @@ Program Instance Reflexive_complement_Irreflexive [ Reflexive A (R : relation A) unfold complement. red. intros H. intros H' ; apply H'. - apply (reflexivity H). + apply reflexivity. Qed. @@ -129,7 +124,7 @@ Ltac simpl_relation := unfold flip, impl, arrow ; try reduce ; program_simpl ; try ( solve [ intuition ]). -Ltac obligations_tactic ::= simpl_relation. +Ltac obligation_tactic ::= simpl_relation. (** Logical implication. *) @@ -171,17 +166,17 @@ Class Equivalence (carrier : Type) (equiv : relation carrier) : Prop := (** An Equivalence is a PER plus reflexivity. *) -Instance Equivalence_PER [ Equivalence A R ] : PER A R := +Instance Equivalence_PER [ Equivalence A R ] : PER A R | 10 := PER_Symmetric := Equivalence_Symmetric ; PER_Transitive := Equivalence_Transitive. (** We can now define antisymmetry w.r.t. an equivalence relation on the carrier. *) -Class [ Equivalence A eqA ] => Antisymmetric (R : relation A) := +Class Antisymmetric ((equ : Equivalence A eqA)) (R : relation A) := antisymmetry : forall x y, R x y -> R y x -> eqA x y. -Program Instance flip_antiSymmetric [ eq : Equivalence A eqA, ! Antisymmetric eq R ] : - Antisymmetric eq (flip R). +Program Instance flip_antiSymmetric {{Antisymmetric A eqA R}} : + ! Antisymmetric A eqA (flip R). (** Leibinz equality [eq] is an equivalence relation. The instance has low priority as it is always applicable @@ -372,7 +367,7 @@ Proof. intro A. exact (@predicate_implication_preorder (cons A (cons A nil))). Q We give an equivalent definition, up-to an equivalence relation on the carrier. *) -Class [ equ : Equivalence A eqA, PreOrder A R ] => PartialOrder := +Class [ equ : Equivalence A eqA, preo : PreOrder A R ] => PartialOrder := partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (inverse R)). (** The equivalence proof is sufficient for proving that [R] must be a morphism @@ -394,7 +389,3 @@ Program Instance subrelation_partial_order : Proof. unfold relation_equivalence in *. firstorder. Qed. - -Lemma inverse_pointwise_relation A (R : relation A) : - relation_equivalence (pointwise_relation (inverse R)) (inverse (pointwise_relation (A:=A) R)). -Proof. reflexivity. Qed. diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v index a9bdaa8f..178d5333 100644 --- a/theories/Classes/SetoidClass.v +++ b/theories/Classes/SetoidClass.v @@ -13,7 +13,7 @@ Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud 91405 Orsay, France *) -(* $Id: SetoidClass.v 11065 2008-06-06 22:39:43Z msozeau $ *) +(* $Id: SetoidClass.v 11282 2008-07-28 11:51:53Z msozeau $ *) Set Implicit Arguments. Unset Strict Implicit. @@ -41,13 +41,13 @@ Typeclasses unfold equiv. (** Shortcuts to make proof search easier. *) Definition setoid_refl [ sa : Setoid A ] : Reflexive equiv. -Proof. eauto with typeclass_instances. Qed. +Proof. typeclasses eauto. Qed. Definition setoid_sym [ sa : Setoid A ] : Symmetric equiv. -Proof. eauto with typeclass_instances. Qed. +Proof. typeclasses eauto. Qed. Definition setoid_trans [ sa : Setoid A ] : Transitive equiv. -Proof. eauto with typeclass_instances. Qed. +Proof. typeclasses eauto. Qed. Existing Instance setoid_refl. Existing Instance setoid_sym. @@ -123,7 +123,7 @@ Ltac setoidify := repeat setoidify_tac. (** Every setoid relation gives rise to a morphism, in fact every partial setoid does. *) Program Definition setoid_morphism [ sa : Setoid A ] : Morphism (equiv ++> equiv ++> iff) equiv := - trans_sym_morphism. + PER_morphism. (** Add this very useful instance in the database. *) @@ -142,7 +142,7 @@ Program Instance type_equivalence : Equivalence Type type_eq. Ltac morphism_tac := try red ; unfold arrow ; intros ; program_simpl ; try tauto. -Ltac obligations_tactic ::= morphism_tac. +Ltac obligation_tactic ::= morphism_tac. (** These are morphisms used to rewrite at the top level of a proof, using [iff_impl_id_morphism] if the proof is in [Prop] and @@ -178,4 +178,4 @@ Infix "=~=" := pequiv (at level 70, no associativity) : type_scope. (** Reset the default Program tactic. *) -Ltac obligations_tactic ::= program_simpl. +Ltac obligation_tactic ::= program_simpl. diff --git a/theories/Classes/SetoidDec.v b/theories/Classes/SetoidDec.v index cf3d202d..8a069343 100644 --- a/theories/Classes/SetoidDec.v +++ b/theories/Classes/SetoidDec.v @@ -13,7 +13,7 @@ * Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud * 91405 Orsay, France *) -(* $Id: SetoidDec.v 10919 2008-05-11 22:04:26Z msozeau $ *) +(* $Id: SetoidDec.v 11282 2008-07-28 11:51:53Z msozeau $ *) Set Implicit Arguments. Unset Strict Implicit. @@ -27,12 +27,12 @@ Require Export Coq.Classes.SetoidClass. Require Import Coq.Logic.Decidable. -Class [ Setoid A ] => DecidableSetoid := +Class DecidableSetoid A [ Setoid A ] := setoid_decidable : forall x y : A, decidable (x == y). (** The [EqDec] class gives a decision procedure for a particular setoid equality. *) -Class [ Setoid A ] => EqDec := +Class (( s : Setoid A )) => EqDec := equiv_dec : forall x y : A, { x == y } + { x =/= y }. (** We define the [==] overloaded notation for deciding equality. It does not take precedence @@ -75,18 +75,18 @@ Require Import Coq.Arith.Arith. (** The equiv is burried inside the setoid, but we can recover it by specifying which setoid we're talking about. *) -Program Instance eq_setoid : Setoid A := +Program Instance eq_setoid A : Setoid A := equiv := eq ; setoid_equiv := eq_equivalence. -Program Instance nat_eq_eqdec : EqDec (@eq_setoid nat) := +Program Instance nat_eq_eqdec : EqDec (eq_setoid nat) := equiv_dec := eq_nat_dec. Require Import Coq.Bool.Bool. -Program Instance bool_eqdec : EqDec (@eq_setoid bool) := +Program Instance bool_eqdec : EqDec (eq_setoid bool) := equiv_dec := bool_dec. -Program Instance unit_eqdec : EqDec (@eq_setoid unit) := +Program Instance unit_eqdec : EqDec (eq_setoid unit) := equiv_dec x y := in_left. Next Obligation. @@ -95,7 +95,7 @@ Program Instance unit_eqdec : EqDec (@eq_setoid unit) := reflexivity. Qed. -Program Instance prod_eqdec [ ! EqDec (@eq_setoid A), ! EqDec (@eq_setoid B) ] : EqDec (@eq_setoid (prod A B)) := +Program Instance prod_eqdec [ ! EqDec (eq_setoid A), ! EqDec (eq_setoid B) ] : EqDec (eq_setoid (prod A B)) := equiv_dec x y := let '(x1, x2) := x in let '(y1, y2) := y in @@ -110,7 +110,7 @@ Program Instance prod_eqdec [ ! EqDec (@eq_setoid A), ! EqDec (@eq_setoid B) ] : Require Import Coq.Program.FunctionalExtensionality. -Program Instance bool_function_eqdec [ ! EqDec (@eq_setoid A) ] : EqDec (@eq_setoid (bool -> A)) := +Program Instance bool_function_eqdec [ ! EqDec (eq_setoid A) ] : EqDec (eq_setoid (bool -> A)) := equiv_dec f g := if f true == g true then if f false == g false then in_left diff --git a/theories/Classes/SetoidTactics.v b/theories/Classes/SetoidTactics.v index b29a52cc..6398b125 100644 --- a/theories/Classes/SetoidTactics.v +++ b/theories/Classes/SetoidTactics.v @@ -13,7 +13,7 @@ * Institution: LRI, CNRS UMR 8623 - UniversitĂcopyright Paris Sud * 91405 Orsay, France *) -(* $Id: SetoidTactics.v 10921 2008-05-12 12:27:25Z msozeau $ *) +(* $Id: SetoidTactics.v 11282 2008-07-28 11:51:53Z msozeau $ *) Require Export Coq.Classes.RelationClasses. Require Export Coq.Classes.Morphisms. @@ -24,11 +24,22 @@ Require Export Coq.Relations.Relation_Definitions. Set Implicit Arguments. Unset Strict Implicit. +(** Setoid relation on a given support: declares a relation as a setoid + for use with rewrite. It helps choosing if a rewrite should be handled + by setoid_rewrite or the regular rewrite using leibniz equality. + Users can declare an [SetoidRelation A RA] anywhere to declare default + relations. This is also done automatically by the [Declare Relation A RA] + commands. *) + +Class SetoidRelation A (R : relation A). + +Instance impl_setoid_relation : SetoidRelation impl. +Instance iff_setoid_relation : SetoidRelation iff. + (** Default relation on a given support. Can be used by tactics to find a sensible default relation on any carrier. Users can - declare an [Instance A RA] anywhere to declare default relations. - This is also done by the [Declare Relation A RA] command with no - parameters for backward compatibility. *) + declare an [Instance def : DefaultRelation A RA] anywhere to + declare default relations. *) Class DefaultRelation A (R : relation A). @@ -38,7 +49,7 @@ Definition default_relation [ DefaultRelation A R ] := R. (** Every [Equivalence] gives a default relation, if no other is given (lowest priority). *) -Instance equivalence_default [ Equivalence A R ] : DefaultRelation A R | 4. +Instance equivalence_default [ Equivalence A R ] : DefaultRelation R | 4. (** The setoid_replace tactics in Ltac, defined in terms of default relations and the setoid_rewrite tactic. *) @@ -174,3 +185,5 @@ Ltac default_add_morphism_tactic := end. Ltac add_morphism_tactic := default_add_morphism_tactic. + +Ltac obligation_tactic ::= program_simpl. diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v index b307efe3..94444f5b 100644 --- a/theories/FSets/FMapFacts.v +++ b/theories/FSets/FMapFacts.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FMapFacts.v 10782 2008-04-12 16:08:04Z msozeau $ *) +(* $Id: FMapFacts.v 11282 2008-07-28 11:51:53Z msozeau $ *) (** * Finite maps library *) @@ -660,6 +660,8 @@ Add Relation key E.eq transitivity proved by E.eq_trans as KeySetoid. +Typeclasses unfold key. + Implicit Arguments Equal [[elt]]. Add Parametric Relation (elt : Type) : (t elt) Equal diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v index b4b834b1..d77d9c60 100644 --- a/theories/FSets/FSetFacts.v +++ b/theories/FSets/FSetFacts.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetFacts.v 10765 2008-04-08 16:15:23Z msozeau $ *) +(* $Id: FSetFacts.v 11282 2008-07-28 11:51:53Z msozeau $ *) (** * Finite sets library *) @@ -309,6 +309,8 @@ Add Relation elt E.eq transitivity proved by E.eq_trans as EltSetoid. +Typeclasses unfold elt. + Add Relation t Equal reflexivity proved by eq_refl symmetry proved by eq_sym diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v index afe8297e..10555fc0 100644 --- a/theories/Init/Tactics.v +++ b/theories/Init/Tactics.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Tactics.v 11072 2008-06-08 16:13:37Z herbelin $ i*) +(*i $Id: Tactics.v 11309 2008-08-06 10:30:35Z herbelin $ i*) Require Import Notations. Require Import Logic. @@ -115,7 +115,7 @@ lazymatch T with evar (a : t); pose proof (H a) as H1; unfold a in H1; clear a; clear H; rename H1 into H; find_equiv H | ?A <-> ?B => idtac -| _ => fail "The given statement does not seem to end with an equivalence" +| _ => fail "The given statement does not seem to end with an equivalence." end. Ltac bapply lemma todo := @@ -141,7 +141,7 @@ t; match goal with | H : _ |- _ => solve [inversion H] | _ => solve [trivial | reflexivity | symmetry; trivial | discriminate | split] -| _ => fail 1 "Cannot solve this goal" +| _ => fail 1 "Cannot solve this goal." end. (** A tactic to document or check what is proved at some point of a script *) diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v index f46b2b11..d3f8f1ab 100644 --- a/theories/Init/Wf.v +++ b/theories/Init/Wf.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Wf.v 10712 2008-03-23 11:38:38Z herbelin $ i*) +(*i $Id: Wf.v 11251 2008-07-24 08:28:40Z herbelin $ i*) (** * This module proves the validity of - well-founded recursion (also known as course of values) @@ -27,6 +27,7 @@ Section Well_founded. Variable R : A -> A -> Prop. (** The accessibility predicate is defined to be non-informative *) + (** (Acc_rect is automatically defined because Acc is a singleton type) *) Inductive Acc (x: A) : Prop := Acc_intro : (forall y:A, R y x -> Acc y) -> Acc x. @@ -35,22 +36,6 @@ Section Well_founded. destruct 1; trivial. Defined. - (** Informative elimination : - [let Acc_rec F = let rec wf x = F x wf in wf] *) - - Section AccRecType. - - Variable P : A -> Type. - Variable F : forall x:A, - (forall y:A, R y x -> Acc y) -> (forall y:A, R y x -> P y) -> P x. - - Fixpoint Acc_rect (x:A) (a:Acc x) {struct a} : P x := - F (Acc_inv a) (fun (y:A) (h:R y x) => Acc_rect (Acc_inv a h)). - - End AccRecType. - - Definition Acc_rec (P:A -> Set) := Acc_rect P. - (** A relation is well-founded if every element is accessible *) Definition well_founded := forall a:A, Acc a. diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v index 3737abf6..d15e2c96 100644 --- a/theories/Logic/ClassicalDescription.v +++ b/theories/Logic/ClassicalDescription.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ClassicalDescription.v 10170 2007-10-03 14:41:25Z herbelin $ i*) +(*i $Id: ClassicalDescription.v 11238 2008-07-19 09:34:03Z herbelin $ i*) (** This file provides classical logic and definite description, which is equivalent to providing classical logic and Church's iota operator *) @@ -21,7 +21,7 @@ Set Implicit Arguments. Require Export Classical. Require Import ChoiceFacts. -Notation Local "'inhabited' A" := A (at level 200, only parsing). +Notation Local inhabited A := A. Axiom constructive_definite_description : forall (A : Type) (P : A->Prop), (exists! x : A, P x) -> { x : A | P x }. diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v index 734de52d..8a045ec8 100644 --- a/theories/Logic/ClassicalFacts.v +++ b/theories/Logic/ClassicalFacts.v @@ -7,7 +7,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ClassicalFacts.v 10156 2007-09-30 19:02:14Z herbelin $ i*) +(*i $Id: ClassicalFacts.v 11238 2008-07-19 09:34:03Z herbelin $ i*) (** Some facts and definitions about classical logic @@ -119,7 +119,7 @@ Qed. *) -Definition inhabited (A:Prop) := A. +Notation Local inhabited A := A. Lemma prop_ext_A_eq_A_imp_A : prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A. @@ -514,8 +514,6 @@ Qed. 344 of Lecture Notes in Mathematics, Springer-Verlag, 1973. *) -Notation Local "'inhabited' A" := A (at level 10, only parsing). - Definition IndependenceOfGeneralPremises := forall (A:Type) (P:A -> Prop) (Q:Prop), inhabited A -> (Q -> exists x, P x) -> exists x, Q -> P x. diff --git a/theories/Logic/ConstructiveEpsilon.v b/theories/Logic/ConstructiveEpsilon.v index f1503d24..3753b97b 100644 --- a/theories/Logic/ConstructiveEpsilon.v +++ b/theories/Logic/ConstructiveEpsilon.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ConstructiveEpsilon.v 10739 2008-04-01 14:45:20Z herbelin $ i*) +(*i $Id: ConstructiveEpsilon.v 11238 2008-07-19 09:34:03Z herbelin $ i*) (** This module proves the constructive description schema, which infers the sigma-existence (i.e., [Set]-existence) of a witness to a @@ -53,7 +53,7 @@ of our searching algorithm. *) Let R (x y : nat) : Prop := x = S y /\ ~ P y. -Notation Local "'acc' x" := (Acc R x) (at level 10). +Notation Local acc x := (Acc R x). Lemma P_implies_acc : forall x : nat, P x -> acc x. Proof. diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v index 5f139f35..880ef7e2 100644 --- a/theories/Logic/Diaconescu.v +++ b/theories/Logic/Diaconescu.v @@ -7,7 +7,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Diaconescu.v 9245 2006-10-17 12:53:34Z notin $ i*) +(*i $Id: Diaconescu.v 11238 2008-07-19 09:34:03Z herbelin $ i*) (** Diaconescu showed that the Axiom of Choice entails Excluded-Middle in topoi [Diaconescu75]. Lacas and Werner adapted the proof to show @@ -267,7 +267,7 @@ End ProofIrrel_RelChoice_imp_EqEM. (** Proof sketch from Bell [Bell93] (with thanks to P. CastĂŠran) *) -Notation Local "'inhabited' A" := A (at level 10, only parsing). +Notation Local inhabited A := A. Section ExtensionalEpsilon_imp_EM. diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v index 9669eacd..83ecd10d 100644 --- a/theories/Numbers/BigNumPrelude.v +++ b/theories/Numbers/BigNumPrelude.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: BigNumPrelude.v 11013 2008-05-28 18:17:30Z letouzey $ i*) +(*i $Id: BigNumPrelude.v 11207 2008-07-04 16:50:32Z letouzey $ i*) (** * BigNumPrelude *) @@ -277,7 +277,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Qed. - Lemma shift_unshift_mod_2 : forall n p a, (0<=p<=n)%Z -> + Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n -> ((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) = a mod 2 ^ p. Proof. @@ -329,7 +329,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Qed. Theorem Zgcd_div_pos a b: - (0 < b)%Z -> (0 < Zgcd a b)%Z -> (0 < b / Zgcd a b)%Z. + 0 < b -> 0 < Zgcd a b -> 0 < b / Zgcd a b. Proof. intros a b Ha Hg. case (Zle_lt_or_eq 0 (b/Zgcd a b)); auto. @@ -340,6 +340,72 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. assert (F := (Zgcd_is_gcd a b)); inversion F; auto. Qed. + Theorem Zdiv_neg a b: + a < 0 -> 0 < b -> a / b < 0. + Proof. + intros a b Ha Hb. + assert (b > 0) by omega. + generalize (Z_mult_div_ge a _ H); intros. + assert (b * (a / b) < 0)%Z. + apply Zle_lt_trans with a; auto with zarith. + destruct b; try (compute in Hb; discriminate). + destruct (a/Zpos p)%Z. + compute in H1; discriminate. + compute in H1; discriminate. + compute; auto. + Qed. + + Lemma Zgcd_Zabs : forall z z', Zgcd (Zabs z) z' = Zgcd z z'. + Proof. + destruct z; simpl; auto. + Qed. + + Lemma Zgcd_sym : forall p q, Zgcd p q = Zgcd q p. + Proof. + intros. + apply Zis_gcd_gcd. + apply Zgcd_is_pos. + apply Zis_gcd_sym. + apply Zgcd_is_gcd. + Qed. + + Lemma Zdiv_gcd_zero : forall a b, b / Zgcd a b = 0 -> b <> 0 -> + Zgcd a b = 0. + Proof. + intros. + generalize (Zgcd_is_gcd a b); destruct 1. + destruct H2 as (k,Hk). + generalize H; rewrite Hk at 1. + destruct (Z_eq_dec (Zgcd a b) 0) as [H'|H']; auto. + rewrite Z_div_mult_full; auto. + intros; subst k; simpl in *; subst b; elim H0; auto. + Qed. + + Lemma Zgcd_1 : forall z, Zgcd z 1 = 1. + Proof. + intros; apply Zis_gcd_gcd; auto with zarith; apply Zis_gcd_1. + Qed. + Hint Resolve Zgcd_1. + + Lemma Zgcd_mult_rel_prime : forall a b c, + Zgcd a c = 1 -> Zgcd b c = 1 -> Zgcd (a*b) c = 1. + Proof. + intros. + rewrite Zgcd_1_rel_prime in *. + apply rel_prime_sym; apply rel_prime_mult; apply rel_prime_sym; auto. + Qed. + + Lemma Zcompare_gt : forall (A:Type)(a a':A)(p q:Z), + match (p?=q)%Z with Gt => a | _ => a' end = + if Z_le_gt_dec p q then a' else a. + Proof. + intros. + destruct Z_le_gt_dec as [H|H]. + red in H. + destruct (p?=q)%Z; auto; elim H; auto. + rewrite H; auto. + Qed. + Theorem Zbounded_induction : (forall Q : Z -> Prop, forall b : Z, Q 0 -> diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v index 22f6d95b..fb3f0cef 100644 --- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v +++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v @@ -8,7 +8,7 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NZCyclic.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id: NZCyclic.v 11238 2008-07-19 09:34:03Z herbelin $ i*) Require Export NZAxioms. Require Import BigNumPrelude. @@ -89,8 +89,8 @@ Open Local Scope IntScope. Notation "x == y" := (NZeq x y) (at level 70) : IntScope. Notation "x ~= y" := (~ NZeq x y) (at level 70) : IntScope. Notation "0" := NZ0 : IntScope. -Notation "'S'" := NZsucc : IntScope. -Notation "'P'" := NZpred : IntScope. +Notation S x := (NZsucc x). +Notation P x := (NZpred x). (*Notation "1" := (S 0) : IntScope.*) Notation "x + y" := (NZadd x y) : IntScope. Notation "x - y" := (NZsub x y) : IntScope. diff --git a/theories/Numbers/Integer/BigZ/BigZ.v b/theories/Numbers/Integer/BigZ/BigZ.v index 09abf424..cb920124 100644 --- a/theories/Numbers/Integer/BigZ/BigZ.v +++ b/theories/Numbers/Integer/BigZ/BigZ.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: BigZ.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id: BigZ.v 11282 2008-07-28 11:51:53Z msozeau $ i*) Require Export BigN. Require Import ZMulOrder. @@ -42,25 +42,27 @@ Infix "?=" := BigZ.compare : bigZ_scope. Infix "==" := BigZ.eq (at level 70, no associativity) : bigZ_scope. Infix "<" := BigZ.lt : bigZ_scope. Infix "<=" := BigZ.le : bigZ_scope. +Notation "x > y" := (BigZ.lt y x)(only parsing) : bigZ_scope. +Notation "x >= y" := (BigZ.le y x)(only parsing) : bigZ_scope. Notation "[ i ]" := (BigZ.to_Z i) : bigZ_scope. Open Scope bigZ_scope. (** Some additional results about [BigZ] *) -Theorem spec_to_Z: forall n:bigZ, +Theorem spec_to_Z: forall n:bigZ, BigN.to_Z (BigZ.to_N n) = ((Zsgn [n]) * [n])%Z. Proof. -intros n; case n; simpl; intros p; +intros n; case n; simpl; intros p; generalize (BigN.spec_pos p); case (BigN.to_Z p); auto. intros p1 H1; case H1; auto. intros p1 H1; case H1; auto. Qed. -Theorem spec_to_N n: +Theorem spec_to_N n: ([n] = Zsgn [n] * (BigN.to_Z (BigZ.to_N n)))%Z. Proof. -intros n; case n; simpl; intros p; +intros n; case n; simpl; intros p; generalize (BigN.spec_pos p); case (BigN.to_Z p); auto. intros p1 H1; case H1; auto. intros p1 H1; case H1; auto. @@ -69,7 +71,7 @@ Qed. Theorem spec_to_Z_pos: forall n, (0 <= [n])%Z -> BigN.to_Z (BigZ.to_N n) = [n]. Proof. -intros n; case n; simpl; intros p; +intros n; case n; simpl; intros p; generalize (BigN.spec_pos p); case (BigN.to_Z p); auto. intros p1 _ H1; case H1; auto. intros p1 H1; case H1; auto. @@ -87,7 +89,7 @@ Qed. (** [BigZ] is a ring *) -Lemma BigZring : +Lemma BigZring : ring_theory BigZ.zero BigZ.one BigZ.add BigZ.mul BigZ.sub BigZ.opp BigZ.eq. Proof. constructor. @@ -102,6 +104,8 @@ exact sub_opp. exact add_opp. Qed. +Typeclasses unfold NZadd NZmul NZsub NZeq. + Add Ring BigZr : BigZring. (** Todo: tactic translating from [BigZ] to [Z] + omega *) diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v index 1f2b12bb..6305156b 100644 --- a/theories/Numbers/Integer/BigZ/ZMake.v +++ b/theories/Numbers/Integer/BigZ/ZMake.v @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: ZMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*) +(*i $Id: ZMake.v 11282 2008-07-28 11:51:53Z msozeau $ i*) Require Import ZArith. Require Import BigNumPrelude. @@ -30,6 +30,7 @@ Module Make (N:NType) <: ZType. | Neg : N.t -> t_. Definition t := t_. + Typeclasses unfold t. Definition zero := Pos N.zero. Definition one := Pos N.one. diff --git a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v index d7c56267..aceb8984 100644 --- a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v +++ b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ZSigZAxioms.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id: ZSigZAxioms.v 11282 2008-07-28 11:51:53Z msozeau $ i*) Require Import ZArith. Require Import ZAxioms. @@ -216,7 +216,7 @@ Qed. Add Morphism Z.compare with signature Z.eq ==> Z.eq ==> (@eq comparison) as compare_wd. Proof. intros x x' Hx y y' Hy. -rewrite 2 spec_compare_alt; rewrite Hx, Hy; intuition. +rewrite 2 spec_compare_alt; unfold Z.eq in *; rewrite Hx, Hy; intuition. Qed. Add Morphism Z.lt with signature Z.eq ==> Z.eq ==> iff as NZlt_wd. diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v index 826ffa2c..15aed7ab 100644 --- a/theories/Numbers/Natural/Abstract/NOrder.v +++ b/theories/Numbers/Natural/Abstract/NOrder.v @@ -8,7 +8,7 @@ (* Evgeny Makarov, INRIA, 2007 *) (************************************************************************) -(*i $Id: NOrder.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id: NOrder.v 11282 2008-07-28 11:51:53Z msozeau $ i*) Require Export NMul. @@ -309,13 +309,12 @@ Proof NZgt_wf. Theorem lt_wf_0 : well_founded lt. Proof. -assert (H : relations_eq lt (fun n m : N => 0 <= n /\ n < m)). +setoid_replace lt with (fun n m : N => 0 <= n /\ n < m) + using relation (@relations_eq N N). +apply lt_wf. intros x y; split. intro H; split; [apply le_0_l | assumption]. now intros [_ H]. -rewrite H; apply lt_wf. -(* does not work: -setoid_replace lt with (fun n m : N => 0 <= n /\ n < m) using relation relations_eq.*) -Qed. +Defined. (* Theorems that are true for natural numbers but not for integers *) diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v index 0574c09f..41c255b1 100644 --- a/theories/Numbers/Natural/BigN/BigN.v +++ b/theories/Numbers/Natural/BigN/BigN.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: BigN.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id: BigN.v 11282 2008-07-28 11:51:53Z msozeau $ i*) (** * Natural numbers in base 2^31 *) @@ -47,6 +47,8 @@ Infix "?=" := BigN.compare : bigN_scope. Infix "==" := BigN.eq (at level 70, no associativity) : bigN_scope. Infix "<" := BigN.lt : bigN_scope. Infix "<=" := BigN.le : bigN_scope. +Notation "x > y" := (BigN.lt y x)(only parsing) : bigN_scope. +Notation "x >= y" := (BigN.le y x)(only parsing) : bigN_scope. Notation "[ i ]" := (BigN.to_Z i) : bigN_scope. Open Scope bigN_scope. @@ -62,7 +64,7 @@ Qed. (** [BigN] is a semi-ring *) -Lemma BigNring : +Lemma BigNring : semi_ring_theory BigN.zero BigN.one BigN.add BigN.mul BigN.eq. Proof. constructor. @@ -76,6 +78,8 @@ exact mul_assoc. exact mul_add_distr_r. Qed. +Typeclasses unfold NZadd NZsub NZmul. + Add Ring BigNr : BigNring. (** Todo: tactic translating from [BigN] to [Z] + omega *) diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml index bd0fb5b1..4d6b45c5 100644 --- a/theories/Numbers/Natural/BigN/NMake_gen.ml +++ b/theories/Numbers/Natural/BigN/NMake_gen.ml @@ -8,7 +8,7 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: NMake_gen.ml 11136 2008-06-18 10:41:34Z herbelin $ i*) +(*i $Id: NMake_gen.ml 11282 2008-07-28 11:51:53Z msozeau $ i*) (*S NMake_gen.ml : this file generates NMake.v *) @@ -139,7 +139,7 @@ let _ = pr ""; pr " Definition %s := %s_." t t; pr ""; - + pr " Typeclasses unfold %s." t; pr " Definition w_0 := w0_op.(znz_0)."; pr ""; diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v index fe068437..84836268 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v +++ b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: NSigNAxioms.v 11040 2008-06-03 00:04:16Z letouzey $ i*) +(*i $Id: NSigNAxioms.v 11282 2008-07-28 11:51:53Z msozeau $ i*) Require Import ZArith. Require Import Nnat. @@ -223,7 +223,7 @@ Qed. Add Morphism N.compare with signature N.eq ==> N.eq ==> (@eq comparison) as compare_wd. Proof. intros x x' Hx y y' Hy. -rewrite 2 spec_compare_alt; rewrite Hx, Hy; intuition. +rewrite 2 spec_compare_alt. unfold N.eq in *. rewrite Hx, Hy; intuition. Qed. Add Morphism N.lt with signature N.eq ==> N.eq ==> iff as NZlt_wd. diff --git a/theories/Numbers/Rational/BigQ/BigQ.v b/theories/Numbers/Rational/BigQ/BigQ.v index 39e120f7..21f2513f 100644 --- a/theories/Numbers/Rational/BigQ/BigQ.v +++ b/theories/Numbers/Rational/BigQ/BigQ.v @@ -8,19 +8,35 @@ (* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) (************************************************************************) -(*i $Id: BigQ.v 11028 2008-06-01 17:34:19Z letouzey $ i*) +(*i $Id: BigQ.v 11208 2008-07-04 16:57:46Z letouzey $ i*) -Require Export QMake_base. -Require Import QpMake. -Require Import QvMake. -Require Import Q0Make. -Require Import QifMake. -Require Import QbiMake. +Require Import Field Qfield BigN BigZ QSig QMake. -(* We choose for Q the implemention with - multiple representation of 0: 0, 1/0, 2/0 etc *) +(** We choose for BigQ an implemention with + multiple representation of 0: 0, 1/0, 2/0 etc. + See [QMake.v] *) -Module BigQ <: QSig.QType := Q0. +(** First, we provide translations functions between [BigN] and [BigZ] *) + +Module BigN_BigZ <: NType_ZType BigN.BigN BigZ. + Definition Z_of_N := BigZ.Pos. + Lemma spec_Z_of_N : forall n, BigZ.to_Z (Z_of_N n) = BigN.to_Z n. + Proof. + reflexivity. + Qed. + Definition Zabs_N := BigZ.to_N. + Lemma spec_Zabs_N : forall z, BigN.to_Z (Zabs_N z) = Zabs (BigZ.to_Z z). + Proof. + unfold Zabs_N; intros. + rewrite BigZ.spec_to_Z, Zmult_comm; apply Zsgn_Zabs. + Qed. +End BigN_BigZ. + +(** This allows to build [BigQ] out of [BigN] and [BigQ] via [QMake] *) + +Module BigQ <: QSig.QType := QMake.Make BigN BigZ BigN_BigZ. + +(** Notations about [BigQ] *) Notation bigQ := BigQ.t. @@ -28,8 +44,150 @@ Delimit Scope bigQ_scope with bigQ. Bind Scope bigQ_scope with bigQ. Bind Scope bigQ_scope with BigQ.t. -Notation " i + j " := (BigQ.add i j) : bigQ_scope. -Notation " i - j " := (BigQ.sub i j) : bigQ_scope. -Notation " i * j " := (BigQ.mul i j) : bigQ_scope. -Notation " i / j " := (BigQ.div i j) : bigQ_scope. -Notation " i ?= j " := (BigQ.compare i j) : bigQ_scope. +Infix "+" := BigQ.add : bigQ_scope. +Infix "-" := BigQ.sub : bigQ_scope. +Notation "- x" := (BigQ.opp x) : bigQ_scope. +Infix "*" := BigQ.mul : bigQ_scope. +Infix "/" := BigQ.div : bigQ_scope. +Infix "^" := BigQ.power : bigQ_scope. +Infix "?=" := BigQ.compare : bigQ_scope. +Infix "==" := BigQ.eq : bigQ_scope. +Infix "<" := BigQ.lt : bigQ_scope. +Infix "<=" := BigQ.le : bigQ_scope. +Notation "x > y" := (BigQ.lt y x)(only parsing) : bigQ_scope. +Notation "x >= y" := (BigQ.le y x)(only parsing) : bigQ_scope. +Notation "[ q ]" := (BigQ.to_Q q) : bigQ_scope. + +Open Scope bigQ_scope. + +(** [BigQ] is a setoid *) + +Add Relation BigQ.t BigQ.eq + reflexivity proved by (fun x => Qeq_refl [x]) + symmetry proved by (fun x y => Qeq_sym [x] [y]) + transitivity proved by (fun x y z => Qeq_trans [x] [y] [z]) +as BigQeq_rel. + +Add Morphism BigQ.add with signature BigQ.eq ==> BigQ.eq ==> BigQ.eq as BigQadd_wd. +Proof. + unfold BigQ.eq; intros; rewrite !BigQ.spec_add; rewrite H, H0; apply Qeq_refl. +Qed. + +Add Morphism BigQ.opp with signature BigQ.eq ==> BigQ.eq as BigQopp_wd. +Proof. + unfold BigQ.eq; intros; rewrite !BigQ.spec_opp; rewrite H; apply Qeq_refl. +Qed. + +Add Morphism BigQ.sub with signature BigQ.eq ==> BigQ.eq ==> BigQ.eq as BigQsub_wd. +Proof. + unfold BigQ.eq; intros; rewrite !BigQ.spec_sub; rewrite H, H0; apply Qeq_refl. +Qed. + +Add Morphism BigQ.mul with signature BigQ.eq ==> BigQ.eq ==> BigQ.eq as BigQmul_wd. +Proof. + unfold BigQ.eq; intros; rewrite !BigQ.spec_mul; rewrite H, H0; apply Qeq_refl. +Qed. + +Add Morphism BigQ.inv with signature BigQ.eq ==> BigQ.eq as BigQinv_wd. +Proof. + unfold BigQ.eq; intros; rewrite !BigQ.spec_inv; rewrite H; apply Qeq_refl. +Qed. + +Add Morphism BigQ.div with signature BigQ.eq ==> BigQ.eq ==> BigQ.eq as BigQdiv_wd. +Proof. + unfold BigQ.eq; intros; rewrite !BigQ.spec_div; rewrite H, H0; apply Qeq_refl. +Qed. + +(* TODO : fix this. For the moment it's useless (horribly slow) +Hint Rewrite + BigQ.spec_0 BigQ.spec_1 BigQ.spec_m1 BigQ.spec_compare + BigQ.spec_red BigQ.spec_add BigQ.spec_sub BigQ.spec_opp + BigQ.spec_mul BigQ.spec_inv BigQ.spec_div BigQ.spec_power_pos + BigQ.spec_square : bigq. *) + + +(** [BigQ] is a field *) + +Lemma BigQfieldth : + field_theory BigQ.zero BigQ.one BigQ.add BigQ.mul BigQ.sub BigQ.opp BigQ.div BigQ.inv BigQ.eq. +Proof. +constructor. +constructor; intros; red. +rewrite BigQ.spec_add, BigQ.spec_0; ring. +rewrite ! BigQ.spec_add; ring. +rewrite ! BigQ.spec_add; ring. +rewrite BigQ.spec_mul, BigQ.spec_1; ring. +rewrite ! BigQ.spec_mul; ring. +rewrite ! BigQ.spec_mul; ring. +rewrite BigQ.spec_add, ! BigQ.spec_mul, BigQ.spec_add; ring. +unfold BigQ.sub; apply Qeq_refl. +rewrite BigQ.spec_add, BigQ.spec_0, BigQ.spec_opp; ring. +compute; discriminate. +intros; red. +unfold BigQ.div; apply Qeq_refl. +intros; red. +rewrite BigQ.spec_mul, BigQ.spec_inv, BigQ.spec_1; field. +rewrite <- BigQ.spec_0; auto. +Qed. + +Lemma BigQpowerth : + power_theory BigQ.one BigQ.mul BigQ.eq Z_of_N BigQ.power. +Proof. +constructor. +intros; red. +rewrite BigQ.spec_power. +replace ([r] ^ Z_of_N n)%Q with (pow_N 1 Qmult [r] n)%Q. +destruct n. +simpl; compute; auto. +induction p; simpl; auto; try rewrite !BigQ.spec_mul, !IHp; apply Qeq_refl. +destruct n; reflexivity. +Qed. + +Lemma BigQ_eq_bool_correct : + forall x y, BigQ.eq_bool x y = true -> x==y. +Proof. +intros; generalize (BigQ.spec_eq_bool x y); rewrite H; auto. +Qed. + +Lemma BigQ_eq_bool_complete : + forall x y, x==y -> BigQ.eq_bool x y = true. +Proof. +intros; generalize (BigQ.spec_eq_bool x y). +destruct BigQ.eq_bool; auto. +Qed. + +(* TODO : improve later the detection of constants ... *) + +Ltac BigQcst t := + match t with + | BigQ.zero => BigQ.zero + | BigQ.one => BigQ.one + | BigQ.minus_one => BigQ.minus_one + | _ => NotConstant + end. + +Add Field BigQfield : BigQfieldth + (decidable BigQ_eq_bool_correct, + completeness BigQ_eq_bool_complete, + constants [BigQcst], + power_tac BigQpowerth [Qpow_tac]). + +Section Examples. + +Let ex1 : forall x y z, (x+y)*z == (x*z)+(y*z). + intros. + ring. +Qed. + +Let ex8 : forall x, x ^ 1 == x. + intro. + ring. +Qed. + +Let ex10 : forall x y, ~(y==BigQ.zero) -> (x/y)*y == x. +intros. +field. +auto. +Qed. + +End Examples.
\ No newline at end of file diff --git a/theories/Numbers/Rational/BigQ/Q0Make.v b/theories/Numbers/Rational/BigQ/Q0Make.v deleted file mode 100644 index 93f52c03..00000000 --- a/theories/Numbers/Rational/BigQ/Q0Make.v +++ /dev/null @@ -1,1412 +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 *) -(************************************************************************) -(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: Q0Make.v 11028 2008-06-01 17:34:19Z letouzey $ i*) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import BigNumPrelude. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QSig. -Require Import QMake_base. - -Module Q0 <: QType. - - Import BinInt Zorder. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a natural - number y interpreted as x/y. The pairs (x,0) and (0,y) are all - interpreted as 0. *) - - Definition t := q_type. - - (** Specification with respect to [QArith] *) - - Open Local Scope Q_scope. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.of_N (Npos y)) - end. - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => if BigN.eq_bool y BigN.zero then 0 - else BigZ.to_Z x # Z2P (BigN.to_Z y) - end. - - Notation "[ x ]" := (to_Q x). - - Theorem strong_spec_of_Q: forall q: Q, [of_Q q] = q. - Proof. - intros (x,y); simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_of_pos; intros HH; discriminate HH. - rewrite BigZ.spec_of_Z; simpl. - rewrite (BigN.spec_of_pos); auto. - Qed. - - Theorem spec_of_Q: forall q: Q, [of_Q q] == q. - Proof. - intros; rewrite strong_spec_of_Q; red; auto. - Qed. - - Definition eq x y := [x] == [y]. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Lemma spec_0: [zero] == 0. - Proof. - reflexivity. - Qed. - - Lemma spec_1: [one] == 1. - Proof. - reflexivity. - Qed. - - Lemma spec_m1: [minus_one] == -(1). - Proof. - reflexivity. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - Theorem strong_spec_opp: forall q, [opp q] = -[q]. - Proof. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigZ.spec_opp; auto. - Qed. - - Theorem spec_opp : forall q, [opp q] == -[q]. - Proof. - intros; rewrite strong_spec_opp; red; auto. - Qed. - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => - if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero - else BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny - | Qq nx dx, Qz zy => - if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy - else BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx)) - | Qq nx dx, Qq ny dy => - match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with - | true, true => Eq - | true, false => BigZ.compare BigZ.zero ny - | false, true => BigZ.compare nx BigZ.zero - | false, false => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) - end - end. - - Theorem spec_compare: forall q1 q2, (compare q1 q2) = ([q1] ?= [q2]). - Proof. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare, to_Q, Qnum, Qden. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero z2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zcompare_refl; auto. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero x2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare; - auto; rewrite BigZ.spec_0. - intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - repeat rewrite Z2P_correct. - 2: generalize (BigN.spec_pos y1); auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (x1 * BigZ.Pos y2) - (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - Qed. - - Definition lt n m := compare n m = Lt. - Definition le n m := compare n m <> Gt. - Definition min n m := match compare n m with Gt => m | _ => n end. - Definition max n m := match compare n m with Lt => m | _ => n end. - -(* Je pense que cette fonction normalise bien ... *) - Definition norm n d: t := - let gcd := BigN.gcd (BigZ.to_N n) d in - match BigN.compare BigN.one gcd with - | Lt => - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - match BigN.compare d BigN.one with - | Gt => Qq n d - | Eq => Qz n - | Lt => zero - end - | Eq => Qq n d - | Gt => zero (* gcd = 0 => both numbers are 0 *) - end. - - Theorem spec_norm: forall n q, [norm n q] == [Qq n q]. - Proof. - intros p q; unfold norm. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1. - apply Qeq_refl. - generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H2 HH. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl; - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - auto with zarith. - generalize H2; rewrite H3; - rewrite Zdiv_0_l; auto with zarith. - generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3. - rewrite spec_to_N. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl. - case H3. - generalize H1 H2 H3 HH; clear H1 H2 H3 HH. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 HH. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith. - case (Zle_lt_or_eq _ _ HH); auto with zarith. - intros HH1; rewrite <- HH1; ring. - generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith. - simpl. - assert (FF := BigN.spec_pos q). - rewrite Z2P_correct; auto with zarith. - rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith. - simpl; rewrite BigZ.spec_div; simpl. - rewrite BigN.spec_gcd; auto with zarith. - generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4 HH FF. - rewrite spec_to_N; fold a. - rewrite Zgcd_div_swap; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q))); - rewrite BigN.spec_gcd; auto with zarith. - intros; apply False_ind; auto with zarith. - intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2; simpl. - rewrite spec_to_N. - rewrite FF2; ring. - Qed. - - - Definition add (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - Qq n d - end - end. - - Theorem spec_add : forall x y, [add x y] == [x] + [y]. - Proof. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r; red; simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - rewrite Zmult_1_r; rewrite Pmult_1_r. - apply Qeq_refl. - assert (F1:= BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - case HH2; auto. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH2; auto. - case HH1; auto. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH; auto. - rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r. - apply Qeq_refl. - simpl. - generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_mul; - rewrite BigN.spec_0; intros HH2. - (case (Zmult_integral _ _ HH2); intros HH3); - [case HH| case HH1]; auto. - rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - red; simpl; rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - apply Zmult_lt_0_compat; auto. - Qed. - - Definition add_norm (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - norm n d - end - end. - - Theorem spec_add_norm : forall x y, [add_norm x y] == [x] + [y]. - Proof. - intros x y; rewrite <- spec_add; auto. - case x; case y; clear x y; unfold add_norm, add. - intros; apply Qeq_refl. - intros p1 n p2. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - simpl. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - apply Qeq_refl. - intros p1 p2 n. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - intros p1 q1 p2 q2. - generalize (BigN.spec_eq_bool q2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - generalize (BigN.spec_eq_bool q1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - Qed. - - Definition sub x y := add x (opp y). - - Theorem spec_sub : forall x y, [sub x y] == [x] - [y]. - Proof. - intros x y; unfold sub; rewrite spec_add; auto. - rewrite spec_opp; ring. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem spec_sub_norm : forall x y, [sub_norm x y] == [x] - [y]. - Proof. - intros x y; unfold sub_norm; rewrite spec_add_norm; auto. - rewrite spec_opp; ring. - Qed. - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem spec_mul : forall x y, [mul x y] == [x] * [y]. - Proof. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; rewrite Pmult_1_r. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; - intros HH1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - red; simpl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - red; simpl; ring. - case (Zmult_integral _ _ HH1); intros HH. - case HH2; auto. - case HH3; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - case HH1; rewrite HH2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - case HH1; rewrite HH3; ring. - rewrite BigZ.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - apply Qeq_refl. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dy); auto with zarith. - Qed. - -Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => - if BigZ.eq_bool zx BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N zx) dy in - match BigN.compare gcd BigN.one with - Gt => - let zx := BigZ.div zx (BigZ.Pos gcd) in - let d := BigN.div dy gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny) - else Qq (BigZ.mul zx ny) d - | _ => Qq (BigZ.mul zx ny) dy - end - | Qq nx dx, Qz zy => - if BigZ.eq_bool zy BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N zy) dx in - match BigN.compare gcd BigN.one with - Gt => - let zy := BigZ.div zy (BigZ.Pos gcd) in - let d := BigN.div dx gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx) - else Qq (BigZ.mul zy nx) d - | _ => Qq (BigZ.mul zy nx) dx - end - | Qq nx dx, Qq ny dy => - let (nx, dy) := - let gcd := BigN.gcd (BigZ.to_N nx) dy in - match BigN.compare gcd BigN.one with - Gt => (BigZ.div nx (BigZ.Pos gcd), BigN.div dy gcd) - | _ => (nx, dy) - end in - let (ny, dx) := - let gcd := BigN.gcd (BigZ.to_N ny) dx in - match BigN.compare gcd BigN.one with - Gt => (BigZ.div ny (BigZ.Pos gcd), BigN.div dx gcd) - | _ => (ny, dx) - end in - let d := (BigN.mul dx dy) in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul ny nx) - else Qq (BigZ.mul ny nx) d - end. - - Theorem spec_mul_norm : forall x y, [mul_norm x y] == [x] * [y]. - Proof. - intros x y; rewrite <- spec_mul; auto. - unfold mul_norm, mul; case x; case y; clear x y. - intros; apply Qeq_refl. - intros p1 n p2. - set (a := BigN.to_Z (BigZ.to_N p2)). - set (b := BigN.to_Z n). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - case BigN.eq_bool; try apply Qeq_refl. - rewrite BigZ.spec_mul; rewrite H. - red; simpl; ring. - assert (F: (0 < a)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; - fold a b; intros H1. - apply Qeq_refl. - apply Qeq_refl. - assert (F0 : (0 < (Zgcd a b))%Z). - apply Zlt_trans with 1%Z. - red; auto. - apply Zgt_lt; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; - fold a b; intros H2. - assert (F1: b = Zgcd a b). - pattern b at 1; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); - auto with zarith. - rewrite H2; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - assert (F2: (0 < b)%Z). - rewrite F1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros H3. - rewrite H3 in F2; discriminate F2. - rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite BigZ.spec_mul. - red; simpl; rewrite Z2P_correct; auto. - rewrite Zmult_1_r; rewrite spec_to_N; fold a b. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; fold a b; auto; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - apply Qeq_refl. - case H4; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite H3; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto. - rewrite BigZ.spec_mul; rewrite BigZ.spec_div; simpl; - rewrite BigN.spec_gcd; fold a b; auto with zarith. - assert (F1: (0 < b)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos n)); fold b; auto with zarith. - red; simpl. - rewrite BigZ.spec_mul. - repeat rewrite Z2P_correct; auto. - rewrite spec_to_N; fold a. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - ring. - apply Zgcd_div_pos; auto. - intros p1 p2 n. - set (a := BigN.to_Z (BigZ.to_N p1)). - set (b := BigN.to_Z n). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - case BigN.eq_bool; try apply Qeq_refl. - rewrite BigZ.spec_mul; rewrite H. - red; simpl; ring. - assert (F: (0 < a)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; - fold a b; intros H1. - repeat rewrite BigZ.spec_mul; rewrite Zmult_comm. - apply Qeq_refl. - repeat rewrite BigZ.spec_mul; rewrite Zmult_comm. - apply Qeq_refl. - assert (F0 : (0 < (Zgcd a b))%Z). - apply Zlt_trans with 1%Z. - red; auto. - apply Zgt_lt; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; - fold a b; intros H2. - assert (F1: b = Zgcd a b). - pattern b at 1; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); - auto with zarith. - rewrite H2; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - assert (F2: (0 < b)%Z). - rewrite F1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros H3. - rewrite H3 in F2; discriminate F2. - rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite BigZ.spec_mul. - red; simpl; rewrite Z2P_correct; auto. - rewrite Zmult_1_r; rewrite spec_to_N; fold a b. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; fold a b; auto; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - apply Qeq_refl. - case H4; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite H3; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto. - rewrite BigZ.spec_mul; rewrite BigZ.spec_div; simpl; - rewrite BigN.spec_gcd; fold a b; auto with zarith. - assert (F1: (0 < b)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos n)); fold b; auto with zarith. - red; simpl. - rewrite BigZ.spec_mul. - repeat rewrite Z2P_correct; auto. - rewrite spec_to_N; fold a. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - ring. - apply Zgcd_div_pos; auto. - set (f := fun p t => - match (BigN.gcd (BigZ.to_N p) t ?= BigN.one)%bigN with - | Eq => (p, t) - | Lt => (p, t) - | Gt => - ((p / BigZ.Pos (BigN.gcd (BigZ.to_N p) t))%bigZ, - (t / BigN.gcd (BigZ.to_N p) t)%bigN) - end). - assert (F: forall p t, - let (n, d) := f p t in [Qq p t] == [Qq n d]). - intros p t1; unfold f. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1. - apply Qeq_refl. - apply Qeq_refl. - set (a := BigN.to_Z (BigZ.to_N p)). - set (b := BigN.to_Z t1). - fold a b in H1. - assert (F0 : (0 < (Zgcd a b))%Z). - apply Zlt_trans with 1%Z. - red; auto. - apply Zgt_lt; auto. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros HH1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; fold b; intros HH2. - simpl; ring. - case HH2. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b; auto. - rewrite HH1; rewrite Zdiv_0_l; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b; auto; - intros HH2. - case HH1. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite HH2; ring. - assert (FF := Zgcd_is_gcd a b); inversion FF; auto. - simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; fold a b; auto with zarith. - assert (F1: (0 < b)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos t1)); fold b; auto with zarith. - intros HH; case HH1; auto. - repeat rewrite Z2P_correct; auto. - rewrite spec_to_N; fold a. - rewrite Zgcd_div_swap; auto. - apply Zgcd_div_pos; auto. - intros HH; rewrite HH in F0; discriminate F0. - intros p1 n1 p2 n2. - change ([let (nx , dy) := f p2 n1 in - let (ny, dx) := f p1 n2 in - if BigN.eq_bool (dx * dy)%bigN BigN.one - then Qz (ny * nx) - else Qq (ny * nx) (dx * dy)] == [Qq (p2 * p1) (n2 * n1)]). - generalize (F p2 n1) (F p1 n2). - case f; case f. - intros u1 u2 v1 v2 Hu1 Hv1. - apply Qeq_trans with [mul (Qq p2 n1) (Qq p1 n2)]. - rewrite spec_mul; rewrite Hu1; rewrite Hv1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; rewrite BigN.spec_mul; intros HH1. - assert (F1: BigN.to_Z u2 = 1%Z). - case (Zmult_1_inversion_l _ _ HH1); auto. - generalize (BigN.spec_pos u2); auto with zarith. - assert (F2: BigN.to_Z v2 = 1%Z). - rewrite Zmult_comm in HH1. - case (Zmult_1_inversion_l _ _ HH1); auto. - generalize (BigN.spec_pos v2); auto with zarith. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1 in F2; discriminate F2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2. - rewrite H2 in F1; discriminate F1. - simpl; rewrite BigZ.spec_mul. - rewrite F1; rewrite F2; simpl; ring. - rewrite Qmult_comm; rewrite <- spec_mul. - apply Qeq_refl. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; - rewrite Zmult_comm; intros H1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; intros H2; auto. - case H2; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; intros H2; auto. - case H1; auto. - Qed. - - -Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => Qq BigZ.one n - | Qz (BigZ.Neg n) => Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n - end. - - Theorem spec_inv : forall x, [inv x] == /[x]. - Proof. - intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - Qed. - -Definition inv_norm (x: t): t := - match x with - | Qz (BigZ.Pos n) => - match BigN.compare n BigN.one with - Gt => Qq BigZ.one n - | _ => x - end - | Qz (BigZ.Neg n) => - match BigN.compare n BigN.one with - Gt => Qq BigZ.minus_one n - | _ => x - end - | Qq (BigZ.Pos n) d => - match BigN.compare n BigN.one with - Gt => Qq (BigZ.Pos d) n - | Eq => Qz (BigZ.Pos d) - | Lt => Qz (BigZ.zero) - end - | Qq (BigZ.Neg n) d => - match BigN.compare n BigN.one with - Gt => Qq (BigZ.Neg d) n - | Eq => Qz (BigZ.Neg d) - | Lt => Qz (BigZ.zero) - end - end. - - Theorem spec_inv_norm : forall x, [inv_norm x] == /[x]. - Proof. - intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, Qinv. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H. - simpl; rewrite H; apply Qeq_refl. - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl. - generalize H; case BigN.to_Z. - intros _ HH; discriminate HH. - intros p; case p; auto. - intros p1 HH; discriminate HH. - intros p1 HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; discriminate HH. - intros HH; rewrite <- HH. - apply Qeq_refl. - generalize H; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1; intros HH; discriminate. - generalize H; case BigN.to_Z. - intros HH; discriminate HH. - intros; red; simpl; auto. - intros p HH; discriminate HH. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H. - simpl; rewrite H; apply Qeq_refl. - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl. - generalize H; case BigN.to_Z. - intros _ HH; discriminate HH. - intros p; case p; auto. - intros p1 HH; discriminate HH. - intros p1 HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; discriminate HH. - intros HH; rewrite <- HH. - apply Qeq_refl. - generalize H; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1; intros HH; discriminate. - generalize H; case BigN.to_Z. - intros HH; discriminate HH. - intros; red; simpl; auto. - intros p HH; discriminate HH. - simpl Qnum. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; simpl. - case BigN.compare; red; simpl; auto. - rewrite H1; auto. - case BigN.eq_bool; auto. - simpl; rewrite H1; auto. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H2. - rewrite H2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - red; simpl. - rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx). - intros; apply Qeq_refl. - intros p; case p; clear p. - intros p HH; discriminate HH. - intros p HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - simpl; generalize H2; case (BigN.to_Z nx). - intros HH; discriminate HH. - intros p Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - rewrite H4 in H2; discriminate H2. - red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p HH; discriminate HH. - simpl Qnum. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; simpl. - case BigN.compare; red; simpl; auto. - rewrite H1; auto. - case BigN.eq_bool; auto. - simpl; rewrite H1; auto. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H2. - rewrite H2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx). - intros; apply Qeq_refl. - intros p; case p; clear p. - intros p HH; discriminate HH. - intros p HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - simpl; generalize H2; case (BigN.to_Z nx). - intros HH; discriminate HH. - intros p Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - rewrite H4 in H2; discriminate H2. - red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p HH; discriminate HH. - Qed. - - Definition div x y := mul x (inv y). - - Theorem spec_div x y: [div x y] == [x] / [y]. - Proof. - intros x y; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem spec_div_norm x y: [div_norm x y] == [x] / [y]. - Proof. - intros x y; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx) - end. - - Theorem spec_square : forall x, [square x] == [x] ^ 2. - Proof. - intros [ x | nx dx]; unfold square. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - simpl Qpower. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H1; rewrite H; auto. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H; case (Zmult_integral _ _ H1); auto. - simpl. - rewrite BigZ.spec_square. - rewrite Zpos_mult_morphism. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Definition power_pos (x: t) p: t := - match x with - | Qz zx => Qz (BigZ.power_pos zx p) - | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p) - end. - - Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p. - Proof. - intros [x | nx dx] p; unfold power_pos. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z x) 1). - unfold Qeq; simpl. - rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Zmult_1_r. - intros H; rewrite H. - rewrite BigZ.spec_power_pos; simpl; ring. - simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_power_pos; intros H1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2. - elim p; simpl. - intros; red; simpl; auto. - intros p1 Hp1; rewrite <- Hp1; red; simpl; auto. - apply Qeq_refl. - case H2; generalize H1. - elim p; simpl. - intros p1 Hrec. - change (xI p1) with (1 + (xO p1))%positive. - rewrite Zpower_pos_is_exp; rewrite Zpower_pos_1_r. - intros HH; case (Zmult_integral _ _ HH); auto. - rewrite <- Pplus_diag. - rewrite Zpower_pos_is_exp. - intros HH1; case (Zmult_integral _ _ HH1); auto. - intros p1 Hrec. - rewrite <- Pplus_diag. - rewrite Zpower_pos_is_exp. - intros HH1; case (Zmult_integral _ _ HH1); auto. - rewrite Zpower_pos_1_r; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2. - case H1; rewrite H2; auto. - simpl; rewrite Zpower_pos_0_l; auto. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z). - unfold Zpower; apply Zpower_pos_pos; auto. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z nx) - (Z2P (BigN.to_Z dx))). - unfold Qeq; simpl. - repeat rewrite Z2P_correct; auto. - unfold Qeq; simpl; intros HH. - rewrite HH. - rewrite BigZ.spec_power_pos; simpl; ring. - Qed. - - (** Interaction with [Qcanon.Qc] *) - - Open Scope Qc_scope. - - Definition of_Qc q := of_Q (this q). - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Theorem spec_of_Qc: forall q, [[of_Qc q]] = q. - Proof. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros. - rewrite <- H0 at 2; apply Qred_complete. - apply spec_of_Q. - Qed. - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - Proof. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_correct; red; auto. - Qed. - - Theorem spec_comparec: forall q1 q2, - compare q1 q2 = ([[q1]] ?= [[q2]]). - Proof. - unfold Qccompare, to_Qc. - intros q1 q2; rewrite spec_compare; simpl; auto. - apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Theorem spec_addc x y: - [[add x y]] = [[x]] + [[y]]. - Proof. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Theorem spec_add_normc x y: - [[add_norm x y]] = [[x]] + [[y]]. - Proof. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. - Proof. - intros x y; unfold sub; rewrite spec_addc; auto. - rewrite spec_oppc; ring. - Qed. - - Theorem spec_sub_normc x y: - [[sub_norm x y]] = [[x]] - [[y]]. - intros x y; unfold sub_norm; rewrite spec_add_normc; auto. - rewrite spec_oppc; ring. - Qed. - - Theorem spec_mulc x y: - [[mul x y]] = [[x]] * [[y]]. - Proof. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Theorem spec_mul_normc x y: - [[mul_norm x y]] = [[x]] * [[y]]. - Proof. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Theorem spec_invc x: - [[inv x]] = /[[x]]. - Proof. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Theorem spec_inv_normc x: - [[inv_norm x]] = /[[x]]. - Proof. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv_norm; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. - Proof. - intros x y; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. - Proof. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Theorem spec_squarec x: [[square x]] = [[x]]^2. - Proof. - intros x; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square; auto. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Theorem spec_power_posc x p: - [[power_pos x p]] = [[x]] ^ nat_of_P p. - Proof. - intros x p; unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_power_pos; auto. - pattern p; apply Pind; clear p. - simpl; ring. - intros p Hrec. - rewrite nat_of_P_succ_morphism; simpl Qcpower. - rewrite <- Hrec. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; - unfold this. - apply Qred_complete. - assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p). - simpl; case x; simpl; clear x Hrec. - intros x; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - intros nx dx. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - unfold Qpower_positive. - assert (tmp: forall p, pow_pos Qmult 0%Q p = 0%Q). - intros p1; elim p1; simpl; auto; clear p1. - intros p1 Hp1; rewrite Hp1; auto. - intros p1 Hp1; rewrite Hp1; auto. - repeat rewrite tmp; intros; red; simpl; auto. - intros H1. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - repeat rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - 2: apply Zpower_pos_pos; auto. - 2: apply Zpower_pos_pos; auto. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - rewrite F. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -End Q0. diff --git a/theories/Numbers/Rational/BigQ/QMake.v b/theories/Numbers/Rational/BigQ/QMake.v new file mode 100644 index 00000000..494420bd --- /dev/null +++ b/theories/Numbers/Rational/BigQ/QMake.v @@ -0,0 +1,1345 @@ +(************************************************************************) +(* 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 *) +(************************************************************************) +(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) +(************************************************************************) + +(*i $Id: QMake.v 11208 2008-07-04 16:57:46Z letouzey $ i*) + +Require Import BigNumPrelude ROmega. +Require Import QArith Qcanon Qpower. +Require Import NSig ZSig QSig. + +Module Type NType_ZType (N:NType)(Z:ZType). + Parameter Z_of_N : N.t -> Z.t. + Parameter spec_Z_of_N : forall n, Z.to_Z (Z_of_N n) = N.to_Z n. + Parameter Zabs_N : Z.t -> N.t. + Parameter spec_Zabs_N : forall z, N.to_Z (Zabs_N z) = Zabs (Z.to_Z z). +End NType_ZType. + +Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. + + (** The notation of a rational number is either an integer x, + interpreted as itself or a pair (x,y) of an integer x and a natural + number y interpreted as x/y. The pairs (x,0) and (0,y) are all + interpreted as 0. *) + + Inductive t_ := + | Qz : Z.t -> t_ + | Qq : Z.t -> N.t -> t_. + + Definition t := t_. + + (** Specification with respect to [QArith] *) + + Open Local Scope Q_scope. + + Definition of_Z x: t := Qz (Z.of_Z x). + + Definition of_Q (q:Q) : t := + let (x,y) := q in + match y with + | 1%positive => Qz (Z.of_Z x) + | _ => Qq (Z.of_Z x) (N.of_N (Npos y)) + end. + + Definition to_Q (q: t) := + match q with + | Qz x => Z.to_Z x # 1 + | Qq x y => if N.eq_bool y N.zero then 0 + else Z.to_Z x # Z2P (N.to_Z y) + end. + + Notation "[ x ]" := (to_Q x). + + Theorem strong_spec_of_Q: forall q: Q, [of_Q q] = q. + Proof. + intros(x,y); destruct y; simpl; rewrite Z.spec_of_Z; auto. + generalize (N.spec_eq_bool (N.of_N (Npos y~1)) N.zero); + case N.eq_bool; auto; rewrite N.spec_0. + rewrite N.spec_of_N; intros; discriminate. + rewrite N.spec_of_N; auto. + generalize (N.spec_eq_bool (N.of_N (Npos y~0)) N.zero); + case N.eq_bool; auto; rewrite N.spec_0. + rewrite N.spec_of_N; intros; discriminate. + rewrite N.spec_of_N; auto. + Qed. + + Theorem spec_of_Q: forall q: Q, [of_Q q] == q. + Proof. + intros; rewrite strong_spec_of_Q; red; auto. + Qed. + + Definition eq x y := [x] == [y]. + + Definition zero: t := Qz Z.zero. + Definition one: t := Qz Z.one. + Definition minus_one: t := Qz Z.minus_one. + + Lemma spec_0: [zero] == 0. + Proof. + simpl; rewrite Z.spec_0; reflexivity. + Qed. + + Lemma spec_1: [one] == 1. + Proof. + simpl; rewrite Z.spec_1; reflexivity. + Qed. + + Lemma spec_m1: [minus_one] == -(1). + Proof. + simpl; rewrite Z.spec_m1; reflexivity. + Qed. + + Definition compare (x y: t) := + match x, y with + | Qz zx, Qz zy => Z.compare zx zy + | Qz zx, Qq ny dy => + if N.eq_bool dy N.zero then Z.compare zx Z.zero + else Z.compare (Z.mul zx (Z_of_N dy)) ny + | Qq nx dx, Qz zy => + if N.eq_bool dx N.zero then Z.compare Z.zero zy + else Z.compare nx (Z.mul zy (Z_of_N dx)) + | Qq nx dx, Qq ny dy => + match N.eq_bool dx N.zero, N.eq_bool dy N.zero with + | true, true => Eq + | true, false => Z.compare Z.zero ny + | false, true => Z.compare nx Z.zero + | false, false => Z.compare (Z.mul nx (Z_of_N dy)) + (Z.mul ny (Z_of_N dx)) + end + end. + + Lemma Zcompare_spec_alt : + forall z z', Z.compare z z' = (Z.to_Z z ?= Z.to_Z z')%Z. + Proof. + intros; generalize (Z.spec_compare z z'); destruct Z.compare; auto. + intro H; rewrite H; symmetry; apply Zcompare_refl. + Qed. + + Lemma Ncompare_spec_alt : + forall n n', N.compare n n' = (N.to_Z n ?= N.to_Z n')%Z. + Proof. + intros; generalize (N.spec_compare n n'); destruct N.compare; auto. + intro H; rewrite H; symmetry; apply Zcompare_refl. + Qed. + + Lemma N_to_Z2P : forall n, N.to_Z n <> 0%Z -> + Zpos (Z2P (N.to_Z n)) = N.to_Z n. + Proof. + intros; apply Z2P_correct. + generalize (N.spec_pos n); romega. + Qed. + + Hint Rewrite + Zplus_0_r Zplus_0_l Zmult_0_r Zmult_0_l Zmult_1_r Zmult_1_l + Z.spec_0 N.spec_0 Z.spec_1 N.spec_1 Z.spec_m1 Z.spec_opp + Zcompare_spec_alt Ncompare_spec_alt + Z.spec_add N.spec_add Z.spec_mul N.spec_mul + Z.spec_gcd N.spec_gcd Zgcd_Zabs + spec_Z_of_N spec_Zabs_N + : nz. + Ltac nzsimpl := autorewrite with nz in *. + + Ltac destr_neq_bool := repeat + (match goal with |- context [N.eq_bool ?x ?y] => + generalize (N.spec_eq_bool x y); case N.eq_bool + end). + + Ltac destr_zeq_bool := repeat + (match goal with |- context [Z.eq_bool ?x ?y] => + generalize (Z.spec_eq_bool x y); case Z.eq_bool + end). + + Ltac simpl_ndiv := rewrite N.spec_div by (nzsimpl; romega). + Tactic Notation "simpl_ndiv" "in" "*" := + rewrite N.spec_div in * by (nzsimpl; romega). + + Ltac simpl_zdiv := rewrite Z.spec_div by (nzsimpl; romega). + Tactic Notation "simpl_zdiv" "in" "*" := + rewrite Z.spec_div in * by (nzsimpl; romega). + + Ltac qsimpl := try red; unfold to_Q; simpl; intros; + destr_neq_bool; destr_zeq_bool; simpl; nzsimpl; auto; intros. + + Theorem spec_compare: forall q1 q2, (compare q1 q2) = ([q1] ?= [q2]). + Proof. + intros [z1 | x1 y1] [z2 | x2 y2]; + unfold Qcompare, compare; qsimpl; rewrite ! N_to_Z2P; auto. + Qed. + + Definition lt n m := compare n m = Lt. + Definition le n m := compare n m <> Gt. + Definition min n m := match compare n m with Gt => m | _ => n end. + Definition max n m := match compare n m with Lt => m | _ => n end. + + Definition eq_bool n m := + match compare n m with Eq => true | _ => false end. + + Theorem spec_eq_bool: forall x y, + if eq_bool x y then [x] == [y] else ~([x] == [y]). + Proof. + intros. + unfold eq_bool. + rewrite spec_compare. + generalize (Qeq_alt [x] [y]). + destruct Qcompare. + intros H; rewrite H; auto. + intros H H'; rewrite H in H'; discriminate. + intros H H'; rewrite H in H'; discriminate. + Qed. + + (** Normalisation function *) + + Definition norm n d : t := + let gcd := N.gcd (Zabs_N n) d in + match N.compare N.one gcd with + | Lt => + let n := Z.div n (Z_of_N gcd) in + let d := N.div d gcd in + match N.compare d N.one with + | Gt => Qq n d + | Eq => Qz n + | Lt => zero + end + | Eq => Qq n d + | Gt => zero (* gcd = 0 => both numbers are 0 *) + end. + + Theorem spec_norm: forall n q, [norm n q] == [Qq n q]. + Proof. + intros p q; unfold norm. + assert (Hp := N.spec_pos (Zabs_N p)). + assert (Hq := N.spec_pos q). + nzsimpl. + destr_zcompare. + qsimpl. + + simpl_ndiv. + destr_zcompare. + qsimpl. + rewrite H1 in *; rewrite Zdiv_0_l in H0; discriminate. + rewrite N_to_Z2P; auto. + simpl_zdiv; nzsimpl. + rewrite Zgcd_div_swap0, H0; romega. + + qsimpl. + assert (0 < N.to_Z q / Zgcd (Z.to_Z p) (N.to_Z q))%Z. + apply Zgcd_div_pos; romega. + romega. + + qsimpl. + simpl_ndiv in *; nzsimpl; romega. + simpl_ndiv in *. + rewrite H1, Zdiv_0_l in H2; elim H2; auto. + rewrite 2 N_to_Z2P; auto. + simpl_ndiv; simpl_zdiv; nzsimpl. + apply Zgcd_div_swap0; romega. + + qsimpl. + assert (H' : Zgcd (Z.to_Z p) (N.to_Z q) = 0%Z). + generalize (Zgcd_is_pos (Z.to_Z p) (N.to_Z q)); romega. + symmetry; apply (Zgcd_inv_0_l _ _ H'); auto. + Qed. + + Theorem strong_spec_norm : forall p q, [norm p q] = Qred [Qq p q]. + Proof. + intros. + replace (Qred [Qq p q]) with (Qred [norm p q]) by + (apply Qred_complete; apply spec_norm). + symmetry; apply Qred_identity. + unfold norm. + assert (Hp := N.spec_pos (Zabs_N p)). + assert (Hq := N.spec_pos q). + nzsimpl. + destr_zcompare. + (* Eq *) + simpl. + destr_neq_bool; nzsimpl; simpl; auto. + intros. + rewrite N_to_Z2P; auto. + (* Lt *) + simpl_ndiv. + destr_zcompare. + qsimpl; auto. + qsimpl. + qsimpl. + simpl_zdiv; nzsimpl. + rewrite N_to_Z2P; auto. + clear H1. + simpl_ndiv; nzsimpl. + rewrite Zgcd_1_rel_prime. + destruct (Z_lt_le_dec 0 (N.to_Z q)). + apply Zis_gcd_rel_prime; auto with zarith. + apply Zgcd_is_gcd. + replace (N.to_Z q) with 0%Z in * by romega. + rewrite Zdiv_0_l in H0; discriminate. + (* Gt *) + simpl; auto. + Qed. + + (** Reduction function : producing irreducible fractions *) + + Definition red (x : t) : t := + match x with + | Qz z => x + | Qq n d => norm n d + end. + + Definition Reduced x := [red x] = [x]. + + Theorem spec_red : forall x, [red x] == [x]. + Proof. + intros [ z | n d ]. + auto with qarith. + unfold red. + apply spec_norm. + Qed. + + Theorem strong_spec_red : forall x, [red x] = Qred [x]. + Proof. + intros [ z | n d ]. + unfold red. + symmetry; apply Qred_identity; simpl; auto. + unfold red; apply strong_spec_norm. + Qed. + + Definition add (x y: t): t := + match x with + | Qz zx => + match y with + | Qz zy => Qz (Z.add zx zy) + | Qq ny dy => + if N.eq_bool dy N.zero then x + else Qq (Z.add (Z.mul zx (Z_of_N dy)) ny) dy + end + | Qq nx dx => + if N.eq_bool dx N.zero then y + else match y with + | Qz zy => Qq (Z.add nx (Z.mul zy (Z_of_N dx))) dx + | Qq ny dy => + if N.eq_bool dy N.zero then x + else + let n := Z.add (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) in + let d := N.mul dx dy in + Qq n d + end + end. + + Theorem spec_add : forall x y, [add x y] == [x] + [y]. + Proof. + intros [x | nx dx] [y | ny dy]; unfold Qplus; qsimpl. + intuition. + rewrite N_to_Z2P; auto. + intuition. + rewrite Pmult_1_r, N_to_Z2P; auto. + intuition. + rewrite Pmult_1_r, N_to_Z2P; auto. + destruct (Zmult_integral _ _ H); intuition. + rewrite Zpos_mult_morphism, 2 N_to_Z2P; auto. + rewrite (Z2P_correct (N.to_Z dx * N.to_Z dy)); auto. + apply Zmult_lt_0_compat. + generalize (N.spec_pos dx); romega. + generalize (N.spec_pos dy); romega. + Qed. + + Definition add_norm (x y: t): t := + match x with + | Qz zx => + match y with + | Qz zy => Qz (Z.add zx zy) + | Qq ny dy => + if N.eq_bool dy N.zero then x + else norm (Z.add (Z.mul zx (Z_of_N dy)) ny) dy + end + | Qq nx dx => + if N.eq_bool dx N.zero then y + else match y with + | Qz zy => norm (Z.add nx (Z.mul zy (Z_of_N dx))) dx + | Qq ny dy => + if N.eq_bool dy N.zero then x + else + let n := Z.add (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) in + let d := N.mul dx dy in + norm n d + end + end. + + Theorem spec_add_norm : forall x y, [add_norm x y] == [x] + [y]. + Proof. + intros x y; rewrite <- spec_add. + destruct x; destruct y; unfold add_norm, add; + destr_neq_bool; auto using Qeq_refl, spec_norm. + Qed. + + Theorem strong_spec_add_norm : forall x y : t, + Reduced x -> Reduced y -> Reduced (add_norm x y). + Proof. + unfold Reduced; intros. + rewrite strong_spec_red. + rewrite <- (Qred_complete [add x y]); + [ | rewrite spec_add, spec_add_norm; apply Qeq_refl ]. + rewrite <- strong_spec_red. + destruct x as [zx|nx dx]; destruct y as [zy|ny dy]. + simpl in *; auto. + simpl; intros. + destr_neq_bool; nzsimpl; simpl; auto. + simpl; intros. + destr_neq_bool; nzsimpl; simpl; auto. + simpl; intros. + destr_neq_bool; nzsimpl; simpl; auto. + Qed. + + Definition opp (x: t): t := + match x with + | Qz zx => Qz (Z.opp zx) + | Qq nx dx => Qq (Z.opp nx) dx + end. + + Theorem strong_spec_opp: forall q, [opp q] = -[q]. + Proof. + intros [z | x y]; simpl. + rewrite Z.spec_opp; auto. + match goal with |- context[N.eq_bool ?X ?Y] => + generalize (N.spec_eq_bool X Y); case N.eq_bool + end; auto; rewrite N.spec_0. + rewrite Z.spec_opp; auto. + Qed. + + Theorem spec_opp : forall q, [opp q] == -[q]. + Proof. + intros; rewrite strong_spec_opp; red; auto. + Qed. + + Theorem strong_spec_opp_norm : forall q, Reduced q -> Reduced (opp q). + Proof. + unfold Reduced; intros. + rewrite strong_spec_opp, <- H, !strong_spec_red, <- Qred_opp. + apply Qred_complete; apply spec_opp. + Qed. + + Definition sub x y := add x (opp y). + + Theorem spec_sub : forall x y, [sub x y] == [x] - [y]. + Proof. + intros x y; unfold sub; rewrite spec_add; auto. + rewrite spec_opp; ring. + Qed. + + Definition sub_norm x y := add_norm x (opp y). + + Theorem spec_sub_norm : forall x y, [sub_norm x y] == [x] - [y]. + Proof. + intros x y; unfold sub_norm; rewrite spec_add_norm; auto. + rewrite spec_opp; ring. + Qed. + + Theorem strong_spec_sub_norm : forall x y, + Reduced x -> Reduced y -> Reduced (sub_norm x y). + Proof. + intros. + unfold sub_norm. + apply strong_spec_add_norm; auto. + apply strong_spec_opp_norm; auto. + Qed. + + Definition mul (x y: t): t := + match x, y with + | Qz zx, Qz zy => Qz (Z.mul zx zy) + | Qz zx, Qq ny dy => Qq (Z.mul zx ny) dy + | Qq nx dx, Qz zy => Qq (Z.mul nx zy) dx + | Qq nx dx, Qq ny dy => Qq (Z.mul nx ny) (N.mul dx dy) + end. + + Theorem spec_mul : forall x y, [mul x y] == [x] * [y]. + Proof. + intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl; qsimpl. + rewrite Pmult_1_r, N_to_Z2P; auto. + destruct (Zmult_integral _ _ H1); intuition. + rewrite H0 in H1; elim H1; auto. + rewrite H0 in H1; elim H1; auto. + rewrite H in H1; nzsimpl; elim H1; auto. + rewrite Zpos_mult_morphism, 2 N_to_Z2P; auto. + rewrite (Z2P_correct (N.to_Z dx * N.to_Z dy)); auto. + apply Zmult_lt_0_compat. + generalize (N.spec_pos dx); omega. + generalize (N.spec_pos dy); omega. + Qed. + + Lemma norm_denum : forall n d, + [if N.eq_bool d N.one then Qz n else Qq n d] == [Qq n d]. + Proof. + intros; simpl; qsimpl. + rewrite H0 in H; discriminate. + rewrite N_to_Z2P, H0; auto with zarith. + Qed. + + Definition irred n d := + let gcd := N.gcd (Zabs_N n) d in + match N.compare gcd N.one with + | Gt => (Z.div n (Z_of_N gcd), N.div d gcd) + | _ => (n, d) + end. + + Lemma spec_irred : forall n d, exists g, + let (n',d') := irred n d in + (Z.to_Z n' * g = Z.to_Z n)%Z /\ (N.to_Z d' * g = N.to_Z d)%Z. + Proof. + intros. + unfold irred; nzsimpl; simpl. + destr_zcompare. + exists 1%Z; nzsimpl; auto. + exists 0%Z; nzsimpl. + assert (Zgcd (Z.to_Z n) (N.to_Z d) = 0%Z). + generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega. + clear H. + split. + symmetry; apply (Zgcd_inv_0_l _ _ H0). + symmetry; apply (Zgcd_inv_0_r _ _ H0). + exists (Zgcd (Z.to_Z n) (N.to_Z d)). + simpl. + split. + simpl_zdiv; nzsimpl. + destruct (Zgcd_is_gcd (Z.to_Z n) (N.to_Z d)). + rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith. + simpl_ndiv; nzsimpl. + destruct (Zgcd_is_gcd (Z.to_Z n) (N.to_Z d)). + rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith. + Qed. + + Lemma spec_irred_zero : forall n d, + (N.to_Z d = 0)%Z <-> (N.to_Z (snd (irred n d)) = 0)%Z. + Proof. + intros. + unfold irred. + split. + nzsimpl; intros. + destr_zcompare; auto. + simpl. + simpl_ndiv; nzsimpl. + rewrite H, Zdiv_0_l; auto. + nzsimpl; destr_zcompare; simpl; auto. + simpl_ndiv; nzsimpl. + intros. + generalize (N.spec_pos d); intros. + destruct (N.to_Z d); auto. + assert (0 < 0)%Z. + rewrite <- H0 at 2. + apply Zgcd_div_pos; auto with zarith. + compute; auto. + discriminate. + compute in H1; elim H1; auto. + Qed. + + Lemma strong_spec_irred : forall n d, + (N.to_Z d <> 0%Z) -> + let (n',d') := irred n d in Zgcd (Z.to_Z n') (N.to_Z d') = 1%Z. + Proof. + unfold irred; intros. + nzsimpl. + destr_zcompare; simpl; auto. + elim H. + apply (Zgcd_inv_0_r (Z.to_Z n)). + generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega. + + simpl_ndiv; simpl_zdiv; nzsimpl. + rewrite Zgcd_1_rel_prime. + apply Zis_gcd_rel_prime. + generalize (N.spec_pos d); romega. + generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega. + apply Zgcd_is_gcd; auto. + Qed. + + Definition mul_norm_Qz_Qq z n d := + if Z.eq_bool z Z.zero then zero + else + let gcd := N.gcd (Zabs_N z) d in + match N.compare gcd N.one with + | Gt => + let z := Z.div z (Z_of_N gcd) in + let d := N.div d gcd in + if N.eq_bool d N.one then Qz (Z.mul z n) else Qq (Z.mul z n) d + | _ => Qq (Z.mul z n) d + end. + + Definition mul_norm (x y: t): t := + match x, y with + | Qz zx, Qz zy => Qz (Z.mul zx zy) + | Qz zx, Qq ny dy => mul_norm_Qz_Qq zx ny dy + | Qq nx dx, Qz zy => mul_norm_Qz_Qq zy nx dx + | Qq nx dx, Qq ny dy => + let (nx, dy) := irred nx dy in + let (ny, dx) := irred ny dx in + let d := N.mul dx dy in + if N.eq_bool d N.one then Qz (Z.mul ny nx) else Qq (Z.mul ny nx) d + end. + + Lemma spec_mul_norm_Qz_Qq : forall z n d, + [mul_norm_Qz_Qq z n d] == [Qq (Z.mul z n) d]. + Proof. + intros z n d; unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. + destr_zeq_bool; intros Hz; nzsimpl. + qsimpl; rewrite Hz; auto. + assert (Hd := N.spec_pos d). + destruct Z_le_gt_dec. + qsimpl. + rewrite norm_denum. + qsimpl. + simpl_ndiv in *; nzsimpl. + rewrite (Zdiv_gcd_zero _ _ H0 H) in z0; discriminate. + simpl_ndiv in *; nzsimpl. + rewrite H, Zdiv_0_l in H0; elim H0; auto. + rewrite 2 N_to_Z2P; auto. + simpl_ndiv; simpl_zdiv; nzsimpl. + rewrite (Zmult_comm (Z.to_Z z)), <- 2 Zmult_assoc. + rewrite <- Zgcd_div_swap0; auto with zarith; ring. + Qed. + + Lemma strong_spec_mul_norm_Qz_Qq : forall z n d, + Reduced (Qq n d) -> Reduced (mul_norm_Qz_Qq z n d). + Proof. + unfold Reduced; intros z n d. + rewrite 2 strong_spec_red, 2 Qred_iff. + simpl; nzsimpl. + destr_neq_bool; intros Hd H; simpl in *; nzsimpl. + + unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. + destr_zeq_bool; intros Hz; simpl; nzsimpl; simpl; auto. + destruct Z_le_gt_dec. + simpl; nzsimpl. + destr_neq_bool; simpl; nzsimpl; auto. + intros H'; elim H'; auto. + destr_neq_bool; simpl; nzsimpl. + simpl_ndiv; nzsimpl; rewrite Hd, Zdiv_0_l; intros; discriminate. + intros _. + destr_neq_bool; simpl; nzsimpl; auto. + simpl_ndiv; nzsimpl; rewrite Hd, Zdiv_0_l; intro H'; elim H'; auto. + + rewrite N_to_Z2P in H; auto. + unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. + destr_zeq_bool; intros Hz; simpl; nzsimpl; simpl; auto. + destruct Z_le_gt_dec as [H'|H']. + simpl; nzsimpl. + destr_neq_bool; simpl; nzsimpl; auto. + intros. + rewrite N_to_Z2P; auto. + apply Zgcd_mult_rel_prime; auto. + generalize (Zgcd_inv_0_l (Z.to_Z z) (N.to_Z d)) + (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega. + destr_neq_bool; simpl; nzsimpl; auto. + simpl_ndiv; simpl_zdiv; nzsimpl. + intros. + destr_neq_bool; simpl; nzsimpl; auto. + simpl_ndiv in *; nzsimpl. + intros. + rewrite Z2P_correct. + apply Zgcd_mult_rel_prime. + rewrite Zgcd_1_rel_prime. + apply Zis_gcd_rel_prime. + generalize (N.spec_pos d); romega. + generalize (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega. + apply Zgcd_is_gcd. + destruct (Zgcd_is_gcd (Z.to_Z z) (N.to_Z d)) as [ (z0,Hz0) (d0,Hd0) Hzd]. + replace (N.to_Z d / Zgcd (Z.to_Z z) (N.to_Z d))%Z with d0. + rewrite Zgcd_1_rel_prime in *. + apply bezout_rel_prime. + destruct (rel_prime_bezout _ _ H) as [u v Huv]. + apply Bezout_intro with u (v*(Zgcd (Z.to_Z z) (N.to_Z d)))%Z. + rewrite <- Huv; rewrite Hd0 at 2; ring. + rewrite Hd0 at 1. + symmetry; apply Z_div_mult_full; auto with zarith. + apply Zgcd_div_pos. + generalize (N.spec_pos d); romega. + generalize (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega. + Qed. + + Theorem spec_mul_norm : forall x y, [mul_norm x y] == [x] * [y]. + Proof. + intros x y; rewrite <- spec_mul; auto. + unfold mul_norm, mul; destruct x; destruct y. + apply Qeq_refl. + apply spec_mul_norm_Qz_Qq. + rewrite spec_mul_norm_Qz_Qq; qsimpl; ring. + + rename t0 into nx, t3 into dy, t2 into ny, t1 into dx. + destruct (spec_irred nx dy) as (g & Hg). + destruct (spec_irred ny dx) as (g' & Hg'). + assert (Hz := spec_irred_zero nx dy). + assert (Hz':= spec_irred_zero ny dx). + destruct irred as (n1,d1); destruct irred as (n2,d2). + simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2']. + rewrite norm_denum. + qsimpl. + + elim H; destruct (Zmult_integral _ _ H0) as [Eq|Eq]. + rewrite <- Hz' in Eq; rewrite Eq; simpl; auto. + rewrite <- Hz in Eq; rewrite Eq; nzsimpl; auto. + + elim H0; destruct (Zmult_integral _ _ H) as [Eq|Eq]. + rewrite Hz' in Eq; rewrite Eq; simpl; auto. + rewrite Hz in Eq; rewrite Eq; nzsimpl; auto. + + rewrite 2 Z2P_correct. + rewrite <- Hg1, <- Hg2, <- Hg1', <- Hg2'; ring. + + assert (0 <= N.to_Z d2 * N.to_Z d1)%Z + by (apply Zmult_le_0_compat; apply N.spec_pos). + romega. + assert (0 <= N.to_Z dx * N.to_Z dy)%Z + by (apply Zmult_le_0_compat; apply N.spec_pos). + romega. + Qed. + + Theorem strong_spec_mul_norm : forall x y, + Reduced x -> Reduced y -> Reduced (mul_norm x y). + Proof. + unfold Reduced; intros. + rewrite strong_spec_red, Qred_iff. + destruct x as [zx|nx dx]; destruct y as [zy|ny dy]. + simpl in *; auto. + simpl. + rewrite <- Qred_iff, <- strong_spec_red, strong_spec_mul_norm_Qz_Qq; auto. + simpl. + rewrite <- Qred_iff, <- strong_spec_red, strong_spec_mul_norm_Qz_Qq; auto. + simpl. + destruct (spec_irred nx dy) as [g Hg]. + destruct (spec_irred ny dx) as [g' Hg']. + assert (Hz := spec_irred_zero nx dy). + assert (Hz':= spec_irred_zero ny dx). + assert (Hgc := strong_spec_irred nx dy). + assert (Hgc' := strong_spec_irred ny dx). + destruct irred as (n1,d1); destruct irred as (n2,d2). + simpl snd in *; destruct Hg as [Hg1 Hg2]; destruct Hg' as [Hg1' Hg2']. + destr_neq_bool; simpl; nzsimpl; intros. + apply Zis_gcd_gcd; auto with zarith; apply Zis_gcd_1. + destr_neq_bool; simpl; nzsimpl; intros. + auto. + + revert H H0. + rewrite 2 strong_spec_red, 2 Qred_iff; simpl. + destr_neq_bool; simpl; nzsimpl; intros. + rewrite Hz in H; rewrite H in H2; nzsimpl; elim H2; auto. + rewrite Hz' in H0; rewrite H0 in H2; nzsimpl; elim H2; auto. + rewrite Hz in H; rewrite H in H2; nzsimpl; elim H2; auto. + + rewrite N_to_Z2P in *; auto. + rewrite Z2P_correct. + + apply Zgcd_mult_rel_prime; rewrite Zgcd_sym; + apply Zgcd_mult_rel_prime; rewrite Zgcd_sym; auto. + + rewrite Zgcd_1_rel_prime in *. + apply bezout_rel_prime. + destruct (rel_prime_bezout _ _ H4) as [u v Huv]. + apply Bezout_intro with (u*g')%Z (v*g)%Z. + rewrite <- Huv, <- Hg1', <- Hg2. ring. + + rewrite Zgcd_1_rel_prime in *. + apply bezout_rel_prime. + destruct (rel_prime_bezout _ _ H3) as [u v Huv]. + apply Bezout_intro with (u*g)%Z (v*g')%Z. + rewrite <- Huv, <- Hg2', <- Hg1. ring. + + assert (0 <= N.to_Z d2 * N.to_Z d1)%Z. + apply Zmult_le_0_compat; apply N.spec_pos. + romega. + Qed. + + Definition inv (x: t): t := + match x with + | Qz z => + match Z.compare Z.zero z with + | Eq => zero + | Lt => Qq Z.one (Zabs_N z) + | Gt => Qq Z.minus_one (Zabs_N z) + end + | Qq n d => + match Z.compare Z.zero n with + | Eq => zero + | Lt => Qq (Z_of_N d) (Zabs_N n) + | Gt => Qq (Z.opp (Z_of_N d)) (Zabs_N n) + end + end. + + Theorem spec_inv : forall x, [inv x] == /[x]. + Proof. + destruct x as [ z | n d ]. + (* Qz z *) + simpl. + rewrite Zcompare_spec_alt; destr_zcompare. + (* 0 = z *) + rewrite <- H. + simpl; nzsimpl; compute; auto. + (* 0 < z *) + simpl. + destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ]. + set (z':=Z.to_Z z) in *; clearbody z'. + red; simpl. + rewrite Zabs_eq by romega. + rewrite Z2P_correct by auto. + unfold Qinv; simpl; destruct z'; simpl; auto; discriminate. + (* 0 > z *) + simpl. + destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ]. + set (z':=Z.to_Z z) in *; clearbody z'. + red; simpl. + rewrite Zabs_non_eq by romega. + rewrite Z2P_correct by romega. + unfold Qinv; simpl; destruct z'; simpl; auto; discriminate. + (* Qq n d *) + simpl. + rewrite Zcompare_spec_alt; destr_zcompare. + (* 0 = n *) + rewrite <- H. + simpl; nzsimpl. + destr_neq_bool; intros; compute; auto. + (* 0 < n *) + simpl. + destr_neq_bool; nzsimpl; intros. + intros; rewrite Zabs_eq in *; romega. + intros; rewrite Zabs_eq in *; romega. + clear H1. + rewrite H0. + compute; auto. + clear H1. + set (n':=Z.to_Z n) in *; clearbody n'. + rewrite Zabs_eq by romega. + red; simpl. + rewrite Z2P_correct by auto. + unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate. + rewrite Zpos_mult_morphism, N_to_Z2P; auto. + (* 0 > n *) + simpl. + destr_neq_bool; nzsimpl; intros. + intros; rewrite Zabs_non_eq in *; romega. + intros; rewrite Zabs_non_eq in *; romega. + clear H1. + red; nzsimpl; rewrite H0; compute; auto. + clear H1. + set (n':=Z.to_Z n) in *; clearbody n'. + red; simpl; nzsimpl. + rewrite Zabs_non_eq by romega. + rewrite Z2P_correct by romega. + unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate. + assert (T : forall x, Zneg x = Zopp (Zpos x)) by auto. + rewrite T, Zpos_mult_morphism, N_to_Z2P; auto; ring. + Qed. + + Definition inv_norm (x: t): t := + match x with + | Qz z => + match Z.compare Z.zero z with + | Eq => zero + | Lt => Qq Z.one (Zabs_N z) + | Gt => Qq Z.minus_one (Zabs_N z) + end + | Qq n d => + if N.eq_bool d N.zero then zero else + match Z.compare Z.zero n with + | Eq => zero + | Lt => + match Z.compare n Z.one with + | Gt => Qq (Z_of_N d) (Zabs_N n) + | _ => Qz (Z_of_N d) + end + | Gt => + match Z.compare n Z.minus_one with + | Lt => Qq (Z.opp (Z_of_N d)) (Zabs_N n) + | _ => Qz (Z.opp (Z_of_N d)) + end + end + end. + + Theorem spec_inv_norm : forall x, [inv_norm x] == /[x]. + Proof. + intros. + rewrite <- spec_inv. + destruct x as [ z | n d ]. + (* Qz z *) + simpl. + rewrite Zcompare_spec_alt; destr_zcompare; auto with qarith. + (* Qq n d *) + simpl; nzsimpl; destr_neq_bool. + destr_zcompare; simpl; auto with qarith. + destr_neq_bool; nzsimpl; auto with qarith. + intros _ Hd; rewrite Hd; auto with qarith. + destr_neq_bool; nzsimpl; auto with qarith. + intros _ Hd; rewrite Hd; auto with qarith. + (* 0 < n *) + destr_zcompare; auto with qarith. + destr_zcompare; nzsimpl; simpl; auto with qarith; intros. + destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ]. + rewrite H0; auto with qarith. + romega. + (* 0 > n *) + destr_zcompare; nzsimpl; simpl; auto with qarith. + destr_neq_bool; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ]. + rewrite H0; auto with qarith. + romega. + Qed. + + Theorem strong_spec_inv_norm : forall x, Reduced x -> Reduced (inv_norm x). + Proof. + unfold Reduced. + intros. + destruct x as [ z | n d ]. + (* Qz *) + simpl; nzsimpl. + rewrite strong_spec_red, Qred_iff. + destr_zcompare; simpl; nzsimpl; auto. + destr_neq_bool; nzsimpl; simpl; auto. + destr_neq_bool; nzsimpl; simpl; auto. + (* Qq n d *) + rewrite strong_spec_red, Qred_iff in H; revert H. + simpl; nzsimpl. + destr_neq_bool; nzsimpl; auto with qarith. + destr_zcompare; simpl; nzsimpl; auto; intros. + (* 0 < n *) + destr_zcompare; simpl; nzsimpl; auto. + destr_neq_bool; nzsimpl; simpl; auto. + rewrite Zabs_eq; romega. + intros _. + rewrite strong_spec_norm; simpl; nzsimpl. + destr_neq_bool; nzsimpl. + rewrite Zabs_eq; romega. + intros _. + rewrite Qred_iff. + simpl. + rewrite Zabs_eq; auto with zarith. + rewrite N_to_Z2P in *; auto. + rewrite Z2P_correct; auto with zarith. + rewrite Zgcd_sym; auto. + (* 0 > n *) + destr_neq_bool; nzsimpl; simpl; auto; intros. + destr_zcompare; simpl; nzsimpl; auto. + destr_neq_bool; nzsimpl. + rewrite Zabs_non_eq; romega. + intros _. + rewrite strong_spec_norm; simpl; nzsimpl. + destr_neq_bool; nzsimpl. + rewrite Zabs_non_eq; romega. + intros _. + rewrite Qred_iff. + simpl. + rewrite N_to_Z2P in *; auto. + rewrite Z2P_correct; auto with zarith. + intros. + rewrite Zgcd_sym, Zgcd_Zabs, Zgcd_sym. + apply Zis_gcd_gcd; auto with zarith. + apply Zis_gcd_minus. + rewrite Zopp_involutive, <- H1; apply Zgcd_is_gcd. + rewrite Zabs_non_eq; romega. + Qed. + + Definition div x y := mul x (inv y). + + Theorem spec_div x y: [div x y] == [x] / [y]. + Proof. + intros x y; unfold div; rewrite spec_mul; auto. + unfold Qdiv; apply Qmult_comp. + apply Qeq_refl. + apply spec_inv; auto. + Qed. + + Definition div_norm x y := mul_norm x (inv_norm y). + + Theorem spec_div_norm x y: [div_norm x y] == [x] / [y]. + Proof. + intros x y; unfold div_norm; rewrite spec_mul_norm; auto. + unfold Qdiv; apply Qmult_comp. + apply Qeq_refl. + apply spec_inv_norm; auto. + Qed. + + Theorem strong_spec_div_norm : forall x y, + Reduced x -> Reduced y -> Reduced (div_norm x y). + Proof. + intros; unfold div_norm. + apply strong_spec_mul_norm; auto. + apply strong_spec_inv_norm; auto. + Qed. + + Definition square (x: t): t := + match x with + | Qz zx => Qz (Z.square zx) + | Qq nx dx => Qq (Z.square nx) (N.square dx) + end. + + Theorem spec_square : forall x, [square x] == [x] ^ 2. + Proof. + destruct x as [ z | n d ]. + simpl; rewrite Z.spec_square; red; auto. + simpl. + destr_neq_bool; nzsimpl; intros. + apply Qeq_refl. + rewrite N.spec_square in *; nzsimpl. + contradict H; elim (Zmult_integral _ _ H0); auto. + rewrite N.spec_square in *; nzsimpl. + rewrite H in H0; simpl in H0; elim H0; auto. + assert (0 < N.to_Z d)%Z by (generalize (N.spec_pos d); romega). + clear H H0. + rewrite Z.spec_square, N.spec_square. + red; simpl. + rewrite Zpos_mult_morphism; rewrite !Z2P_correct; auto. + apply Zmult_lt_0_compat; auto. + Qed. + + Definition power_pos (x : t) p : t := + match x with + | Qz zx => Qz (Z.power_pos zx p) + | Qq nx dx => Qq (Z.power_pos nx p) (N.power_pos dx p) + end. + + Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p. + Proof. + intros [ z | n d ] p; unfold power_pos. + (* Qz *) + simpl. + rewrite Z.spec_power_pos. + rewrite Qpower_decomp. + red; simpl; f_equal. + rewrite Zpower_pos_1_l; auto. + (* Qq *) + simpl. + rewrite Z.spec_power_pos. + destr_neq_bool; nzsimpl; intros. + apply Qeq_sym; apply Qpower_positive_0. + rewrite N.spec_power_pos in *. + assert (0 < N.to_Z d ^ ' p)%Z. + apply Zpower_gt_0; auto with zarith. + generalize (N.spec_pos d); romega. + romega. + rewrite N.spec_power_pos, H in *. + rewrite Zpower_0_l in H0; [ elim H0; auto | discriminate ]. + rewrite Qpower_decomp. + red; simpl; do 3 f_equal. + rewrite Z2P_correct by (generalize (N.spec_pos d); romega). + rewrite N.spec_power_pos. auto. + Qed. + + Theorem strong_spec_power_pos : forall x p, + Reduced x -> Reduced (power_pos x p). + Proof. + destruct x as [z | n d]; simpl; intros. + red; simpl; auto. + red; simpl; intros. + rewrite strong_spec_norm; simpl. + destr_neq_bool; nzsimpl; intros. + simpl; auto. + rewrite Qred_iff. + revert H. + unfold Reduced; rewrite strong_spec_red, Qred_iff; simpl. + destr_neq_bool; nzsimpl; simpl; intros. + rewrite N.spec_power_pos in H0. + elim H0; rewrite H; rewrite Zpower_0_l; auto; discriminate. + rewrite N_to_Z2P in *; auto. + rewrite N.spec_power_pos, Z.spec_power_pos; auto. + rewrite Zgcd_1_rel_prime in *. + apply rel_prime_Zpower; auto with zarith. + Qed. + + Definition power (x : t) (z : Z) : t := + match z with + | Z0 => one + | Zpos p => power_pos x p + | Zneg p => inv (power_pos x p) + end. + + Theorem spec_power : forall x z, [power x z] == [x]^z. + Proof. + destruct z. + simpl; nzsimpl; red; auto. + apply spec_power_pos. + simpl. + rewrite spec_inv, spec_power_pos; apply Qeq_refl. + Qed. + + Definition power_norm (x : t) (z : Z) : t := + match z with + | Z0 => one + | Zpos p => power_pos x p + | Zneg p => inv_norm (power_pos x p) + end. + + Theorem spec_power_norm : forall x z, [power_norm x z] == [x]^z. + Proof. + destruct z. + simpl; nzsimpl; red; auto. + apply spec_power_pos. + simpl. + rewrite spec_inv_norm, spec_power_pos; apply Qeq_refl. + Qed. + + Theorem strong_spec_power_norm : forall x z, + Reduced x -> Reduced (power_norm x z). + Proof. + destruct z; simpl. + intros _; unfold Reduced; rewrite strong_spec_red. + unfold one. + simpl to_Q; nzsimpl; auto. + intros; apply strong_spec_power_pos; auto. + intros; apply strong_spec_inv_norm; apply strong_spec_power_pos; auto. + Qed. + + + (** Interaction with [Qcanon.Qc] *) + + Open Scope Qc_scope. + + Definition of_Qc q := of_Q (this q). + + Definition to_Qc q := !! [q]. + + Notation "[[ x ]]" := (to_Qc x). + + Theorem strong_spec_of_Qc : forall q, [of_Qc q] = q. + Proof. + intros (q,Hq); intros. + unfold of_Qc; rewrite strong_spec_of_Q; auto. + Qed. + + Lemma strong_spec_of_Qc_bis : forall q, Reduced (of_Qc q). + Proof. + intros; red; rewrite strong_spec_red, strong_spec_of_Qc. + destruct q; simpl; auto. + Qed. + + Theorem spec_of_Qc: forall q, [[of_Qc q]] = q. + Proof. + intros; apply Qc_decomp; simpl; intros. + rewrite strong_spec_of_Qc; auto. + Qed. + + Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. + Proof. + intros q; unfold Qcopp, to_Qc, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + rewrite spec_opp, <- Qred_opp, Qred_correct. + apply Qeq_refl. + Qed. + + Theorem spec_oppc_bis : forall q : Qc, [opp (of_Qc q)] = - q. + Proof. + intros. + rewrite <- strong_spec_opp_norm by apply strong_spec_of_Qc_bis. + rewrite strong_spec_red. + symmetry; apply (Qred_complete (-q)%Q). + rewrite spec_opp, strong_spec_of_Qc; auto with qarith. + Qed. + + Theorem spec_comparec: forall q1 q2, + compare q1 q2 = ([[q1]] ?= [[q2]]). + Proof. + unfold Qccompare, to_Qc. + intros q1 q2; rewrite spec_compare; simpl; auto. + apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. + Qed. + + Theorem spec_addc x y: + [[add x y]] = [[x]] + [[y]]. + Proof. + intros x y; unfold to_Qc. + apply trans_equal with (!! ([x] + [y])). + unfold Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete; apply spec_add; auto. + unfold Qcplus, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + apply Qplus_comp; apply Qeq_sym; apply Qred_correct. + Qed. + + Theorem spec_add_normc x y: + [[add_norm x y]] = [[x]] + [[y]]. + Proof. + intros x y; unfold to_Qc. + apply trans_equal with (!! ([x] + [y])). + unfold Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete; apply spec_add_norm; auto. + unfold Qcplus, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + apply Qplus_comp; apply Qeq_sym; apply Qred_correct. + Qed. + + Theorem spec_add_normc_bis : forall x y : Qc, + [add_norm (of_Qc x) (of_Qc y)] = x+y. + Proof. + intros. + rewrite <- strong_spec_add_norm by apply strong_spec_of_Qc_bis. + rewrite strong_spec_red. + symmetry; apply (Qred_complete (x+y)%Q). + rewrite spec_add_norm, ! strong_spec_of_Qc; auto with qarith. + Qed. + + Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. + Proof. + intros x y; unfold sub; rewrite spec_addc; auto. + rewrite spec_oppc; ring. + Qed. + + Theorem spec_sub_normc x y: + [[sub_norm x y]] = [[x]] - [[y]]. + Proof. + intros x y; unfold sub_norm; rewrite spec_add_normc; auto. + rewrite spec_oppc; ring. + Qed. + + Theorem spec_sub_normc_bis : forall x y : Qc, + [sub_norm (of_Qc x) (of_Qc y)] = x-y. + Proof. + intros. + rewrite <- strong_spec_sub_norm by apply strong_spec_of_Qc_bis. + rewrite strong_spec_red. + symmetry; apply (Qred_complete (x+(-y)%Qc)%Q). + rewrite spec_sub_norm, ! strong_spec_of_Qc. + unfold Qcopp, Q2Qc; rewrite Qred_correct; auto with qarith. + Qed. + + Theorem spec_mulc x y: + [[mul x y]] = [[x]] * [[y]]. + Proof. + intros x y; unfold to_Qc. + apply trans_equal with (!! ([x] * [y])). + unfold Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete; apply spec_mul; auto. + unfold Qcmult, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + apply Qmult_comp; apply Qeq_sym; apply Qred_correct. + Qed. + + Theorem spec_mul_normc x y: + [[mul_norm x y]] = [[x]] * [[y]]. + Proof. + intros x y; unfold to_Qc. + apply trans_equal with (!! ([x] * [y])). + unfold Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete; apply spec_mul_norm; auto. + unfold Qcmult, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + apply Qmult_comp; apply Qeq_sym; apply Qred_correct. + Qed. + + Theorem spec_mul_normc_bis : forall x y : Qc, + [mul_norm (of_Qc x) (of_Qc y)] = x*y. + Proof. + intros. + rewrite <- strong_spec_mul_norm by apply strong_spec_of_Qc_bis. + rewrite strong_spec_red. + symmetry; apply (Qred_complete (x*y)%Q). + rewrite spec_mul_norm, ! strong_spec_of_Qc; auto with qarith. + Qed. + + Theorem spec_invc x: + [[inv x]] = /[[x]]. + Proof. + intros x; unfold to_Qc. + apply trans_equal with (!! (/[x])). + unfold Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete; apply spec_inv; auto. + unfold Qcinv, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + apply Qinv_comp; apply Qeq_sym; apply Qred_correct. + Qed. + + Theorem spec_inv_normc x: + [[inv_norm x]] = /[[x]]. + Proof. + intros x; unfold to_Qc. + apply trans_equal with (!! (/[x])). + unfold Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete; apply spec_inv_norm; auto. + unfold Qcinv, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + apply Qinv_comp; apply Qeq_sym; apply Qred_correct. + Qed. + + Theorem spec_inv_normc_bis : forall x : Qc, + [inv_norm (of_Qc x)] = /x. + Proof. + intros. + rewrite <- strong_spec_inv_norm by apply strong_spec_of_Qc_bis. + rewrite strong_spec_red. + symmetry; apply (Qred_complete (/x)%Q). + rewrite spec_inv_norm, ! strong_spec_of_Qc; auto with qarith. + Qed. + + Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. + Proof. + intros x y; unfold div; rewrite spec_mulc; auto. + unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. + apply spec_invc; auto. + Qed. + + Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. + Proof. + intros x y; unfold div_norm; rewrite spec_mul_normc; auto. + unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. + apply spec_inv_normc; auto. + Qed. + + Theorem spec_div_normc_bis : forall x y : Qc, + [div_norm (of_Qc x) (of_Qc y)] = x/y. + Proof. + intros. + rewrite <- strong_spec_div_norm by apply strong_spec_of_Qc_bis. + rewrite strong_spec_red. + symmetry; apply (Qred_complete (x*(/y)%Qc)%Q). + rewrite spec_div_norm, ! strong_spec_of_Qc. + unfold Qcinv, Q2Qc; rewrite Qred_correct; auto with qarith. + Qed. + + Theorem spec_squarec x: [[square x]] = [[x]]^2. + Proof. + intros x; unfold to_Qc. + apply trans_equal with (!! ([x]^2)). + unfold Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete; apply spec_square; auto. + simpl Qcpower. + replace (!! [x] * 1) with (!![x]); try ring. + simpl. + unfold Qcmult, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + apply Qmult_comp; apply Qeq_sym; apply Qred_correct. + Qed. + + Theorem spec_power_posc x p: + [[power_pos x p]] = [[x]] ^ nat_of_P p. + Proof. + intros x p; unfold to_Qc. + apply trans_equal with (!! ([x]^Zpos p)). + unfold Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete; apply spec_power_pos; auto. + induction p using Pind. + simpl; ring. + rewrite nat_of_P_succ_morphism; simpl Qcpower. + rewrite <- IHp; clear IHp. + unfold Qcmult, Q2Qc. + apply Qc_decomp; intros _ _; unfold this. + apply Qred_complete. + setoid_replace ([x] ^ ' Psucc p)%Q with ([x] * [x] ^ ' p)%Q. + apply Qmult_comp; apply Qeq_sym; apply Qred_correct. + simpl. + rewrite Pplus_one_succ_l. + rewrite Qpower_plus_positive; simpl; apply Qeq_refl. + Qed. + +End Make. + diff --git a/theories/Numbers/Rational/BigQ/QMake_base.v b/theories/Numbers/Rational/BigQ/QMake_base.v deleted file mode 100644 index 547e74b7..00000000 --- a/theories/Numbers/Rational/BigQ/QMake_base.v +++ /dev/null @@ -1,34 +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 *) -(************************************************************************) -(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) -(************************************************************************) - -(* $Id: QMake_base.v 10964 2008-05-22 11:08:13Z letouzey $ *) - -(** * An implementation of rational numbers based on big integers *) - -Require Export BigN. -Require Export BigZ. - -(* Basic type for Q: a Z or a pair of a Z and an N *) - -Inductive q_type := - | Qz : BigZ.t -> q_type - | Qq : BigZ.t -> BigN.t -> q_type. - -Definition print_type x := - match x with - | Qz _ => Z - | _ => (Z*Z)%type - end. - -Definition print x := - match x return print_type x with - | Qz zx => BigZ.to_Z zx - | Qq nx dx => (BigZ.to_Z nx, BigN.to_Z dx) - end. diff --git a/theories/Numbers/Rational/BigQ/QbiMake.v b/theories/Numbers/Rational/BigQ/QbiMake.v deleted file mode 100644 index 699f383e..00000000 --- a/theories/Numbers/Rational/BigQ/QbiMake.v +++ /dev/null @@ -1,1066 +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 *) -(************************************************************************) -(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: QbiMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import BigNumPrelude. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Module Qbi. - - Import BinInt Zorder. - Open Local Scope Q_scope. - Open Local Scope Qc_scope. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/y. The pairs (x,0) and (0,y) are all - interpreted as 0. *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.of_N (Npos y)) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => if BigN.eq_bool y BigN.zero then 0%Q - else BigZ.to_Z x # Z2P (BigN.to_Z y) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_of_pos; intros HH; discriminate HH. - rewrite BigZ.spec_of_Z; simpl. - rewrite (BigN.spec_of_pos); auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigZ.spec_opp; auto. - Qed. - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => - if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero - else - match BigZ.cmp_sign zx ny with - | Lt => Lt - | Gt => Gt - | Eq => BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny - end - | Qq nx dx, Qz zy => - if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy - else - match BigZ.cmp_sign nx zy with - | Lt => Lt - | Gt => Gt - | Eq => BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx)) - end - | Qq nx dx, Qq ny dy => - match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with - | true, true => Eq - | true, false => BigZ.compare BigZ.zero ny - | false, true => BigZ.compare nx BigZ.zero - | false, false => - match BigZ.cmp_sign nx ny with - | Lt => Lt - | Gt => Gt - | Eq => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) - end - end - end. - - Theorem spec_compare: forall q1 q2, - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare, to_Q, Qnum, Qden. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto. - set (a := BigZ.to_Z z1); set (b := BigZ.to_Z x2); - set (c := BigN.to_Z y2); fold c in HH. - assert (F: (0 < c)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos y2)); fold c; auto. - intros H1; case HH; rewrite <- H1; auto. - rewrite Z2P_correct; auto with zarith. - generalize (BigZ.spec_cmp_sign z1 x2); case BigZ.cmp_sign; fold a b c. - intros _; generalize (BigZ.spec_compare (z1 * BigZ.Pos y2)%bigZ x2); - case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c; auto. - intros H1; rewrite H1; rewrite Zcompare_refl; auto. - intros (H1, H2); apply sym_equal; change (a * c < b)%Z. - apply Zlt_le_trans with (2 := H2). - change 0%Z with (0 * c)%Z. - apply Zmult_lt_compat_r; auto with zarith. - intros (H1, H2); apply sym_equal; change (a * c > b)%Z. - apply Zlt_gt. - apply Zlt_le_trans with (1 := H2). - change 0%Z with (0 * c)%Z. - apply Zmult_le_compat_r; auto with zarith. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero z2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto. - set (a := BigZ.to_Z z2); set (b := BigZ.to_Z x1); - set (c := BigN.to_Z y1); fold c in HH. - assert (F: (0 < c)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos y1)); fold c; auto. - intros H1; case HH; rewrite <- H1; auto. - rewrite Zmult_1_r; rewrite Z2P_correct; auto with zarith. - generalize (BigZ.spec_cmp_sign x1 z2); case BigZ.cmp_sign; fold a b c. - intros _; generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1)%bigZ); - case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c; auto. - intros H1; rewrite H1; rewrite Zcompare_refl; auto. - intros (H1, H2); apply sym_equal; change (b < a * c)%Z. - apply Zlt_le_trans with (1 := H1). - change 0%Z with (0 * c)%Z. - apply Zmult_le_compat_r; auto with zarith. - intros (H1, H2); apply sym_equal; change (b > a * c)%Z. - apply Zlt_gt. - apply Zlt_le_trans with (2 := H1). - change 0%Z with (0 * c)%Z. - apply Zmult_lt_compat_r; auto with zarith. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zcompare_refl; auto. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero x2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare; - auto; rewrite BigZ.spec_0. - intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - set (a := BigZ.to_Z x1); set (b := BigZ.to_Z x2); - set (c1 := BigN.to_Z y1); set (c2 := BigN.to_Z y2). - fold c1 in HH; fold c2 in HH1. - assert (F1: (0 < c1)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos y1)); fold c1; auto. - intros H1; case HH; rewrite <- H1; auto. - assert (F2: (0 < c2)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos y2)); fold c2; auto. - intros H1; case HH1; rewrite <- H1; auto. - repeat rewrite Z2P_correct; auto. - generalize (BigZ.spec_cmp_sign x1 x2); case BigZ.cmp_sign. - intros _; generalize (BigZ.spec_compare (x1 * BigZ.Pos y2)%bigZ - (x2 * BigZ.Pos y1)%bigZ); - case BigZ.compare; rewrite BigZ.spec_mul; simpl; fold a b c1 c2; auto. - rewrite BigZ.spec_mul; simpl; fold a b c1; intros HH2; rewrite HH2; - rewrite Zcompare_refl; auto. - rewrite BigZ.spec_mul; simpl; auto. - rewrite BigZ.spec_mul; simpl; auto. - fold a b; intros (H1, H2); apply sym_equal; change (a * c2 < b * c1)%Z. - apply Zlt_le_trans with 0%Z. - change 0%Z with (0 * c2)%Z. - apply Zmult_lt_compat_r; auto with zarith. - apply Zmult_le_0_compat; auto with zarith. - fold a b; intros (H1, H2); apply sym_equal; change (a * c2 > b * c1)%Z. - apply Zlt_gt; apply Zlt_le_trans with 0%Z. - change 0%Z with (0 * c1)%Z. - apply Zmult_lt_compat_r; auto with zarith. - apply Zmult_le_0_compat; auto with zarith. - Qed. - - - Definition do_norm_n n := - match n with - | BigN.N0 _ => false - | BigN.N1 _ => false - | BigN.N2 _ => false - | BigN.N3 _ => false - | BigN.N4 _ => false - | BigN.N5 _ => false - | BigN.N6 _ => false - | _ => true - end. - - Definition do_norm_z z := - match z with - | BigZ.Pos n => do_norm_n n - | BigZ.Neg n => do_norm_n n - end. - -(* Je pense que cette fonction normalise bien ... *) - Definition norm n d: t := - if andb (do_norm_z n) (do_norm_n d) then - let gcd := BigN.gcd (BigZ.to_N n) d in - match BigN.compare BigN.one gcd with - | Lt => - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - match BigN.compare d BigN.one with - | Gt => Qq n d - | Eq => Qz n - | Lt => zero - end - | Eq => Qq n d - | Gt => zero (* gcd = 0 => both numbers are 0 *) - end - else Qq n d. - - Theorem spec_norm: forall n q, - ([norm n q] == [Qq n q])%Q. - intros p q; unfold norm. - case do_norm_z; simpl andb. - 2: apply Qeq_refl. - case do_norm_n. - 2: apply Qeq_refl. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1. - apply Qeq_refl. - generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H2 HH. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl; - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - auto with zarith. - generalize H2; rewrite H3; - rewrite Zdiv_0_l; auto with zarith. - generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3. - rewrite spec_to_N. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl. - case H3. - generalize H1 H2 H3 HH; clear H1 H2 H3 HH. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 HH. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith. - case (Zle_lt_or_eq _ _ HH); auto with zarith. - intros HH1; rewrite <- HH1; ring. - generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith. - simpl. - assert (FF := BigN.spec_pos q). - rewrite Z2P_correct; auto with zarith. - rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith. - simpl; rewrite BigZ.spec_div; simpl. - rewrite BigN.spec_gcd; auto with zarith. - generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4 HH FF. - rewrite spec_to_N; fold a. - rewrite Zgcd_div_swap; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q))); - rewrite BigN.spec_gcd; auto with zarith. - intros; apply False_ind; auto with zarith. - intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2; simpl. - rewrite spec_to_N. - rewrite FF2; ring. - Qed. - - Definition add (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - if BigN.eq_bool dx dy then - let n := BigZ.add nx ny in - Qq n dx - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - Qq n d - end - end. - - - - Theorem spec_add x y: - ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r; red; simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - rewrite Zmult_1_r; rewrite Pmult_1_r. - apply Qeq_refl. - assert (F1:= BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - case HH2; auto. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH2; auto. - case HH1; auto. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH; auto. - rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r. - apply Qeq_refl. - simpl. - generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_mul; - rewrite BigN.spec_0; intros HH2. - (case (Zmult_integral _ _ HH2); intros HH3); - [case HH| case HH1]; auto. - generalize (BigN.spec_eq_bool dx dy); - case BigN.eq_bool; intros HH3. - rewrite <- HH3. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - red; simpl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH4. - case HH; auto. - simpl; rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl. - ring. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - red; simpl; rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_mul; - rewrite BigN.spec_0; intros H3; simpl. - absurd (0 < 0)%Z; auto with zarith. - rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl. - repeat rewrite Z2P_correct; auto with zarith. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: - [[add x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - if BigN.eq_bool dx dy then - let n := BigZ.add nx ny in - norm n dx - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - norm n d - end - end. - - Theorem spec_add_norm x y: - ([add_norm x y] == [x] + [y])%Q. - intros x y; rewrite <- spec_add; auto. - case x; case y; clear x y; unfold add_norm, add. - intros; apply Qeq_refl. - intros p1 n p2. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - simpl. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - apply Qeq_refl. - intros p1 p2 n. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - intros p1 q1 p2 q2. - generalize (BigN.spec_eq_bool q2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - generalize (BigN.spec_eq_bool q1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; intros HH3; - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; apply Qeq_refl. - Qed. - - Theorem spec_add_normc x y: - [[add_norm x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub x y := add x (opp y). - - Theorem spec_sub x y: - ([sub x y] == [x] - [y])%Q. - intros x y; unfold sub; rewrite spec_add; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. - intros x y; unfold sub; rewrite spec_addc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem spec_sub_norm x y: - ([sub_norm x y] == [x] - [y])%Q. - intros x y; unfold sub_norm; rewrite spec_add_norm; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_sub_normc x y: - [[sub_norm x y]] = [[x]] - [[y]]. - intros x y; unfold sub_norm; rewrite spec_add_normc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; rewrite Pmult_1_r. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; - intros HH1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - red; simpl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - red; simpl; ring. - case (Zmult_integral _ _ HH1); intros HH. - case HH2; auto. - case HH3; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - case HH1; rewrite HH2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - case HH1; rewrite HH3; ring. - rewrite BigZ.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - apply Qeq_refl. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dy); auto with zarith. - Qed. - - Theorem spec_mulc x y: - [[mul x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => mul (Qz ny) (norm zx dy) - | Qq nx dx, Qz zy => mul (Qz nx) (norm zy dx) - | Qq nx dx, Qq ny dy => mul (norm nx dy) (norm ny dx) - end. - - Theorem spec_mul_norm x y: - ([mul_norm x y] == [x] * [y])%Q. - intros x y; rewrite <- spec_mul; auto. - unfold mul_norm; case x; case y; clear x y. - intros; apply Qeq_refl. - intros p1 n p2. - repeat rewrite spec_mul. - match goal with |- ?Z == _ => - match Z with context id [norm ?X ?Y] => - let y := context id [Qq X Y] in - apply Qeq_trans with y; [repeat apply Qmult_comp; - repeat apply Qplus_comp; repeat apply Qeq_refl; - apply spec_norm | idtac] - end - end. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH; simpl; ring. - intros p1 p2 n. - repeat rewrite spec_mul. - match goal with |- ?Z == _ => - match Z with context id [norm ?X ?Y] => - let y := context id [Qq X Y] in - apply Qeq_trans with y; [repeat apply Qmult_comp; - repeat apply Qplus_comp; repeat apply Qeq_refl; - apply spec_norm | idtac] - end - end. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH; simpl; try ring. - rewrite Pmult_1_r; auto. - intros p1 n1 p2 n2. - repeat rewrite spec_mul. - repeat match goal with |- ?Z == _ => - match Z with context id [norm ?X ?Y] => - let y := context id [Qq X Y] in - apply Qeq_trans with y; [repeat apply Qmult_comp; - repeat apply Qplus_comp; repeat apply Qeq_refl; - apply spec_norm | idtac] - end - end. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; try ring. - repeat rewrite Zpos_mult_morphism; ring. - Qed. - - Theorem spec_mul_normc x y: - [[mul_norm x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => Qq BigZ.one n - | Qz (BigZ.Neg n) => Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n - end. - - - Theorem spec_inv x: - ([inv x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - Qed. - - Theorem spec_invc x: - [[inv x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition inv_norm (x: t): t := - match x with - | Qz (BigZ.Pos n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one n - | Qz (BigZ.Neg n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg d) n - end. - - Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q. - intros x; rewrite <- spec_inv; generalize x; clear x. - intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, inv; - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; try apply Qeq_refl; - red; simpl; - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; auto; - case H2; auto. - Qed. - - Theorem spec_inv_normc x: - [[inv_norm x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv_norm; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem spec_div x y: ([div x y] == [x] / [y])%Q. - intros x y; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. - intros x y; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q. - intros x y; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx) - end. - - - Theorem spec_square x: ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - simpl Qpower. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H1; rewrite H; auto. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H; case (Zmult_integral _ _ H1); auto. - simpl. - rewrite BigZ.spec_square. - rewrite Zpos_mult_morphism. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_squarec x: [[square x]] = [[x]]^2. - intros x; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square; auto. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition power_pos (x: t) p: t := - match x with - | Qz zx => Qz (BigZ.power_pos zx p) - | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p) - end. - - Theorem spec_power_pos x p: ([power_pos x p] == [x] ^ Zpos p)%Q. - Proof. - intros [x | nx dx] p; unfold power_pos. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z x) 1). - unfold Qeq; simpl. - rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Zmult_1_r. - intros H; rewrite H. - rewrite BigZ.spec_power_pos; simpl; ring. - simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_power_pos; intros H1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2. - elim p; simpl. - intros; red; simpl; auto. - intros p1 Hp1; rewrite <- Hp1; red; simpl; auto. - apply Qeq_refl. - case H2; generalize H1. - elim p; simpl. - intros p1 Hrec. - change (xI p1) with (1 + (xO p1))%positive. - rewrite Zpower_pos_is_exp; rewrite Zpower_pos_1_r. - intros HH; case (Zmult_integral _ _ HH); auto. - rewrite <- Pplus_diag. - rewrite Zpower_pos_is_exp. - intros HH1; case (Zmult_integral _ _ HH1); auto. - intros p1 Hrec. - rewrite <- Pplus_diag. - rewrite Zpower_pos_is_exp. - intros HH1; case (Zmult_integral _ _ HH1); auto. - rewrite Zpower_pos_1_r; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2. - case H1; rewrite H2; auto. - simpl; rewrite Zpower_pos_0_l; auto. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z). - unfold Zpower; apply Zpower_pos_pos; auto. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z nx) - (Z2P (BigN.to_Z dx))). - unfold Qeq; simpl. - repeat rewrite Z2P_correct; auto. - unfold Qeq; simpl; intros HH. - rewrite HH. - rewrite BigZ.spec_power_pos; simpl; ring. - Qed. - - Theorem spec_power_posc x p: - [[power_pos x p]] = [[x]] ^ nat_of_P p. - intros x p; unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_power_pos; auto. - pattern p; apply Pind; clear p. - simpl; ring. - intros p Hrec. - rewrite nat_of_P_succ_morphism; simpl Qcpower. - rewrite <- Hrec. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; - unfold this. - apply Qred_complete. - assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p). - simpl; case x; simpl; clear x Hrec. - intros x; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - intros nx dx. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - unfold Qpower_positive. - assert (tmp: forall p, pow_pos Qmult 0%Q p = 0%Q). - intros p1; elim p1; simpl; auto; clear p1. - intros p1 Hp1; rewrite Hp1; auto. - intros p1 Hp1; rewrite Hp1; auto. - repeat rewrite tmp; intros; red; simpl; auto. - intros H1. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - repeat rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - 2: apply Zpower_pos_pos; auto. - 2: apply Zpower_pos_pos; auto. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - rewrite F. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -End Qbi. diff --git a/theories/Numbers/Rational/BigQ/QifMake.v b/theories/Numbers/Rational/BigQ/QifMake.v deleted file mode 100644 index 1d8ecc94..00000000 --- a/theories/Numbers/Rational/BigQ/QifMake.v +++ /dev/null @@ -1,979 +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 *) -(************************************************************************) -(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: QifMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import BigNumPrelude. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Module Qif. - - Import BinInt. - Open Local Scope Q_scope. - Open Local Scope Qc_scope. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/y. The pairs (x,0) and (0,y) are all - interpreted as 0. *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.of_N (Npos y)) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => if BigN.eq_bool y BigN.zero then 0%Q - else BigZ.to_Z x # Z2P (BigN.to_Z y) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_of_pos; intros HH; discriminate HH. - rewrite BigZ.spec_of_Z; simpl. - rewrite (BigN.spec_of_pos); auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigZ.spec_opp; auto. - Qed. - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => - if BigN.eq_bool dy BigN.zero then BigZ.compare zx BigZ.zero - else BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny - | Qq nx dx, Qz zy => - if BigN.eq_bool dx BigN.zero then BigZ.compare BigZ.zero zy - else BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx)) - | Qq nx dx, Qq ny dy => - match BigN.eq_bool dx BigN.zero, BigN.eq_bool dy BigN.zero with - | true, true => Eq - | true, false => BigZ.compare BigZ.zero ny - | false, true => BigZ.compare nx BigZ.zero - | false, false => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) - end - end. - - Theorem spec_compare: forall q1 q2, - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare, to_Q, Qnum, Qden. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_1_r; generalize (BigZ.spec_compare z1 BigZ.zero); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite HH1; rewrite Zcompare_refl; auto. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero z2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH1; rewrite <- HH1; rewrite Zcompare_refl; auto. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zcompare_refl; auto. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare BigZ.zero x2); - case BigZ.compare; auto. - rewrite BigZ.spec_0; intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - rewrite Zmult_0_l; rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 BigZ.zero)%bigZ; case BigZ.compare; - auto; rewrite BigZ.spec_0. - intros HH2; rewrite <- HH2; rewrite Zcompare_refl; auto. - repeat rewrite Z2P_correct. - 2: generalize (BigN.spec_pos y1); auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (x1 * BigZ.Pos y2) - (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - Qed. - - Definition do_norm_n n := - match n with - | BigN.N0 _ => false - | BigN.N1 _ => false - | BigN.N2 _ => false - | BigN.N3 _ => false - | BigN.N4 _ => false - | BigN.N5 _ => false - | BigN.N6 _ => false - | _ => true - end. - - Definition do_norm_z z := - match z with - | BigZ.Pos n => do_norm_n n - | BigZ.Neg n => do_norm_n n - end. - -(* Je pense que cette fonction normalise bien ... *) - Definition norm n d: t := - if andb (do_norm_z n) (do_norm_n d) then - let gcd := BigN.gcd (BigZ.to_N n) d in - match BigN.compare BigN.one gcd with - | Lt => - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - match BigN.compare d BigN.one with - | Gt => Qq n d - | Eq => Qz n - | Lt => zero - end - | Eq => Qq n d - | Gt => zero (* gcd = 0 => both numbers are 0 *) - end - else Qq n d. - - Theorem spec_norm: forall n q, - ([norm n q] == [Qq n q])%Q. - intros p q; unfold norm. - case do_norm_z; simpl andb. - 2: apply Qeq_refl. - case do_norm_n. - 2: apply Qeq_refl. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_gcd; intros H1. - apply Qeq_refl. - generalize (BigN.spec_pos (q / BigN.gcd (BigZ.to_N p) q)%bigN). - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; auto; rewrite BigN.spec_1; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H2 HH. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl; - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - auto with zarith. - generalize H2; rewrite H3; - rewrite Zdiv_0_l; auto with zarith. - generalize H1 H2 H3 (BigN.spec_pos q); clear H1 H2 H3. - rewrite spec_to_N. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4; rewrite Z2P_correct; auto with zarith. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H3; simpl. - case H3. - generalize H1 H2 H3 HH; clear H1 H2 H3 HH. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 HH. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto with zarith. - case (Zle_lt_or_eq _ _ HH); auto with zarith. - intros HH1; rewrite <- HH1; ring. - generalize (Zgcd_is_gcd a b); intros HH1; inversion HH1; auto. - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith; intros H3. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H4. - case H3; rewrite H4; rewrite Zdiv_0_l; auto with zarith. - simpl. - assert (FF := BigN.spec_pos q). - rewrite Z2P_correct; auto with zarith. - rewrite <- BigN.spec_gcd; rewrite <- BigN.spec_div; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto with zarith. - simpl; rewrite BigZ.spec_div; simpl. - rewrite BigN.spec_gcd; auto with zarith. - generalize H1 H2 H3 H4 HH FF; clear H1 H2 H3 H4 HH FF. - set (a := (BigN.to_Z (BigZ.to_N p))). - set (b := (BigN.to_Z q)). - intros H1 H2 H3 H4 HH FF. - rewrite spec_to_N; fold a. - rewrite Zgcd_div_swap; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; - rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_gcd; auto with zarith. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.gcd (BigZ.to_N p) q))); - rewrite BigN.spec_gcd; auto with zarith. - intros; apply False_ind; auto with zarith. - intros HH2; assert (FF1 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - assert (FF2 := Zgcd_inv_0_l _ _ (sym_equal HH2)). - red; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H2; simpl. - rewrite spec_to_N. - rewrite FF2; ring. - Qed. - - - Definition add (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - Qq n d - end - end. - - - Theorem spec_add x y: - ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r; red; simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH; simpl; try ring. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; - rewrite BigN.spec_0; intros HH1; simpl; try ring. - case HH; auto. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl; auto. - rewrite Zmult_1_r; rewrite Pmult_1_r. - apply Qeq_refl. - assert (F1:= BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - case HH2; auto. - simpl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH2; auto. - case HH1; auto. - rewrite Zmult_1_r; apply Qeq_refl. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - simpl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - case HH; auto. - rewrite Zmult_1_r; rewrite Zplus_0_r; rewrite Pmult_1_r. - apply Qeq_refl. - simpl. - generalize (BigN.spec_eq_bool (dx * dy)%bigN BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_mul; - rewrite BigN.spec_0; intros HH2. - (case (Zmult_integral _ _ HH2); intros HH3); - [case HH| case HH1]; auto. - rewrite BigZ.spec_add; repeat rewrite BigZ.spec_mul; simpl. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - red; simpl; rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: - [[add x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x with - | Qz zx => - match y with - | Qz zy => Qz (BigZ.add zx zy) - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - end - | Qq nx dx => - if BigN.eq_bool dx BigN.zero then y - else match y with - | Qz zy => norm (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq ny dy => - if BigN.eq_bool dy BigN.zero then x - else - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - norm n d - end - end. - - Theorem spec_add_norm x y: - ([add_norm x y] == [x] + [y])%Q. - intros x y; rewrite <- spec_add; auto. - case x; case y; clear x y; unfold add_norm, add. - intros; apply Qeq_refl. - intros p1 n p2. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - simpl. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - apply Qeq_refl. - intros p1 p2 n. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - intros p1 q1 p2 q2. - generalize (BigN.spec_eq_bool q2 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH1. - apply Qeq_refl. - generalize (BigN.spec_eq_bool q1 BigN.zero); - case BigN.eq_bool; rewrite BigN.spec_0; intros HH2. - apply Qeq_refl. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - apply Qeq_refl. - Qed. - - Theorem spec_add_normc x y: - [[add_norm x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub x y := add x (opp y). - - - Theorem spec_sub x y: - ([sub x y] == [x] - [y])%Q. - intros x y; unfold sub; rewrite spec_add; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. - intros x y; unfold sub; rewrite spec_addc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem spec_sub_norm x y: - ([sub_norm x y] == [x] - [y])%Q. - intros x y; unfold sub_norm; rewrite spec_add_norm; auto. - rewrite spec_opp; ring. - Qed. - - Theorem spec_sub_normc x y: - [[sub_norm x y]] = [[x]] - [[y]]. - intros x y; unfold sub_norm; rewrite spec_add_normc; auto. - rewrite spec_oppc; ring. - Qed. - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => Qq (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - - Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH1. - red; simpl; ring. - rewrite BigZ.spec_mul; rewrite Pmult_1_r. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; rewrite BigN.spec_mul; - intros HH1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - red; simpl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - red; simpl; ring. - case (Zmult_integral _ _ HH1); intros HH. - case HH2; auto. - case HH3; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH2. - case HH1; rewrite HH2; ring. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros HH3. - case HH1; rewrite HH3; ring. - rewrite BigZ.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - apply Qeq_refl. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dy); auto with zarith. - Qed. - - Theorem spec_mulc x y: - [[mul x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => norm (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => norm (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => norm (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem spec_mul_norm x y: - ([mul_norm x y] == [x] * [y])%Q. - intros x y; rewrite <- spec_mul; auto. - unfold mul_norm, mul; case x; case y; clear x y. - intros; apply Qeq_refl. - intros p1 n p2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; apply Qeq_refl. - intros p1 p2 n. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; apply Qeq_refl. - intros p1 n1 p2 n2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; apply Qeq_refl. - Qed. - - Theorem spec_mul_normc x y: - [[mul_norm x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - - Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => Qq BigZ.one n - | Qz (BigZ.Neg n) => Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => Qq (BigZ.Neg d) n - end. - - Theorem spec_inv x: - ([inv x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv, Qinv; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - rewrite H1; apply Qeq_refl. - generalize H1 (BigN.spec_pos x); case (BigN.to_Z x); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl; auto. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - apply Qeq_refl. - rewrite H1; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H2; simpl; auto. - rewrite H2; red; simpl; auto. - generalize H1 (BigN.spec_pos nx); case (BigN.to_Z nx); simpl; - auto. - intros HH; case HH; auto. - intros; red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p _ HH; case HH; auto. - Qed. - - Theorem spec_invc x: - [[inv x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -Definition inv_norm (x: t): t := - match x with - | Qz (BigZ.Pos n) => - match BigN.compare n BigN.one with - Gt => Qq BigZ.one n - | _ => x - end - | Qz (BigZ.Neg n) => - match BigN.compare n BigN.one with - Gt => Qq BigZ.minus_one n - | _ => x - end - | Qq (BigZ.Pos n) d => - match BigN.compare n BigN.one with - Gt => Qq (BigZ.Pos d) n - | Eq => Qz (BigZ.Pos d) - | Lt => Qz (BigZ.zero) - end - | Qq (BigZ.Neg n) d => - match BigN.compare n BigN.one with - Gt => Qq (BigZ.Neg d) n - | Eq => Qz (BigZ.Neg d) - | Lt => Qz (BigZ.zero) - end - end. - - Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv_norm, Qinv. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H. - simpl; rewrite H; apply Qeq_refl. - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl. - generalize H; case BigN.to_Z. - intros _ HH; discriminate HH. - intros p; case p; auto. - intros p1 HH; discriminate HH. - intros p1 HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; discriminate HH. - intros HH; rewrite <- HH. - apply Qeq_refl. - generalize H; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1; intros HH; discriminate. - generalize H; case BigN.to_Z. - intros HH; discriminate HH. - intros; red; simpl; auto. - intros p HH; discriminate HH. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H. - simpl; rewrite H; apply Qeq_refl. - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); simpl. - generalize H; case BigN.to_Z. - intros _ HH; discriminate HH. - intros p; case p; auto. - intros p1 HH; discriminate HH. - intros p1 HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; discriminate HH. - intros HH; rewrite <- HH. - apply Qeq_refl. - generalize H; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - rewrite H1; intros HH; discriminate. - generalize H; case BigN.to_Z. - intros HH; discriminate HH. - intros; red; simpl; auto. - intros p HH; discriminate HH. - simpl Qnum. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; simpl. - case BigN.compare; red; simpl; auto. - rewrite H1; auto. - case BigN.eq_bool; auto. - simpl; rewrite H1; auto. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H2. - rewrite H2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - red; simpl. - rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx). - intros; apply Qeq_refl. - intros p; case p; clear p. - intros p HH; discriminate HH. - intros p HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - simpl; generalize H2; case (BigN.to_Z nx). - intros HH; discriminate HH. - intros p Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - rewrite H4 in H2; discriminate H2. - red; simpl. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - intros p HH; discriminate HH. - simpl Qnum. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1; simpl. - case BigN.compare; red; simpl; auto. - rewrite H1; auto. - case BigN.eq_bool; auto. - simpl; rewrite H1; auto. - match goal with |- context[BigN.compare ?X ?Y] => - generalize (BigN.spec_compare X Y); case BigN.compare - end; rewrite BigN.spec_1; intros H2. - rewrite H2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zmult_1_r; rewrite Pmult_1_r; rewrite Z2P_correct; auto. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - generalize H2 (BigN.spec_pos nx); case (BigN.to_Z nx). - intros; apply Qeq_refl. - intros p; case p; clear p. - intros p HH; discriminate HH. - intros p HH; discriminate HH. - intros HH; discriminate HH. - intros p _ HH; case HH; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H3. - case H1; auto. - simpl; generalize H2; case (BigN.to_Z nx). - intros HH; discriminate HH. - intros p Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H4. - rewrite H4 in H2; discriminate H2. - red; simpl. - assert (tmp: forall x, Zneg x = Zopp (Zpos x)); auto. - rewrite tmp. - rewrite Zpos_mult_morphism. - rewrite Z2P_correct; auto. - ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p HH; discriminate HH. - Qed. - - Theorem spec_inv_normc x: - [[inv_norm x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv_norm; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem spec_div x y: ([div x y] == [x] / [y])%Q. - intros x y; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. - intros x y; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q. - intros x y; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx) - end. - - Theorem spec_square x: ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - simpl Qpower. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; intros H. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H1; rewrite H; auto. - red; simpl. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_square; - intros H1. - case H; case (Zmult_integral _ _ H1); auto. - simpl. - rewrite BigZ.spec_square. - rewrite Zpos_mult_morphism. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_squarec x: [[square x]] = [[x]]^2. - intros x; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square; auto. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -End Qif. diff --git a/theories/Numbers/Rational/BigQ/QpMake.v b/theories/Numbers/Rational/BigQ/QpMake.v deleted file mode 100644 index ac3ca47a..00000000 --- a/theories/Numbers/Rational/BigQ/QpMake.v +++ /dev/null @@ -1,901 +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 *) -(************************************************************************) -(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: QpMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import BigNumPrelude. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Notation Nspec_lt := BigNAxiomsMod.NZOrdAxiomsMod.spec_lt. -Notation Nspec_le := BigNAxiomsMod.NZOrdAxiomsMod.spec_le. - -Module Qp. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/(y+1). *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - Definition d_to_Z d := BigZ.Pos (BigN.succ d). - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.pred (BigN.of_N (Npos y))) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => BigZ.to_Z x # Z2P (BigN.to_Z (BigN.succ y)) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - rewrite BigZ.spec_of_Z; auto. - rewrite BigN.spec_succ; simpl. simpl. - rewrite BigN.spec_pred; rewrite (BigN.spec_of_pos). - replace (Zpos y - 1 + 1)%Z with (Zpos y); auto; ring. - red; auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - rewrite BigZ.spec_opp; auto. - Qed. - - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => BigZ.compare (BigZ.mul zx (d_to_Z dy)) ny - | Qq nx dy, Qz zy => BigZ.compare nx (BigZ.mul zy (d_to_Z dy)) - | Qq nx dx, Qq ny dy => - BigZ.compare (BigZ.mul nx (d_to_Z dy)) (BigZ.mul ny (d_to_Z dx)) - end. - - Theorem spec_compare: forall q1 q2, - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; unfold Qcompare; simpl. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - rewrite BigN.spec_succ. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (z1 * d_to_Z y2) x2)%bigZ; case BigZ.compare; - intros H; rewrite <- H. - rewrite BigZ.spec_mul; unfold d_to_Z; simpl. - rewrite BigN.spec_succ. - rewrite Zcompare_refl; auto. - rewrite BigZ.spec_mul; unfold d_to_Z; simpl. - rewrite BigN.spec_succ; auto. - rewrite BigZ.spec_mul; unfold d_to_Z; simpl. - rewrite BigN.spec_succ; auto. - rewrite Zmult_1_r. - rewrite BigN.spec_succ. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - generalize (BigZ.spec_compare x1 (z2 * d_to_Z y1))%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; unfold d_to_Z; simpl; - rewrite BigN.spec_succ; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - repeat rewrite BigN.spec_succ; auto. - repeat rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (x1 * d_to_Z y2) - (x2 * d_to_Z y1))%bigZ; case BigZ.compare; - repeat rewrite BigZ.spec_mul; unfold d_to_Z; simpl; - repeat rewrite BigN.spec_succ; intros H; auto. - rewrite H; auto. - rewrite Zcompare_refl; auto. - Qed. - - - Theorem spec_comparec: forall q1 q2, - compare q1 q2 = ([[q1]] ?= [[q2]]). - unfold Qccompare, to_Qc. - intros q1 q2; rewrite spec_compare; simpl. - apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -(* Inv d > 0, Pour la forme normal unique on veut d > 1 *) - Definition norm n d: t := - if BigZ.eq_bool n BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N n) d in - if BigN.eq_bool gcd BigN.one then Qq n (BigN.pred d) - else - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - if BigN.eq_bool d BigN.one then Qz n - else Qq n (BigN.pred d). - - Theorem spec_norm: forall n q, - ((0 < BigN.to_Z q)%Z -> [norm n q] == [Qq n (BigN.pred q)])%Q. - intros p q; unfold norm; intros Hq. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto; rewrite BigZ.spec_0; intros H1. - red; simpl; rewrite H1; ring. - case (Zle_lt_or_eq _ _ Hp); clear Hp; intros Hp. - case (Zle_lt_or_eq _ _ - (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p)) (BigN.to_Z q))); intros H4. - 2: generalize Hq; rewrite (Zgcd_inv_0_r _ _ (sym_equal H4)); auto with zarith. - 2: red; simpl; auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1; intros H2. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1. - red; simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Zmult_1_r. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N; intros; rewrite Zgcd_div_swap; auto. - rewrite H; ring. - intros H3. - red; simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - assert (F: (0 < BigN.to_Z (q / BigN.gcd (BigZ.to_N p) q)%bigN)%Z). - rewrite BigN.spec_div; auto with zarith. - rewrite BigN.spec_gcd. - apply Zgcd_div_pos; auto. - rewrite BigN.spec_gcd; auto. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - rewrite Z2P_correct; auto. - rewrite Z2P_correct; auto. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite spec_to_N; apply Zgcd_div_swap; auto. - case H1; rewrite spec_to_N; rewrite <- Hp; ring. - Qed. - - Theorem spec_normc: forall n q, - (0 < BigN.to_Z q)%Z -> [[norm n q]] = [[Qq n (BigN.pred q)]]. - intros n q H; unfold to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_norm; auto. - Qed. - - Definition add (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.add zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.add (BigZ.mul zx (d_to_Z dy)) ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.add nx (BigZ.mul zy (d_to_Z dx))) dx - | Qq nx dx, Qq ny dy => - let dx' := BigN.succ dx in - let dy' := BigN.succ dy in - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy')) (BigZ.mul ny (BigZ.Pos dx')) in - let d := BigN.pred (BigN.mul dx' dy') in - Qq n d - end. - - Theorem spec_d_to_Z: forall dy, - (BigZ.to_Z (d_to_Z dy) = BigN.to_Z dy + 1)%Z. - intros dy; unfold d_to_Z; simpl. - rewrite BigN.spec_succ; auto. - Qed. - - Theorem spec_succ_pos: forall p, - (0 < BigN.to_Z (BigN.succ p))%Z. - intros p; rewrite BigN.spec_succ; - generalize (BigN.spec_pos p); auto with zarith. - Qed. - - Theorem spec_add x y: ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r. - simpl; rewrite Z2P_correct; rewrite BigN.spec_succ; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul. - rewrite spec_d_to_Z; apply Qeq_refl. - assert (F1:= BigN.spec_pos dx). - rewrite Zmult_1_r; rewrite Pmult_1_r. - simpl; rewrite Z2P_correct; rewrite BigN.spec_succ; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul. - rewrite spec_d_to_Z; apply Qeq_refl. - repeat rewrite BigN.spec_succ. - assert (Fx: (0 < BigN.to_Z dx + 1)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy + 1)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - repeat rewrite BigN.spec_pred. - rewrite BigZ.spec_add; repeat rewrite BigN.spec_mul; - repeat rewrite BigN.spec_succ. - assert (tmp: forall x, (x-1+1 = x)%Z); [intros; ring | rewrite tmp; clear tmp]. - repeat rewrite Z2P_correct; auto. - repeat rewrite BigZ.spec_mul; simpl. - repeat rewrite BigN.spec_succ. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto; apply Qeq_refl. - rewrite BigN.spec_mul; repeat rewrite BigN.spec_succ; auto with zarith. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: [[add x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.add zx zy) - | Qz zx, Qq ny dy => - let d := BigN.succ dy in - norm (BigZ.add (BigZ.mul zx (BigZ.Pos d)) ny) d - | Qq nx dx, Qz zy => - let d := BigN.succ dx in - norm (BigZ.add (BigZ.mul zy (BigZ.Pos d)) nx) d - | Qq nx dx, Qq ny dy => - let dx' := BigN.succ dx in - let dy' := BigN.succ dy in - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy')) (BigZ.mul ny (BigZ.Pos dx')) in - let d := BigN.mul dx' dy' in - norm n d - end. - - Theorem spec_add_norm x y: ([add_norm x y] == [x] + [y])%Q. - intros x y; rewrite <- spec_add. - unfold add_norm, add; case x; case y. - intros; apply Qeq_refl. - intros p1 n p2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X (BigN.pred Y)]); - [apply spec_norm | idtac] - end. - rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith. - simpl. - repeat rewrite BigZ.spec_add. - repeat rewrite BigZ.spec_mul; simpl. - rewrite BigN.succ_pred; try apply Qeq_refl; apply lt_0_succ. - intros p1 n p2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X (BigN.pred Y)]); - [apply spec_norm | idtac] - end. - rewrite BigN.spec_succ; generalize (BigN.spec_pos p2); auto with zarith. - simpl. - repeat rewrite BigZ.spec_add. - repeat rewrite BigZ.spec_mul; simpl. - rewrite BinInt.Zplus_comm. - rewrite BigN.succ_pred; try apply Qeq_refl; apply lt_0_succ. - intros p1 q1 p2 q2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X (BigN.pred Y)]); - [apply spec_norm | idtac] - end; try apply Qeq_refl. - rewrite BigN.spec_mul. - apply Zmult_lt_0_compat; apply spec_succ_pos. - Qed. - - Theorem spec_add_normc x y: [[add_norm x y]] = [[x]] + [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub (x y: t): t := add x (opp y). - - Theorem spec_sub x y: ([sub x y] == [x] - [y])%Q. - intros x y; unfold sub; rewrite spec_add. - rewrite spec_opp; ring. - Qed. - - Theorem spec_subc x y: [[sub x y]] = [[x]] - [[y]]. - intros x y; unfold sub; rewrite spec_addc. - rewrite spec_oppc; ring. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem spec_sub_norm x y: ([sub_norm x y] == [x] - [y])%Q. - intros x y; unfold sub_norm; rewrite spec_add_norm. - rewrite spec_opp; ring. - Qed. - - Theorem spec_sub_normc x y: [[sub_norm x y]] = [[x]] - [[y]]. - intros x y; unfold sub_norm; rewrite spec_add_normc. - rewrite spec_oppc; ring. - Qed. - - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => - Qq (BigZ.mul nx ny) (BigN.pred (BigN.mul (BigN.succ dx) (BigN.succ dy))) - end. - - Theorem spec_mul x y: ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - apply Qeq_refl; auto. - rewrite BigZ.spec_mul; apply Qeq_refl. - rewrite BigZ.spec_mul; rewrite Pmult_1_r; auto. - apply Qeq_refl; auto. - assert (F1:= spec_succ_pos dx). - assert (F2:= spec_succ_pos dy). - rewrite BigN.succ_pred. - rewrite BigN.spec_mul; rewrite BigZ.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto; apply Qeq_refl. - rewrite Nspec_lt, BigN.spec_0, BigN.spec_mul; auto. - apply Zmult_lt_0_compat; apply spec_succ_pos. - Qed. - - Theorem spec_mulc x y: [[mul x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => - if BigZ.eq_bool zx BigZ.zero then zero - else - let d := BigN.succ dy in - let gcd := BigN.gcd (BigZ.to_N zx) d in - if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zx ny) dy - else - let zx := BigZ.div zx (BigZ.Pos gcd) in - let d := BigN.div d gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny) - else Qq (BigZ.mul zx ny) (BigN.pred d) - | Qq nx dx, Qz zy => - if BigZ.eq_bool zy BigZ.zero then zero - else - let d := BigN.succ dx in - let gcd := BigN.gcd (BigZ.to_N zy) d in - if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zy nx) dx - else - let zy := BigZ.div zy (BigZ.Pos gcd) in - let d := BigN.div d gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx) - else Qq (BigZ.mul zy nx) (BigN.pred d) - | Qq nx dx, Qq ny dy => - norm (BigZ.mul nx ny) (BigN.mul (BigN.succ dx) (BigN.succ dy)) - end. - - Theorem spec_mul_norm x y: ([mul_norm x y] == [x] * [y])%Q. - intros x y; rewrite <- spec_mul. - unfold mul_norm, mul; case x; case y. - intros; apply Qeq_refl. - intros p1 n p2. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - rewrite BigZ.spec_mul; rewrite H; red; auto. - assert (F: (0 < BigN.to_Z (BigZ.to_N p2))%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - assert (F1: (0 < BigN.to_Z (BigN.succ n))%Z). - rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith. - assert (F2: (0 < Zgcd (BigN.to_Z (BigZ.to_N p2)) (BigN.to_Z (BigN.succ n)))%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p2)) - (BigN.to_Z (BigN.succ n)))); intros H3; auto. - generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - intros; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N. - rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite (spec_to_N p2). - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.succ n / - BigN.gcd (BigZ.to_N p2) - (BigN.succ n)))%bigN); intros F3. - rewrite BigN.succ_pred; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto; try ring. - rewrite Nspec_lt, BigN.spec_0; auto. - apply False_ind; generalize F1. - rewrite (Zdivide_Zdiv_eq - (Zgcd (BigN.to_Z (BigZ.to_N p2)) (BigN.to_Z (BigN.succ n))) - (BigN.to_Z (BigN.succ n))); auto. - generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - intros HH; rewrite <- HH; auto with zarith. - assert (FF:= Zgcd_is_gcd (BigN.to_Z (BigZ.to_N p2)) - (BigN.to_Z (BigN.succ n))); inversion FF; auto. - intros p1 p2 n. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - rewrite BigZ.spec_mul; rewrite H; red; simpl; ring. - assert (F: (0 < BigN.to_Z (BigZ.to_N p1))%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - assert (F1: (0 < BigN.to_Z (BigN.succ n))%Z). - rewrite BigN.spec_succ; generalize (BigN.spec_pos n); auto with zarith. - assert (F2: (0 < Zgcd (BigN.to_Z (BigZ.to_N p1)) (BigN.to_Z (BigN.succ n)))%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p1)) - (BigN.to_Z (BigN.succ n)))); intros H3; auto. - generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - intros; repeat rewrite BigZ.spec_mul; rewrite Zmult_comm; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N. - rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite (spec_to_N p1). - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (BigN.succ n / - BigN.gcd (BigZ.to_N p1) - (BigN.succ n)))%bigN); intros F3. - rewrite BigN.succ_pred; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto; try ring. - rewrite Nspec_lt, BigN.spec_0; auto. - apply False_ind; generalize F1. - rewrite (Zdivide_Zdiv_eq - (Zgcd (BigN.to_Z (BigZ.to_N p1)) (BigN.to_Z (BigN.succ n))) - (BigN.to_Z (BigN.succ n))); auto. - generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - intros HH; rewrite <- HH; auto with zarith. - assert (FF:= Zgcd_is_gcd (BigN.to_Z (BigZ.to_N p1)) - (BigN.to_Z (BigN.succ n))); inversion FF; auto. - intros p1 n1 p2 n2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X (BigN.pred Y)]); - [apply spec_norm | idtac] - end; try apply Qeq_refl. - rewrite BigN.spec_mul. - apply Zmult_lt_0_compat; rewrite BigN.spec_succ; - generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith. - Qed. - - Theorem spec_mul_normc x y: [[mul_norm x y]] = [[x]] * [[y]]. - intros x y; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one (BigN.pred n) - | Qz (BigZ.Neg n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one (BigN.pred n) - | Qq (BigZ.Pos n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos (BigN.succ d)) (BigN.pred n) - | Qq (BigZ.Neg n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg (BigN.succ d)) (BigN.pred n) - end. - - Theorem spec_inv x: ([inv x] == /[x])%Q. - intros [ [x | x] | [nx | nx] dx]; unfold inv. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - unfold to_Q; rewrite BigZ.spec_1. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - red; unfold Qinv; simpl. - generalize F; case BigN.to_Z; auto with zarith. - intros p Hp; discriminate Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - red; unfold Qinv; simpl. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - generalize F; case BigN.to_Z; simpl; auto with zarith. - intros p Hp; discriminate Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z nx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith. - red; unfold Qinv; simpl. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - rewrite BigN.spec_succ; rewrite Z2P_correct; auto with zarith. - generalize F; case BigN.to_Z; auto with zarith. - intros p Hp; discriminate Hp. - generalize (BigN.spec_pos dx); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z nx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith. - red; unfold Qinv; simpl. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - rewrite BigN.spec_succ; rewrite Z2P_correct; auto with zarith. - generalize F; case BigN.to_Z; auto with zarith. - simpl; intros. - match goal with |- (?X = Zneg ?Y)%Z => - replace (Zneg Y) with (-(Zpos Y))%Z; - try rewrite Z2P_correct; auto with zarith - end. - rewrite Zpos_mult_morphism; - rewrite Z2P_correct; auto with zarith; try ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p Hp; discriminate Hp. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_invc x: [[inv x]] = /[[x]]. - intros x; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -Definition inv_norm x := - match x with - | Qz (BigZ.Pos n) => - if BigN.eq_bool n BigN.zero then zero else - if BigN.eq_bool n BigN.one then x else Qq BigZ.one (BigN.pred n) - | Qz (BigZ.Neg n) => - if BigN.eq_bool n BigN.zero then zero else - if BigN.eq_bool n BigN.one then x else Qq BigZ.minus_one (BigN.pred n) - | Qq (BigZ.Pos n) d => let d := BigN.succ d in - if BigN.eq_bool n BigN.zero then zero else - if BigN.eq_bool n BigN.one then Qz (BigZ.Pos d) - else Qq (BigZ.Pos d) (BigN.pred n) - | Qq (BigZ.Neg n) d => let d := BigN.succ d in - if BigN.eq_bool n BigN.zero then zero else - if BigN.eq_bool n BigN.one then Qz (BigZ.Neg d) - else Qq (BigZ.Neg d) (BigN.pred n) - end. - - Theorem spec_inv_norm x: ([inv_norm x] == /[x])%Q. - intros x; rewrite <- spec_inv. - (case x; clear x); [intros [x | x] | intros nx dx]; - unfold inv_norm, inv. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - red; simpl. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - rewrite Z2P_correct; try rewrite H1; auto with zarith. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - red; simpl. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - rewrite Z2P_correct; try rewrite H1; auto with zarith. - apply Qeq_refl. - case nx; clear nx; intros nx. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - red; simpl. - rewrite BigN.succ_pred; try rewrite H1; auto with zarith. - rewrite Nspec_lt, BigN.spec_0, H1; auto with zarith. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; intros H1. - red; simpl. - rewrite BigN.succ_pred; try rewrite H1; auto with zarith. - rewrite Nspec_lt, BigN.spec_0, H1; auto with zarith. - apply Qeq_refl. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem spec_div x y: ([div x y] == [x] / [y])%Q. - intros x y; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_divc x y: [[div x y]] = [[x]] / [[y]]. - intros x y; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem spec_div_norm x y: ([div_norm x y] == [x] / [y])%Q. - intros x y; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - Qed. - - Theorem spec_div_normc x y: [[div_norm x y]] = [[x]] / [[y]]. - intros x y; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - Qed. - - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.pred (BigN.square (BigN.succ dx))) - end. - - Theorem spec_square x: ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - assert (F: (0 < BigN.to_Z (BigN.succ dx))%Z). - rewrite BigN.spec_succ; - case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith. - assert (F1 : (0 < BigN.to_Z (BigN.square (BigN.succ dx)))%Z). - rewrite BigN.spec_square; apply Zmult_lt_0_compat; - auto with zarith. - rewrite BigN.succ_pred by (rewrite Nspec_lt, BigN.spec_0; auto). - rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - repeat rewrite BigN.spec_succ; auto with zarith. - rewrite BigN.spec_square; auto with zarith. - repeat rewrite BigN.spec_succ; auto with zarith. - Qed. - - Theorem spec_squarec x: [[square x]] = [[x]]^2. - intros x; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition power_pos (x: t) p: t := - match x with - | Qz zx => Qz (BigZ.power_pos zx p) - | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.pred (BigN.power_pos (BigN.succ dx) p)) - end. - - - Theorem spec_power_pos x p: ([power_pos x p] == [x] ^ Zpos p)%Q. - Proof. - intros [x | nx dx] p; unfold power_pos. - unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z x) 1). - unfold Qeq; simpl. - rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Zmult_1_r. - intros H; rewrite H. - rewrite BigZ.spec_power_pos; simpl; ring. - assert (F1: (0 < BigN.to_Z (BigN.succ dx))%Z). - rewrite BigN.spec_succ; - generalize (BigN.spec_pos dx); auto with zarith. - assert (F2: (0 < BigN.to_Z (BigN.succ dx) ^ ' p)%Z). - unfold Zpower; apply Zpower_pos_pos; auto. - unfold power_pos; red; simpl. - rewrite BigN.succ_pred, BigN.spec_power_pos. - rewrite Z2P_correct; auto. - generalize (Qpower_decomp p (BigZ.to_Z nx) - (Z2P (BigN.to_Z (BigN.succ dx)))). - unfold Qeq; simpl. - repeat rewrite Z2P_correct; auto. - unfold Qeq; simpl; intros HH. - rewrite HH. - rewrite BigZ.spec_power_pos; simpl; ring. - rewrite Nspec_lt, BigN.spec_0, BigN.spec_power_pos; auto. - Qed. - - Theorem spec_power_posc x p: [[power_pos x p]] = [[x]] ^ nat_of_P p. - intros x p; unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_power_pos. - pattern p; apply Pind; clear p. - simpl; ring. - intros p Hrec. - rewrite nat_of_P_succ_morphism; simpl Qcpower. - rewrite <- Hrec. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; - unfold this. - apply Qred_complete. - assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p). - simpl; case x; simpl; clear x Hrec. - intros x; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - intros nx dx; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - assert (F1: (0 < BigN.to_Z (BigN.succ dx))%Z). - rewrite BigN.spec_succ; generalize (BigN.spec_pos dx); - auto with zarith. - repeat rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - 2: apply Zpower_pos_pos; auto. - 2: apply Zpower_pos_pos; auto. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - rewrite F. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - -End Qp. diff --git a/theories/Numbers/Rational/BigQ/QvMake.v b/theories/Numbers/Rational/BigQ/QvMake.v deleted file mode 100644 index 4523e241..00000000 --- a/theories/Numbers/Rational/BigQ/QvMake.v +++ /dev/null @@ -1,1151 +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 *) -(************************************************************************) -(* Benjamin Gregoire, Laurent Thery, INRIA, 2007 *) -(************************************************************************) - -(*i $Id: QvMake.v 11027 2008-06-01 13:28:59Z letouzey $ i*) - -Require Import Bool. -Require Import ZArith. -Require Import Znumtheory. -Require Import BigNumPrelude. -Require Import Arith. -Require Export BigN. -Require Export BigZ. -Require Import QArith. -Require Import Qcanon. -Require Import Qpower. -Require Import QMake_base. - -Module Qv. - - Import BinInt Zorder. - Open Local Scope Q_scope. - Open Local Scope Qc_scope. - - (** The notation of a rational number is either an integer x, - interpreted as itself or a pair (x,y) of an integer x and a naturel - number y interpreted as x/y. All functions maintain the invariant - that y is never zero. *) - - Definition t := q_type. - - Definition zero: t := Qz BigZ.zero. - Definition one: t := Qz BigZ.one. - Definition minus_one: t := Qz BigZ.minus_one. - - Definition of_Z x: t := Qz (BigZ.of_Z x). - - Definition wf x := - match x with - | Qz _ => True - | Qq n d => if BigN.eq_bool d BigN.zero then False else True - end. - - Definition of_Q q: t := - match q with x # y => - Qq (BigZ.of_Z x) (BigN.of_N (Npos y)) - end. - - Definition of_Qc q := of_Q (this q). - - Definition to_Q (q: t) := - match q with - Qz x => BigZ.to_Z x # 1 - |Qq x y => BigZ.to_Z x # Z2P (BigN.to_Z y) - end. - - Definition to_Qc q := !!(to_Q q). - - Notation "[[ x ]]" := (to_Qc x). - - Notation "[ x ]" := (to_Q x). - - Theorem spec_to_Q: forall q: Q, [of_Q q] = q. - intros (x,y); simpl. - rewrite BigZ.spec_of_Z; simpl. - rewrite (BigN.spec_of_pos); auto. - Qed. - - Theorem spec_to_Qc: forall q, [[of_Qc q]] = q. - intros (x, Hx); unfold of_Qc, to_Qc; simpl. - apply Qc_decomp; simpl. - intros; rewrite spec_to_Q; auto. - Qed. - - Definition opp (x: t): t := - match x with - | Qz zx => Qz (BigZ.opp zx) - | Qq nx dx => Qq (BigZ.opp nx) dx - end. - - Theorem wf_opp: forall x, wf x -> wf (opp x). - intros [zx | nx dx]; unfold opp, wf; auto. - Qed. - - Theorem spec_opp: forall q, ([opp q] = -[q])%Q. - intros [z | x y]; simpl. - rewrite BigZ.spec_opp; auto. - rewrite BigZ.spec_opp; auto. - Qed. - - Theorem spec_oppc: forall q, [[opp q]] = -[[q]]. - intros q; unfold Qcopp, to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - rewrite spec_opp. - rewrite <- Qred_opp. - rewrite Qred_involutive; auto. - Qed. - - (* Les fonctions doivent assurer que si leur arguments sont valides alors - le resultat est correct et valide (si c'est un Q) - *) - - Definition compare (x y: t) := - match x, y with - | Qz zx, Qz zy => BigZ.compare zx zy - | Qz zx, Qq ny dy => BigZ.compare (BigZ.mul zx (BigZ.Pos dy)) ny - | Qq nx dx, Qz zy => BigZ.compare nx (BigZ.mul zy (BigZ.Pos dx)) - | Qq nx dx, Qq ny dy => BigZ.compare (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) - end. - - Theorem spec_compare: forall q1 q2, wf q1 -> wf q2 -> - compare q1 q2 = ([q1] ?= [q2])%Q. - intros [z1 | x1 y1] [z2 | x2 y2]; - unfold Qcompare, compare, to_Q, Qnum, Qden, wf. - repeat rewrite Zmult_1_r. - generalize (BigZ.spec_compare z1 z2); case BigZ.compare; intros H; auto. - rewrite H; rewrite Zcompare_refl; auto. - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (z1 * BigZ.Pos y2) x2)%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - rewrite Z2P_correct; auto with zarith. - 2: generalize (BigN.spec_pos y1); auto with zarith. - rewrite Zmult_1_r. - generalize (BigZ.spec_compare x1 (z2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - generalize (BigN.spec_eq_bool y1 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH1. - generalize (BigN.spec_eq_bool y2 BigN.zero); - case BigN.eq_bool. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH2 _ _. - repeat rewrite Z2P_correct. - 2: generalize (BigN.spec_pos y1); auto with zarith. - 2: generalize (BigN.spec_pos y2); auto with zarith. - generalize (BigZ.spec_compare (x1 * BigZ.Pos y2) - (x2 * BigZ.Pos y1))%bigZ; case BigZ.compare; - repeat rewrite BigZ.spec_mul; simpl; intros H; apply sym_equal; auto. - rewrite H; rewrite Zcompare_refl; auto. - Qed. - - Theorem spec_comparec: forall q1 q2, wf q1 -> wf q2 -> - compare q1 q2 = ([[q1]] ?= [[q2]]). - unfold Qccompare, to_Qc. - intros q1 q2 Hq1 Hq2; rewrite spec_compare; simpl; auto. - apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition norm n d: t := - if BigZ.eq_bool n BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N n) d in - if BigN.eq_bool gcd BigN.one then Qq n d - else - let n := BigZ.div n (BigZ.Pos gcd) in - let d := BigN.div d gcd in - if BigN.eq_bool d BigN.one then Qz n - else Qq n d. - - Theorem wf_norm: forall n q, - (BigN.to_Z q <> 0)%Z -> wf (norm n q). - intros p q; unfold norm, wf; intros Hq. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto; rewrite BigZ.spec_0; intros H1. - simpl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - set (a := BigN.to_Z (BigZ.to_N p)). - set (b := (BigN.to_Z q)). - assert (F: (0 < Zgcd a b)%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto. - intros HH1; case Hq; apply (Zgcd_inv_0_r _ _ (sym_equal HH1)). - rewrite BigN.spec_div; rewrite BigN.spec_gcd; auto; fold a; fold b. - intros H; case Hq; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite H; auto with zarith. - assert (F1:= Zgcd_is_gcd a b); inversion F1; auto. - Qed. - - Theorem spec_norm: forall n q, - ((0 < BigN.to_Z q)%Z -> [norm n q] == [Qq n q])%Q. - intros p q; unfold norm; intros Hq. - assert (Hp := BigN.spec_pos (BigZ.to_N p)). - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto; rewrite BigZ.spec_0; intros H1. - red; simpl; rewrite H1; ring. - case (Zle_lt_or_eq _ _ Hp); clear Hp; intros Hp. - case (Zle_lt_or_eq _ _ - (Zgcd_is_pos (BigN.to_Z (BigZ.to_N p)) (BigN.to_Z q))); intros H4. - 2: generalize Hq; rewrite (Zgcd_inv_0_r _ _ (sym_equal H4)); auto with zarith. - 2: red; simpl; auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1; intros H2. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_1. - red; simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite Zmult_1_r. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N; intros; rewrite Zgcd_div_swap; auto. - rewrite H; ring. - intros H3. - red; simpl. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - assert (F: (0 < BigN.to_Z (q / BigN.gcd (BigZ.to_N p) q)%bigN)%Z). - rewrite BigN.spec_div; auto with zarith. - rewrite BigN.spec_gcd. - apply Zgcd_div_pos; auto. - rewrite BigN.spec_gcd; auto. - rewrite Z2P_correct; auto. - rewrite Z2P_correct; auto. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; auto with zarith. - rewrite spec_to_N; apply Zgcd_div_swap; auto. - case H1; rewrite spec_to_N; rewrite <- Hp; ring. - Qed. - - Theorem spec_normc: forall n q, - (0 < BigN.to_Z q)%Z -> [[norm n q]] = [[Qq n q]]. - intros n q H; unfold to_Qc, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_norm; auto. - Qed. - - Definition add (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.add zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.add nx (BigZ.mul zy (BigZ.Pos dx))) dx - | Qq nx dx, Qq ny dy => - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - Qq n d - end. - - Theorem wf_add: forall x y, wf x -> wf y -> wf (add x y). - intros [zx | nx dx] [zy | ny dy]; unfold add, wf; auto. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul. - intros H1 H2 H3. - case (Zmult_integral _ _ H1); auto with zarith. - Qed. - - Theorem spec_add x y: wf x -> wf y -> - ([add x y] == [x] + [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qplus; simpl. - rewrite BigZ.spec_add; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - assert (F1:= BigN.spec_pos dy). - rewrite Zmult_1_r. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul. - simpl; apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - assert (F1:= BigN.spec_pos dx). - rewrite Zmult_1_r; rewrite Pmult_1_r. - simpl; rewrite Z2P_correct; auto with zarith. - rewrite BigZ.spec_add; rewrite BigZ.spec_mul; simpl. - apply Qeq_refl. - generalize (BigN.spec_eq_bool dx BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH1. - generalize (BigN.spec_eq_bool dy BigN.zero); - case BigN.eq_bool. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH2 _ _. - assert (Fx: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (Fy: (0 < BigN.to_Z dy)%Z). - generalize (BigN.spec_pos dy); auto with zarith. - rewrite BigZ.spec_add; repeat rewrite BigN.spec_mul. - red; simpl. - rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - repeat rewrite BigZ.spec_mul; simpl; auto. - apply Zmult_lt_0_compat; auto. - Qed. - - Theorem spec_addc x y: wf x -> wf y -> - [[add x y]] = [[x]] + [[y]]. - intros x y H1 H2; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition add_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.add zx zy) - | Qz zx, Qq ny dy => - norm (BigZ.add (BigZ.mul zx (BigZ.Pos dy)) ny) dy - | Qq nx dx, Qz zy => - norm (BigZ.add (BigZ.mul zy (BigZ.Pos dx)) nx) dx - | Qq nx dx, Qq ny dy => - let n := BigZ.add (BigZ.mul nx (BigZ.Pos dy)) (BigZ.mul ny (BigZ.Pos dx)) in - let d := BigN.mul dx dy in - norm n d - end. - - Theorem wf_add_norm: forall x y, wf x -> wf y -> wf (add_norm x y). - intros [zx | nx dx] [zy | ny dy]; unfold add_norm; auto. - intros HH1 HH2; apply wf_norm. - generalize HH2; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros HH1 HH2; apply wf_norm. - generalize HH1; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros HH1 HH2; apply wf_norm. - rewrite BigN.spec_mul; intros HH3. - case (Zmult_integral _ _ HH3). - generalize HH1; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - generalize HH2; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - Qed. - - Theorem spec_add_norm x y: wf x -> wf y -> - ([add_norm x y] == [x] + [y])%Q. - intros x y H1 H2; rewrite <- spec_add; auto. - generalize H1 H2; unfold add_norm, add, wf; case x; case y; clear H1 H2. - intros; apply Qeq_refl. - intros p1 n p2 _. - generalize (BigN.spec_eq_bool n BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH _. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - generalize (BigN.spec_pos n); auto with zarith. - simpl. - repeat rewrite BigZ.spec_add. - repeat rewrite BigZ.spec_mul; simpl. - apply Qeq_refl. - intros p1 n p2. - generalize (BigN.spec_eq_bool p2 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH _ _. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end. - generalize (BigN.spec_pos p2); auto with zarith. - simpl. - repeat rewrite BigZ.spec_add. - repeat rewrite BigZ.spec_mul; simpl. - rewrite Zplus_comm. - apply Qeq_refl. - intros p1 q1 p2 q2. - generalize (BigN.spec_eq_bool q2 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH1 _. - generalize (BigN.spec_eq_bool q1 BigN.zero); - case BigN.eq_bool. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH2 _. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; try apply Qeq_refl. - rewrite BigN.spec_mul. - apply Zmult_lt_0_compat. - generalize (BigN.spec_pos q2); auto with zarith. - generalize (BigN.spec_pos q1); auto with zarith. - Qed. - - Theorem spec_add_normc x y: wf x -> wf y -> - [[add_norm x y]] = [[x]] + [[y]]. - intros x y Hx Hy; unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_add_norm; auto. - unfold Qcplus, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qplus_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition sub x y := add x (opp y). - - Theorem wf_sub x y: wf x -> wf y -> wf (sub x y). - intros x y Hx Hy; unfold sub; apply wf_add; auto. - apply wf_opp; auto. - Qed. - - Theorem spec_sub x y: wf x -> wf y -> - ([sub x y] == [x] - [y])%Q. - intros x y Hx Hy; unfold sub; rewrite spec_add; auto. - rewrite spec_opp; ring. - apply wf_opp; auto. - Qed. - - Theorem spec_subc x y: wf x -> wf y -> - [[sub x y]] = [[x]] - [[y]]. - intros x y Hx Hy; unfold sub; rewrite spec_addc; auto. - rewrite spec_oppc; ring. - apply wf_opp; auto. - Qed. - - Definition sub_norm x y := add_norm x (opp y). - - Theorem wf_sub_norm x y: wf x -> wf y -> wf (sub_norm x y). - intros x y Hx Hy; unfold sub_norm; apply wf_add_norm; auto. - apply wf_opp; auto. - Qed. - - Theorem spec_sub_norm x y: wf x -> wf y -> - ([sub_norm x y] == [x] - [y])%Q. - intros x y Hx Hy; unfold sub_norm; rewrite spec_add_norm; auto. - rewrite spec_opp; ring. - apply wf_opp; auto. - Qed. - - Theorem spec_sub_normc x y: wf x -> wf y -> - [[sub_norm x y]] = [[x]] - [[y]]. - intros x y Hx Hy; unfold sub_norm; rewrite spec_add_normc; auto. - rewrite spec_oppc; ring. - apply wf_opp; auto. - Qed. - - Definition mul (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => Qq (BigZ.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (BigZ.mul nx zy) dx - | Qq nx dx, Qq ny dy => - Qq (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem wf_mul: forall x y, wf x -> wf y -> wf (mul x y). - intros [zx | nx dx] [zy | ny dy]; unfold mul, wf; auto. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul. - intros H1 H2 H3. - case (Zmult_integral _ _ H1); auto with zarith. - Qed. - - Theorem spec_mul x y: wf x -> wf y -> ([mul x y] == [x] * [y])%Q. - intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl. - rewrite BigZ.spec_mul; repeat rewrite Zmult_1_r; auto. - intros; apply Qeq_refl; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ _ HH; case HH. - rewrite BigN.spec_0; intros HH1 _ _. - rewrite BigZ.spec_mul; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ HH; case HH. - rewrite BigN.spec_0; intros HH1 _ _. - rewrite BigZ.spec_mul; rewrite Pmult_1_r. - apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ HH; case HH. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ _ _ HH; case HH. - rewrite BigN.spec_0; intros H1 H2 _ _. - rewrite BigZ.spec_mul; rewrite BigN.spec_mul. - assert (tmp: - (forall a b, 0 < a -> 0 < b -> Z2P (a * b) = (Z2P a * Z2P b)%positive)%Z). - intros [|a|a] [|b|b]; simpl; auto; intros; apply False_ind; auto with zarith. - rewrite tmp; auto. - apply Qeq_refl. - generalize (BigN.spec_pos dx); auto with zarith. - generalize (BigN.spec_pos dy); auto with zarith. - Qed. - - Theorem spec_mulc x y: wf x -> wf y -> - [[mul x y]] = [[x]] * [[y]]. - intros x y Hx Hy; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition mul_norm (x y: t): t := - match x, y with - | Qz zx, Qz zy => Qz (BigZ.mul zx zy) - | Qz zx, Qq ny dy => - if BigZ.eq_bool zx BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N zx) dy in - if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zx ny) dy - else - let zx := BigZ.div zx (BigZ.Pos gcd) in - let d := BigN.div dy gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zx ny) - else Qq (BigZ.mul zx ny) d - | Qq nx dx, Qz zy => - if BigZ.eq_bool zy BigZ.zero then zero - else - let gcd := BigN.gcd (BigZ.to_N zy) dx in - if BigN.eq_bool gcd BigN.one then Qq (BigZ.mul zy nx) dx - else - let zy := BigZ.div zy (BigZ.Pos gcd) in - let d := BigN.div dx gcd in - if BigN.eq_bool d BigN.one then Qz (BigZ.mul zy nx) - else Qq (BigZ.mul zy nx) d - | Qq nx dx, Qq ny dy => norm (BigZ.mul nx ny) (BigN.mul dx dy) - end. - - Theorem wf_mul_norm: forall x y, wf x -> wf y -> wf (mul_norm x y). - intros [zx | nx dx] [zy | ny dy]; unfold mul_norm; auto. - intros HH1 HH2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_1; rewrite BigZ.spec_0. - intros H1 H2; unfold wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_0. - set (a := BigN.to_Z (BigZ.to_N zx)). - set (b := (BigN.to_Z dy)). - assert (F: (0 < Zgcd a b)%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto. - intros HH3; case H2; rewrite spec_to_N; fold a. - rewrite (Zgcd_inv_0_l _ _ (sym_equal HH3)); try ring. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto. - intros H. - generalize HH2; simpl wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_0; intros HH; case HH; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite H; auto with zarith. - assert (F1:= Zgcd_is_gcd a b); inversion F1; auto. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_1; rewrite BigN.spec_gcd. - intros HH1 H1 H2. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto. - rewrite BigN.spec_1; rewrite BigN.spec_gcd. - intros HH1 H1 H2. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; auto. - rewrite BigZ.spec_0. - intros HH2. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - set (a := BigN.to_Z (BigZ.to_N zy)). - set (b := (BigN.to_Z dx)). - assert (F: (0 < Zgcd a b)%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); auto. - intros HH3; case HH2; rewrite spec_to_N; fold a. - rewrite (Zgcd_inv_0_l _ _ (sym_equal HH3)); try ring. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto. - intros H; unfold wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_0. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a; fold b; auto. - intros HH; generalize H1; simpl wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - rewrite BigN.spec_0. - intros HH3; case HH3; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite HH; auto with zarith. - assert (F1:= Zgcd_is_gcd a b); inversion F1; auto. - intros HH1 HH2; apply wf_norm. - rewrite BigN.spec_mul; intros HH3. - case (Zmult_integral _ _ HH3). - generalize HH1; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - generalize HH2; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - Qed. - - Theorem spec_mul_norm x y: wf x -> wf y -> - ([mul_norm x y] == [x] * [y])%Q. - intros x y Hx Hy; rewrite <- spec_mul; auto. - unfold mul_norm, mul; generalize Hx Hy; case x; case y; clear Hx Hy. - intros; apply Qeq_refl. - intros p1 n p2 Hx Hy. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - rewrite BigZ.spec_mul; rewrite H; red; auto. - assert (F: (0 < BigN.to_Z (BigZ.to_N p2))%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p2))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - assert (F1: (0 < BigN.to_Z n)%Z). - generalize Hy; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto. - intros _ HH; case HH. - rewrite BigN.spec_0; generalize (BigN.spec_pos n); auto with zarith. - set (a := BigN.to_Z (BigZ.to_N p2)). - set (b := BigN.to_Z n). - assert (F2: (0 < Zgcd a b )%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); intros H3; auto. - generalize F; fold a; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; try rewrite BigN.spec_gcd; - fold a b; intros H1. - intros; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith; fold a b; intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N; fold a; fold b. - rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - intros H2; red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite Z2P_correct; auto with zarith. - rewrite (spec_to_N p2); fold a b. - rewrite Z2P_correct; auto with zarith. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p1)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto; try ring. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (n / - BigN.gcd (BigZ.to_N p2) - n))%bigN); - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - intros H3. - apply False_ind; generalize F1. - generalize Hy; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; auto with zarith. - intros HH; case HH; fold b. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite <- H3; ring. - assert (FF:= Zgcd_is_gcd a b); inversion FF; auto. - intros p1 p2 n Hx Hy. - match goal with |- context[BigZ.eq_bool ?X ?Y] => - generalize (BigZ.spec_eq_bool X Y); case BigZ.eq_bool - end; unfold zero, to_Q; repeat rewrite BigZ.spec_0; intros H. - rewrite BigZ.spec_mul; rewrite H; red; simpl; ring. - set (a := BigN.to_Z (BigZ.to_N p1)). - set (b := BigN.to_Z n). - assert (F: (0 < a)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos (BigZ.to_N p1))); auto. - intros H1; case H; rewrite spec_to_N; rewrite <- H1; ring. - assert (F1: (0 < b)%Z). - generalize Hx; unfold wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; auto with zarith. - generalize (BigN.spec_pos n); fold b; auto with zarith. - assert (F2: (0 < Zgcd a b)%Z). - case (Zle_lt_or_eq _ _ (Zgcd_is_pos a b)); intros H3; auto. - generalize F; rewrite (Zgcd_inv_0_l _ _ (sym_equal H3)); auto with zarith. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1; rewrite BigN.spec_gcd; fold a b; intros H1. - intros; repeat rewrite BigZ.spec_mul; rewrite Zmult_comm; apply Qeq_refl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_1. - rewrite BigN.spec_div; rewrite BigN.spec_gcd; - auto with zarith. - fold a b; intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite spec_to_N; fold a b. - rewrite Zmult_1_r; repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto with zarith. - rewrite H2; ring. - intros H2. - red; simpl. - repeat rewrite BigZ.spec_mul. - rewrite BigZ.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - rewrite Z2P_correct; auto with zarith. - rewrite (spec_to_N p1); fold a b. - case (Zle_lt_or_eq _ _ - (BigN.spec_pos (n / BigN.gcd (BigZ.to_N p1) n))%bigN); intros F3. - rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_div; simpl; rewrite BigN.spec_gcd; - fold a b; auto with zarith. - repeat rewrite <- Zmult_assoc. - rewrite (Zmult_comm (BigZ.to_Z p2)). - repeat rewrite Zmult_assoc. - rewrite Zgcd_div_swap; auto; try ring. - apply False_ind; generalize F1. - rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - generalize F3; rewrite BigN.spec_div; rewrite BigN.spec_gcd; fold a b; - auto with zarith. - intros HH; rewrite <- HH; auto with zarith. - assert (FF:= Zgcd_is_gcd a b); inversion FF; auto. - intros p1 n1 p2 n2 Hn1 Hn2. - match goal with |- [norm ?X ?Y] == _ => - apply Qeq_trans with ([Qq X Y]); - [apply spec_norm | idtac] - end; try apply Qeq_refl. - rewrite BigN.spec_mul. - apply Zmult_lt_0_compat. - generalize Hn1; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; auto with zarith. - generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith. - generalize Hn2; simpl. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; auto with zarith. - generalize (BigN.spec_pos n1) (BigN.spec_pos n2); auto with zarith. - Qed. - - Theorem spec_mul_normc x y: wf x -> wf y -> - [[mul_norm x y]] = [[x]] * [[y]]. - intros x y Hx Hy; unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_mul_norm; auto. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - Definition inv (x: t): t := - match x with - | Qz (BigZ.Pos n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.one n - | Qz (BigZ.Neg n) => - if BigN.eq_bool n BigN.zero then zero else Qq BigZ.minus_one n - | Qq (BigZ.Pos n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Pos d) n - | Qq (BigZ.Neg n) d => - if BigN.eq_bool n BigN.zero then zero else Qq (BigZ.Neg d) n - end. - - - Theorem wf_inv: forall x, wf x -> wf (inv x). - intros [ zx | nx dx]; unfold inv, wf; auto. - case zx; clear zx. - intros nx. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul. - intros nx. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0; rewrite BigN.spec_mul. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - intros _ HH; case HH. - intros H1 _. - case nx; clear nx. - intros nx. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; simpl; auto. - intros nx. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; simpl; auto. - Qed. - - Theorem spec_inv x: wf x -> - ([inv x] == /[x])%Q. - intros [ [x | x] _ | [nx | nx] dx]; unfold inv. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - unfold to_Q; rewrite BigZ.spec_1. - red; unfold Qinv; simpl. - generalize F; case BigN.to_Z; auto with zarith. - intros p Hp; discriminate Hp. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z x)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos x)); auto with zarith. - red; unfold Qinv; simpl. - generalize F; case BigN.to_Z; simpl; auto with zarith. - intros p Hp; discriminate Hp. - simpl wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - intros HH; case HH. - intros _. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z nx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith. - red; unfold Qinv; simpl. - rewrite Z2P_correct; auto with zarith. - generalize F; case BigN.to_Z; auto with zarith. - intros p Hp; discriminate Hp. - generalize (BigN.spec_pos dx); auto with zarith. - simpl wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H1. - intros HH; case HH. - intros _. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; rewrite BigN.spec_0; intros H. - unfold zero, to_Q; rewrite BigZ.spec_0. - unfold BigZ.to_Z; rewrite H; apply Qeq_refl. - assert (F: (0 < BigN.to_Z nx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos nx)); auto with zarith. - red; unfold Qinv; simpl. - rewrite Z2P_correct; auto with zarith. - generalize F; case BigN.to_Z; auto with zarith. - simpl; intros. - match goal with |- (?X = Zneg ?Y)%Z => - replace (Zneg Y) with (Zopp (Zpos Y)); - try rewrite Z2P_correct; auto with zarith - end. - rewrite Zpos_mult_morphism; - rewrite Z2P_correct; auto with zarith; try ring. - generalize (BigN.spec_pos dx); auto with zarith. - intros p Hp; discriminate Hp. - generalize (BigN.spec_pos dx); auto with zarith. - Qed. - - Theorem spec_invc x: wf x -> - [[inv x]] = /[[x]]. - intros x Hx; unfold to_Qc. - apply trans_equal with (!! (/[x])). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_inv; auto. - unfold Qcinv, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qinv_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition div x y := mul x (inv y). - - Theorem wf_div x y: wf x -> wf y -> wf (div x y). - intros x y Hx Hy; unfold div; apply wf_mul; auto. - apply wf_inv; auto. - Qed. - - Theorem spec_div x y: wf x -> wf y -> - ([div x y] == [x] / [y])%Q. - intros x y Hx Hy; unfold div; rewrite spec_mul; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - apply wf_inv; auto. - Qed. - - Theorem spec_divc x y: wf x -> wf y -> - [[div x y]] = [[x]] / [[y]]. - intros x y Hx Hy; unfold div; rewrite spec_mulc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - apply wf_inv; auto. - Qed. - - Definition div_norm x y := mul_norm x (inv y). - - Theorem wf_div_norm x y: wf x -> wf y -> wf (div_norm x y). - intros x y Hx Hy; unfold div_norm; apply wf_mul_norm; auto. - apply wf_inv; auto. - Qed. - - Theorem spec_div_norm x y: wf x -> wf y -> - ([div_norm x y] == [x] / [y])%Q. - intros x y Hx Hy; unfold div_norm; rewrite spec_mul_norm; auto. - unfold Qdiv; apply Qmult_comp. - apply Qeq_refl. - apply spec_inv; auto. - apply wf_inv; auto. - Qed. - - Theorem spec_div_normc x y: wf x -> wf y -> - [[div_norm x y]] = [[x]] / [[y]]. - intros x y Hx Hy; unfold div_norm; rewrite spec_mul_normc; auto. - unfold Qcdiv; apply f_equal2 with (f := Qcmult); auto. - apply spec_invc; auto. - apply wf_inv; auto. - Qed. - - Definition square (x: t): t := - match x with - | Qz zx => Qz (BigZ.square zx) - | Qq nx dx => Qq (BigZ.square nx) (BigN.square dx) - end. - - Theorem wf_square: forall x, wf x -> wf (square x). - intros [ zx | nx dx]; unfold square, wf; auto. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_square; intros H1 H2; case H2. - case (Zmult_integral _ _ H1); auto. - Qed. - - Theorem spec_square x: wf x -> ([square x] == [x] ^ 2)%Q. - intros [ x | nx dx]; unfold square. - intros _. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - unfold wf. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - intros _ HH; case HH. - intros H1 _. - red; simpl; rewrite BigZ.spec_square; auto with zarith. - assert (F: (0 < BigN.to_Z dx)%Z). - case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith. - assert (F1 : (0 < BigN.to_Z (BigN.square dx))%Z). - rewrite BigN.spec_square; apply Zmult_lt_0_compat; - auto with zarith. - rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto with zarith. - rewrite BigN.spec_square; auto with zarith. - Qed. - - Theorem spec_squarec x: wf x -> [[square x]] = [[x]]^2. - intros x Hx; unfold to_Qc. - apply trans_equal with (!! ([x]^2)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_square; auto. - simpl Qcpower. - replace (!! [x] * 1) with (!![x]); try ring. - simpl. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - - - Definition power_pos (x: t) p: t := - match x with - | Qz zx => Qz (BigZ.power_pos zx p) - | Qq nx dx => Qq (BigZ.power_pos nx p) (BigN.power_pos dx p) - end. - - Theorem wf_power_pos: forall x p, wf x -> wf (power_pos x p). - intros [ zx | nx dx] p; unfold power_pos, wf; auto. - repeat match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - rewrite BigN.spec_power_pos; simpl. - intros H1 H2 _. - case (Zle_lt_or_eq _ _ (BigN.spec_pos dx)); auto with zarith. - intros H3; generalize (Zpower_pos_pos _ p H3); auto with zarith. - Qed. - - Theorem spec_power_pos x p: wf x -> ([power_pos x p] == [x] ^ Zpos p)%Q. - Proof. - intros [x | nx dx] p; unfold power_pos. - intros _; unfold power_pos; red; simpl. - generalize (Qpower_decomp p (BigZ.to_Z x) 1). - unfold Qeq; simpl. - rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Zmult_1_r. - intros H; rewrite H. - rewrite BigZ.spec_power_pos; simpl; ring. - unfold wf. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - intros _ HH; case HH. - intros H1 _. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - assert (F2: (0 < BigN.to_Z dx ^ ' p)%Z). - unfold Zpower; apply Zpower_pos_pos; auto. - unfold power_pos; red; simpl. - rewrite Z2P_correct; rewrite BigN.spec_power_pos; auto. - generalize (Qpower_decomp p (BigZ.to_Z nx) - (Z2P (BigN.to_Z dx))). - unfold Qeq; simpl. - repeat rewrite Z2P_correct; auto. - unfold Qeq; simpl; intros HH. - rewrite HH. - rewrite BigZ.spec_power_pos; simpl; ring. - Qed. - - Theorem spec_power_posc x p: wf x -> - [[power_pos x p]] = [[x]] ^ nat_of_P p. - intros x p Hx; unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). - unfold Q2Qc. - apply Qc_decomp; intros _ _; unfold this. - apply Qred_complete; apply spec_power_pos; auto. - pattern p; apply Pind; clear p. - simpl; ring. - intros p Hrec. - rewrite nat_of_P_succ_morphism; simpl Qcpower. - rewrite <- Hrec. - unfold Qcmult, Q2Qc. - apply Qc_decomp; intros _ _; - unfold this. - apply Qred_complete. - assert (F: [x] ^ ' Psucc p == [x] * [x] ^ ' p). - simpl; generalize Hx; case x; simpl; clear x Hx Hrec. - intros x _; simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - intros nx dx. - match goal with |- context[BigN.eq_bool ?X ?Y] => - generalize (BigN.spec_eq_bool X Y); case BigN.eq_bool - end; auto; rewrite BigN.spec_0. - intros _ HH; case HH. - intros H1 _. - assert (F1: (0 < BigN.to_Z dx)%Z). - generalize (BigN.spec_pos dx); auto with zarith. - simpl; repeat rewrite Qpower_decomp; simpl. - red; simpl; repeat rewrite Zpower_pos_1_l; simpl Z2P. - rewrite Pplus_one_succ_l. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - repeat rewrite Zpos_mult_morphism. - repeat rewrite Z2P_correct; auto. - 2: apply Zpower_pos_pos; auto. - 2: apply Zpower_pos_pos; auto. - rewrite Zpower_pos_is_exp. - rewrite Zpower_pos_1_r; auto. - rewrite F. - apply Qmult_comp; apply Qeq_sym; apply Qred_correct. - Qed. - -End Qv. - diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v index a488c7c6..be9b2d4e 100644 --- a/theories/Numbers/Rational/SpecViaQ/QSig.v +++ b/theories/Numbers/Rational/SpecViaQ/QSig.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: QSig.v 11028 2008-06-01 17:34:19Z letouzey $ i*) +(*i $Id: QSig.v 11207 2008-07-04 16:50:32Z letouzey $ i*) Require Import QArith Qpower. @@ -40,14 +40,24 @@ Module Type QType. Parameter compare : t -> t -> comparison. - Parameter spec_compare: forall x y, compare x y = ([x] ?= [y]). + Parameter spec_compare : forall x y, compare x y = ([x] ?= [y]). Definition lt n m := compare n m = Lt. Definition le n m := compare n m <> Gt. Definition min n m := match compare n m with Gt => m | _ => n end. Definition max n m := match compare n m with Lt => m | _ => n end. - Parameter add : t -> t -> t. + Parameter eq_bool : t -> t -> bool. + + Parameter spec_eq_bool : forall x y, + if eq_bool x y then [x]==[y] else ~([x]==[y]). + + Parameter red : t -> t. + + Parameter spec_red : forall x, [red x] == [x]. + Parameter strong_spec_red : forall x, [red x] = Qred [x]. + + Parameter add : t -> t -> t. Parameter spec_add: forall x y, [add x y] == [x] + [y]. @@ -75,10 +85,13 @@ Module Type QType. Parameter spec_div: forall x y, [div x y] == [x] / [y]. - Parameter power_pos : t -> positive -> t. + Parameter power : t -> Z -> t. - Parameter spec_power_pos: forall x n, [power_pos x n] == [x] ^ Zpos n. + Parameter spec_power: forall x z, [power x z] == [x] ^ z. End QType. -(* TODO: add norm function and variants, add eq_bool, what about Qc ? *)
\ No newline at end of file +(** NB: several of the above functions come with [..._norm] variants + that expect reduced arguments and return reduced results. *) + +(** TODO : also speak of specifications via Qcanon ... *) diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v index d19f29c3..c776070a 100644 --- a/theories/Program/Equality.v +++ b/theories/Program/Equality.v @@ -7,7 +7,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Equality.v 11023 2008-05-30 11:08:39Z msozeau $ i*) +(*i $Id: Equality.v 11282 2008-07-28 11:51:53Z msozeau $ i*) (** Tactics related to (dependent) equality and proof irrelevance. *) @@ -82,7 +82,7 @@ Ltac simpl_uip := (** Simplify equalities appearing in the context and goal. *) -Ltac simpl_eq := simpl ; repeat (elim_eq_rect ; simpl) ; repeat (simpl_uip ; simpl). +Ltac simpl_eq := simpl ; unfold eq_rec_r, eq_rec ; repeat (elim_eq_rect ; simpl) ; repeat (simpl_uip ; simpl). (** Try to abstract a proof of equality, if no proof of the same equality is present in the context. *) @@ -235,30 +235,43 @@ Ltac simpl_depind := subst* ; autoinjections ; try discriminates ; and starts a dependent induction using this tactic. *) Ltac do_depind tac H := + generalize_eqs_vars H ; tac H ; repeat progress simpl_depind. + +(** A variant where generalized variables should be given by the user. *) + +Ltac do_depind' tac H := generalize_eqs H ; tac H ; repeat progress simpl_depind. (** Calls [destruct] on the generalized hypothesis, results should be similar to inversion. *) Tactic Notation "dependent" "destruction" ident(H) := - do_depind ltac:(fun H => destruct H ; intros) H ; subst*. + do_depind ltac:(fun hyp => destruct hyp ; intros) H ; subst*. Tactic Notation "dependent" "destruction" ident(H) "using" constr(c) := - do_depind ltac:(fun H => destruct H using c ; intros) H. + do_depind ltac:(fun hyp => destruct hyp using c ; intros) H. + +(** This tactic also generalizes the goal by the given variables before the induction. *) + +Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) := + do_depind' ltac:(fun hyp => revert l ; destruct hyp ; intros) H. + +Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := + do_depind' ltac:(fun hyp => revert l ; destruct hyp using c ; intros) H. (** Then we have wrappers for usual calls to induction. One can customize the induction tactic by writting another wrapper calling do_depind. *) Tactic Notation "dependent" "induction" ident(H) := - do_depind ltac:(fun H => induction H ; intros) H. + do_depind ltac:(fun hyp => induction hyp ; intros) H. Tactic Notation "dependent" "induction" ident(H) "using" constr(c) := - do_depind ltac:(fun H => induction H using c ; intros) H. + do_depind ltac:(fun hyp => induction hyp using c ; intros) H. (** This tactic also generalizes the goal by the given variables before the induction. *) Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) := - do_depind ltac:(fun H => generalize l ; clear l ; induction H ; intros) H. + do_depind' ltac:(fun hyp => generalize l ; clear l ; induction hyp ; intros) H. Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := - do_depind ltac:(fun H => generalize l ; clear l ; induction H using c ; intros) H. + do_depind' ltac:(fun hyp => generalize l ; clear l ; induction hyp using c ; intros) H. diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v index 41b170c9..bb5054b4 100644 --- a/theories/Program/Tactics.v +++ b/theories/Program/Tactics.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Tactics.v 11122 2008-06-13 14:18:44Z msozeau $ i*) +(*i $Id: Tactics.v 11282 2008-07-28 11:51:53Z msozeau $ i*) (** This module implements various tactics used to simplify the goals produced by Program, which are also generally useful. *) @@ -77,10 +77,10 @@ Ltac clear_dup := match goal with | [ H : ?X |- _ ] => match goal with - | [ H' : X |- _ ] => - match H' with - | H => fail 2 - | _ => clear H' || clear H + | [ H' : ?Y |- _ ] => + match H with + | H' => fail 2 + | _ => conv X Y ; (clear H' || clear H) end end end. @@ -158,14 +158,6 @@ Ltac autoinjection := let tac H := progress (inversion H ; subst ; clear_dups) ; clear H in match goal with | [ H : ?f ?a = ?f' ?a' |- _ ] => tac H - | [ H : ?f ?a ?b = ?f' ?a' ?b' |- _ ] => tac H - | [ H : ?f ?a ?b ?c = ?f' ?a' ?b' ?c' |- _ ] => tac H - | [ H : ?f ?a ?b ?c ?d= ?f' ?a' ?b' ?c' ?d' |- _ ] => tac H - | [ H : ?f ?a ?b ?c ?d ?e= ?f' ?a' ?b' ?c' ?d' ?e' |- _ ] => tac H - | [ H : ?f ?a ?b ?c ?d ?e ?g= ?f' ?a' ?b' ?c' ?d' ?e' ?g' |- _ ] => tac H - | [ H : ?f ?a ?b ?c ?d ?e ?g ?h= ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' |- _ ] => tac H - | [ H : ?f ?a ?b ?c ?d ?e ?g ?h ?i = ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' ?i' |- _ ] => tac H - | [ H : ?f ?a ?b ?c ?d ?e ?g ?h ?i ?j = ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' ?i' ?j' |- _ ] => tac H end. Ltac autoinjections := repeat autoinjection. @@ -222,7 +214,7 @@ Ltac refine_hyp c := end. (** The default simplification tactic used by Program is defined by [program_simpl], sometimes [auto] - is not enough, better rebind using [Obligations Tactic := tac] in this case, + is not enough, better rebind using [Obligation Tactic := tac] in this case, possibly using [program_simplify] to use standard goal-cleaning tactics. *) Ltac program_simplify := @@ -231,4 +223,4 @@ Ltac program_simplify := Ltac program_simpl := program_simplify ; auto. -Ltac obligations_tactic := program_simpl. +Ltac obligation_tactic := program_simpl. diff --git a/theories/Program/Utils.v b/theories/Program/Utils.v index 21eee0ca..fcd85f41 100644 --- a/theories/Program/Utils.v +++ b/theories/Program/Utils.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Utils.v 10919 2008-05-11 22:04:26Z msozeau $ i*) +(*i $Id: Utils.v 11309 2008-08-06 10:30:35Z herbelin $ i*) Require Export Coq.Program.Tactics. @@ -42,8 +42,8 @@ Notation dec := sumbool_of_bool. (** Hide proofs and generates obligations when put in a term. *) -Notation "'in_left'" := (@left _ _ _) : program_scope. -Notation "'in_right'" := (@right _ _ _) : program_scope. +Notation in_left := (@left _ _ _). +Notation in_right := (@right _ _ _). (** Extraction directives *) (* diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index 304fbf77..78cf2892 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -6,11 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: QArith_base.v 10765 2008-04-08 16:15:23Z msozeau $ i*) +(*i $Id: QArith_base.v 11301 2008-08-04 19:41:18Z herbelin $ i*) Require Export ZArith. Require Export ZArithRing. -Require Export Setoid. +Require Export Setoid Bool. (** * Definition of [Q] and basic properties *) @@ -28,24 +28,24 @@ Ltac simpl_mult := repeat rewrite Zpos_mult_morphism. Notation "a # b" := (Qmake a b) (at level 55, no associativity) : Q_scope. -Definition inject_Z (x : Z) := Qmake x 1. +Definition inject_Z (x : Z) := Qmake x 1. Arguments Scope inject_Z [Z_scope]. -Notation " 'QDen' p " := (Zpos (Qden p)) (at level 20, no associativity) : Q_scope. +Notation QDen p := (Zpos (Qden p)). Notation " 0 " := (0#1) : Q_scope. Notation " 1 " := (1#1) : Q_scope. Definition Qeq (p q : Q) := (Qnum p * QDen q)%Z = (Qnum q * QDen p)%Z. Definition Qle (x y : Q) := (Qnum x * QDen y <= Qnum y * QDen x)%Z. Definition Qlt (x y : Q) := (Qnum x * QDen y < Qnum y * QDen x)%Z. -Notation Qgt := (fun a b : Q => Qlt b a). -Notation Qge := (fun a b : Q => Qle b a). +Notation Qgt a b := (Qlt b a) (only parsing). +Notation Qge a b := (Qle b a) (only parsing). -Infix "==" := Qeq (at level 70, no associativity) : Q_scope. +Infix "==" := Qeq (at level 70, no associativity) : Q_scope. Infix "<" := Qlt : Q_scope. -Infix ">" := Qgt : Q_scope. Infix "<=" := Qle : Q_scope. -Infix ">=" := Qge : Q_scope. +Notation "x > y" := (Qlt y x)(only parsing) : Q_scope. +Notation "x >= y" := (Qle y x)(only parsing) : Q_scope. Notation "x <= y <= z" := (x<=y/\y<=z) : Q_scope. (** Another approach : using Qcompare for defining order relations. *) @@ -84,7 +84,7 @@ rewrite Zcompare_Gt_Lt_antisym; auto. rewrite Zcompare_Gt_Lt_antisym in H; auto. Qed. -Hint Unfold Qeq Qlt Qle: qarith. +Hint Unfold Qeq Qlt Qle : qarith. Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith. (** * Properties of equality. *) @@ -94,7 +94,7 @@ Proof. auto with qarith. Qed. -Theorem Qeq_sym : forall x y, x == y -> y == x. +Theorem Qeq_sym : forall x y, x == y -> y == x. Proof. auto with qarith. Qed. @@ -102,7 +102,7 @@ Qed. Theorem Qeq_trans : forall x y z, x == y -> y == z -> x == z. Proof. unfold Qeq in |- *; intros. -apply Zmult_reg_l with (QDen y). +apply Zmult_reg_l with (QDen y). auto with qarith. transitivity (Qnum x * QDen y * QDen z)%Z; try ring. rewrite H. @@ -117,6 +117,44 @@ Proof. intros; case (Z_eq_dec (Qnum x * QDen y) (Qnum y * QDen x)); auto. Defined. +Definition Qeq_bool x y := + (Zeq_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z. + +Definition Qle_bool x y := + (Zle_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z. + +Lemma Qeq_bool_iff : forall x y, Qeq_bool x y = true <-> x == y. +Proof. + unfold Qeq_bool, Qeq; intros. + symmetry; apply Zeq_is_eq_bool. +Qed. + +Lemma Qeq_bool_eq : forall x y, Qeq_bool x y = true -> x == y. +Proof. + intros; rewrite <- Qeq_bool_iff; auto. +Qed. + +Lemma Qeq_eq_bool : forall x y, x == y -> Qeq_bool x y = true. +Proof. + intros; rewrite Qeq_bool_iff; auto. +Qed. + +Lemma Qeq_bool_neq : forall x y, Qeq_bool x y = false -> ~ x == y. +Proof. + intros x y H; rewrite <- Qeq_bool_iff, H; discriminate. +Qed. + +Lemma Qle_bool_iff : forall x y, Qle_bool x y = true <-> x <= y. +Proof. + unfold Qle_bool, Qle; intros. + symmetry; apply Zle_is_le_bool. +Qed. + +Lemma Qle_bool_imp_le : forall x y, Qle_bool x y = true -> x <= y. +Proof. + intros; rewrite <- Qle_bool_iff; auto. +Qed. + (** We now consider [Q] seen as a setoid. *) Definition Q_Setoid : Setoid_Theory Q Qeq. @@ -130,7 +168,7 @@ Hint Resolve (Seq_refl Q Qeq Q_Setoid): qarith. Hint Resolve (Seq_sym Q Qeq Q_Setoid): qarith. Hint Resolve (Seq_trans Q Qeq Q_Setoid): qarith. -Theorem Qnot_eq_sym : forall x y, ~x == y -> ~y == x. +Theorem Qnot_eq_sym : forall x y, ~x == y -> ~y == x. Proof. auto with qarith. Qed. @@ -139,13 +177,13 @@ Hint Resolve Qnot_eq_sym : qarith. (** * Addition, multiplication and opposite *) -(** The addition, multiplication and opposite are defined +(** The addition, multiplication and opposite are defined in the straightforward way: *) Definition Qplus (x y : Q) := (Qnum x * QDen y + Qnum y * QDen x) # (Qden x * Qden y). -Definition Qmult (x y : Q) := (Qnum x * Qnum y) # (Qden x * Qden y). +Definition Qmult (x y : Q) := (Qnum x * Qnum y) # (Qden x * Qden y). Definition Qopp (x : Q) := (- Qnum x) # (Qden x). @@ -164,8 +202,8 @@ Infix "+" := Qplus : Q_scope. Notation "- x" := (Qopp x) : Q_scope. Infix "-" := Qminus : Q_scope. Infix "*" := Qmult : Q_scope. -Notation "/ x" := (Qinv x) : Q_scope. -Infix "/" := Qdiv : Q_scope. +Notation "/ x" := (Qinv x) : Q_scope. +Infix "/" := Qdiv : Q_scope. (** A light notation for [Zpos] *) @@ -181,7 +219,7 @@ Qed. (** * Setoid compatibility results *) -Add Morphism Qplus : Qplus_comp. +Add Morphism Qplus : Qplus_comp. Proof. unfold Qeq, Qplus; simpl. Open Scope Z_scope. @@ -208,7 +246,7 @@ Qed. Add Morphism Qminus : Qminus_comp. Proof. intros. - unfold Qminus. + unfold Qminus. rewrite H; rewrite H0; auto with qarith. Qed. @@ -232,11 +270,11 @@ Proof. Open Scope Z_scope. intros (p1, p2) (q1, q2); simpl. case p1; simpl. - intros. + intros. assert (q1 = 0). elim (Zmult_integral q1 ('p2)); auto with zarith. intros; discriminate. - subst; auto. + subst; auto. case q1; simpl; intros; try discriminate. rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto. case q1; simpl; intros; try discriminate. @@ -254,7 +292,7 @@ Add Morphism Qle with signature Qeq ==> Qeq ==> iff as Qle_comp. Proof. cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<=x3 -> x2<=x4). split; apply H; assumption || (apply Qeq_sym ; assumption). - + unfold Qeq, Qle; simpl. Open Scope Z_scope. intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *. @@ -289,14 +327,26 @@ Proof. replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring. rewrite <- H0. replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring. - replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. + replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. apply Zlt_gt. apply Zmult_gt_0_lt_compat_l; auto with zarith. Close Scope Z_scope. Qed. +Add Morphism Qeq_bool with signature Qeq ==> Qeq ==> (@eq bool) as Qeqb_comp. +Proof. + intros; apply eq_true_iff_eq. + rewrite 2 Qeq_bool_iff, H, H0; split; auto with qarith. +Qed. + +Add Morphism Qle_bool with signature Qeq ==> Qeq ==> (@eq bool) as Qleb_comp. +Proof. + intros; apply eq_true_iff_eq. + rewrite 2 Qle_bool_iff, H, H0. + split; auto with qarith. +Qed. -Lemma Qcompare_egal_dec: forall n m p q : Q, +Lemma Qcompare_egal_dec: forall n m p q : Q, (n<m -> p<q) -> (n==m -> p==q) -> (n>m -> p>q) -> ((n?=m) = (p?=q)). Proof. intros. @@ -306,7 +356,6 @@ Proof. omega. Qed. - Add Morphism Qcompare : Qcompare_comp. Proof. intros; apply Qcompare_egal_dec; rewrite H; rewrite H0; auto. @@ -341,7 +390,7 @@ Lemma Qplus_0_r : forall x, x+0 == x. Proof. intros (x1, x2); unfold Qeq, Qplus; simpl. rewrite Pmult_comm; simpl; ring. -Qed. +Qed. (** Commutativity of addition: *) @@ -374,6 +423,18 @@ Proof. intros; red; simpl; rewrite Pmult_assoc; ring. Qed. +(** multiplication and zero *) + +Lemma Qmult_0_l : forall x , 0*x == 0. +Proof. + intros; compute; reflexivity. +Qed. + +Lemma Qmult_0_r : forall x , x*0 == 0. +Proof. + intros; red; simpl; ring. +Qed. + (** [1] is a neutral element for multiplication: *) Lemma Qmult_1_l : forall n, 1*n == n. @@ -385,7 +446,7 @@ Theorem Qmult_1_r : forall n, n*1==n. Proof. intro; red; simpl. rewrite Zmult_1_r with (n := Qnum n). - rewrite Pmult_comm; simpl; trivial. + rewrite Pmult_comm; simpl; trivial. Qed. (** Commutativity of multiplication *) @@ -427,7 +488,7 @@ Proof. rewrite <- H0; ring. Qed. -(** * Inverse and division. *) +(** * Inverse and division. *) Lemma Qinv_involutive : forall q, (/ / q) == q. Proof. @@ -438,13 +499,13 @@ Theorem Qmult_inv_r : forall x, ~ x == 0 -> x*(/x) == 1. Proof. intros (x1, x2); unfold Qeq, Qdiv, Qmult; case x1; simpl; intros; simpl_mult; try ring. - elim H; auto. + elim H; auto. Qed. Lemma Qinv_mult_distr : forall p q, / (p * q) == /p * /q. Proof. intros (x1,x2) (y1,y2); unfold Qeq, Qinv, Qmult; simpl. - destruct x1; simpl; auto; + destruct x1; simpl; auto; destruct y1; simpl; auto. Qed. @@ -485,10 +546,10 @@ Proof. red; trivial. apply Zle_trans with (y1 * 'x2 * 'z2). replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. - apply Zmult_le_compat_r; auto with zarith. + apply Zmult_le_compat_r; auto with zarith. replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. - apply Zmult_le_compat_r; auto with zarith. + apply Zmult_le_compat_r; auto with zarith. Close Scope Z_scope. Qed. @@ -516,9 +577,9 @@ Proof. apply Zgt_le_trans with (y1 * 'x2 * 'z2). replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. - apply Zmult_gt_compat_r; auto with zarith. + apply Zmult_gt_compat_r; auto with zarith. replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. - apply Zmult_le_compat_r; auto with zarith. + apply Zmult_le_compat_r; auto with zarith. Close Scope Z_scope. Qed. @@ -532,9 +593,9 @@ Proof. apply Zle_gt_trans with (y1 * 'x2 * 'z2). replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. - apply Zmult_le_compat_r; auto with zarith. + apply Zmult_le_compat_r; auto with zarith. replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. - apply Zmult_gt_compat_r; auto with zarith. + apply Zmult_gt_compat_r; auto with zarith. Close Scope Z_scope. Qed. @@ -572,7 +633,7 @@ Proof. unfold Qle, Qlt, Qeq; intros; apply Zle_lt_or_eq; auto. Qed. -Hint Resolve Qle_not_lt Qlt_not_le Qnot_le_lt Qnot_lt_le +Hint Resolve Qle_not_lt Qlt_not_le Qnot_le_lt Qnot_lt_le Qlt_le_weak Qlt_not_eq Qle_antisym Qle_refl: qartih. (** Some decidability results about orders. *) @@ -679,7 +740,7 @@ Proof. intros [[|n|n] d] Ha; assumption. Qed. -Lemma Qle_shift_div_l : forall a b c, +Lemma Qle_shift_div_l : forall a b c, 0 < c -> a*c <= b -> a <= b/c. Proof. intros a b c Hc H. @@ -690,7 +751,7 @@ rewrite Qmult_div_r; try assumption. auto with *. Qed. -Lemma Qle_shift_inv_l : forall a c, +Lemma Qle_shift_inv_l : forall a c, 0 < c -> a*c <= 1 -> a <= /c. Proof. intros a c Hc H. @@ -699,7 +760,7 @@ change (a <= 1/c). apply Qle_shift_div_l; assumption. Qed. -Lemma Qle_shift_div_r : forall a b c, +Lemma Qle_shift_div_r : forall a b c, 0 < b -> a <= c*b -> a/b <= c. Proof. intros a b c Hc H. @@ -710,7 +771,7 @@ rewrite Qmult_div_r; try assumption. auto with *. Qed. -Lemma Qle_shift_inv_r : forall b c, +Lemma Qle_shift_inv_r : forall b c, 0 < b -> 1 <= c*b -> /b <= c. Proof. intros b c Hc H. @@ -772,7 +833,7 @@ Qed. (** * Rational to the n-th power *) -Definition Qpower_positive (q:Q)(p:positive) : Q := +Definition Qpower_positive (q:Q)(p:positive) : Q := pow_pos Qmult q p. Add Morphism Qpower_positive with signature Qeq ==> @eq _ ==> Qeq as Qpower_positive_comp. diff --git a/theories/QArith/Qfield.v b/theories/QArith/Qfield.v index 5d548aea..9841ef89 100644 --- a/theories/QArith/Qfield.v +++ b/theories/QArith/Qfield.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Qfield.v 10739 2008-04-01 14:45:20Z herbelin $ i*) +(*i $Id: Qfield.v 11208 2008-07-04 16:57:46Z letouzey $ i*) Require Export Field. Require Export QArith_base. @@ -14,24 +14,9 @@ Require Import NArithRing. (** * field and ring tactics for rational numbers *) -Definition Qeq_bool (x y : Q) := - if Qeq_dec x y then true else false. - -Lemma Qeq_bool_correct : forall x y : Q, Qeq_bool x y = true -> x==y. -Proof. - intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto. - intros _ H; inversion H. -Qed. - -Lemma Qeq_bool_complete : forall x y : Q, x==y -> Qeq_bool x y = true. -Proof. - intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto. -Qed. - -Definition Qsft : field_theory 0 1 Qplus Qmult Qminus Qopp Qdiv Qinv Qeq. +Definition Qsrt : ring_theory 0 1 Qplus Qmult Qminus Qopp Qeq. Proof. constructor. - constructor. exact Qplus_0_l. exact Qplus_comm. exact Qplus_assoc. @@ -41,6 +26,12 @@ Proof. exact Qmult_plus_distr_l. reflexivity. exact Qplus_opp_r. +Qed. + +Definition Qsft : field_theory 0 1 Qplus Qmult Qminus Qopp Qdiv Qinv Qeq. +Proof. + constructor. + exact Qsrt. discriminate. reflexivity. intros p Hp. @@ -83,8 +74,8 @@ Ltac Qpow_tac t := end. Add Field Qfield : Qsft - (decidable Qeq_bool_correct, - completeness Qeq_bool_complete, + (decidable Qeq_bool_eq, + completeness Qeq_eq_bool, constants [Qcst], power_tac Qpower_theory [Qpow_tac]). diff --git a/theories/Strings/String.v b/theories/Strings/String.v index 53260480..00f28a9c 100644 --- a/theories/Strings/String.v +++ b/theories/Strings/String.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: String.v 10855 2008-04-27 11:16:15Z msozeau $ *) +(* $Id: String.v 11206 2008-07-04 16:21:28Z letouzey $ *) (** Contributed by Laurent Théry (INRIA); Adapted to Coq V8 by the Coq Development Team *) @@ -225,7 +225,7 @@ Fixpoint index (n : nat) (s1 s2 : string) {struct s2} : option nat := end end. -(* Dirty trick to evaluate locally that prefix reduces itself *) +(* Dirty trick to avoid locally that prefix reduces itself *) Opaque prefix. (** If the result of [index] is [Some m], [s1] in [s2] at position [m] *) diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v index 34114d46..71befa4a 100644 --- a/theories/ZArith/Zbool.v +++ b/theories/ZArith/Zbool.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Zbool.v 10063 2007-08-08 14:21:03Z emakarov $ *) +(* $Id: Zbool.v 11208 2008-07-04 16:57:46Z letouzey $ *) Require Import BinInt. Require Import Zeven. @@ -16,7 +16,7 @@ Require Import ZArith_dec. Require Import Sumbool. Unset Boxed Definitions. - +Open Local Scope Z_scope. (** * Boolean operations from decidabilty of order *) (** The decidability of equality and order relations over @@ -37,80 +37,82 @@ Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x). (** * Boolean comparisons of binary integers *) Definition Zle_bool (x y:Z) := - match (x ?= y)%Z with + match x ?= y with | Gt => false | _ => true end. Definition Zge_bool (x y:Z) := - match (x ?= y)%Z with + match x ?= y with | Lt => false | _ => true end. Definition Zlt_bool (x y:Z) := - match (x ?= y)%Z with + match x ?= y with | Lt => true | _ => false end. Definition Zgt_bool (x y:Z) := - match (x ?= y)%Z with + match x ?= y with | Gt => true | _ => false end. Definition Zeq_bool (x y:Z) := - match (x ?= y)%Z with + match x ?= y with | Eq => true | _ => false end. Definition Zneq_bool (x y:Z) := - match (x ?= y)%Z with + match x ?= y with | Eq => false | _ => true end. +(** Properties in term of [if ... then ... else ...] *) + Lemma Zle_cases : - forall n m:Z, if Zle_bool n m then (n <= m)%Z else (n > m)%Z. + forall n m:Z, if Zle_bool n m then (n <= m) else (n > m). Proof. intros x y; unfold Zle_bool, Zle, Zgt in |- *. - case (x ?= y)%Z; auto; discriminate. + case (x ?= y); auto; discriminate. Qed. Lemma Zlt_cases : - forall n m:Z, if Zlt_bool n m then (n < m)%Z else (n >= m)%Z. + forall n m:Z, if Zlt_bool n m then (n < m) else (n >= m). Proof. intros x y; unfold Zlt_bool, Zlt, Zge in |- *. - case (x ?= y)%Z; auto; discriminate. + case (x ?= y); auto; discriminate. Qed. Lemma Zge_cases : - forall n m:Z, if Zge_bool n m then (n >= m)%Z else (n < m)%Z. + forall n m:Z, if Zge_bool n m then (n >= m) else (n < m). Proof. intros x y; unfold Zge_bool, Zge, Zlt in |- *. - case (x ?= y)%Z; auto; discriminate. + case (x ?= y); auto; discriminate. Qed. Lemma Zgt_cases : - forall n m:Z, if Zgt_bool n m then (n > m)%Z else (n <= m)%Z. + forall n m:Z, if Zgt_bool n m then (n > m) else (n <= m). Proof. intros x y; unfold Zgt_bool, Zgt, Zle in |- *. - case (x ?= y)%Z; auto; discriminate. + case (x ?= y); auto; discriminate. Qed. (** Lemmas on [Zle_bool] used in contrib/graphs *) -Lemma Zle_bool_imp_le : forall n m:Z, Zle_bool n m = true -> (n <= m)%Z. +Lemma Zle_bool_imp_le : forall n m:Z, Zle_bool n m = true -> (n <= m). Proof. unfold Zle_bool, Zle in |- *. intros x y. unfold not in |- *. - case (x ?= y)%Z; intros; discriminate. + case (x ?= y); intros; discriminate. Qed. -Lemma Zle_imp_le_bool : forall n m:Z, (n <= m)%Z -> Zle_bool n m = true. +Lemma Zle_imp_le_bool : forall n m:Z, (n <= m) -> Zle_bool n m = true. Proof. - unfold Zle, Zle_bool in |- *. intros x y. case (x ?= y)%Z; trivial. intro. elim (H (refl_equal _)). + unfold Zle, Zle_bool in |- *. intros x y. case (x ?= y); trivial. intro. elim (H (refl_equal _)). Qed. Lemma Zle_bool_refl : forall n:Z, Zle_bool n n = true. @@ -136,8 +138,8 @@ Qed. Definition Zle_bool_total : forall x y:Z, {Zle_bool x y = true} + {Zle_bool y x = true}. Proof. - intros x y; intros. unfold Zle_bool in |- *. cut ((x ?= y)%Z = Gt <-> (y ?= x)%Z = Lt). - case (x ?= y)%Z. left. reflexivity. + intros x y; intros. unfold Zle_bool in |- *. cut ((x ?= y) = Gt <-> (y ?= x) = Lt). + case (x ?= y). left. reflexivity. left. reflexivity. right. rewrite (proj1 H (refl_equal _)). reflexivity. apply Zcompare_Gt_Lt_antisym. @@ -159,39 +161,40 @@ Qed. Lemma Zone_min_pos : forall n:Z, Zle_bool n 0 = false -> Zle_bool 1 n = true. Proof. - intros x; intros. apply Zle_imp_le_bool. change (Zsucc 0 <= x)%Z in |- *. apply Zgt_le_succ. generalize H. - unfold Zle_bool, Zgt in |- *. case (x ?= 0)%Z. intro H0. discriminate H0. + intros x; intros. apply Zle_imp_le_bool. change (Zsucc 0 <= x) in |- *. apply Zgt_le_succ. generalize H. + unfold Zle_bool, Zgt in |- *. case (x ?= 0). intro H0. discriminate H0. intro H0. discriminate H0. reflexivity. Qed. +(** Properties in term of [iff] *) -Lemma Zle_is_le_bool : forall n m:Z, (n <= m)%Z <-> Zle_bool n m = true. +Lemma Zle_is_le_bool : forall n m:Z, (n <= m) <-> Zle_bool n m = true. Proof. intros. split. intro. apply Zle_imp_le_bool. assumption. intro. apply Zle_bool_imp_le. assumption. Qed. -Lemma Zge_is_le_bool : forall n m:Z, (n >= m)%Z <-> Zle_bool m n = true. +Lemma Zge_is_le_bool : forall n m:Z, (n >= m) <-> Zle_bool m n = true. Proof. intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption. intro. apply Zle_ge. apply Zle_bool_imp_le. assumption. Qed. -Lemma Zlt_is_lt_bool : forall n m:Z, (n < m)%Z <-> Zlt_bool n m = true. +Lemma Zlt_is_lt_bool : forall n m:Z, (n < m) <-> Zlt_bool n m = true. Proof. intros n m; unfold Zlt_bool, Zlt. -destruct (n ?= m)%Z; simpl; split; now intro. +destruct (n ?= m); simpl; split; now intro. Qed. -Lemma Zgt_is_gt_bool : forall n m:Z, (n > m)%Z <-> Zgt_bool n m = true. +Lemma Zgt_is_gt_bool : forall n m:Z, (n > m) <-> Zgt_bool n m = true. Proof. intros n m; unfold Zgt_bool, Zgt. -destruct (n ?= m)%Z; simpl; split; now intro. +destruct (n ?= m); simpl; split; now intro. Qed. Lemma Zlt_is_le_bool : - forall n m:Z, (n < m)%Z <-> Zle_bool n (m - 1) = true. + forall n m:Z, (n < m) <-> Zle_bool n (m - 1) = true. Proof. intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H. assumption. @@ -199,9 +202,29 @@ Proof. Qed. Lemma Zgt_is_le_bool : - forall n m:Z, (n > m)%Z <-> Zle_bool m (n - 1) = true. + forall n m:Z, (n > m) <-> Zle_bool m (n - 1) = true. Proof. - intros x y. apply iff_trans with (y < x)%Z. split. exact (Zgt_lt x y). + intros x y. apply iff_trans with (y < x). split. exact (Zgt_lt x y). exact (Zlt_gt y x). exact (Zlt_is_le_bool y x). Qed. + +Lemma Zeq_is_eq_bool : forall x y, x = y <-> Zeq_bool x y = true. +Proof. + intros; unfold Zeq_bool. + generalize (Zcompare_Eq_iff_eq x y); destruct Zcompare; intuition; + try discriminate. +Qed. + +Lemma Zeq_bool_eq : forall x y, Zeq_bool x y = true -> x = y. +Proof. + intros x y H; apply <- Zeq_is_eq_bool; auto. +Qed. + +Lemma Zeq_bool_neq : forall x y, Zeq_bool x y = false -> x <> y. +Proof. + unfold Zeq_bool; red ; intros; subst. + rewrite Zcompare_refl in H. + discriminate. +Qed. + diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v index 6c5b07d2..8244d4ce 100644 --- a/theories/ZArith/Zcompare.v +++ b/theories/ZArith/Zcompare.v @@ -40,6 +40,15 @@ Proof. | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ]. Qed. +Ltac destr_zcompare := + match goal with |- context [Zcompare ?x ?y] => + let H := fresh "H" in + case_eq (Zcompare x y); intro H; + [generalize (Zcompare_Eq_eq _ _ H); clear H; intro H | + change (x<y)%Z in H | + change (x>y)%Z in H ] + end. + Lemma Zcompare_Eq_iff_eq : forall n m:Z, (n ?= m) = Eq <-> n = m. Proof. intros x y; split; intro E; diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index e77475e0..9be372a3 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Znumtheory.v 10295 2007-11-06 22:46:21Z letouzey $ i*) +(*i $Id: Znumtheory.v 11282 2008-07-28 11:51:53Z msozeau $ i*) Require Import ZArith_base. Require Import ZArithRing. @@ -522,7 +522,7 @@ Lemma Zis_gcd_mult : forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d). Proof. intros a b c d; simple induction 1; constructor; intuition. - elim (Zis_gcd_bezout a b d H); intros. + elim (Zis_gcd_bezout a b d H). intros. elim H3; intros. elim H4; intros. apply Zdivide_intro with (u * q + v * q0). |